* obsoleted by files in the normal compiler dir

compiler/new/Makefile

@@ -1,1508 +0,0 @@
-#
-# Don't edit, this file is generated by FPCMake Version 1.1 [2002/08/01]
-#
-default: all
-MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx
-override PATH:=$(subst \,/,$(PATH))
-ifeq ($(findstring ;,$(PATH)),)
-inUnix=1
-SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
-else
-SEARCHPATH:=$(subst ;, ,$(PATH))
-endif
-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 cygwin,$(MACHTYPE)),)
-inCygWin=1
-endif
-endif
-ifeq ($(OS_TARGET),freebsd)
-BSDhier=1
-endif
-ifeq ($(OS_TARGET),netbsd)
-BSDhier=1
-endif
-ifeq ($(OS_TARGET),openbsd)
-BSDhier=1
-endif
-ifdef inUnix
-BATCHEXT=.sh
-else
-ifdef inOS2
-BATCHEXT=.cmd
-else
-BATCHEXT=.bat
-endif
-endif
-ifdef inUnix
-PATHSEP=/
-else
-PATHSEP:=$(subst /,\,/)
-endif
-ifdef PWD
-BASEDIR:=$(subst \,/,$(shell $(PWD)))
-ifdef inCygWin
-ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
-BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
-BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
-BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
-endif
-endif
-else
-BASEDIR=.
-endif
-ifdef inOS2
-ifndef ECHO
-ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(ECHO),)
-ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(ECHO),)
-ECHO=echo
-else
-ECHO:=$(firstword $(ECHO))
-endif
-else
-ECHO:=$(firstword $(ECHO))
-endif
-endif
-export ECHO
-endif
-override DEFAULT_FPCDIR=../..
-ifndef FPC
-ifdef PP
-FPC=$(PP)
-endif
-endif
-ifndef FPC
-FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
-ifneq ($(FPCPROG),)
-FPCPROG:=$(firstword $(FPCPROG))
-FPC:=$(shell $(FPCPROG) -PB)
-ifneq ($(findstring Error,$(FPC)),)
-override FPC=ppc386
-endif
-else
-override FPC=ppc386
-endif
-endif
-override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
-override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
-ifndef FPC_VERSION
-FPC_VERSION:=$(shell $(FPC) -iV)
-endif
-export FPC FPC_VERSION
-unexport CHECKDEPEND ALLDEPENDENCIES
-ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
-COMPILERINFO:=$(shell $(FPC) -iSP -iTP -iSO -iTO)
-ifndef CPU_SOURCE
-CPU_SOURCE:=$(word 1,$(COMPILERINFO))
-endif
-ifndef CPU_TARGET
-CPU_TARGET:=$(word 2,$(COMPILERINFO))
-endif
-ifndef OS_SOURCE
-OS_SOURCE:=$(word 3,$(COMPILERINFO))
-endif
-ifndef OS_TARGET
-OS_TARGET:=$(word 4,$(COMPILERINFO))
-endif
-else
-ifndef CPU_SOURCE
-CPU_SOURCE:=$(shell $(FPC) -iSP)
-endif
-ifndef CPU_TARGET
-CPU_TARGET:=$(shell $(FPC) -iTP)
-endif
-ifndef OS_SOURCE
-OS_SOURCE:=$(shell $(FPC) -iSO)
-endif
-ifndef OS_TARGET
-OS_TARGET:=$(shell $(FPC) -iTO)
-endif
-endif
-FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
-FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
-ifneq ($(FULL_TARGET),$(FULL_SOURCE))
-CROSSCOMPILE=1
-endif
-ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
-ifeq ($(findstring $(OS_TARGET),$(MAKEFILETARGETS)),)
-$(error The Makefile doesn't support target $(OS_TARGET), please run fpcmake first)
-endif
-endif
-export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE 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=c:/pp
-endif
-endif
-endif
-endif
-ifndef CROSSDIR
-CROSSDIR:=$(FPCDIR)/cross/$(FULL_TARGET)
-endif
-ifndef CROSSTARGETDIR
-CROSSTARGETDIR=$(CROSSDIR)/$(FULL_TARGET)
-endif
-ifdef CROSSCOMPILE
-UNITSDIR:=$(wildcard $(CROSSTARGETDIR)/units)
-ifeq ($(UNITSDIR),)
-UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
-endif
-else
-UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
-endif
-PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
-override PACKAGE_NAME=fpcompiler
-override PACKAGE_VERSION=1.1
-unexport OS_SOURCE FPC_VERSION
-OLDDIR=..
-ifdef ALPHA
-CPU_TARGET=alpha
-endif
-ifdef POWERPC
-CPU_TARGET=powerpc
-endif
-ifdef M68K
-CPU_TARGET=m68k
-endif
-ifdef I386
-CPU_TARGET=i386
-endif
-UTILSDIR=$(OLDDIR)/../utils
-COMPILERUTILSDIR=$(OLDDIR)/utils
-ifndef FPCLANG
-FPCLANG=e
-endif
-ifndef LOCALDEF
-LOCALDEF=
-endif
-ifndef LOCALOPT
-LOCALOPT=$(OPT)
-endif
-ifndef RTLOPTS
-RTLOPTS=$(OPT)
-endif
-MSGFILES=$(wildcard $(OLDDIR)/error*.msg)
-ifeq ($(CPU_TARGET),i386)
-CPUSUF=386
-endif
-ifeq ($(CPU_TARGET),alpha)
-CPUSUF=axp
-endif
-ifeq ($(CPU_TARGET),m68k)
-CPUSUF=68k
-endif
-ifeq ($(CPU_TARGET),powerpc)
-CPUSUF=ppc
-endif
-ifeq ($(OS_TARGET),linux)
-ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
-override LOCALDEF+=-dUNIX
-endif
-endif
-ifeq ($(OS_TARGET),freebsd)
-ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
-override LOCALDEF+=-dUNIX
-endif
-endif
-MSGFILE=$(OLDDIR)/error$(FPCLANG).msg
-override LOCALDEF+=-dGDB -dBROWSERLOG -dNEWCG
-ifeq ($(CPU_TARGET),i386)
-override LOCALDEF+=-dSUPPORT_MMX
-endif
-override LOCALOPT+=$(LOCALDEF)
-override FPCOPT:=$(LOCALOPT)
-override COMPILER_INCLUDEDIR+=$(OLDDIR)/$(CPU_TARGET) $(OLDDIR)
-override COMPILER_UNITDIR+=$(OLDDIR)/$(CPU_TARGET)
-override COMPILER_TARGETDIR+=.
-ifdef REQUIRE_UNITSDIR
-override UNITSDIR+=$(REQUIRE_UNITSDIR)
-endif
-ifdef REQUIRE_PACKAGESDIR
-override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
-endif
-ifdef ZIPINSTALL
-ifeq ($(OS_TARGET),linux)
-UNIXINSTALLDIR=1
-endif
-ifeq ($(OS_TARGET),freebsd)
-UNIXINSTALLDIR=1
-endif
-ifeq ($(OS_TARGET),netbsd)
-UNIXINSTALLDIR=1
-endif
-ifeq ($(OS_TARGET),openbsd)
-UNIXINSTALLDIR=1
-endif
-ifeq ($(OS_TARGET),sunos)
-UNIXINSTALLDIR=1
-endif
-ifeq ($(OS_TARGET),qnx)
-UNIXINSTALLDIR=1
-endif
-else
-ifeq ($(OS_SOURCE),linux)
-UNIXINSTALLDIR=1
-endif
-ifeq ($(OS_SOURCE),freebsd)
-UNIXINSTALLDIR=1
-endif
-ifeq ($(OS_SOURCE),netbsd)
-UNIXINSTALLDIR=1
-endif
-ifeq ($(OS_SOURCE),openbsd)
-UNIXINSTALLDIR=1
-endif
-ifeq ($(OS_TARGET),sunos)
-UNIXINSTALLDIR=1
-endif
-ifeq ($(OS_TARGET),qnx)
-UNIXINSTALLDIR=1
-endif
-endif
-ifndef INSTALL_PREFIX
-ifdef PREFIX
-INSTALL_PREFIX=$(PREFIX)
-endif
-endif
-ifndef INSTALL_PREFIX
-ifdef UNIXINSTALLDIR
-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 INSTALL_BASEDIR
-ifdef UNIXINSTALLDIR
-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 UNIXINSTALLDIR
-INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
-else
-INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
-ifdef INSTALL_FPCPACKAGE
-INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(OS_TARGET)
-endif
-endif
-endif
-ifndef INSTALL_UNITDIR
-ifdef CROSSCOMPILE
-INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/cross/$(FULL_TARGET)/units
-else
-INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(OS_TARGET)
-endif
-ifdef INSTALL_FPCPACKAGE
-ifdef PACKAGE_NAME
-INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
-endif
-endif
-endif
-ifndef INSTALL_LIBDIR
-ifdef UNIXINSTALLDIR
-INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
-else
-INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
-endif
-endif
-ifndef INSTALL_SOURCEDIR
-ifdef UNIXINSTALLDIR
-ifdef BSDhier
-SRCPREFIXDIR=share/src
-else
-SRCPREFIXDIR=src
-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 UNIXINSTALLDIR
-ifdef BSDhier
-DOCPREFIXDIR=share/doc
-else
-DOCPREFIXDIR=doc
-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 UNIXINSTALLDIR
-ifdef INSTALL_FPCPACKAGE
-ifdef BSDhier
-INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
-else
-INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
-endif
-else
-ifdef BSDhier
-INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
-else
-INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
-endif
-endif
-else
-ifdef INSTALL_FPCPACKAGE
-INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
-else
-INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
-endif
-endif
-endif
-ifndef INSTALL_DATADIR
-INSTALL_DATADIR=$(INSTALL_BASEDIR)
-endif
-ifdef CROSSCOMPILE
-ifndef CROSSBINDIR
-CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(FULL_SOURCE))
-ifeq ($(CROSSBINDIR),)
-CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(FULL_TARGET)/bin/$(FULL_SOURCE))
-endif
-endif
-else
-CROSSBINDIR=
-endif
-LOADEREXT=.as
-EXEEXT=.exe
-PPLEXT=.ppl
-PPUEXT=.ppu
-OEXT=.o
-ASMEXT=.s
-SMARTEXT=.sl
-STATICLIBEXT=.a
-SHAREDLIBEXT=.so
-STATICLIBPREFIX=libp
-RSTEXT=.rst
-FPCMADE=fpcmade
-ifeq ($(OS_TARGET),go32v1)
-PPUEXT=.pp1
-OEXT=.o1
-ASMEXT=.s1
-SMARTEXT=.sl1
-STATICLIBEXT=.a1
-SHAREDLIBEXT=.so1
-STATICLIBPREFIX=
-FPCMADE=fpcmade.v1
-PACKAGESUFFIX=v1
-endif
-ifeq ($(OS_TARGET),go32v2)
-STATICLIBPREFIX=
-FPCMADE=fpcmade.dos
-ZIPSUFFIX=go32
-endif
-ifeq ($(OS_TARGET),linux)
-EXEEXT=
-HASSHAREDLIB=1
-FPCMADE=fpcmade.lnx
-ZIPSUFFIX=linux
-endif
-ifeq ($(OS_TARGET),freebsd)
-EXEEXT=
-HASSHAREDLIB=1
-FPCMADE=fpcmade.freebsd
-ZIPSUFFIX=freebsd
-endif
-ifeq ($(OS_TARGET),netbsd)
-EXEEXT=
-HASSHAREDLIB=1
-FPCMADE=fpcmade.netbsd
-ZIPSUFFIX=netbsd
-endif
-ifeq ($(OS_TARGET),openbsd)
-EXEEXT=
-HASSHAREDLIB=1
-FPCMADE=fpcmade.openbsd
-ZIPSUFFIX=openbsd
-endif
-ifeq ($(OS_TARGET),win32)
-PPUEXT=.ppw
-OEXT=.ow
-ASMEXT=.sw
-SMARTEXT=.slw
-STATICLIBEXT=.aw
-SHAREDLIBEXT=.dll
-FPCMADE=fpcmade.w32
-ZIPSUFFIX=w32
-endif
-ifeq ($(OS_TARGET),os2)
-PPUEXT=.ppo
-ASMEXT=.so2
-OEXT=.oo2
-AOUTEXT=.out
-SMARTEXT=.sl2
-STATICLIBPREFIX=
-STATICLIBEXT=.ao2
-SHAREDLIBEXT=.dll
-FPCMADE=fpcmade.os2
-ZIPSUFFIX=emx
-ECHO=echo
-endif
-ifeq ($(OS_TARGET),amiga)
-EXEEXT=
-PPUEXT=.ppu
-ASMEXT=.asm
-OEXT=.o
-SMARTEXT=.sl
-STATICLIBEXT=.a
-SHAREDLIBEXT=.library
-FPCMADE=fpcmade.amg
-endif
-ifeq ($(OS_TARGET),atari)
-PPUEXT=.ppu
-ASMEXT=.s
-OEXT=.o
-SMARTEXT=.sl
-STATICLIBEXT=.a
-EXEEXT=.ttp
-FPCMADE=fpcmade.ata
-endif
-ifeq ($(OS_TARGET),beos)
-PPUEXT=.ppu
-ASMEXT=.s
-OEXT=.o
-SMARTEXT=.sl
-STATICLIBEXT=.a
-EXEEXT=
-FPCMADE=fpcmade.be
-ZIPSUFFIX=be
-endif
-ifeq ($(OS_TARGET),sunos)
-PPUEXT=.ppu
-ASMEXT=.s
-OEXT=.o
-SMARTEXT=.sl
-STATICLIBEXT=.a
-EXEEXT=
-FPCMADE=fpcmade.sun
-ZIPSUFFIX=sun
-endif
-ifeq ($(OS_TARGET),qnx)
-PPUEXT=.ppu
-ASMEXT=.s
-OEXT=.o
-SMARTEXT=.sl
-STATICLIBEXT=.a
-EXEEXT=
-FPCMADE=fpcmade.qnx
-ZIPSUFFIX=qnx
-endif
-ifeq ($(OS_TARGET),netware)
-STATICLIBPREFIX=
-PPUEXT=.ppn
-OEXT=.on
-ASMEXT=.s
-SMARTEXT=.sl
-STATICLIBEXT=.a
-SHAREDLIBEXT=.nlm
-FPCMADE=fpcmade.nw
-ZIPSUFFIX=nw
-EXEEXT=.nlm
-endif
-ifndef ECHO
-ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(ECHO),)
-ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(ECHO),)
-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=
-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=
-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=
-else
-CPPROG:=$(firstword $(CPPROG))
-endif
-endif
-export CPPROG
-ifndef RMPROG
-RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(RMPROG),)
-RMPROG=
-else
-RMPROG:=$(firstword $(RMPROG))
-endif
-endif
-export RMPROG
-ifndef MVPROG
-MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(MVPROG),)
-MVPROG=
-else
-MVPROG:=$(firstword $(MVPROG))
-endif
-endif
-export MVPROG
-ifndef ECHOREDIR
-ECHOREDIR:=$(subst /,$(PATHSEP),$(ECHO))
-endif
-ifndef COPY
-COPY:=$(CPPROG) -fp
-endif
-ifndef COPYTREE
-COPYTREE:=$(CPPROG) -rfp
-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=
-else
-PPUMOVE:=$(firstword $(PPUMOVE))
-endif
-endif
-export PPUMOVE
-ifndef FPCMAKE
-FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(FPCMAKE),)
-FPCMAKE=
-else
-FPCMAKE:=$(firstword $(FPCMAKE))
-endif
-endif
-export FPCMAKE
-ifndef ZIPPROG
-ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(ZIPPROG),)
-ZIPPROG=
-else
-ZIPPROG:=$(firstword $(ZIPPROG))
-endif
-endif
-export ZIPPROG
-ifndef TARPROG
-TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(TARPROG),)
-TARPROG=
-else
-TARPROG:=$(firstword $(TARPROG))
-endif
-endif
-export TARPROG
-ASNAME=as
-LDNAME=ld
-ARNAME=ar
-RCNAME=rc
-ifeq ($(OS_TARGET),win32)
-ASNAME=asw
-LDNAME=ldw
-ARNAME=arw
-endif
-ifndef ASPROG
-ifdef CROSSBINDIR
-ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
-else
-ASPROG=$(ASNAME)
-endif
-endif
-ifndef LDPROG
-ifdef CROSSBINDIR
-LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT)
-else
-LDPROG=$(LDNAME)
-endif
-endif
-ifndef RCPROG
-ifdef CROSSBINDIR
-RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT)
-else
-RCPROG=$(RCNAME)
-endif
-endif
-ifndef ARPROG
-ifdef CROSSBINDIR
-ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT)
-else
-ARPROG=$(ARNAME)
-endif
-endif
-AS=$(ASPROG)
-LD=$(LDPROG)
-RC=$(RCPROG)
-AR=$(ARPROG)
-PPAS=ppas$(BATCHEXT)
-ifdef inUnix
-LDCONFIG=ldconfig
-else
-LDCONFIG=
-endif
-ifdef DATE
-DATESTR:=$(shell $(DATE) +%Y%m%d)
-else
-DATESTR=
-endif
-ifndef UPXPROG
-ifeq ($(OS_TARGET),go32v2)
-UPXPROG:=1
-endif
-ifeq ($(OS_TARGET),win32)
-UPXPROG:=1
-endif
-ifdef UPXPROG
-UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(UPXPROG),)
-UPXPROG=
-else
-UPXPROG:=$(firstword $(UPXPROG))
-endif
-else
-UPXPROG=
-endif
-endif
-export UPXPROG
-ZIPOPT=-9
-ZIPEXT=.zip
-ifeq ($(USETAR),bz2)
-TAROPT=vI
-TAREXT=.tar.bz2
-else
-TAROPT=vz
-TAREXT=.tar.gz
-endif
-override REQUIRE_PACKAGES=rtl
-ifeq ($(OS_TARGET),linux)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(OS_TARGET),go32v2)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(OS_TARGET),win32)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(OS_TARGET),os2)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(OS_TARGET),freebsd)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(OS_TARGET),beos)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(OS_TARGET),netbsd)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(OS_TARGET),amiga)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(OS_TARGET),atari)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(OS_TARGET),sunos)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(OS_TARGET),qnx)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(OS_TARGET),netware)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(OS_TARGET),openbsd)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(OS_TARGET),wdosx)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifdef REQUIRE_PACKAGES_RTL
-PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/$(OS_TARGET)/Makefile.fpc,$(PACKAGESDIR))))))
-ifneq ($(PACKAGEDIR_RTL),)
-ifneq ($(wildcard $(PACKAGEDIR_RTL)/$(OS_TARGET)),)
-UNITDIR_RTL=$(PACKAGEDIR_RTL)/$(OS_TARGET)
-else
-UNITDIR_RTL=$(PACKAGEDIR_RTL)
-endif
-ifdef CHECKDEPEND
-$(PACKAGEDIR_RTL)/$(FPCMADE):
-	$(MAKE) -C $(PACKAGEDIR_RTL) $(FPCMADE)
-override ALLDEPENDENCIES+=$(PACKAGEDIR_RTL)/$(FPCMADE)
-endif
-else
-PACKAGEDIR_RTL=
-UNITDIR_RTL:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /rtl/Package.fpc,$(UNITSDIR)))))
-ifneq ($(UNITDIR_RTL),)
-UNITDIR_RTL:=$(firstword $(UNITDIR_RTL))
-else
-UNITDIR_RTL=
-endif
-endif
-ifdef UNITDIR_RTL
-override COMPILER_UNITDIR+=$(UNITDIR_RTL)
-endif
-endif
-ifndef NOCPUDEF
-override FPCOPTDEF=$(CPU_TARGET)
-endif
-ifneq ($(OS_TARGET),$(OS_SOURCE))
-override FPCOPT+=-T$(OS_TARGET)
-endif
-ifeq ($(OS_SOURCE),openbsd)
-override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
-endif
-ifdef UNITDIR
-override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
-endif
-ifdef LIBDIR
-override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
-endif
-ifdef OBJDIR
-override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
-endif
-ifdef INCDIR
-override FPCOPT+=$(addprefix -Fi,$(INCDIR))
-endif
-ifdef LINKSMART
-override FPCOPT+=-XX
-endif
-ifdef CREATESMART
-override FPCOPT+=-CX
-endif
-ifdef DEBUG
-override FPCOPT+=-gl
-override FPCOPTDEF+=DEBUG
-endif
-ifdef RELEASE
-ifeq ($(CPU_TARGET),i386)
-FPCCPUOPT:=-OG2p3
-else
-FPCCPUOPT:=
-endif
-override FPCOPT+=-Xs $(FPCCPUOPT) -n
-override FPCOPTDEF+=RELEASE
-endif
-ifdef STRIP
-override FPCOPT+=-Xs
-endif
-ifdef OPTIMIZE
-ifeq ($(CPU_TARGET),i386)
-override FPCOPT+=-OG2p3
-endif
-endif
-ifdef VERBOSE
-override FPCOPT+=-vwni
-endif
-ifdef COMPILER_OPTIONS
-override FPCOPT+=$(COMPILER_OPTIONS)
-endif
-ifdef COMPILER_UNITDIR
-override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
-endif
-ifdef COMPILER_LIBRARYDIR
-override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
-endif
-ifdef COMPILER_OBJECTDIR
-override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
-endif
-ifdef COMPILER_INCLUDEDIR
-override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
-endif
-ifdef CROSSBINDIR
-override FPCOPT+=-FD$(CROSSBINDIR)
-endif
-ifdef COMPILER_TARGETDIR
-override FPCOPT+=-FE$(COMPILER_TARGETDIR)
-ifeq ($(COMPILER_TARGETDIR),.)
-override TARGETDIRPREFIX=
-else
-override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
-endif
-endif
-ifdef COMPILER_UNITTARGETDIR
-override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
-ifeq ($(COMPILER_UNITTARGETDIR),.)
-override UNITTARGETDIRPREFIX=
-else
-override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/
-endif
-else
-ifdef COMPILER_TARGETDIR
-override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
-override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
-endif
-endif
-ifdef OPT
-override FPCOPT+=$(OPT)
-endif
-ifdef FPCOPTDEF
-override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
-endif
-ifdef CFGFILE
-override FPCOPT+=@$(CFGFILE)
-endif
-ifdef USEENV
-override FPCEXTCMD:=$(FPCOPT)
-override FPCOPT:=!FPCEXTCMD
-export FPCEXTCMD
-endif
-override COMPILER:=$(FPC) $(FPCOPT)
-ifeq (,$(findstring -s ,$(COMPILER)))
-EXECPPAS=
-else
-ifeq ($(OS_SOURCE),$(OS_TARGET))
-EXECPPAS:=@$(PPAS)
-endif
-endif
-ifdef TARGET_RSTS
-override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
-override CLEANRSTFILES+=$(RSTFILES)
-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)))
-override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPUFILES))
-override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPULINKFILES)))
-override INSTALL_CREATEPACKAGEFPC=1
-endif
-ifdef INSTALLEXEFILES
-override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(INSTALLEXEFILES))
-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$(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=$(ZIPPREFIX)$(PACKAGE_NAME)$(ZIPSUFFIX)
-endif
-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$(BATCHEXT))
-else
-ZIPPATHSEP=/
-endif
-ZIPCMD_CDPACK:=cd $(subst /,$(ZIPPATHSEP),$(PACKDIR))
-ZIPCMD_CDBASE:=cd $(subst /,$(ZIPPATHSEP),$(BASEDIR))
-ifdef USETAR
-ZIPDESTFILE:=$(DIST_DESTDIR)/$(ZIPNAME)$(TAREXT)
-ZIPCMD_ZIP:=$(TARPROG) cf$(TAROPT) $(ZIPDESTFILE) *
-else
-ZIPDESTFILE:=$(DIST_DESTDIR)/$(ZIPNAME)$(ZIPEXT)
-ZIPCMD_ZIP:=$(subst /,$(ZIPPATHSEP),$(ZIPPROG)) -Dr $(ZIPOPT) $(ZIPDESTFILE) *
-endif
-fpc_zipinstall:
-	$(MAKE) $(ZIPTARGET) INSTALL_PREFIX=$(PACKDIR) ZIPINSTALL=1
-	$(MKDIR) $(DIST_DESTDIR)
-	$(DEL) $(ZIPDESTFILE)
-ifdef USEZIPWRAPPER
-ifneq ($(ECHOREDIR),echo)
-	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDPACK))" > $(ZIPWRAPPER)
-	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_ZIP))" >> $(ZIPWRAPPER)
-	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDBASE))" >> $(ZIPWRAPPER)
-else
-	echo $(ZIPCMD_CDPACK) > $(ZIPWRAPPER)
-	echo $(ZIPCMD_ZIP) >> $(ZIPWRAPPER)
-	echo $(ZIPCMD_CDBASE) >> $(ZIPWRAPPER)
-endif
-ifdef inUnix
-	/bin/sh $(ZIPWRAPPER)
-else
-	$(ZIPWRAPPER)
-endif
-	$(DEL) $(ZIPWRAPPER)
-else
-	$(ZIPCMD_CDPACK) ; $(ZIPCMD_ZIP) ; $(ZIPCMD_CDBASE)
-endif
-	$(DELTREE) $(PACKDIR)
-fpc_zipsourceinstall:
-	$(MAKE) fpc_zipinstall ZIPTARGET=sourceinstall ZIPSUFFIX=src
-fpc_zipexampleinstall:
-ifdef HASEXAMPLES
-	$(MAKE) fpc_zipinstall ZIPTARGET=exampleinstall ZIPSUFFIX=exm
-endif
-fpc_zipdistinstall:
-	$(MAKE) fpc_zipinstall ZIPTARGET=distinstall
-.PHONY: fpc_clean fpc_cleanall fpc_distclean
-ifdef EXEFILES
-override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
-endif
-ifdef CLEAN_UNITS
-override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
-endif
-ifdef CLEANPPUFILES
-override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
-override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
-override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
-endif
-fpc_clean: $(CLEANTARGET)
-ifdef CLEANEXEFILES
-	-$(DEL) $(CLEANEXEFILES)
-endif
-ifdef CLEANPPUFILES
-	-$(DEL) $(CLEANPPUFILES)
-endif
-ifneq ($(CLEANPPULINKFILES),)
-	-$(DEL) $(CLEANPPULINKFILES)
-endif
-ifdef CLEANRSTFILES
-	-$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
-endif
-ifdef CLEAN_FILES
-	-$(DEL) $(CLEAN_FILES)
-endif
-ifdef LIB_NAME
-	-$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
-endif
-	-$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
-fpc_distclean: clean
-ifdef COMPILER_UNITTARGETDIR
-TARGETDIRCLEAN=fpc_clean
-endif
-fpc_cleanall: $(CLEANTARGET) $(TARGETDIRCLEAN)
-ifdef CLEANEXEFILES
-	-$(DEL) $(CLEANEXEFILES)
-endif
-	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
-	-$(DELTREE) *$(SMARTEXT)
-	-$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
-ifdef AOUTEXT
-	-$(DEL) *$(AOUTEXT)
-endif
-.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)
-	@$(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)  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)  ZipPrefix............ $(ZIPPREFIX)
-	@$(ECHO)  ZipSuffix............ $(ZIPSUFFIX)
-	@$(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 DIFF
-DIFF:=$(strip $(wildcard $(addsuffix /diff$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(DIFF),)
-DIFF=
-else
-DIFF:=$(firstword $(DIFF))
-endif
-endif
-export DIFF
-ifndef CMP
-CMP:=$(strip $(wildcard $(addsuffix /cmp$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(CMP),)
-CMP=
-else
-CMP:=$(firstword $(CMP))
-endif
-endif
-export CMP
-debug:
-smart:
-release:
-examples:
-shared:
-sourceinstall: fpc_sourceinstall
-exampleinstall: fpc_exampleinstall
-distinstall: fpc_distinstall
-zipinstall: fpc_zipinstall
-zipsourceinstall: fpc_zipsourceinstall
-zipexampleinstall: fpc_zipexampleinstall
-zipdistinstall: fpc_zipdistinstall
-cleanall:
-info: fpc_info
-makefiles: fpc_makefiles
-.PHONY: debug smart release examples shared sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall cleanall info makefiles
-ifneq ($(wildcard fpcmake.loc),)
-include fpcmake.loc
-endif
-ifeq ($(OS_TARGET),win32)
-ifdef CMP
-override DIFF:=$(CMP) -i138
-endif
-override COMPILER+=-XX
-endif
-ifdef DIFF
-ifdef OLDFPC
-DIFFRESULT:=$(shell $(DIFF) $(OLDFPC) $(FPC))
-else
-DIFFRESULT=Not equal
-endif
-else
-DIFFRESULT=No diff program
-endif
-FPCEXE=fpc$(EXEEXT)
-PPEXENAME=pp$(EXEEXT)
-EXENAME=ppc$(CPUSUF)$(EXEEXT)
-TEMPNAME=ppc$(EXEEXT)
-TEMPNAME1=ppc1$(EXEEXT)
-TEMPNAME2=ppc2$(EXEEXT)
-TEMPNAME3=ppc3$(EXEEXT)
-MAKEDEP=ppdep$(EXEEXT)
-MSG2INC=msg2inc$(EXEEXT)
-alpha:
-	$(MAKE) ALPHA=1 all
-i386:
-	$(MAKE) I386=1 all
-m68k:
-	$(MAKE) M68K=1 all
-powerpc:
-	$(MAKE) POWERPC=1 all
-all: $(EXENAME)
-fpcexe: $(FPCEXE)
-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)
-ifndef DIFFRESULT
-next :
-	@echo $(OLDFPC) and $(FPC) are equal
-	$(COPY) $(FPC) $(EXENAME)
-else
-next :
-	$(MAKE) execlean
-	$(MAKE) -C $(UNITDIR_RTL) clean
-	$(MAKE) -C $(UNITDIR_RTL) 'FPC=$(FPC)' 'OPT=$(RTLOPTS)'
-	$(MAKE) clean
-	$(MAKE) $(EXENAME)
-	$(MAKE) echotime
-endif
-clean : execlean fpc_cleanall
-ppuclean:
-	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
-execlean :
-	-$(DEL) fpc$(EXEEXT) ppc386$(EXEEXT) ppcaxp$(EXEEXT) ppc68k$(EXEEXT) ppcppc$(EXEEXT)
-distclean: clean
-	-$(DEL) $(TEMPNAME) $(TEMPNAME1) $(TEMPNAME2) $(TEMPNAME3) $(MSG2INC)
-$(MAKEDEP): $(UTILSDIR)/ppdep.pp
-	$(COMPILER) $(UTILSDIR)/ppdep.pp
-	$(COPY) $(UTILSDIR)/$(MAKEDEP) $(MAKEDEP)
-dependencies : $(MAKEDEP)
-	$(MAKEDEP) pp.pas $(FPCOPTDEF) $(LOCALDEF) '-F$$(COMPILER) $$(LOCALOPT)' > depend
-ifdef USEDEPEND
-include depend
-endif
-$(MSG2INC): $(COMPILERUTILSDIR)/msg2inc.pp
-	$(COMPILER) -FE. $(COMPILERUTILSDIR)/msg2inc.pp
-msgtxt.inc: $(MSGFILE)
-	$(MAKE) $(MSG2INC)
-	$(MSG2INC) $(MSGFILE) msg msg
-msg: msgtxt.inc
-ifndef COMPLETE
-$(EXENAME) : $(wildcard *.pas) $(wildcard *.inc) msg
-	$(COMPILER) pp.pas
-	$(EXECPPAS)
-	$(MOVE) $(PPEXENAME) $(EXENAME)
-else
-$(EXENAME) : $(wildcard *.pas) $(wildcard *.inc) msg
-	$(COMPILER) pp.pas
-	$(EXECPPAS)
-	$(COMPILER) pp.pas
-	$(EXECPPAS)
-	$(COMPILER) pp.pas
-	$(EXECPPAS)
-	$(MOVE) $(PPEXENAME) $(EXENAME)
-endif
-tokens.dat : $(wildcard *.pas) $(wildcard *.inc)
-	$(COMPILER) tokendat.pas
-	./tokendat
-remake: $(EXENAME)
-	$(MOVE) $(EXENAME) $(TEMPNAME)
-	$(MAKE) execlean
-	$(MAKE) -C $(UNITDIR_RTL) clean
-	$(MAKE) clean
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' all
-remake3: $(TEMPNAME3)
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OLDFPC=$(BASEDIR)/$(TEMPNAME2)' next
-	$(DIFF) $(TEMPNAME3) $(EXENAME)
-$(TEMPNAME1) : $(EXENAME)
-	-$(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) clean
-	$(MAKE) -C $(UNITDIR_RTL) clean
-	$(MAKE) -C $(UNITDIR_RTL) 'OPT=$(RTLOPTS)' all
-	$(MAKE) remake3
-	$(MAKE) echotime
-cycledep:
-	$(MAKE) cycle USEDEPEND=1
-cvstest:
-	$(MAKE) cycle 'LOCALOPT=-n -Se' 'RTLOPTS=-n -Se'
-.PHONY: quickinstall install installsym
-MSGINSTALLDIR=$(INSTALL_BASEDIR)/msg
-override FPCEXEFILE:=$(wildcard $(FPCEXE))
-override PPEXEFILE:=$(wildcard $(EXENAME))
-quickinstall:
-ifneq ($(FPCEXEFILE),)
-ifdef UPXPROG
-	-$(UPXPROG) $(FPCEXEFILE)
-endif
-	$(MKDIR) $(INSTALL_BINDIR)
-	$(INSTALLEXE) $(FPCEXEFILE) $(INSTALL_BINDIR)
-endif
-ifneq ($(PPEXEFILE),)
-ifdef UPXPROG
-	-$(UPXPROG) $(EXENAME)
-endif
-ifdef UNIXINSTALLDIR
-	$(MKDIR) $(INSTALL_BASEDIR)
-	$(INSTALLEXE) $(EXENAME) $(INSTALL_BASEDIR)
-else
-	$(MKDIR) $(INSTALL_BINDIR)
-	$(INSTALLEXE) $(EXENAME) $(INSTALL_BINDIR)
-endif
-endif
-install: quickinstall
-ifdef UNIXINSTALLDIR
-	$(MKDIR) $(INSTALL_BASEDIR)
-	$(INSTALLEXE) $(COMPILERUTILSDIR)/samplecfg $(INSTALL_BASEDIR)/samplecfg
-endif
-	$(MKDIR) $(MSGINSTALLDIR)
-	$(INSTALL) $(MSGFILES) $(MSGINSTALLDIR)
-installsymlink: install
-ifdef UNIXINSTALLDIR
-	$(MKDIR) $(INSTALL_BINDIR)
-	ln -sf $(INSTALL_BASEDIR)/ppc386 $(INSTALL_BINDIR)/ppc386
-endif
-.PHONY: rtl rtlclean rtlinstall
-rtl:
-	$(MAKE) -C $(UNITDIR_RTL) all
-rtlclean:
-	$(MAKE) -C $(UNITDIR_RTL) clean
-rtlinstall:
-	$(MAKE) -C $(UNITDIR_RTL) install
-localmake:=$(strip $(wildcard makefile.loc))
-ifdef localmake
-include ./$(localmake)
-endif

compiler/new/Makefile.fpc

@@ -1,396 +0,0 @@
-#
-#   Makefile.fpc for Free Pascal Compiler
-#
-
-[package]
-name=fpcompiler
-version=1.1
-
-[compiler]
-targetdir=.
-unitdir=$(OLDDIR)/$(CPU_TARGET)
-includedir=$(OLDDIR)/$(CPU_TARGET) $(OLDDIR)
-
-[require]
-packages=rtl
-tools=diff cmp
-
-[default]
-fpcdir=../..
-
-[prerules]
-# Don't export OS_SOURCE because it can change after the first compile
-unexport OS_SOURCE FPC_VERSION
-
-# Where is the 'old' compiler located
-OLDDIR=..
-
-# Allow ALPHA, POWERPC, M68K, I386 defines for target cpu
-ifdef ALPHA
-CPU_TARGET=alpha
-endif
-ifdef POWERPC
-CPU_TARGET=powerpc
-endif
-ifdef M68K
-CPU_TARGET=m68k
-endif
-ifdef I386
-CPU_TARGET=i386
-endif
-
-# RTL
-UTILSDIR=$(OLDDIR)/../utils
-
-# Utils used by compiler development/installation
-COMPILERUTILSDIR=$(OLDDIR)/utils
-
-# Default language for the compiler
-ifndef FPCLANG
-FPCLANG=e
-endif
-
-# Local defines for the compiler only
-ifndef LOCALDEF
-LOCALDEF=
-endif
-
-# Local options for the compiler only
-ifndef LOCALOPT
-LOCALOPT=$(OPT)
-endif
-
-# Options for the RTL only when cycling
-ifndef RTLOPTS
-RTLOPTS=$(OPT)
-endif
-
-# Message files
-MSGFILES=$(wildcard $(OLDDIR)/error*.msg)
-
-# ppcSUFFIX
-ifeq ($(CPU_TARGET),i386)
-CPUSUF=386
-endif
-ifeq ($(CPU_TARGET),alpha)
-CPUSUF=axp
-endif
-ifeq ($(CPU_TARGET),m68k)
-CPUSUF=68k
-endif
-ifeq ($(CPU_TARGET),powerpc)
-CPUSUF=ppc
-endif
-
-# Define Unix also for Linux
-ifeq ($(OS_TARGET),linux)
-ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
-override LOCALDEF+=-dUNIX
-endif
-endif
-
-ifeq ($(OS_TARGET),freebsd)
-ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
-override LOCALDEF+=-dUNIX
-endif
-endif
-
-# Default message file
-MSGFILE=$(OLDDIR)/error$(FPCLANG).msg
-
-# set correct defines (-d$(CPU_TARGET) is automaticly added in makefile.fpc)
-override LOCALDEF+=-dGDB -dBROWSERLOG -dNEWCG
-
-# i386 specific
-ifeq ($(CPU_TARGET),i386)
-# also insert MMX support
-override LOCALDEF+=-dSUPPORT_MMX
-endif
-
-override LOCALOPT+=$(LOCALDEF)
-
-override FPCOPT:=$(LOCALOPT)
-
-
-[rules]
-#####################################################################
-# Setup Targets
-#####################################################################
-
-ifeq ($(OS_TARGET),win32)
-ifdef CMP
-override DIFF:=$(CMP) -i138
-endif
-# force try to smartlink for windows unit
-override COMPILER+=-XX
-endif
-
-# Used to avoid unnecessary steps in remake3
-ifdef DIFF
-ifdef OLDFPC
-DIFFRESULT:=$(shell $(DIFF) $(OLDFPC) $(FPC))
-else
-DIFFRESULT=Not equal
-endif
-else
-DIFFRESULT=No diff program
-endif
-
-
-#####################################################################
-# Setup os-independent filenames
-#####################################################################
-
-FPCEXE=fpc$(EXEEXT)
-PPEXENAME=pp$(EXEEXT)
-EXENAME=ppc$(CPUSUF)$(EXEEXT)
-TEMPNAME=ppc$(EXEEXT)
-TEMPNAME1=ppc1$(EXEEXT)
-TEMPNAME2=ppc2$(EXEEXT)
-TEMPNAME3=ppc3$(EXEEXT)
-MAKEDEP=ppdep$(EXEEXT)
-MSG2INC=msg2inc$(EXEEXT)
-
-
-#####################################################################
-# CPU targets
-#####################################################################
-
-alpha:
-        $(MAKE) ALPHA=1 all
-
-i386:
-        $(MAKE) I386=1 all
-
-m68k:
-        $(MAKE) M68K=1 all
-
-powerpc:
-        $(MAKE) POWERPC=1 all
-
-
-#####################################################################
-# Default makefile
-#####################################################################
-
-all: $(EXENAME)
-
-fpcexe: $(FPCEXE)
-
-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)
-
-ifndef DIFFRESULT
-next :
-        @echo $(OLDFPC) and $(FPC) are equal
-        $(COPY) $(FPC) $(EXENAME)
-else
-next :
-        $(MAKE) execlean
-        $(MAKE) -C $(UNITDIR_RTL) clean
-        $(MAKE) -C $(UNITDIR_RTL) 'FPC=$(FPC)' 'OPT=$(RTLOPTS)'
-        $(MAKE) clean
-        $(MAKE) $(EXENAME)
-        $(MAKE) echotime
-endif
-
-clean : execlean fpc_cleanall
-
-ppuclean:
-        -$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
-
-execlean :
-        -$(DEL) fpc$(EXEEXT) ppc386$(EXEEXT) ppcaxp$(EXEEXT) ppc68k$(EXEEXT) ppcppc$(EXEEXT)
-
-distclean: clean
-        -$(DEL) $(TEMPNAME) $(TEMPNAME1) $(TEMPNAME2) $(TEMPNAME3) $(MSG2INC)
-
-
-#####################################################################
-# Include depencies
-#####################################################################
-
-$(MAKEDEP): $(UTILSDIR)/ppdep.pp
-        $(COMPILER) $(UTILSDIR)/ppdep.pp
-        $(COPY) $(UTILSDIR)/$(MAKEDEP) $(MAKEDEP)
-
-dependencies : $(MAKEDEP)
-        $(MAKEDEP) pp.pas $(FPCOPTDEF) $(LOCALDEF) '-F$$(COMPILER) $$(LOCALOPT)' > depend
-
-ifdef USEDEPEND
-
-include depend
-
-endif
-
-
-#####################################################################
-# Make targets
-#####################################################################
-
-$(MSG2INC): $(COMPILERUTILSDIR)/msg2inc.pp
-        $(COMPILER) -FE. $(COMPILERUTILSDIR)/msg2inc.pp
-
-# The msgtxt.inc only depends on the error?.msg file, not on msg2inc,
-# because that one will be new almost everytime
-msgtxt.inc: $(MSGFILE)
-        $(MAKE) $(MSG2INC)
-        $(MSG2INC) $(MSGFILE) msg msg
-
-msg: msgtxt.inc
-
-# Make only the compiler
-ifndef COMPLETE
-$(EXENAME) : $(wildcard *.pas) $(wildcard *.inc) msg
-        $(COMPILER) pp.pas
-        $(EXECPPAS)
-        $(MOVE) $(PPEXENAME) $(EXENAME)
-else
-$(EXENAME) : $(wildcard *.pas) $(wildcard *.inc) msg
-        $(COMPILER) pp.pas
-        $(EXECPPAS)
-        $(COMPILER) pp.pas
-        $(EXECPPAS)
-        $(COMPILER) pp.pas
-        $(EXECPPAS)
-        $(MOVE) $(PPEXENAME) $(EXENAME)
-endif
-
-tokens.dat : $(wildcard *.pas) $(wildcard *.inc)
-        $(COMPILER) tokendat.pas
-        ./tokendat
-
-# This target remakes the units with the currently made version
-remake: $(EXENAME)
-        $(MOVE) $(EXENAME) $(TEMPNAME)
-        $(MAKE) execlean
-        $(MAKE) -C $(UNITDIR_RTL) clean
-        $(MAKE) clean
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' all
-
-remake3: $(TEMPNAME3)
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OLDFPC=$(BASEDIR)/$(TEMPNAME2)' next
-        $(DIFF) $(TEMPNAME3) $(EXENAME)
-
-$(TEMPNAME1) : $(EXENAME)
-        -$(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) clean
-        $(MAKE) -C $(UNITDIR_RTL) clean
-        $(MAKE) -C $(UNITDIR_RTL) 'OPT=$(RTLOPTS)' all
-        $(MAKE) remake3
-        $(MAKE) echotime
-
-cycledep:
-        $(MAKE) cycle USEDEPEND=1
-
-cvstest:
-        $(MAKE) cycle 'LOCALOPT=-n -Se' 'RTLOPTS=-n -Se'
-
-
-#####################################################################
-# Installation
-#####################################################################
-
-.PHONY: quickinstall install installsym
-
-MSGINSTALLDIR=$(INSTALL_BASEDIR)/msg
-override FPCEXEFILE:=$(wildcard $(FPCEXE))
-override PPEXEFILE:=$(wildcard $(EXENAME))
-
-# This will only install the ppc386.exe, not the message files etc.
-quickinstall:
-# Install fpc.exe
-ifneq ($(FPCEXEFILE),)
-ifdef UPXPROG
-        -$(UPXPROG) $(FPCEXEFILE)
-endif
-        $(MKDIR) $(INSTALL_BINDIR)
-        $(INSTALLEXE) $(FPCEXEFILE) $(INSTALL_BINDIR)
-endif
-# Install ppc386.exe
-ifneq ($(PPEXEFILE),)
-ifdef UPXPROG
-        -$(UPXPROG) $(EXENAME)
-endif
-ifdef UNIXINSTALLDIR
-        $(MKDIR) $(INSTALL_BASEDIR)
-        $(INSTALLEXE) $(EXENAME) $(INSTALL_BASEDIR)
-else
-        $(MKDIR) $(INSTALL_BINDIR)
-        $(INSTALLEXE) $(EXENAME) $(INSTALL_BINDIR)
-endif
-endif
-
-install: quickinstall
-ifdef UNIXINSTALLDIR
-        $(MKDIR) $(INSTALL_BASEDIR)
-        $(INSTALLEXE) $(COMPILERUTILSDIR)/samplecfg $(INSTALL_BASEDIR)/samplecfg
-endif
-        $(MKDIR) $(MSGINSTALLDIR)
-        $(INSTALL) $(MSGFILES) $(MSGINSTALLDIR)
-
-# this also installs the link /usr/bin/ppc386. The .deb does that later
-installsymlink: install
-ifdef UNIXINSTALLDIR
-        $(MKDIR) $(INSTALL_BINDIR)
-        ln -sf $(INSTALL_BASEDIR)/ppc386 $(INSTALL_BINDIR)/ppc386
-endif
-
-
-#####################################################################
-# Misc
-#####################################################################
-
-.PHONY: rtl rtlclean rtlinstall
-
-rtl:
-        $(MAKE) -C $(UNITDIR_RTL) all
-
-rtlclean:
-        $(MAKE) -C $(UNITDIR_RTL) clean
-
-rtlinstall:
-        $(MAKE) -C $(UNITDIR_RTL) install
-
-
-#####################################################################
-# local user configurable file
-# in makefile.loc you can add any desired target
-#####################################################################
-
-localmake:=$(strip $(wildcard makefile.loc))
-
-ifdef localmake
-include ./$(localmake)
-endif

compiler/new/TODO

@@ -1,5 +0,0 @@
-Well, this list is very incomplete, mainly it contains things
-which shoundn't be forgotten
-
-Alpha processor:
-  - DLL variables

compiler/new/cgflags.pas

@@ -1,63 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 by Florian Klaempfl
-    Member of the Free Pascal development team
-
-    This unit implements the code generation for things regarding
-    flags, this unit applies of course only for cpus support flags
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-
-unit cgflags;
-
-  interface
-
-    uses
-       cgobj;
-
-  implementation
-
-    uses
-       cgobj,nmem;
-
-    procedure flags_assignment_flags(p : passignmentnode);
-
-      begin
-         if loc=LOC_CREGISTER then
-           emit_flag2reg(p^.right^.location.resflags,p^.left^.location.register)
-         else
-           begin
-             ai:=new(paicpu,op_ref(A_Setcc,S_B,newreference(p^.left^.location.reference)));
-             ai^.SetCondition(flag_2_cond[p^.right^.location.resflags]);
-             exprasmlist^.concat(ai);
-           end;
-         del_reference(p^.left^.location.reference);
-      end;
-
-begin
-   p2_assignment_flags:=@flags_assignment_flags;
-end.
-{
-  $Log$
-  Revision 1.1  2000-07-13 06:30:07  michael
-  + Initial import
-
-  Revision 1.1  2000/03/01 15:36:13  florian
-    * some new stuff for the new cg
-
-}

compiler/new/i386/cgcpu.pas

@@ -1,190 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 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;
-
-  interface
-
-    uses
-       cgobj,aasm,cpuinfo,cpubase;
-
-    type
-       pcg386 = ^tcg386;
-
-       tcg386 = object(tcg)
-          procedure a_push_reg(list : paasmoutput;r : tregister);virtual;
-          procedure a_call_name(list : paasmoutput;const s : string;
-            offset : longint);virtual;
-
-          procedure a_load_const8_ref(list : paasmoutput;b : byte;const ref : treference);virtual;
-          procedure a_load_const16_ref(list : paasmoutput;w : word;const ref : treference);virtual;
-          procedure a_load_const32_ref(list : paasmoutput;l : longint;const ref : treference);virtual;
-          procedure a_load_const64_ref(list : paasmoutput;q : qword;const ref : treference);virtual;
-
-          procedure g_stackframe_entry(list : paasmoutput;localsize : longint);virtual;
-          procedure g_restore_frame_pointer(list : paasmoutput);virtual;
-          procedure g_ret_from_proc(list : paasmoutput;parasize : aword);
-          constructor init;
-       end;
-
-  implementation
-
-    uses
-       globtype,globals,cpuasm,symconst,symtable,cgbase,verbose;
-
-    constructor tcg386.init;
-
-      begin
-         inherited init;
-      end;
-
-    procedure tcg386.g_stackframe_entry(list : paasmoutput;localsize : longint);
-
-      begin
-         if localsize<>0 then
-           begin
-              if (cs_littlesize in aktglobalswitches) and (localsize<=65535) then
-                list^.insert(new(paicpu,op_const_const(A_ENTER,S_NO,localsize,0)))
-              else
-                begin
-                   list^.concat(new(paicpu,op_reg(A_PUSH,S_L,R_EBP)));
-                   list^.concat(new(paicpu,op_reg_reg(A_MOV,S_L,R_ESP,R_EBP)));
-                   list^.concat(new(paicpu,op_const_reg(A_SUB,S_L,localsize,R_ESP)));
-                end;
-             end
-         else
-           begin
-              list^.concat(new(paicpu,op_reg(A_PUSH,S_L,R_EBP)));
-              list^.concat(new(paicpu,op_reg_reg(A_MOV,S_L,R_ESP,R_EBP)));
-           end;
-       end;
-
-     procedure tcg386.a_call_name(list : paasmoutput;const s : string;
-       offset : longint);
-
-       begin
-          list^.concat(new(paicpu,op_sym(A_CALL,S_NO,newasmsymbol(s))));
-          {!!!!!!!!!1 offset is ignored }
-       end;
-
-     procedure tcg386.a_push_reg(list : paasmoutput;r : tregister);
-
-       begin
-          list^.concat(new(paicpu,op_reg(A_PUSH,regsize(r),r)));
-       end;
-
-     procedure tcg386.a_load_const8_ref(list : paasmoutput;b : byte;const ref : treference);
-
-       begin
-          abstract;
-       end;
-
-     procedure tcg386.a_load_const16_ref(list : paasmoutput;w : word;const ref : treference);
-
-       begin
-          abstract;
-       end;
-
-     procedure tcg386.a_load_const32_ref(list : paasmoutput;l : longint;const ref : treference);
-
-       begin
-          abstract;
-       end;
-
-     procedure tcg386.a_load_const64_ref(list : paasmoutput;q : qword;const ref : treference);
-
-       begin
-          abstract;
-       end;
-
-     procedure tcg386.g_restore_frame_pointer(list : paasmoutput);
-
-       begin
-          list^.concat(new(paicpu,op_none(A_LEAVE,S_NO)));
-       end;
-
-     procedure tcg386.g_ret_from_proc(list : paasmoutput;parasize : aword);
-
-       begin
-          { parameters are limited to 65535 bytes because }
-          { ret allows only imm16                    }
-          if (parasize>65535) and not(pocall_clearstack in aktprocsym^.definition^.proccalloptions) then
-            CGMessage(cg_e_parasize_too_big);
-          { Routines with the poclearstack flag set use only a ret.}
-          { also routines with parasize=0     }
-          if (parasize=0) or (pocall_clearstack in aktprocsym^.definition^.proccalloptions) then
-            list^.concat(new(paicpu,op_none(A_RET,S_NO)))
-          else
-            list^.concat(new(paicpu,op_const(A_RET,S_NO,parasize)));
-       end;
-
-end.
-{
-  $Log$
-  Revision 1.1  2000-07-13 06:30:10  michael
-  + Initial import
-
-  Revision 1.9  2000/01/07 01:14:57  peter
-    * updated copyright to 2000
-
-  Revision 1.8  1999/11/09 22:57:09  peter
-    * compiles again both i386,alpha both with optimizer
-
-  Revision 1.7  1999/09/15 20:35:47  florian
-    * small fix to operator overloading when in MMX mode
-    + the compiler uses now fldz and fld1 if possible
-    + some fixes to floating point registers
-    + some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
-    * .... ???
-
-  Revision 1.6  1999/09/10 18:48:11  florian
-    * some bug fixes (e.g. must_be_valid and procinfo.funcret_is_valid)
-    * most things for stored properties fixed
-
-  Revision 1.5  1999/08/25 12:00:21  jonas
-    * changed pai386, paippc and paiapha (same for tai*) to paicpu (taicpu)
-
-  Revision 1.4  1999/08/06 14:15:56  florian
-    * made the alpha version compilable
-
-  Revision 1.3  1999/08/06 13:26:54  florian
-    * more changes ...
-
-  Revision 1.2  1999/08/01 23:19:59  florian
-    + make a new makefile using the old compiler makefile
-
-  Revision 1.1  1999/08/01 23:11:24  florian
-    + renamed ot tp cgcpu.pas
-
-  Revision 1.1  1999/08/01 22:08:26  florian
-    * reorganisation of directory structure
-
-  Revision 1.3  1999/08/01 18:22:31  florian
-   * made it again compilable
-
-  Revision 1.2  1999/01/23 23:29:43  florian
-    * first running version of the new code generator
-    * when compiling exceptions under Linux fixed
-
-  Revision 1.1  1998/12/15 22:17:02  florian
-    * first version
-}

compiler/new/i386/cpuinfo.pas

@@ -1,35 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal compiler
-    Copyright (c) 1998-2000 by Florian Klaempfl
-
-    Basic Processor information for i386
-
-    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 }
-{$ifdef FPC}
-   AWord = DWord;
-{$else FPC}
-   AWord = Longint;
-{$endif FPC}
-
-Const
-   { Size of native extended type }
-   extended_size = 10;
-   
-Implementation
-
-end.

compiler/new/i386/tgcpu.pas

@@ -1,137 +0,0 @@
-{
-    $Id$
-    Copyright (C) 1998-2000 by Florian Klaempfl
-
-    This unit handles the temporary variables stuff 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 tgcpu;
-
-  interface
-
-    uses
-       cobjects,globals,tree,hcodegen,verbose,files,
-       aasm,cpubase,cpuasm,tgobj;
-
-    const
-       countusablereg : byte = 4;
-
-       { this value is used in tsaved, if the register isn't saved }
-       reg_not_saved = $7fffffff;
-       usableregmmx : byte = 8;
-
-    type
-       ttgobji386 = object(ttgobj)
-          procedure ungetregister(r : tregister);virtual;
-          function istemp(const ref : treference) : boolean;virtual;
-          procedure del_reference(const ref : treference);virtual;
-          procedure pushusedregisters(var pushed : tpushed;b : byte);virtual;
-          procedure popusedregisters(const pushed : tpushed);virtual;
-          procedure saveusedregisters(var saved : tsaved;b : byte);virtual;
-          procedure restoreusedregisters(const saved : tsaved);virtual;
-          procedure clearregistercount;virtual;
-          procedure resetusableregisters;virtual;
-       end;
-
-    var
-       tg : ttgobji386;
-
-  implementation
-
-
-{ !!!!!!!! the following procedures need to be implemented !!!!!!!!!! }
-
-    procedure ttgobji386.ungetregister(r : tregister);
-
-      begin
-      end;
-
-    function ttgobji386.istemp(const ref : treference) : boolean;
-
-      begin
-      end;
-
-    procedure ttgobji386.del_reference(const ref : treference);
-
-      begin
-      end;
-
-    procedure ttgobji386.pushusedregisters(var pushed : tpushed;b : byte);
-
-      begin
-      end;
-
-    procedure ttgobji386.popusedregisters(const pushed : tpushed);
-
-      begin
-      end;
-
-    procedure ttgobji386.saveusedregisters(var saved : tsaved;b : byte);
-
-      begin
-      end;
-
-    procedure ttgobji386.restoreusedregisters(const saved : tsaved);
-
-      begin
-      end;
-
-    procedure ttgobji386.clearregistercount;
-
-      begin
-      end;
-
-    procedure ttgobji386.resetusableregisters;
-
-      begin
-      end;
-
-begin
-   tg.init;
-end.
-{
-  $Log$
-  Revision 1.1  2000-07-13 06:30:11  michael
-  + Initial import
-
-  Revision 1.7  2000/03/01 15:36:13  florian
-    * some new stuff for the new cg
-
-  Revision 1.6  2000/01/07 01:14:57  peter
-    * updated copyright to 2000
-
-  Revision 1.5  1999/09/15 20:35:47  florian
-    * small fix to operator overloading when in MMX mode
-    + the compiler uses now fldz and fld1 if possible
-    + some fixes to floating point registers
-    + some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
-    * .... ???
-
-  Revision 1.4  1999/09/10 18:48:11  florian
-    * some bug fixes (e.g. must_be_valid and procinfo.funcret_is_valid)
-    * most things for stored properties fixed
-
-  Revision 1.3  1999/08/03 17:09:50  florian
-    * the alpha compiler can be compiled now
-
-  Revision 1.2  1999/08/02 23:13:24  florian
-    * more changes to compile for the Alpha
-
-  Revision 1.1  1999/08/02 17:14:14  florian
-    + changed the temp. generator to an object
-}

compiler/new/ncon.pas

@@ -1,53 +0,0 @@
-{
-    $Id$
-    Copyright (C) 1998-2000 by Florian Klaempfl
-
-    This unit implements load nodes etc.
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU 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;
-
-  interface
-
-    uses
-       cpuinfo,tree;
-
-    type
-       pstringconstnode = ^tstringconstnode;
-
-       tstringconstnode = object(tnode)
-          length : aword;
-       end;
-
-  implementation
-
-end.
-{
-  $Log$
-  Revision 1.1  2000-07-13 06:30:08  michael
-  + Initial import
-
-  Revision 1.3  2000/01/07 01:14:53  peter
-    * updated copyright to 2000
-
-  Revision 1.2  1999/08/06 18:05:53  florian
-    * implemented some stuff for assignments
-
-  Revision 1.1  1999/08/06 16:15:38  florian
-    + initial revision
-}

compiler/new/nmem.pas

@@ -1,786 +0,0 @@
-{
-    $Id$
-    Copyright (C) 1998-2000 by Florian Klaempfl
-
-    This unit implements load nodes etc.
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU 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;
-
-  interface
-
-    uses
-       tree,symtable;
-
-    type
-       ploadnode = ^tloadnode;
-       tloadnode = object(tnode)
-          symtableentry : psym;
-          symtable : psymtable;
-          is_absolute,is_first,is_methodpointer : boolean;
-          constructor init(v : psym;st : psymtable);
-          destructor done;virtual;
-          procedure det_temp;virtual;
-          procedure det_resulttype;virtual;
-          procedure secondpass;virtual;
-       end;
-
-       tassigntyp = (at_normal,at_plus,at_minus,at_star,at_slash);
-
-       passignmentnode = ^tassignmentnode;
-       tassignmentnode = object(tbinarynode)
-          assigntyp : tassigntyp;
-          constructor init(l,r : pnode);
-          destructor done;virtual;
-          procedure det_temp;virtual;
-          procedure det_resulttype;virtual;
-          procedure secondpass;virtual;
-       end;
-
-    var
-       { this is necessary for the const section }
-       simple_loadn : boolean;
-
-       p2_assignment : procedure(p : passignmentnode);
-       p2_assignment_flags : procedure(p : passignmentnode);
-       p2_assignment_string : procedure(p : passignmentnode);
-       p2_assignment_int64_reg : procedure(p : passignmentnode);
-
-  implementation
-
-    uses
-       cobjects,globals,aasm,cgbase,cgobj,types,verbose,tgobj,tgcpu,symconst,
-       cpubase,cpuasm,ncon;
-
-{****************************************************************************
-                                 TLOADNODE
- ****************************************************************************}
-
-    constructor tloadnode.init(v : psym;st : psymtable);
-
-      var
-         p : ptree;
-
-      begin
-         inherited init;
-         treetype:=loadn;
-         if v^.typ=varsym then
-           resulttype:=pvarsym(v)^.vartype.def;
-         symtableentry:=v;
-         symtable:=st;
-         is_first := False;
-         is_methodpointer:=false;
-
-         { method pointer load nodes can use the left subtree }
-         { !!!!! left:=nil; }
-      end;
-
-    destructor tloadnode.done;
-
-      begin
-         inherited done;
-         { method pointer load nodes can use the left subtree }
-         { !!!!! dispose(left,done); }
-      end;
-
-    procedure tloadnode.det_temp;
-
-      begin
-      end;
-
-    procedure tloadnode.det_resulttype;
-
-      begin
-      end;
-
-    procedure tloadnode.secondpass;
-
-      var
-         hregister : tregister;
-         symtabletype : tsymtabletype;
-         i : longint;
-         hp : preference;
-
-      begin
-         simple_loadn:=true;
-         reset_reference(location.reference);
-         case symtableentry^.typ of
-              { this is only for toasm and toaddr }
-              absolutesym :
-                 begin
-                    if (pabsolutesym(symtableentry)^.abstyp=toaddr) then
-                     begin
-{$ifdef i386}
-                       { absseg is go32v2 target specific }
-                       if pabsolutesym(symtableentry)^.absseg then
-                        location.reference.segment:=R_FS;
-{$endif i386}
-                       location.reference.offset:=pabsolutesym(symtableentry)^.address;
-                     end
-                    else
-                     location.reference.symbol:=newasmsymbol(symtableentry^.mangledname);
-                 end;
-              varsym :
-                 begin
-                    hregister:=R_NO;
-                    { C variable }
-                    if (vo_is_C_var in pvarsym(symtableentry)^.varoptions) then
-                      begin
-                         location.reference.symbol:=newasmsymbol(symtableentry^.mangledname);
-                      end
-
-{$ifdef dummy}
-                    { DLL variable, DLL variables are only available on the win32 target }
-                    { maybe we've to add this later for the alpha WinNT                  }
-                    else if vo_is_dll_var in pvarsym(symtableentry)^.varoptions then
-                      begin
-                         hregister:=tg.getregisterint;
-                         location.reference.symbol:=newasmsymbol(symtableentry^.mangledname);
-                         exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOV,S_L,newreference(location.reference),hregister)));
-                         location.reference.symbol:=nil;
-                         location.reference.base:=hregister;
-                      end
-{$endif dummy}
-                    else
-                      begin
-{$ifdef dummy}
-                         symtabletype:=symtable^.symtabletype;
-                         { in case it is a register variable: }
-                         if pvarsym(symtableentry)^.reg<>R_NO then
-                           begin
-                              if pvarsym(symtableentry)^.reg in fpuregs then
-                                begin
-                                   location.loc:=LOC_CFPUREGISTER;
-                                   tg.unusedregsfpu:=tg.unusedregsfpu-[pvarsym(symtableentry)^.reg];
-                                end
-                              else
-                                begin
-                                   location.loc:=LOC_CREGISTER;
-                                   tg.unusedregsint:=tg.unusedregsint-[pvarsym(symtableentry)^.reg];
-                                end;
-                              location.register:=pvarsym(symtableentry)^.reg;
-                           end
-                         else
-                           begin
-                              { first handle local and temporary variables }
-                              if (symtabletype in [parasymtable,inlinelocalsymtable,
-                                                   inlineparasymtable,localsymtable]) then
-                                begin
-                                   location.reference.base:=procinfo.framepointer;
-                                   location.reference.offset:=pvarsym(symtableentry)^.address;
-                                   if (symtabletype in [localsymtable,inlinelocalsymtable]) and
-                                     not(use_esp_stackframe) then
-                                     location.reference.offset:=-location.reference.offset;
-                                   if (lexlevel>(symtable^.symtablelevel)) then
-                                     begin
-                                        hregister:=tg.getregisterint;
-
-                                        { make a reference }
-                                        hp:=new_reference(procinfo^.framepointer,
-                                          procinfo^.framepointer_offset);
-
-
-                                        exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOV,S_L,hp,hregister)));
-
-                                        simple_loadn:=false;
-                                        i:=lexlevel-1;
-                                        while i>(symtable^.symtablelevel) do
-                                          begin
-                                             { make a reference }
-                                             hp:=new_reference(hregister,8);
-                                             exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOV,S_L,hp,hregister)));
-                                             dec(i);
-                                          end;
-                                        location.reference.base:=hregister;
-                                     end;
-                                end
-                              else
-                                case symtabletype of
-                                   unitsymtable,globalsymtable,
-                                   staticsymtable : begin
-                                                       location.reference.symbol:=newasmsymbol(symtableentry^.mangledname);
-                                                    end;
-                                   stt_exceptsymtable:
-                                     begin
-                                        location.reference.base:=procinfo^.framepointer;
-                                        location.reference.offset:=pvarsym(symtableentry)^.address;
-                                     end;
-                                   objectsymtable:
-                                     begin
-                                        if sp_static in pvarsym(symtableentry)^.symoptions then
-                                          begin
-                                             location.reference.symbol:=newasmsymbol(symtableentry^.mangledname);
-                                          end
-                                        else
-                                          begin
-                                             location.reference.base:=self_pointer;
-                                             location.reference.offset:=pvarsym(symtableentry)^.address;
-                                          end;
-                                     end;
-                                   withsymtable:
-                                     begin
-                                        hregister:=tg.getregisterint;
-                                        location.reference.base:=hregister;
-                                        { make a reference }
-                                        { symtable datasize field
-                                          contains the offset of the temp
-                                          stored }
-                                        hp:=new_reference(procinfo^.framepointer,
-                                          symtable^.datasize);
-
-                                        exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOV,S_L,hp,hregister)));
-
-                                        location.reference.offset:=
-                                          pvarsym(symtableentry)^.address;
-                                     end;
-                                end;
-                           end;
-                         { in case call by reference, then calculate: }
-                         if (pvarsym(symtableentry)^.varspez=vs_var) or
-                            is_open_array(pvarsym(symtableentry)^.definition) or
-                            is_array_of_const(pvarsym(symtableentry)^.definition) or
-                            ((pvarsym(symtableentry)^.varspez=vs_const) and
-                             push_addr_param(pvarsym(symtableentry)^.definition)) then
-                           begin
-                              simple_loadn:=false;
-                              if hregister=R_NO then
-                                hregister:=tg.getregisterint;
-                              if is_open_array(pvarsym(symtableentry)^.definition) or
-                                 is_open_string(pvarsym(symtableentry)^.definition) then
-                                begin
-                                   if (location.reference.base=procinfo^.framepointer) then
-                                     begin
-                                        highframepointer:=location.reference.base;
-                                        highoffset:=location.reference.offset;
-                                     end
-                                   else
-                                     begin
-                                        highframepointer:=R_EDI;
-                                        highoffset:=location.reference.offset;
-                                        exprasmlist^.concat(new(paicpu,op_reg_reg(A_MOV,S_L,
-                                          location.reference.base,R_EDI)));
-                                     end;
-                                end;
-                              if location.loc=LOC_CREGISTER then
-                                begin
-                                   exprasmlist^.concat(new(paicpu,op_reg_reg(A_MOV,S_L,
-                                     location.register,hregister)));
-                                   location.loc:=LOC_REFERENCE;
-                                end
-                              else
-                                begin
-                                   exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOV,S_L,
-                                     newreference(location.reference),
-                                     hregister)));
-                                end;
-                              reset_reference(location.reference);
-                              location.reference.base:=hregister;
-                          end;
-{$endif dummy}
-                      end;
-                 end;
-              procsym:
-                 begin
-                    {!!!!!!!!!!}
-                 end;
-              typedconstsym :
-                 begin
-                    location.reference.symbol:=newasmsymbol(symtableentry^.mangledname);
-                 end;
-              else internalerror(4);
-         end;
-      end;
-
-{****************************************************************************
-                            TASSIGNMENTNODE
- ****************************************************************************}
-
-    procedure loadansistring;
-
-      begin
-        { !!! }
-      end;
-
-    procedure loadansi2short(right,left: pnode);
-
-      begin
-        { !!! }
-      end;
-
-    procedure loadshortstring;
-
-      begin
-        { !!! }
-      end;
-
-    constructor tassignmentnode.init(l,r : pnode);
-
-      begin
-         inherited init(l,r);
-{         concat_string:=false; }
-         assigntyp:=at_normal;
-      end;
-
-    destructor tassignmentnode.done;
-
-      begin
-         inherited done;
-      end;
-
-    procedure tassignmentnode.det_temp;
-
-      begin
-      end;
-
-    procedure tassignmentnode.det_resulttype;
-
-      begin
-         inherited det_resulttype;
-         resulttype:=voiddef;
-         { assignements to open arrays aren't allowed }
-         if is_open_array(left^.resulttype) then
-           CGMessage(type_e_mismatch);
-      end;
-
-    { updated from old cg on 29.2.00 by FK }
-    procedure generic_p2_assignment(p : passignmentnode);
-
-      var
-         opsize : tcgsize;
-         otlabel,hlabel,oflabel : pasmlabel;
-         fputyp : tfloattype;
-         loc : tloc;
-         r : preference;
-         ai : paicpu;
-         op : tasmop;
-
-      begin
-         loc:= p^.left^.location.loc;
-         case p^.right^.location.loc of
-            LOC_REFERENCE,
-            LOC_MEM : begin
-                         { extra handling for ordinal constants }
-                         if (p^.right^.treetype in [ordconstn,fixconstn]) or
-                            (loc=LOC_CREGISTER) then
-                           begin
-                              case p^.left^.resulttype^.size of
-                                 1 : opsize:=OS_8;
-                                 2 : opsize:=OS_16;
-                                 4 : opsize:=OS_32;
-                                 8 : opsize:=OS_64;
-                              end;
-                              if loc=LOC_CREGISTER then
-                                begin
-                                  cg^.a_load_ref_reg(p^.list,opsize,
-                                    p^.right^.location.reference,
-                                    p^.left^.location.register);
-{$ifdef dummy}
-                         !!!!!!!!!!!! only 32 bit cpus
-                                  if is_64bitint(p^.right^.resulttype) then
-                                    begin
-                                       r:=newreference(p^.right^.location.reference);
-                                       inc(r^.offset,4);
-                                       emit_ref_reg(A_MOV,opsize,r,
-                                         p^.left^.location.registerhigh);
-                                    end;
-{$endif dummy}
-                                  tg.del_reference(p^.right^.location.reference);
-                                end
-                              else
-                                begin
-                                  cg^.a_load_const_ref(p^.list,opsize,
-                                    p^.right^.location.reference.offset,
-                                    p^.left^.location.reference);
-
-{$ifdef dummy}
-                         !!!!!!!!!!!! only 32 bit cpus
-                                  if is_64bitint(p^.right^.resulttype) then
-                                    begin
-                                       r:=newreference(p^.left^.location.reference);
-                                       inc(r^.offset,4);
-                                       emit_const_ref(A_MOV,opsize,
-                                         0,r);
-                                    end;
-{$endif dummy}
-                                  tg.del_reference(p^.left^.location.reference);
-                                end;
-
-                           end
-
-{$ifdef i386}
-                         !!!!!!!!!!!! only 386
-                         else if loc=LOC_CFPUREGISTER then
-                           begin
-                              floatloadops(pfloatdef(p^.right^.resulttype)^.typ,op,opsize);
-                              emit_ref(op,opsize,
-                                newreference(p^.right^.location.reference));
-                              emit_reg(A_FSTP,S_NO,
-                                correct_fpuregister(p^.left^.location.register,fpuvaroffset+1));
-                           end
-{$endif i386}
-                         else
-                           begin
-{$ifdef dummy}
-                              if (p^.right^.resulttype^.needs_inittable) and
-                                ((p^.right^.resulttype^.deftype<>objectdef) or
-                                  not(pobjectdef(p^.right^.resulttype)^.is_class)) then
-                                begin
-                                   { this would be a problem }
-                                   if not(left^.resulttype^.needs_inittable) then
-                                     internalerror(292001);
-
-                                   { increment source reference counter }
-                                   new(r);
-                                   reset_reference(r^);
-                                   r^.symbol:=p^.right^.resulttype^.get_inittable_label;
-                                   emitpushreferenceaddr(r^);
-
-                                   emitpushreferenceaddr(p^.right^.location.reference);
-                                   emitcall('FPC_ADDREF');
-                                   { decrement destination reference counter }
-                                   new(r);
-                                   reset_reference(r^);
-                                   r^.symbol:=p^.left^.resulttype^.get_inittable_label;
-                                   emitpushreferenceaddr(r^);
-                                   emitpushreferenceaddr(p^.left^.location.reference);
-                                   emitcall('FPC_DECREF');
-                                end;
-{$endif dummy}
-{$ifdef regallocfix}
-                              cg^.concatcopy(p^.list,p^.right^.location.reference,
-                                p^.left^.location.reference,p^.left^.resulttype^.size,true,false);
-                              ungetiftemp(p^.right^.location.reference);
-{$Else regallocfix}
-                              cg^.g_concatcopy(p^.list,p^.right^.location.reference,
-                                p^.left^.location.reference,p^.left^.resulttype^.size,false);
-                              tg.ungetiftemp(p^.right^.location.reference);
-{$endif regallocfix}
-                           end;
-                      end;
-{$ifdef SUPPORT_MMX}
-            LOC_CMMXREGISTER,
-            LOC_MMXREGISTER:
-              begin
-                 if loc=LOC_CMMXREGISTER then
-                   emit_reg_reg(A_MOVQ,S_NO,
-                   p^.right^.location.register,p^.left^.location.register)
-                 else
-                   emit_reg_ref(A_MOVQ,S_NO,
-                     p^.right^.location.register,newreference(p^.left^.location.reference));
-              end;
-{$endif SUPPORT_MMX}
-            LOC_REGISTER,
-            LOC_CREGISTER : begin
-                              case p^.right^.resulttype^.size of
-                                 1 : opsize:=OS_8;
-                                 2 : opsize:=OS_16;
-                                 4 : opsize:=OS_32;
-                                 8 : opsize:=OS_64;
-                              end;
-                              { simplified with op_reg_loc       }
-                              if loc=LOC_CREGISTER then
-                                begin
-                                  cg^.a_load_reg_reg(p^.list,opsize,
-                                    p^.right^.location.register,
-                                    p^.left^.location.register);
-                                 tg.ungetregister(p^.right^.location.register);
-                                end
-                              else
-                                Begin
-                                  cg^.a_load_reg_ref(p^.list,opsize,
-                                    p^.right^.location.register,
-                                    p^.left^.location.reference);
-                                  tg.ungetregister(p^.right^.location.register);
-                                  tg.del_reference(p^.left^.location.reference);
-                                end;
-{$ifdef dummy}
-                              !!!! only for 32bit processors
-                              if is_64bitint(p^.right^.resulttype) then
-                                begin
-                                   { simplified with op_reg_loc  }
-                                   if loc=LOC_CREGISTER then
-                                     emit_reg_reg(A_MOV,opsize,
-                                       p^.right^.location.registerhigh,
-                                       p^.left^.location.registerhigh)
-                                   else
-                                     begin
-                                        r:=newreference(p^.left^.location.reference);
-                                        inc(r^.offset,4);
-                                        emit_reg_ref(A_MOV,opsize,
-                                          p^.right^.location.registerhigh,r);
-                                     end;
-                                end;
-{$endif dummy}
-                           end;
-{$ifdef dummy}
-            LOC_FPU : begin
-                              if (p^.left^.resulttype^.deftype=floatdef) then
-                               fputyp:=pfloatdef(p^.left^.resulttype)^.typ
-                              else
-                               if (p^.right^.resulttype^.deftype=floatdef) then
-                                fputyp:=pfloatdef(p^.right^.resulttype)^.typ
-                              else
-                               if (p^.right^.treetype=typeconvn) and
-                                  (p^.right^.left^.resulttype^.deftype=floatdef) then
-                                fputyp:=pfloatdef(p^.right^.left^.resulttype)^.typ
-                              else
-                                fputyp:=s32real;
-                              case loc of
-                                 LOC_CFPUREGISTER:
-                                   begin
-                                      emit_reg(A_FSTP,S_NO,
-                                        correct_fpuregister(p^.left^.location.register,fpuvaroffset));
-                                      dec(fpuvaroffset);
-                                   end;
-                                 LOC_REFERENCE:
-                                   floatstore(fputyp,p^.left^.location.reference);
-                                 else
-                                   internalerror(48991);
-                              end;
-                           end;
-{$ifdef i386}
-                         !!!!!!!!!!!! only 386
-            LOC_CFPUREGISTER: begin
-                              if (p^.left^.resulttype^.deftype=floatdef) then
-                               fputyp:=pfloatdef(p^.left^.resulttype)^.typ
-                              else
-                               if (p^.right^.resulttype^.deftype=floatdef) then
-                                fputyp:=pfloatdef(p^.right^.resulttype)^.typ
-                              else
-                               if (p^.right^.treetype=typeconvn) and
-                                  (p^.right^.left^.resulttype^.deftype=floatdef) then
-                                fputyp:=pfloatdef(p^.right^.left^.resulttype)^.typ
-                              else
-                                fputyp:=s32real;
-                              emit_reg(A_FLD,S_NO,
-                                correct_fpuregister(p^.right^.location.register,fpuvaroffset));
-                              inc(fpuvaroffset);
-                              case loc of
-                                 LOC_CFPUREGISTER:
-                                   begin
-                                      emit_reg(A_FSTP,S_NO,
-                                        correct_fpuregister(p^.right^.location.register,fpuvaroffset));
-                                      dec(fpuvaroffset);
-                                   end;
-                                 LOC_REFERENCE:
-                                   floatstore(fputyp,p^.left^.location.reference);
-                                 else
-                                   internalerror(48992);
-                              end;
-                           end;
-{$endif i386}
-{$endif dummy}
-            LOC_JUMP     : begin
-                              { support every type of boolean here }
-                              case p^.right^.resulttype^.size of
-                                 1 : opsize:=OS_8;
-                                 2 : opsize:=OS_16;
-                                 4 : opsize:=OS_32;
-                                 { this leads to an efficiency of 1.5   }
-                                 { per cent regarding memory usage .... }
-                                 8 : opsize:=OS_64;
-                              end;
-                              getlabel(hlabel);
-                              cg^.a_label(p^.list,p^.truelabel);
-                              if loc=LOC_CREGISTER then
-                                cg^.a_load_const_reg(p^.list,opsize,1,
-                                  p^.left^.location.register)
-                              else
-                                cg^.a_load_const_ref(p^.list,opsize,1,
-                                  p^.left^.location.reference);
-                              cg^.a_jmp_cond(p^.list,OC_None,hlabel);
-                              cg^.a_label(p^.list,p^.falselabel);
-
-                              if loc=LOC_CREGISTER then
-                                cg^.a_load_const_reg(p^.list,opsize,0,
-                                  p^.left^.location.register)
-                              else
-                                begin
-                                  cg^.a_load_const_ref(p^.list,opsize,0,
-                                    p^.left^.location.reference);
-                                  tg.del_reference(p^.left^.location.reference);
-                                 end;
-                              cg^.a_label(p^.list,hlabel);
-                           end;
-            LOC_FLAGS:
-              p2_assignment_flags(p);
-         end;
-      end;
-
-
-
-    { updated from old cg on 29.2.00 by FK }
-    procedure generic_p2_assignment_string(p : passignmentnode);
-
-      begin
-        with p^ do
-         if is_ansistring(left^.resulttype) then
-           begin
-             { the source and destinations are released
-               in loadansistring, because an ansi string can
-               also be in a register
-             }
-             loadansistring;
-           end
-         else
-         if is_shortstring(left^.resulttype) then
-           begin
-             if is_ansistring(right^.resulttype) then
-               begin
-                 if (right^.treetype=stringconstn) and
-                    (pstringconstnode(right)^.length=0) then
-                   begin
-                      cg^.a_load_const_ref(list,OS_8,0,left^.location.reference);
-                      tg.del_reference(left^.location.reference);
-                   end
-                 else
-                   loadansi2short(right,left);
-               end
-             else
-               begin
-                  { we do not need destination anymore }
-                  tg.del_reference(left^.location.reference);
-                  { tg.del_reference(right^.location.reference);
-                    done in loadshortstring }
-                  loadshortstring;
-                  tg.ungetiftemp(right^.location.reference);
-               end;
-           end
-         else if is_longstring(left^.resulttype) then
-           begin
-              abstract;
-           end
-         else
-           begin
-             { its the only thing we have to do }
-             tg.del_reference(right^.location.reference);
-           end
-      end;
-
-    procedure generic_p2_assignment_int64_reg(p : passignmentnode);
-
-      begin
-         { we don't know it better here }
-         generic_p2_assignment(p);
-      end;
-
-    { updated from old cg on 29.2.00 by FK }
-    procedure generic_p2_assignment_flags(p : passignmentnode);
-
-      begin
-         { for example the alpha doesn't have flags }
-         abstract;
-      end;
-
-    procedure tassignmentnode.secondpass;
-
-      var
-         r : treference;
-         opsize : tcgsize;
-
-      begin
-         if not(left^.location.loc in lvaluelocations) then
-           begin
-              CGMessage(cg_e_illegal_expression);
-              exit;
-           end;
-         if left^.resulttype^.deftype=stringdef then
-           p2_assignment_string(@self)
-         { if is an int64 which has to do with registers, we
-           need to call probably a procedure for 32 bit processors
-         }
-         else if is_64bitint(left^.resulttype) and
-           ((left^.location.loc in [LOC_REGISTER,LOC_CREGISTER]) or
-            (left^.location.loc in [LOC_REGISTER,LOC_CREGISTER])) then
-           p2_assignment_int64_reg(@self)
-         else
-           p2_assignment(@self);
-      end;
-
-begin
-   p2_assignment:=@generic_p2_assignment;
-   p2_assignment_flags:=@generic_p2_assignment_flags;
-   p2_assignment_string:=@generic_p2_assignment_string;
-   p2_assignment_int64_reg:=@generic_p2_assignment_int64_reg;
-end.
-{
-  $Log$
-  Revision 1.1  2000-07-13 06:30:08  michael
-  + Initial import
-
-  Revision 1.18  2000/04/29 09:01:06  jonas
-    * nmem compiles again (at least for powerpc)
-
-  Revision 1.17  2000/03/01 15:36:13  florian
-    * some new stuff for the new cg
-
-  Revision 1.16  2000/01/07 01:14:53  peter
-    * updated copyright to 2000
-
-  Revision 1.15  1999/12/06 18:17:10  peter
-    * newcg compiler compiles again
-
-  Revision 1.14  1999/10/12 21:20:46  florian
-    * new codegenerator compiles again
-
-  Revision 1.13  1999/09/15 20:35:46  florian
-    * small fix to operator overloading when in MMX mode
-    + the compiler uses now fldz and fld1 if possible
-    + some fixes to floating point registers
-    + some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
-    * .... ???
-
-  Revision 1.12  1999/09/14 11:16:09  florian
-    * only small updates to work with the current compiler
-
-  Revision 1.11  1999/08/25 12:00:12  jonas
-    * changed pai386, paippc and paiapha (same for tai*) to paicpu (taicpu)
-
-  Revision 1.10  1999/08/18 17:05:56  florian
-    + implemented initilizing of data for the new code generator
-      so it should compile now simple programs
-
-  Revision 1.9  1999/08/06 18:05:54  florian
-    * implemented some stuff for assignments
-
-  Revision 1.8  1999/08/06 15:53:51  florian
-    * made the alpha version compilable
-
-  Revision 1.7  1999/08/05 17:10:57  florian
-    * some more additions, especially procedure
-      exit code generation
-
-  Revision 1.6  1999/08/05 14:58:13  florian
-    * some fixes for the floating point registers
-    * more things for the new code generator
-
-  Revision 1.5  1999/08/04 00:23:56  florian
-    * renamed i386asm and i386base to cpuasm and cpubase
-
-  Revision 1.4  1999/08/03 17:09:45  florian
-    * the alpha compiler can be compiled now
-
-  Revision 1.3  1999/08/02 17:14:08  florian
-    + changed the temp. generator to an object
-
-  Revision 1.2  1999/08/01 18:22:35  florian
-   * made it again compilable
-
-  Revision 1.1  1999/01/24 22:32:36  florian
-    * well, more changes, especially parts of secondload ported
-}

compiler/new/nstatmnt.pas

@@ -1,168 +0,0 @@
-{
-    $Id$
-    Copyright (C) 1998-2000 by Florian Klaempfl
-
-    This unit implements block, statement nodes etc.
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-unit nstatmnt;
-
-  interface
-
-    uses
-       tree;
-
-    type
-       pblocknode = ^tblocknode;
-       tblocknode = object(tunarynode)
-          constructor init(l : pnode);
-          procedure det_temp;virtual;
-          procedure det_resulttype;virtual;
-          procedure secondpass;virtual;
-       end;
-
-       pstatementnode = ^tstatementnode;
-       tstatementnode = object(tbinarynode)
-          constructor init(l,r : pnode);
-       end;
-
-  implementation
-
-    uses
-       tgobj,globtype,globals,symtable,verbose,cgbase,tgcpu;
-
-{****************************************************************************
-                                 TSTAMENTNODE
- ****************************************************************************}
-
-    constructor tstatementnode.init(l,r : pnode);
-
-      begin
-         inherited init(l,r);
-         treetype:=statementn;
-      end;
-
-{****************************************************************************
-                                 TBLOCKNODE
- ****************************************************************************}
-
-    constructor tblocknode.init(l : pnode);
-
-      begin
-         inherited init(l);
-         treetype:=blockn;
-      end;
-
-    procedure tblocknode.det_resulttype;
-
-      var
-         hp : pstatementnode;
-
-      begin
-         hp:=pstatementnode(left);
-         while assigned(hp) do
-           begin
-              if assigned(pstatementnode(hp)^.right) then
-                begin
-                   tg.cleartempgen;
-                   hp^.right^.det_resulttype;
-                   if (not (cs_extsyntax in aktmoduleswitches)) and
-                      assigned(hp^.right^.resulttype) and
-                      (hp^.right^.resulttype<>pdef(voiddef)) then
-                     CGMessage(cg_e_illegal_expression);
-                   if codegenerror then
-                     exit;
-                end;
-              hp:=pstatementnode(hp^.left);
-           end;
-      end;
-
-    procedure tblocknode.det_temp;
-
-      var
-         hp : pstatementnode;
-
-      begin
-         hp:=pstatementnode(left);
-         while assigned(hp) do
-           begin
-              if assigned(hp^.right) then
-                begin
-                   tg.cleartempgen;
-                   hp^.right^.det_temp;
-                   if (not (cs_extsyntax in aktmoduleswitches)) and
-                      assigned(hp^.right^.resulttype) and
-                      (hp^.right^.resulttype<>pdef(voiddef)) then
-                     CGMessage(cg_e_illegal_expression);
-                   if codegenerror then
-                     exit;
-                   hp^.registersint:=hp^.right^.registersint;
-                   hp^.registersfpu:=hp^.right^.registersfpu;
-{$ifdef SUPPORT_MMX}
-                   hp^.registersmmx:=hp^.right^.registersmmx;
-                   hp^.registerskni:=hp^.right^.registerskni;
-{$endif SUPPORT_MMX}
-                end
-              else
-                hp^.registersint:=0;
-
-              if hp^.registersint>registersint then
-                registersint:=hp^.registersint;
-              if hp^.registersfpu>registersfpu then
-                registersfpu:=hp^.registersfpu;
-{$ifdef SUPPORT_MMX}
-              if hp^.registersmmx>registersmmx then
-                registersmmx:=hp^.registersmmx;
-              if hp^.registerskni>registerskni then
-                registerskni:=hp^.registerskni;
-{$endif}
-              hp:=pstatementnode(hp^.left);
-           end;
-      end;
-
-    procedure tblocknode.secondpass;
-
-      begin
-         if assigned(left) then
-           left^.secondpass;
-      end;
-
-
-end.
-{
-  $Log$
-  Revision 1.1  2000-07-13 06:30:08  michael
-  + Initial import
-
-  Revision 1.5  2000/01/07 01:14:54  peter
-    * updated copyright to 2000
-
-  Revision 1.4  1999/08/05 14:58:14  florian
-    * some fixes for the floating point registers
-    * more things for the new code generator
-
-  Revision 1.3  1999/08/02 17:14:09  florian
-    + changed the temp. generator to an object
-
-  Revision 1.2  1999/08/01 23:36:43  florian
-    * some changes to compile the new code generator
-
-  Revision 1.1  1999/01/23 23:35:02  florian
-    + first versions
-
-}

compiler/new/pass_1.pas

@@ -1,196 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 by Florian Klaempfl
-
-    This unit implements the first pass of the 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.
-
- ****************************************************************************
-}
-{$ifdef tp}
-  {$F+}
-{$endif tp}
-unit pass_1;
-interface
-
-    uses
-       tree;
-
-    procedure firstpass(p : ptree);
-    procedure firstpassnode(p : pnode);
-    function  do_firstpass(var p : ptree) : boolean;
-    function  do_firstpassnode(var p : pnode) : boolean;
-
-implementation
-
-    uses
-      globtype,systems,
-      cobjects,verbose,globals,
-      aasm,symtable,types,
-      cgbase,cpuasm,cpubase
-      { not yet converted:
-      htypechk,tcadd,tccal,tccnv,tccon,tcflw,
-      tcinl,tcld,tcmat,tcmem,tcset
-      }
-      ;
-
-{*****************************************************************************
-                              FirstPass
-*****************************************************************************}
-
-{$ifdef dummy}
-    type
-       firstpassproc = procedure(var p : ptree);
-
-    procedure firstnothing(var p : ptree);
-      begin
-         p^.resulttype:=voiddef;
-      end;
-
-
-    procedure firsterror(var p : ptree);
-      begin
-         p^.error:=true;
-         codegenerror:=true;
-         p^.resulttype:=generrordef;
-      end;
-
-
-    procedure firststatement(var p : ptree);
-      begin
-         { left is the next statement in the list }
-         p^.resulttype:=voiddef;
-         { no temps over several statements }
-         cleartempgen;
-         { right is the statement itself calln assignn or a complex one }
-         firstpass(p^.right);
-         if (not (cs_extsyntax in aktmoduleswitches)) and
-            assigned(p^.right^.resulttype) and
-            (p^.right^.resulttype<>pdef(voiddef)) then
-           CGMessage(cg_e_illegal_expression);
-         if codegenerror then
-           exit;
-         p^.registers32:=p^.right^.registers32;
-         p^.registersfpu:=p^.right^.registersfpu;
-{$ifdef SUPPORT_MMX}
-         p^.registersmmx:=p^.right^.registersmmx;
-{$endif SUPPORT_MMX}
-         { left is the next in the list }
-         firstpass(p^.left);
-         if codegenerror then
-           exit;
-         if p^.right^.registers32>p^.registers32 then
-           p^.registers32:=p^.right^.registers32;
-         if p^.right^.registersfpu>p^.registersfpu then
-           p^.registersfpu:=p^.right^.registersfpu;
-{$ifdef SUPPORT_MMX}
-         if p^.right^.registersmmx>p^.registersmmx then
-           p^.registersmmx:=p^.right^.registersmmx;
-{$endif}
-      end;
-
-
-    procedure firstasm(var p : ptree);
-
-      begin
-        procinfo.flags:=procinfo^.flags or pi_uses_asm;
-      end;
-
-{$endif dummy}
-
-    procedure firstpassnode(p : pnode);
-
-      var
-         oldcodegenerror  : boolean;
-         oldlocalswitches : tlocalswitches;
-         oldpos           : tfileposinfo;
-{$ifdef extdebug}
-         str1,str2 : string;
-         oldp      : pnode;
-         not_first : boolean;
-{$endif extdebug}
-      begin
-         oldcodegenerror:=codegenerror;
-         oldpos:=aktfilepos;
-         oldlocalswitches:=aktlocalswitches;
-
-         if not p^.error then
-           begin
-              codegenerror:=false;
-              aktfilepos:=p^.fileinfo;
-              aktlocalswitches:=p^.localswitches;
-              p^.pass_1;
-              aktlocalswitches:=oldlocalswitches;
-              aktfilepos:=oldpos;
-              p^.error:=codegenerror;
-              codegenerror:=codegenerror or oldcodegenerror;
-           end
-         else
-           codegenerror:=true;
-      end;
-
-
-    function do_firstpass(var p : ptree) : boolean;
-
-      begin
-         codegenerror:=false;
-         do_firstpass:=codegenerror;
-      end;
-
-    procedure firstpass(p : ptree);
-
-      begin
-         codegenerror:=false;
-      end;
-
-    function do_firstpassnode(var p : pnode) : boolean;
-
-      begin
-         codegenerror:=false;
-         firstpassnode(p);
-         do_firstpassnode:=codegenerror;
-      end;
-
-
-end.
-{
-  $Log$
-  Revision 1.1  2000-07-13 06:30:08  michael
-  + Initial import
-
-  Revision 1.7  2000/01/07 01:14:54  peter
-    * updated copyright to 2000
-
-  Revision 1.6  1999/10/12 21:20:47  florian
-    * new codegenerator compiles again
-
-  Revision 1.5  1999/08/04 00:23:57  florian
-    * renamed i386asm and i386base to cpuasm and cpubase
-
-  Revision 1.4  1999/08/01 18:22:36  florian
-   * made it again compilable
-
-  Revision 1.3  1999/01/23 23:29:48  florian
-    * first running version of the new code generator
-    * when compiling exceptions under Linux fixed
-
-  Revision 1.2  1999/01/13 22:52:37  florian
-    + YES, finally the new code generator is compilable, but it doesn't run yet :(
-
-  Revision 1.1  1998/12/26 15:20:31  florian
-    + more changes for the new version
-
-}

compiler/new/pass_2.pas

@@ -1,507 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 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.
-
- ****************************************************************************
-}
-{$ifdef TP}
-  {$E+,F+,N+}
-{$endif}
-unit pass_2;
-interface
-
-uses
-  tree;
-
-{ produces assembler for the expression in variable p }
-{ and produces an assembler node at the end           }
-procedure generatecode(var _p : ptree);
-
-{ produces the actual code }
-function do_secondpass(p : pnode) : boolean;
-procedure secondpass(p : pnode);
-
-
-implementation
-
-   uses
-     globtype,systems,
-     cobjects,verbose,comphook,globals,files,
-     symconst,symtable,types,aasm,scanner,
-     pass_1,tgobj,cgbase,cgobj,tgcpu,cpuasm,cpubase,convtree
-{$ifdef GDB}
-     ,gdb
-{$endif}
-     ;
-   type
-       perrornode = ^terrornode;
-
-       terrornode = object(tnode)
-          constructor init;
-          procedure secondpass;virtual;
-       end;
-
-       tstatementnode = object(tbinarynode)
-          procedure secondpass;virtual;
-       end;
-
-       tblocknode = object(tunarynode)
-          procedure secondpass;virtual;
-       end;
-
-       tasmnode = object(tnode)
-          p_asm : paasmoutput;
-          object_preserved : boolean;
-          procedure secondpass;virtual;
-       end;
-
-{****************************************************************************
-                                 TERRORNODE
- ****************************************************************************}
-
-    constructor terrornode.init;
-
-      begin
-         inherited init;
-         treetype:=errorn;
-      end;
-
-    procedure terrornode.secondpass;
-
-      begin
-         error:=true;
-         codegenerror:=true;
-      end;
-
-{****************************************************************************
-                               TSTATEMENTNODE
- ****************************************************************************}
-
-    procedure tstatementnode.secondpass;
-
-      var
-         hp : pbinarynode;
-         oldrl : plinkedlist;
-
-      begin
-         hp:=@self;
-         while assigned(hp) do
-          begin
-            if assigned(hp^.right) then
-             begin
-               tg.cleartempgen;
-               oldrl:=temptoremove;
-               temptoremove:=new(plinkedlist,init);
-               hp^.right^.secondpass;
-               { release temp. ansi strings }
-               cg^.g_removetemps(exprasmlist,temptoremove);
-               dispose(temptoremove,done);
-               temptoremove:=oldrl;
-             end;
-            hp:=pbinarynode(hp^.left);
-          end;
-      end;
-
-    procedure tblocknode.secondpass;
-      begin
-         { do second pass on left node }
-         if assigned(left) then
-           left^.secondpass;
-      end;
-
-    procedure tasmnode.secondpass;
-      begin
-         exprasmlist^.concatlist(p_asm);
-         if not object_preserved then
-           cg^.g_maybe_loadself(exprasmlist);
-       end;
-
-     function generateexprlist(p : pnode) : plinkedlist;
-
-       var
-          l : plinkedlist;
-
-       begin
-          l:=new(plinkedlist,init);
-          p^.concattolist(l);
-          generateexprlist:=l;
-       end;
-
-     procedure secondpass(p : pnode);
-
-      var
-         oldcodegenerror  : boolean;
-         oldlocalswitches : tlocalswitches;
-         oldpos           : tfileposinfo;
-         l                : plinkedlist;
-         hp : pnode;
-
-      begin
-         if not(p^.error) then
-          begin
-            oldcodegenerror:=codegenerror;
-            oldlocalswitches:=aktlocalswitches;
-            oldpos:=aktfilepos;
-
-            aktfilepos:=p^.fileinfo;
-            aktlocalswitches:=p^.localswitches;
-            codegenerror:=false;
-
-            { do we have a list of statements? }
-            if p^.treetype=statementn then
-              begin
-                 l:=generateexprlist(p);
-                 { here we should do CSE and node reordering }
-                 hp:=pnode(l^.first);
-                 while assigned(hp) do
-                   begin
-                      if assigned(hp^.parent) then
-                        begin
-                           if nf_needs_truefalselabel in hp^.parent^.flags then
-                             begin
-                                if not(assigned(punarynode(hp^.parent)^.truelabel)) then
-                                  getlabel(punarynode(hp^.parent)^.truelabel);
-                                if not(assigned(punarynode(hp^.parent)^.falselabel)) then
-                                  getlabel(punarynode(hp^.parent)^.falselabel);
-                                truelabel:=punarynode(hp^.parent)^.truelabel;
-                                falselabel:=punarynode(hp^.parent)^.falselabel;
-                             end;
-                        end;
-                      hp^.secondpass;
-                      hp:=pnode(hp^.next);
-                   end;
-              end
-            else
-              p^.secondpass;
-
-            p^.error:=codegenerror;
-            codegenerror:=codegenerror or oldcodegenerror;
-            aktlocalswitches:=oldlocalswitches;
-            aktfilepos:=oldpos;
-          end
-         else
-           codegenerror:=true;
-      end;
-
-
-    function do_secondpass(p : pnode) : boolean;
-
-      begin
-         codegenerror:=false;
-         if not(p^.error) then
-           secondpass(p);
-         do_secondpass:=codegenerror;
-      end;
-
-    var
-       regvars : array[1..maxvarregs] of pvarsym;
-       regvars_para : array[1..maxvarregs] of boolean;
-       regvars_refs : array[1..maxvarregs] of longint;
-       parasym : boolean;
-
-    procedure searchregvars(p : pnamedindexobject);
-      var
-         i,j,k : longint;
-      begin
-         if (pvarsym(p)^.typ=varsym) and (vo_regable in pvarsym(p)^.varoptions) then
-           begin
-              { walk through all momentary register variables }
-              for i:=1 to maxvarregs do
-                begin
-                   { free register ? }
-                   if regvars[i]=nil then
-                     begin
-                        regvars[i]:=pvarsym(p);
-                        regvars_para[i]:=parasym;
-                        break;
-                     end;
-                   { else throw out a variable ? }
-                       j:=pvarsym(p)^.refs;
-                   { parameter get a less value }
-                   if parasym then
-                     begin
-                        if cs_littlesize in aktglobalswitches  then
-                          dec(j,1)
-                        else
-                          dec(j,100);
-                     end;
-                   if (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];
-                          end;
-                        { calc the new refs
-                        pvarsym(p)^.refs:=j; }
-                        regvars[i]:=pvarsym(p);
-                        regvars_para[i]:=parasym;
-                        regvars_refs[i]:=j;
-                        break;
-                     end;
-                end;
-           end;
-      end;
-
-    procedure generatecode(var _p : ptree);
-      var
-         i       : longint;
-         hr      : preference;
-{$ifdef i386}
-         regsize : topsize;
-{$endif i386}
-         p : pnode;
-
-      label
-         nextreg;
-      begin
-         temptoremove:=nil;
-         tg.cleartempgen;
-         { when size optimization only count occurrence }
-         if cs_littlesize in aktglobalswitches then
-           t_times:=1
-         else
-           { reference for repetition is 100 }
-           t_times:=100;
-         { clear register count }
-         tg.clearregistercount;
-         use_esp_stackframe:=false;
-
-         if not(do_firstpass(_p)) then
-           begin
-              p:=convtree2node(_p);
-              { max. optimizations     }
-              { only if no asm is used }
-              { and no try statement   }
-              if (cs_regalloc in aktglobalswitches) and
-                ((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
-                begin
-                   { can we omit the stack frame ? }
-                   { conditions:
-                     1. procedure (not main block)
-                     2. no constructor or destructor
-                     3. no call to other procedures
-                     4. no interrupt handler
-                   }
-                   if assigned(aktprocsym) then
-                     begin
-                       if not(aktprocsym^.definition^.proctypeoption in [potype_constructor,potype_destructor]) and
-                          not(po_interrupt in aktprocsym^.definition^.procoptions) and
-                          ((procinfo^.flags and pi_do_call)=0) and
-                          (lexlevel>=normal_function_level) then
-                       begin
-                         { use ESP as frame pointer }
-                         procinfo^.framepointer:=stack_pointer;
-                         use_esp_stackframe:=true;
-
-                         { calc parameter distance new }
-                         dec(procinfo^.framepointer_offset,pointersize);
-                         dec(procinfo^.selfpointer_offset,pointersize);
-
-                         { is this correct ???}
-                         { retoffset can be negativ for results in eax !! }
-                         { the value should be decreased only if positive }
-                         if procinfo^.return_offset>=0 then
-                           dec(procinfo^.return_offset,4);
-
-                         dec(procinfo^.para_offset,4);
-                         aktprocsym^.definition^.parast^.address_fixup:=procinfo^.para_offset;
-                       end;
-                     end;
-                   if (p^.registersint<maxvarregs) then
-                       begin
-                        for i:=1 to maxvarregs do
-                          regvars[i]:=nil;
-                        parasym:=false;
-                      {$ifdef tp}
-                        symtablestack^.foreach(searchregvars);
-                      {$else}
-                        symtablestack^.foreach(@searchregvars);
-                      {$endif}
-                        { copy parameter into a register ? }
-                        parasym:=true;
-                      {$ifdef tp}
-                        symtablestack^.next^.foreach(searchregvars);
-                      {$else}
-                        symtablestack^.next^.foreach(@searchregvars);
-                      {$endif}
-                        { hold needed registers free }
-                        for i:=maxvarregs downto maxvarregs-p^.registersint+1 do
-                          regvars[i]:=nil;
-                        { now assign register }
-                        for i:=1 to maxvarregs-p^.registersint do
-                          begin
-                             if assigned(regvars[i]) then
-                               begin
-                                  { it is nonsens, to copy the variable to }
-                                  { a register because we need then much   }
-                                  { pushes ?                               }
-                                  if tg.reg_pushes[varregs[i]]>=regvars[i]^.refs then
-                                    begin
-                                       regvars[i]:=nil;
-                                       goto nextreg;
-                                    end;
-
-                                  { register is no longer available for }
-                                  { expressions                         }
-                                  { search the register which is the most }
-                                  { unused                                }
-                                  exclude(tg.availabletempregsint,varregs[i]);
-                                  tg.is_reg_var[varregs[i]]:=true;
-                                  dec(tg.c_countusableregsint);
-
-                                  { possibly no 32 bit register are needed }
-                                  { call by reference/const ? }
-                                  {!!!!!!!!!!!!!!
-                                  if (regvars[i]^.varspez=vs_var) or
-                                     ((regvars[i]^.varspez=vs_const) and
-                                       dont_copy_const_param(regvars[i]^.definition)) then
-                                    begin
-                                       regvars[i]^.reg:=varregs[i];
-                                       regsize:=sizepostfix_pointer;
-                                    end
-                                  else
-                                   if (regvars[i]^.definition^.deftype=orddef) and
-                                      (porddef(regvars[i]^.definition)^.size=1) then
-                                    begin
-                                       regvars[i]^.reg:=regtoreg8(varregs[i]);
-                                       regsize:=S_B;
-                                    end
-                                  else
-                                   if (regvars[i]^.definition^.deftype=orddef) and
-                                      (porddef(regvars[i]^.definition)^.size=2) then
-                                    begin
-                                       regvars[i]^.reg:=regtoreg16(varregs[i]);
-                                       regsize:=S_W;
-                                    end
-                                  else
-                                   if (regvars[i]^.definition^.deftype=orddef) and
-                                      (porddef(regvars[i]^.definition)^.size=4) then
-                                    begin
-                                       regvars[i]^.reg:=regtoreg32(varregs[i]);
-                                       regsize:=S_L;
-                                    end
-                                  else
-                                   if (cf_registers64 in cpuflags) and
-                                      (regvars[i]^.definition^.deftype=orddef) and
-                                      (porddef(regvars[i]^.definition)^.size=8) then
-                                    begin
-                                       regvars[i]^.reg:=regtoreg64(varregs[i]);
-                                       regsize:=S_Q;
-                                    end;
-                                  }
-                                  { parameter must be load }
-                                  if regvars_para[i] then
-                                    begin
-                                       { procinfo is there actual,      }
-                                       { because we can't never be in a }
-                                       { nested procedure               }
-                                       { when loading parameter to reg  }
-                                       new(hr);
-                                       reset_reference(hr^);
-                                       hr^.offset:=pvarsym(regvars[i])^.address+procinfo^.para_offset;
-                                       hr^.base:=procinfo^.framepointer;
-{$ifdef i386}
-                                       procinfo^.aktentrycode^.concat(new(paicpu,op_ref_reg(A_MOV,regsize,
-                                         hr,regvars[i]^.reg)));
-{$endif i386}
-{$ifdef m68k}
-                                       procinfo.aktentrycode^.concat(new(pai68k,op_ref_reg(A_MOVE,regsize,
-                                         hr,regvars[i]^.reg)));
-{$endif m68k}
-                                       tg.unusedregsint:=tg.unusedregsint - [regvars[i]^.reg];
-                                    end;
-                                  { procedure uses this register }
-                                  include(tg.usedinproc,varregs[i]);
-                               end;
-                             nextreg:
-{$ifdef i386}
-                               { dummy }
-                               regsize:=S_W;
-{$endif i386}
-                          end;
-                        if (status.verbosity and v_debug)=v_debug then
-                          begin
-                             for i:=1 to maxvarregs do
-                               begin
-                                  if assigned(regvars[i]) then
-                                    Message3(cg_d_register_weight,reg2str(regvars[i]^.reg),
-                                           tostr(regvars[i]^.refs),regvars[i]^.name);
-                               end;
-                          end;
-                     end;
-                end;
-              if assigned(aktprocsym) and
-                 (pocall_inline in aktprocsym^.definition^.proccalloptions) then
-                make_const_global:=true;
-
-              do_secondpass(p);
-
-              if assigned(procinfo^.def) then
-                procinfo^.def^.fpu_used:=p^.registersfpu;
-
-              { all registers can be used again }
-              tg.resetusableregisters;
-           end;
-         procinfo^.aktproccode^.concatlist(exprasmlist);
-         make_const_global:=false;
-      end;
-
-end.
-{
-  $Log$
-  Revision 1.1  2000-07-13 06:30:08  michael
-  + Initial import
-
-  Revision 1.11  2000/02/20 20:49:46  florian
-    * newcg is compiling
-    * fixed the dup id problem reported by Paul Y.
-
-  Revision 1.10  2000/01/07 01:14:54  peter
-    * updated copyright to 2000
-
-  Revision 1.9  1999/12/06 18:17:10  peter
-    * newcg compiler compiles again
-
-  Revision 1.8  1999/10/12 21:20:47  florian
-    * new codegenerator compiles again
-
-  Revision 1.7  1999/08/25 12:00:13  jonas
-    * changed pai386, paippc and paiapha (same for tai*) to paicpu (taicpu)
-
-  Revision 1.6  1999/08/05 14:58:15  florian
-    * some fixes for the floating point registers
-    * more things for the new code generator
-
-  Revision 1.5  1999/08/04 00:23:58  florian
-    * renamed i386asm and i386base to cpuasm and cpubase
-
-  Revision 1.4  1999/08/03 17:09:46  florian
-    * the alpha compiler can be compiled now
-
-  Revision 1.3  1999/08/03 00:30:36  florian
-    * again a fix for the alpha
-
-  Revision 1.2  1999/08/03 00:28:03  florian
-    * some updates to compile for the alpha
-
-  Revision 1.1  1999/08/03 00:07:16  florian
-    * initial revision
-
-}

compiler/new/pp.pas

@@ -1,311 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 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.
-
- ****************************************************************************}
-
-{
-  possible compiler switches (* marks a currently required switch):
-  -----------------------------------------------------------------
-  USE_RHIDE           generates errors and warning in an format recognized
-                      by rhide
-  TP                  to compile the compiler with Turbo or Borland Pascal
-  GDB*                support of the GNU Debugger
-  I386                generate a compiler for the Intel i386+
-  M68K                generate a compiler for the M68000
-  USEOVERLAY          compiles a TP version which uses overlays
-  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
-  -----------------------------------------------------------------
-
-  Required switches for a i386 compiler be compiled by Free Pascal Compiler:
-  GDB;I386
-
-  Required switches for a i386 compiler be compiled by Turbo Pascal:
-  GDB;I386;TP
-
-  Required switches for a 68000 compiler be compiled by Turbo Pascal:
-  GDB;M68k;TP
-}
-
-{$ifdef FPC}
-   {$ifndef GDB}
-      { people can try to compile without GDB }
-      { $error The compiler switch GDB must be defined}
-   {$endif GDB}
-
-   { One of Alpha, I386 or M68K must be defined }
-   {$UNDEF CPUOK}
-
-   {$ifdef I386}
-   {$define CPUOK}
-   {$endif}
-
-   {$ifdef M68K}
-   {$ifndef CPUOK}
-   {$DEFINE CPUOK}
-   {$else}
-     {$fatal cannot define two CPU switches}
-   {$endif}
-   {$endif}
-
-   {$ifdef alpha}
-   {$ifndef CPUOK}
-   {$DEFINE CPUOK}
-   {$else}
-     {$fatal cannot define two CPU switches}
-   {$endif}
-   {$endif}
-
-   {$ifdef powerpc}
-   {$ifndef CPUOK}
-   {$DEFINE CPUOK}
-   {$else}
-     {$fatal cannot define two CPU switches}
-   {$endif}
-   {$endif}
-
-
-   {$ifndef CPUOK}
-   {$fatal One of the switches I386,Alpha, PowerPC or M68K must be defined}
-   {$endif}
-
-   {$ifdef support_mmx}
-     {$ifndef i386}
-       {$fatal I386 switch must be on for MMX support}
-     {$endif i386}
-   {$endif support_mmx}
-{$endif}
-
-{$ifdef TP}
-  {$IFNDEF DPMI}
-    {$M 24000,0,655360}
-  {$ELSE}
-    {$M 65000}
-  {$ENDIF DPMI}
-  {$E+,N+,F+,S-,R-}
-{$endif TP}
-
-
-program pp;
-
-{$IFDEF TP}
-  {$UNDEF PROFILE}
-  {$IFDEF DPMI}
-    {$UNDEF USEOVERLAY}
-  {$ENDIF}
-{$ENDIF}
-{$ifdef FPC}
-  {$UNDEF USEOVERLAY}
-{$ENDIF}
-
-uses
-{$ifdef useoverlay}
-  {$ifopt o+}
-    Overlay,ppovin,
-  {$else}
-    {$error You must compile with the $O+ switch}
-  {$endif}
-{$endif useoverlay}
-{$ifdef profile}
-  profile,
-{$endif profile}
-{$ifdef FPC}
-{$ifdef heaptrc}
-  ppheap,
-{$endif heaptrc}
-{$ifdef Unix}
-  catch,
-{$endif}
-{$endif FPC}
-  globals,compiler
-  ;
-
-{$ifdef useoverlay}
-  {$O files}
-  {$O globals}
-  {$O hcodegen}
-  {$O pass_1}
-  {$O pass_2}
-  {$O tree}
-  {$O types}
-  {$O objects}
-  {$O options}
-  {$O cobjects}
-  {$O globals}
-  {$O systems}
-  {$O parser}
-  {$O pbase}
-  {$O pdecl}
-  {$O pexports}
-  {$O pexpr}
-  {$O pmodules}
-  {$O pstatmnt}
-  {$O psub}
-  {$O psystem}
-  {$O ptconst}
-  {$O script}
-  {$O switches}
-  {$O comphook}
-  {$O dos}
-  {$O scanner}
-  {$O symtable}
-  {$O objects}
-  {$O aasm}
-  {$O link}
-  {$O assemble}
-  {$O messages}
-  {$O gendef}
-  {$O import}
-{$ifdef i386}
-  {$O os2_targ}
-  {$O win_targ}
-{$endif i386}
-  {$ifdef gdb}
-        {$O gdb}
-  {$endif gdb}
-  {$ifdef i386}
-        {$O opts386}
-        {$O i386base}
-        {$O i386asm}
-        {$O tgeni386}
-        {$ifndef NOOPT}
-          {$O aopt386}
-        {$endif}
-        {$IfNDef Nora386dir}
-          {$O ra386dir}
-        {$endif}
-        {$IfNDef Nora386int}
-          {$O ra386int}
-        {$endif}
-        {$IfNDef Nora386att}
-          {$O ra386att}
-        {$endif}
-        {$ifndef NoAg386Int}
-          {$O ag386int}
-        {$endif}
-        {$ifndef NoAg386Att}
-          {$O ag386att}
-        {$endif}
-        {$ifndef NoAg386Nsm}
-          {$O ag386nsm}
-        {$endif}
-  {$endif}
-  {$ifdef m68k}
-        {$O opts68k}
-        {$O m68k}
-        {$O cga68k}
-        {$O tgen68k}
-        {$O cg68kadd}
-        {$O cg68kcal}
-        {$O cg68kcnv}
-        {$O cg68kcon}
-        {$O cg68kflw}
-        {$O cg68kld}
-        {$O cg68kinl}
-        {$O cg68kmat}
-        {$O cg68kset}
-        {$IfNDef Nora68kMot}
-          {$O ra68kmot}
-        {$endif}
-        {$IfNDef Noag68kGas}
-          {$O ag68kgas}
-        {$endif}
-        {$IfNDef Noag68kMot}
-          {$O ag68kmot}
-        {$endif}
-        {$IfNDef Noag68kMit}
-          {$O ag68kmit}
-        {$endif}
-  {$endif}
-{$endif useoverlay}
-
-var
-  oldexit : pointer;
-procedure myexit;{$ifndef FPC}far;{$endif}
-begin
-  exitproc:=oldexit;
-{ Show Runtime error if there was an error }
-  if (erroraddr<>nil) then
-   begin
-     case exitcode of
-      202 : begin
-              erroraddr:=nil;
-              Writeln('Error: Stack Overflow');
-            end;
-      203 : begin
-              erroraddr:=nil;
-              Writeln('Error: Out of memory');
-            end;
-     end;
-     Writeln('Compilation aborted at line ',aktfilepos.line);
-   end;
-end;
-
-begin
-  oldexit:=exitproc;
-  exitproc:=@myexit;
-{$ifdef UseOverlay}
-  InitOverlay;
-{$endif}
-
-{ Call the compiler with empty command, so it will take the parameters }
-  Halt(Compile(''));
-end.
-{
-  $Log$
-  Revision 1.2  2002-06-02 08:41:22  marco
-   * renamefest
-
-  Revision 1.1  2000/07/13 06:30:08  michael
-  + Initial import
-
-  Revision 1.8  2000/01/07 01:14:54  peter
-    * updated copyright to 2000
-
-  Revision 1.7  1999/10/12 21:20:47  florian
-    * new codegenerator compiles again
-
-  Revision 1.6  1999/08/04 12:59:22  jonas
-    * all tokes now start with an underscore
-    * PowerPC compiles!!
-
-  Revision 1.5  1999/08/02 21:29:06  florian
-    * the main branch psub.pas is now used for
-      newcg compiler
-
-  Revision 1.4  1999/08/02 17:15:03  michael
-  + CPU check better
-
-  Revision 1.3  1999/08/02 17:14:10  florian
-    + changed the temp. generator to an object
-
-  Revision 1.2  1999/08/01 18:22:37  florian
-   * made it again compilable
-
-  Revision 1.1  1998/12/26 15:20:31  florian
-    + more changes for the new version
-
-}

compiler/new/symtable/cobjects.pas

@@ -1,1998 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1993-98 by Florian Klaempfl
-
-    This module provides some basic 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.
-
- ****************************************************************************
-}
-
-{$ifdef tp}
-  {$E+,N+,D+,F+}
-{$endif}
-{$I-}
-{$R-}{ necessary for crc calculation }
-
-unit cobjects;
-
-
-interface
-
-uses    strings,objects
-{$IFDEF TP}
-        ,xobjects
-{$ENDIF}
-{$ifndef Unix}
-        ,dos
-{$else}
-	{$ifdef VER1_0}
-        ,linux
-	{$else}
-   	,Unix
-	{$endif}
-{$endif};
-
-    const
-       { the real size will be [-hasharray..hasharray] ! }
-{$ifdef TP}
-       hasharraysize = 127;
-{$else}
-       hasharraysize = 2047;
-{$endif}
-
-
-{$ifdef TP}
-       { redeclare dword only in case of emergency, some small things
-         of the compiler won't work then correctly (FK)
-       }
-type   dword = longint;
-{$endif TP}
-
-type   pfileposinfo = ^tfileposinfo;
-       tfileposinfo = record
-         line      : longint;
-         column    : word;
-         fileindex : word;
-       end;
-
-
-       { some help data types }
-       pstringitem = ^tstringitem;
-       tstringitem = record
-          data : pstring;
-          next : pstringitem;
-          fileinfo : tfileposinfo; { pointer to tinputfile }
-       end;
-
-       plinkedlist_item = ^tlinkedlist_item;
-       tlinkedlist_item = object(Tobject)
-          next,previous : plinkedlist_item;
-       {$IFDEF TP}
-          constructor init;
-       {$ENDIF TP}
-          function getcopy:plinkedlist_item;virtual;
-       end;
-
-       pstring_item = ^tstring_item;
-       tstring_item = object(tlinkedlist_item)
-          str : pstring;
-          constructor init(const s : string);
-          destructor done;virtual;
-       end;
-
-
-       { this implements a double linked list }
-       plinkedlist = ^tlinkedlist;
-       tlinkedlist = object(Tobject)
-          first,last : plinkedlist_item;
-       {$IFDEF TP}
-          constructor init;
-       {$ENDIF TP}
-          destructor done;virtual;
-
-          { disposes the items of the list }
-          procedure clear;
-
-          { concats a new item at the end }
-          procedure concat(p : plinkedlist_item);
-
-          { inserts a new item at the begin }
-          procedure insert(p : plinkedlist_item);
-
-          { inserts another list at the begin and make this list empty }
-          procedure insertlist(p : plinkedlist);
-
-          { concats another list at the end and make this list empty }
-          procedure concatlist(p : plinkedlist);
-
-          procedure concatlistcopy(p : plinkedlist);
-
-          { removes p from the list (p isn't disposed) }
-          { it's not tested if p is in the list !      }
-          procedure remove(p : plinkedlist_item);
-
-          { is the linkedlist empty ? }
-          function  empty:boolean;
-       end;
-
-
-       { String Queue}
-       PStringQueue=^TStringQueue;
-       TStringQueue=object(Tobject)
-         first,last : PStringItem;
-       {$IFDEF TP}
-         constructor init;
-       {$ENDIF TP}
-         destructor Done;virtual;
-         function Empty:boolean;
-         function Get:string;
-         function Find(const s:string):PStringItem;
-         function Delete(const s:string):boolean;
-         procedure Insert(const s:string);
-         procedure Concat(const s:string);
-         procedure Clear;
-       end;
-
-
-       { string container }
-       pstringcontainer = ^tstringcontainer;
-       tstringcontainer = object(Tobject)
-          root,
-          last    : pstringitem;
-          doubles : boolean;  { if this is set to true, doubles are allowed }
-          constructor init;
-          constructor init_no_double;
-          destructor done;virtual;
-
-          { true when the container is empty }
-          function empty:boolean;
-
-          { inserts a string }
-          procedure insert(const s : string);
-          procedure insert_with_tokeninfo(const s : string;const file_info : tfileposinfo);
-
-          { gets a string }
-          function get : string;
-          function get_with_tokeninfo(var file_info : tfileposinfo) : string;
-
-          { true if string is in the container }
-          function find(const s:string):boolean;
-
-          { deletes all strings }
-          procedure clear;
-       end;
-
-
-       Pnamedindexobject=^Tnamedindexobject;
-       Tnamedindexobject=object(Tobject)
-         indexnr    : longint;
-         _name      : Pstring;
-         next,
-         left,right : Pnamedindexobject;
-         speedvalue : longint;
-         {Note: Initname was changed to init. Init without a name is
-                undesired, the object is called _named_ index object.}
-         constructor init(const n:string);
-         function  name:string;virtual;
-         destructor  done;virtual;
-       end;
-
-       Pdictionaryhasharray=^Tdictionaryhasharray;
-       Tdictionaryhasharray=array[-hasharraysize..hasharraysize] of Pnamedindexobject;
-
-       Tnamedindexcallback = procedure(p:Pnamedindexobject);
-
-       Pdictionary=^Tdictionary;
-       Tdictionary=object(Tobject)
-         replace_existing : boolean;
-         constructor init;
-         destructor  done;virtual;
-         procedure usehash;
-         procedure clear;
-         function  empty:boolean;
-         procedure foreach(proc2call:Tnamedindexcallback);
-         function  insert(obj:Pnamedindexobject):Pnamedindexobject;
-         function  rename(const olds,news : string):Pnamedindexobject;
-         function  search(const s:string):Pnamedindexobject;
-         function  speedsearch(const s:string;speedvalue:longint):Pnamedindexobject;
-       private
-         root      : Pnamedindexobject;
-         hasharray : Pdictionaryhasharray;
-         procedure cleartree(obj:Pnamedindexobject);
-         function  insertnode(newnode:Pnamedindexobject;var currnode:Pnamedindexobject):Pnamedindexobject;
-         function delete(const s:string):Pnamedindexobject;
-         procedure inserttree(currtree,currroot:Pnamedindexobject);
-       end;
-
-       pdynamicarray = ^tdynamicarray;
-       tdynamicarray = object(Tobject)
-         posn,
-         count,
-         limit,
-         elemlen,
-         growcount : longint;
-         data      : pchar;
-         constructor init(Aelemlen,Agrow:longint);
-         destructor  done;virtual;
-         function  size:longint;
-         function  usedsize:longint;
-         procedure grow;
-         procedure align(i:longint);
-         procedure seek(i:longint);
-         procedure write(var d;len:longint);
-         procedure read(var d;len:longint);
-         procedure writepos(pos:longint;var d;len:longint);
-         procedure readpos(pos:longint;var d;len:longint);
-       end;
-
-{$ifdef BUFFEREDFILE}
-       { this is implemented to allow buffered binary I/O }
-       pbufferedfile = ^tbufferedfile;
-       tbufferedfile = object(Tobject)
-           f : file;
-           buf : pchar;
-           bufsize,buflast,bufpos : longint;
-
-           { 0 closed, 1 input, 2 output }
-           iomode : byte;
-
-           { true, if the compile should change the endian of the output }
-           change_endian : boolean;
-
-           { calcules a crc for the file,                                    }
-           { but it's assumed, that there no seek while do_crc is true       }
-           do_crc : boolean;
-           crc : longint;
-           { temporary closing feature }
-           tempclosed : boolean;
-           tempmode : byte;
-           temppos : longint;
-
-           { inits a buffer with the size bufsize which is assigned to }
-           { the file  filename                                        }
-           constructor init(const filename : string;_bufsize : longint);
-
-           { closes the file, if needed, and releases the memory }
-           destructor done;virtual;
-
-           { opens the file for input, other accesses are rejected }
-           function  reset:boolean;
-
-           { opens the file for output, other accesses are rejected }
-           procedure rewrite;
-
-           { reads or writes the buffer from or to disk }
-           procedure flush;
-
-           { writes a string to the file }
-           { the string is written without a length byte }
-           procedure write_string(const s : string);
-
-           { writes a zero terminated string }
-           procedure write_pchar(p : pchar);
-
-           { write specific data types, takes care of }
-           { byte order                               }
-           procedure write_byte(b : byte);
-           procedure write_word(w : word);
-           procedure write_long(l : longint);
-           procedure write_double(d : double);
-
-           { writes any data }
-           procedure write_data(var data;count : longint);
-
-           { reads any data }
-           procedure read_data(var data;bytes : longint;var count : longint);
-
-           { closes the file and releases the buffer }
-           procedure close;
-
-           { temporary closing }
-           procedure tempclose;
-           procedure tempreopen;
-
-           { goto the given position }
-           procedure seek(l : longint);
-
-           { installes an user defined buffer      }
-           { and releases the old one, but be      }
-           { careful, if the old buffer contains   }
-           { data, this data is lost               }
-           procedure setbuf(p : pchar;s : longint);
-
-           { reads the file time stamp of the file, }
-           { the file must be opened                }
-           function getftime : longint;
-
-           { returns filesize }
-           function getsize : longint;
-
-           { returns the path }
-           function getpath : string;
-
-           { resets the crc }
-           procedure clear_crc;
-
-           { returns the crc }
-           function getcrc : longint;
-       end;
-{$endif BUFFEREDFILE}
-
-    function getspeedvalue(const s : string) : longint;
-
-    { releases the string p and assignes nil to p }
-    { if p=nil then freemem isn't called          }
-    procedure stringdispose(var p : pstring);
-
-    { idem for ansistrings }
-    procedure ansistringdispose(var p : pchar;length : longint);
-
-    { allocates mem for a copy of s, copies s to this mem and returns }
-    { a pointer to this mem                                           }
-    function stringdup(const s : string) : pstring;
-
-    { allocates memory for s and copies s as zero terminated string
-      to that mem and returns a pointer to that mem }
-    function strpnew(const s : string) : pchar;
-
-    { makes a char lowercase, with spanish, french and german char set }
-    function lowercase(c : char) : char;
-
-    { makes zero terminated string to a pascal string }
-    { the data in p is modified and p is returned     }
-    function pchar2pstring(p : pchar) : pstring;
-
-    { ambivalent to pchar2pstring }
-    function pstring2pchar(p : pstring) : pchar;
-
-  implementation
-
-{$ifndef OLDSPEEDVALUE}
-
-{*****************************************************************************
-                                   Crc 32
-*****************************************************************************}
-
-var
-{$ifdef Delphi}
-  Crc32Tbl : array[0..255] of longword;
-{$else Delphi}
-  Crc32Tbl : array[0..255] of longint;
-{$endif Delphi}
-
-procedure MakeCRC32Tbl;
-var
-{$ifdef Delphi}
-  crc : longword;
-{$else Delphi}
-  crc : longint;
-{$endif Delphi}
-  i,n : byte;
-begin
-  for i:=0 to 255 do
-   begin
-     crc:=i;
-     for n:=1 to 8 do
-      if odd(crc) then
-       crc:=(crc shr 1) xor $edb88320
-      else
-       crc:=crc shr 1;
-     Crc32Tbl[i]:=crc;
-   end;
-end;
-
-
-{$ifopt R+}
-  {$define Range_check_on}
-{$endif opt R+}
-
-{$R- needed here }
-{CRC 32}
-Function GetSpeedValue(Const s:String):longint;
-var
-  i,InitCrc : longint;
-begin
-  if Crc32Tbl[1]=0 then
-   MakeCrc32Tbl;
-  InitCrc:=$ffffffff;
-  for i:=1to Length(s) do
-   InitCrc:=Crc32Tbl[byte(InitCrc) xor ord(s[i])] xor (InitCrc shr 8);
-  GetSpeedValue:=InitCrc;
-end;
-
-{$ifdef Range_check_on}
-  {$R+}
-  {$undef Range_check_on}
-{$endif Range_check_on}
-
-{$else}
-
-{$ifndef TP}
-    function getspeedvalue(const s : string) : longint;
-      var
-        p1,p2:^byte;
-        i : longint;
-
-      begin
-        p1:=@s;
-        longint(p2):=longint(p1)+p1^+1;
-        inc(longint(p1));
-        i:=0;
-        while p1<>p2 do
-         begin
-           i:=i + ord(p1^);
-           inc(longint(p1));
-         end;
-        getspeedvalue:=i;
-      end;
-{$else}
-    function getspeedvalue(const s : string) : longint;
-      type
-        ptrrec=record
-          ofs,seg:word;
-        end;
-      var
-        l,w   : longint;
-        p1,p2 : ^byte;
-      begin
-        p1:=@s;
-        ptrrec(p2).seg:=ptrrec(p1).seg;
-        ptrrec(p2).ofs:=ptrrec(p1).ofs+p1^+1;
-        inc(p1);
-        l:=0;
-        while p1<>p2 do
-         begin
-           l:=l + ord(p1^);
-           inc(p1);
-         end;
-        getspeedvalue:=l;
-      end;
-{$endif}
-
-{$endif OLDSPEEDVALUE}
-
-
-    function pchar2pstring(p : pchar) : pstring;
-      var
-         w,i : longint;
-      begin
-         w:=strlen(p);
-         for i:=w-1 downto 0 do
-           p[i+1]:=p[i];
-         p[0]:=chr(w);
-         pchar2pstring:=pstring(p);
-      end;
-
-
-    function pstring2pchar(p : pstring) : pchar;
-      var
-         w,i : longint;
-      begin
-         w:=length(p^);
-         for i:=1 to w do
-           p^[i-1]:=p^[i];
-         p^[w]:=#0;
-         pstring2pchar:=pchar(p);
-      end;
-
-
-    function lowercase(c : char) : char;
-       begin
-          case c of
-             #65..#90 : c := chr(ord (c) + 32);
-             #154 : c:=#129;  { german }
-             #142 : c:=#132;  { german }
-             #153 : c:=#148;  { german }
-             #144 : c:=#130;  { french }
-             #128 : c:=#135;  { french }
-             #143 : c:=#134;  { swedish/norge (?) }
-             #165 : c:=#164;  { spanish }
-             #228 : c:=#229;  { greek }
-             #226 : c:=#231;  { greek }
-             #232 : c:=#227;  { greek }
-          end;
-          lowercase := c;
-       end;
-
-
-    function strpnew(const s : string) : pchar;
-      var
-         p : pchar;
-      begin
-         getmem(p,length(s)+1);
-         strpcopy(p,s);
-         strpnew:=p;
-      end;
-
-
-    procedure stringdispose(var p : pstring);
-      begin
-         if assigned(p) then
-           freemem(p,length(p^)+1);
-         p:=nil;
-      end;
-
-
-    procedure ansistringdispose(var p : pchar;length : longint);
-      begin
-         if assigned(p) then
-           freemem(p,length+1);
-         p:=nil;
-      end;
-
-
-    function stringdup(const s : string) : pstring;
-      var
-         p : pstring;
-      begin
-         getmem(p,length(s)+1);
-         p^:=s;
-         stringdup:=p;
-      end;
-
-
-{****************************************************************************
-                                  TStringQueue
-****************************************************************************}
-
-{$IFDEF TP}
-constructor Tstringqueue.init;
-
-begin
-    setparent(typeof(Tobject));
-end;
-{$ENDIF TP}
-
-function TStringQueue.Empty:boolean;
-begin
-  Empty:=(first=nil);
-end;
-
-
-function TStringQueue.Get:string;
-var
-  newnode : pstringitem;
-begin
-  if first=nil then
-   begin
-     Get:='';
-     exit;
-   end;
-  Get:=first^.data^;
-  stringdispose(first^.data);
-  newnode:=first;
-  first:=first^.next;
-  dispose(newnode);
-end;
-
-
-procedure TStringQueue.Insert(const s:string);
-var
-  newnode : pstringitem;
-begin
-  new(newnode);
-  newnode^.next:=first;
-  newnode^.data:=stringdup(s);
-  first:=newnode;
-  if last=nil then
-   last:=newnode;
-end;
-
-
-function TStringQueue.Delete(const s:string):boolean;
-var
-  prev,p : PStringItem;
-begin
-  Delete:=false;
-  prev:=nil;
-  p:=first;
-  while assigned(p) do
-   begin
-     if p^.data^=s then
-      begin
-        if p=last then
-          last:=prev;
-        if assigned(prev) then
-         prev^.next:=p^.next
-        else
-         first:=p^.next;
-        dispose(p);
-        Delete:=true;
-        exit;
-      end;
-     prev:=p;
-     p:=p^.next;
-   end;
-end;
-
-function TStringQueue.Find(const s:string):PStringItem;
-var
-  p : PStringItem;
-begin
-  p:=first;
-  while assigned(p) do
-   begin
-     if p^.data^=s then
-      break;
-     p:=p^.next;
-   end;
-  Find:=p;
-end;
-
-procedure TStringQueue.Concat(const s:string);
-var
-  newnode : pstringitem;
-begin
-  new(newnode);
-  newnode^.next:=nil;
-  newnode^.data:=stringdup(s);
-  if first=nil then
-   first:=newnode
-  else
-   last^.next:=newnode;
-  last:=newnode;
-end;
-
-
-procedure TStringQueue.Clear;
-var
-  newnode : pstringitem;
-begin
-  while (first<>nil) do
-   begin
-     newnode:=first;
-     stringdispose(first^.data);
-     first:=first^.next;
-     dispose(newnode);
-   end;
-end;
-
-
-destructor TStringQueue.Done;
-begin
-  Clear;
-end;
-
-{****************************************************************************
-                           TSTRINGCONTAINER
- ****************************************************************************}
-
-    constructor tstringcontainer.init;
-      begin
-         inherited init;
-         {$IFDEF TP}setparent(typeof(Tobject));{$ENDIF}
-         doubles:=true;
-      end;
-
-
-    constructor tstringcontainer.init_no_double;
-      begin
-         doubles:=false;
-         {$IFDEF TP}setparent(typeof(Tobject));{$ENDIF}
-      end;
-
-
-    destructor tstringcontainer.done;
-      begin
-         clear;
-      end;
-
-
-    function tstringcontainer.empty:boolean;
-      begin
-        empty:=(root=nil);
-      end;
-
-
-    procedure tstringcontainer.insert(const s : string);
-      var
-        newnode : pstringitem;
-      begin
-         if not(doubles) then
-           begin
-              newnode:=root;
-              while assigned(newnode) do
-                begin
-                   if newnode^.data^=s then exit;
-                   newnode:=newnode^.next;
-                end;
-           end;
-         new(newnode);
-         newnode^.next:=nil;
-         newnode^.data:=stringdup(s);
-         if root=nil then root:=newnode
-           else last^.next:=newnode;
-         last:=newnode;
-      end;
-
-
-    procedure tstringcontainer.insert_with_tokeninfo(const s : string; const file_info : tfileposinfo);
-      var
-         newnode : pstringitem;
-      begin
-         if not(doubles) then
-           begin
-              newnode:=root;
-              while assigned(newnode) do
-                begin
-                   if newnode^.data^=s then exit;
-                   newnode:=newnode^.next;
-                end;
-           end;
-         new(newnode);
-         newnode^.next:=nil;
-         newnode^.data:=stringdup(s);
-         newnode^.fileinfo:=file_info;
-         if root=nil then root:=newnode
-           else last^.next:=newnode;
-         last:=newnode;
-      end;
-
-
-    procedure tstringcontainer.clear;
-      var
-         newnode : pstringitem;
-      begin
-         newnode:=root;
-         while assigned(newnode) do
-           begin
-              stringdispose(newnode^.data);
-              root:=newnode^.next;
-              dispose(newnode);
-              newnode:=root;
-           end;
-         last:=nil;
-         root:=nil;
-      end;
-
-
-    function tstringcontainer.get : string;
-      var
-         newnode : pstringitem;
-      begin
-         if root=nil then
-          get:=''
-         else
-          begin
-            get:=root^.data^;
-            newnode:=root;
-            root:=root^.next;
-            stringdispose(newnode^.data);
-            dispose(newnode);
-          end;
-      end;
-
-
-    function tstringcontainer.get_with_tokeninfo(var file_info : tfileposinfo) : string;
-      var
-         newnode : pstringitem;
-      begin
-         if root=nil then
-          begin
-             get_with_tokeninfo:='';
-             file_info.fileindex:=0;
-             file_info.line:=0;
-             file_info.column:=0;
-          end
-         else
-          begin
-            get_with_tokeninfo:=root^.data^;
-            newnode:=root;
-            root:=root^.next;
-            stringdispose(newnode^.data);
-            file_info:=newnode^.fileinfo;
-            dispose(newnode);
-          end;
-      end;
-
-
-    function tstringcontainer.find(const s:string):boolean;
-      var
-         newnode : pstringitem;
-      begin
-        find:=false;
-        newnode:=root;
-        while assigned(newnode) do
-         begin
-           if newnode^.data^=s then
-            begin
-              find:=true;
-              exit;
-            end;
-           newnode:=newnode^.next;
-         end;
-      end;
-
-
-{****************************************************************************
-                            TLINKEDLIST_ITEM
- ****************************************************************************}
-
-
-    {$IFDEF TP}
-    constructor Tlinkedlist_item.init;
-
-    begin
-        setparent(typeof(Tobject));
-    end;
-    {$ENDIF TP}
-
-    function tlinkedlist_item.getcopy:plinkedlist_item;
-      var
-        l : longint;
-        p : plinkedlist_item;
-      begin
-        l:=sizeof(self);
-        getmem(p,l);
-        move(self,p^,l);
-        getcopy:=p;
-      end;
-
-
-{****************************************************************************
-                            TSTRING_ITEM
- ****************************************************************************}
-
-    constructor tstring_item.init(const s : string);
-      begin
-         inherited init;
-         {$IFDEF TP}setparent(typeof(Tobject));{$ENDIF}
-         str:=stringdup(s);
-      end;
-
-
-    destructor tstring_item.done;
-      begin
-         stringdispose(str);
-         inherited done;
-      end;
-
-
-{****************************************************************************
-                               TLINKEDLIST
- ****************************************************************************}
-
-
-    {$IFDEF TP}
-    constructor Tlinkedlist.init;
-
-    begin
-        setparent(typeof(Tobject));
-    end;
-    {$ENDIF TP}
-
-    destructor tlinkedlist.done;
-      begin
-         clear;
-      end;
-
-
-    procedure tlinkedlist.clear;
-      var
-         newnode : plinkedlist_item;
-      begin
-         newnode:=first;
-         while assigned(newnode) do
-           begin
-              first:=newnode^.next;
-              dispose(newnode,done);
-              newnode:=first;
-           end;
-      end;
-
-
-    procedure tlinkedlist.insertlist(p : plinkedlist);
-      begin
-         { empty list ? }
-         if not(assigned(p^.first)) then
-           exit;
-
-         p^.last^.next:=first;
-
-         { we have a double linked list }
-         if assigned(first) then
-           first^.previous:=p^.last;
-
-         first:=p^.first;
-
-         if not(assigned(last)) then
-           last:=p^.last;
-
-         { p becomes empty }
-         p^.first:=nil;
-         p^.last:=nil;
-      end;
-
-
-    procedure tlinkedlist.concat(p : plinkedlist_item);
-      begin
-        if not(assigned(first)) then
-         begin
-           first:=p;
-           p^.previous:=nil;
-           p^.next:=nil;
-         end
-        else
-         begin
-           last^.next:=p;
-           p^.previous:=last;
-           p^.next:=nil;
-         end;
-        last:=p;
-      end;
-
-
-    procedure tlinkedlist.insert(p : plinkedlist_item);
-      begin
-         if not(assigned(first)) then
-          begin
-            last:=p;
-            p^.previous:=nil;
-            p^.next:=nil;
-          end
-         else
-          begin
-            first^.previous:=p;
-            p^.previous:=nil;
-            p^.next:=first;
-          end;
-         first:=p;
-      end;
-
-
-    procedure tlinkedlist.remove(p : plinkedlist_item);
-      begin
-         if not(assigned(p)) then
-           exit;
-         if (first=p) and (last=p) then
-           begin
-              first:=nil;
-              last:=nil;
-           end
-         else if first=p then
-           begin
-              first:=p^.next;
-              if assigned(first) then
-                first^.previous:=nil;
-           end
-         else if last=p then
-           begin
-              last:=last^.previous;
-              if assigned(last) then
-                last^.next:=nil;
-           end
-         else
-           begin
-              p^.previous^.next:=p^.next;
-              p^.next^.previous:=p^.previous;
-           end;
-         p^.next:=nil;
-         p^.previous:=nil;
-      end;
-
-
-    procedure tlinkedlist.concatlist(p : plinkedlist);
-     begin
-         if not(assigned(p^.first)) then
-           exit;
-
-         if not(assigned(first)) then
-           first:=p^.first
-           else
-             begin
-                last^.next:=p^.first;
-                p^.first^.previous:=last;
-             end;
-
-         last:=p^.last;
-
-         { make p empty }
-         p^.last:=nil;
-         p^.first:=nil;
-      end;
-
-
-    procedure tlinkedlist.concatlistcopy(p : plinkedlist);
-      var
-        newnode,newnode2 : plinkedlist_item;
-      begin
-         newnode:=p^.first;
-         while assigned(newnode) do
-          begin
-            newnode2:=newnode^.getcopy;
-            if assigned(newnode2) then
-             begin
-               if not(assigned(first)) then
-                begin
-                  first:=newnode2;
-                  newnode2^.previous:=nil;
-                  newnode2^.next:=nil;
-                end
-               else
-                begin
-                  last^.next:=newnode2;
-                  newnode2^.previous:=last;
-                  newnode2^.next:=nil;
-                end;
-               last:=newnode2;
-             end;
-            newnode:=newnode^.next;
-          end;
-      end;
-
-    function tlinkedlist.empty:boolean;
-      begin
-        empty:=(first=nil);
-      end;
-
-
-{****************************************************************************
-                               Tnamedindexobject
-****************************************************************************}
-
-constructor Tnamedindexobject.init(const n:string);
-begin
-  inherited init;
-  {$IFDEF TP}setparent(typeof(Tobject));{$ENDIF}
-  { index }
-  indexnr:=-1;
-  { dictionary }
-  speedvalue:=getspeedvalue(n);
-  _name:=stringdup(n);
-end;
-
-destructor Tnamedindexobject.done;
-begin
-  stringdispose(_name);
-end;
-
-function Tnamedindexobject.name:string;
-begin
-  if assigned(_name) then
-   name:=_name^
-  else
-   name:='';
-end;
-
-
-{****************************************************************************
-                               TDICTIONARY
-****************************************************************************}
-
-    constructor Tdictionary.init;
-      begin
-        inherited init;
-        {$IFDEF TP}setparent(typeof(Tobject));{$ENDIF}
-        replace_existing:=false;
-      end;
-
-
-    procedure Tdictionary.usehash;
-      begin
-        if not(assigned(root)) and
-           not(assigned(hasharray)) then
-         begin
-           new(hasharray);
-           fillchar(hasharray^,sizeof(hasharray^),0);
-         end;
-      end;
-
-
-    destructor Tdictionary.done;
-      begin
-        clear;
-        if assigned(hasharray) then
-         dispose(hasharray);
-      end;
-
-
-    procedure Tdictionary.cleartree(obj:Pnamedindexobject);
-      begin
-        if assigned(obj^.left) then
-          cleartree(obj^.left);
-        if assigned(obj^.right) then
-          cleartree(obj^.right);
-        dispose(obj,done);
-        obj:=nil;
-      end;
-
-
-    procedure Tdictionary.clear;
-      var
-        w : longint;
-      begin
-        if assigned(root) then
-          cleartree(root);
-        if assigned(hasharray) then
-         for w:=-hasharraysize to hasharraysize do
-          if assigned(hasharray^[w]) then
-           cleartree(hasharray^[w]);
-      end;
-
-
-    function Tdictionary.empty:boolean;
-      var
-        w : longint;
-      begin
-        if assigned(hasharray) then
-         begin
-           empty:=false;
-           for w:=-hasharraysize to hasharraysize do
-            if assigned(hasharray^[w]) then
-             exit;
-           empty:=true;
-         end
-        else
-         empty:=(root=nil);
-      end;
-
-
-    procedure Tdictionary.foreach(proc2call:Tnamedindexcallback);
-
-        procedure a(p:Pnamedindexobject);
-        begin
-          proc2call(p);
-          if assigned(p^.left) then
-           a(p^.left);
-          if assigned(p^.right) then
-           a(p^.right);
-        end;
-
-      var
-        i : longint;
-      begin
-        if assigned(hasharray) then
-         begin
-           for i:=-hasharraysize to hasharraysize do
-            if assigned(hasharray^[i]) then
-             a(hasharray^[i]);
-         end
-        else
-         if assigned(root) then
-          a(root);
-      end;
-
-
-    function Tdictionary.insert(obj:Pnamedindexobject):Pnamedindexobject;
-      begin
-        if assigned(hasharray) then
-         insert:=insertnode(obj,hasharray^[obj^.speedvalue mod hasharraysize])
-        else
-         insert:=insertnode(obj,root);
-      end;
-
-
-    function tdictionary.insertnode(newnode:Pnamedindexobject;var currnode:Pnamedindexobject):Pnamedindexobject;
-      var
-        s1,s2:^string;
-      begin
-        if currnode=nil then
-         begin
-           currnode:=newnode;
-           insertnode:=currnode;
-         end
-        { first check speedvalue, to allow a fast insert }
-        else
-         if currnode^.speedvalue>newnode^.speedvalue then
-          insertnode:=insertnode(newnode,currnode^.right)
-        else
-         if currnode^.speedvalue<newnode^.speedvalue then
-          insertnode:=insertnode(newnode,currnode^.left)
-        else
-         begin
-           new(s1);
-           new(s2);
-           s1^:=currnode^._name^;
-           s2^:=newnode^._name^;
-           if s1^>s2^ then
-            begin
-              dispose(s2);
-              dispose(s1);
-              insertnode:=insertnode(newnode,currnode^.right);
-            end
-           else
-            if s1^<s2^ then
-             begin
-               dispose(s2);
-               dispose(s1);
-               insertnode:=insertnode(newnode,currnode^.left);
-             end
-           else
-            begin
-              dispose(s2);
-              dispose(s1);
-              if replace_existing and
-                 assigned(currnode) then
-                begin
-                  newnode^.left:=currnode^.left;
-                  newnode^.right:=currnode^.right;
-                  currnode:=newnode;
-                  insertnode:=newnode;
-                end
-              else
-               insertnode:=currnode;
-             end;
-         end;
-      end;
-
-
-    procedure tdictionary.inserttree(currtree,currroot:Pnamedindexobject);
-      begin
-        if assigned(currtree) then
-         begin
-           inserttree(currtree^.left,currroot);
-           inserttree(currtree^.right,currroot);
-           currtree^.right:=nil;
-           currtree^.left:=nil;
-           insertnode(currtree,currroot);
-         end;
-      end;
-
-
-    function tdictionary.rename(const olds,news : string):Pnamedindexobject;
-      var
-        spdval : longint;
-        lasthp,
-        hp,hp2,hp3 : Pnamedindexobject;
-      begin
-        spdval:=getspeedvalue(olds);
-        if assigned(hasharray) then
-         hp:=hasharray^[spdval mod hasharraysize]
-        else
-         hp:=root;
-        lasthp:=nil;
-        while assigned(hp) do
-          begin
-            if spdval>hp^.speedvalue then
-             begin
-               lasthp:=hp;
-               hp:=hp^.left
-             end
-            else
-             if spdval<hp^.speedvalue then
-              begin
-                lasthp:=hp;
-                hp:=hp^.right
-              end
-            else
-             begin
-               if (hp^.name=olds) then
-                begin
-                  { get in hp2 the replacer for the root or hasharr }
-                  hp2:=hp^.left;
-                  hp3:=hp^.right;
-                  if not assigned(hp2) then
-                   begin
-                     hp2:=hp^.right;
-                     hp3:=hp^.left;
-                   end;
-                  { remove entry from the tree }
-                  if assigned(lasthp) then
-                   begin
-                     if lasthp^.left=hp then
-                      lasthp^.left:=hp2
-                     else
-                      lasthp^.right:=hp2;
-                   end
-                  else
-                   begin
-                     if assigned(hasharray) then
-                      hasharray^[spdval mod hasharraysize]:=hp2
-                     else
-                      root:=hp2;
-                   end;
-                  { reinsert the hp3 in the tree from hp2 }
-                  inserttree(hp3,hp2);
-                  { reset node with new values }
-                  stringdispose(hp^._name);
-                  hp^._name:=stringdup(news);
-                  hp^.speedvalue:=getspeedvalue(news);
-                  hp^.left:=nil;
-                  hp^.right:=nil;
-                  { reinsert }
-                  if assigned(hasharray) then
-                   rename:=insertnode(hp,hasharray^[hp^.speedvalue mod hasharraysize])
-                  else
-                   rename:=insertnode(hp,root);
-                  exit;
-                end
-               else
-                if olds>hp^.name then
-                 begin
-                   lasthp:=hp;
-                   hp:=hp^.left
-                 end
-                else
-                 begin
-                   lasthp:=hp;
-                   hp:=hp^.right;
-                 end;
-             end;
-          end;
-      end;
-    function Tdictionary.delete(const s:string):Pnamedindexobject;
-
-    var p,speedvalue:longint;
-        n:Pnamedindexobject;
-
-        procedure insert_right_bottom(var root,Atree:Pnamedindexobject);
-
-        begin
-            while root^.right<>nil do
-                root:=root^.right;
-            root^.right:=Atree;
-        end;
-
-        function delete_from_tree(root:Pnamedindexobject):Pnamedindexobject;
-
-        type    leftright=(left,right);
-
-        var lr:leftright;
-            oldroot:Pnamedindexobject;
-
-        begin
-            oldroot:=nil;
-            while (root<>nil) and (root^.speedvalue<>speedvalue) do
-                begin
-                    oldroot:=root;
-                    if speedvalue<root^.speedvalue then
-                        begin
-                            root:=root^.right;
-                            lr:=right;
-                        end
-                    else
-                        begin
-                            root:=root^.left;
-                            lr:=left;
-                        end;
-                end;
-            while (root<>nil) and (root^._name^<>s) do
-                begin
-                    oldroot:=root;
-                    if s<root^._name^ then
-                        begin
-                            root:=root^.right;
-                            lr:=right;
-                        end
-                    else
-                        begin
-                            root:=root^.left;
-                            lr:=left;
-                        end;
-                end;
-            if (oldroot=nil) or (root=nil) then
-                runerror(218); {Internalerror is not available...}
-            if root^.left<>nil then
-                begin
-                    {Now the node pointing to root must point to the left
-                     subtree of root. The right subtree of root must be
-                     connected to the right bottom of the left subtree.}
-                    if lr=left then
-                        oldroot^.left:=root^.left
-                    else
-                        oldroot^.right:=root^.left;
-                    if root^.right<>nil then
-                        insert_right_bottom(root^.left,root^.right);
-                end
-            else
-                {There is no left subtree. So we can just replace the node to
-                 delete with the right subtree.}
-                if lr=left then
-                    oldroot^.left:=root^.right
-                else
-                    oldroot^.right:=root^.right;
-            delete_from_tree:=root;
-        end;
-
-    begin
-        speedvalue:=getspeedvalue(s);
-        n:=root;
-        if assigned(hasharray) then
-            begin
-                {First, check if the node to delete directly located under
-                 the hasharray.}
-                p:=speedvalue mod hasharraysize;
-                n:=hasharray^[p];
-                if (n<>nil) and (n^.speedvalue=speedvalue) and
-                 (n^._name^=s) then
-                    begin
-                        {The node to delete is directly located under the
-                         hasharray. Make the hasharray point to the left
-                         subtree of the node and place the right subtree on
-                         the right-bottom of the left subtree.}
-                        if n^.left<>nil then
-                            begin
-                                hasharray^[p]:=n^.left;
-                                if n^.right<>nil then
-                                    insert_right_bottom(n^.left,n^.right);
-                            end
-                        else
-                            hasharray^[p]:=n^.right;
-                        delete:=n;
-                        exit;
-                    end;
-            end
-        else
-            begin
-                {First check if the node to delete is the root.}
-                if (root<>nil) and (n^.speedvalue=speedvalue)
-                 and (n^._name^=s) then
-                    begin
-                        if n^.left<>nil then
-                            begin
-                                root:=n^.left;
-                                if n^.right<>nil then
-                                    insert_right_bottom(n^.left,n^.right);
-                            end
-                        else
-                            root:=n^.right;
-                        delete:=n;
-                        exit;
-                    end;
-            end;
-        delete:=delete_from_tree(n);
-    end;
-
-    function Tdictionary.search(const s:string):Pnamedindexobject;
-      begin
-        search:=speedsearch(s,getspeedvalue(s));
-      end;
-
-
-    function Tdictionary.speedsearch(const s:string;speedvalue:longint):Pnamedindexobject;
-      var
-        newnode:Pnamedindexobject;
-      begin
-        if assigned(hasharray) then
-         newnode:=hasharray^[speedvalue mod hasharraysize]
-        else
-         newnode:=root;
-        while assigned(newnode) do
-         begin
-           if speedvalue>newnode^.speedvalue then
-            newnode:=newnode^.left
-           else
-            if speedvalue<newnode^.speedvalue then
-             newnode:=newnode^.right
-           else
-            begin
-              if (newnode^._name^=s) then
-               begin
-                 speedsearch:=newnode;
-                 exit;
-               end
-              else
-               if s>newnode^._name^ then
-                newnode:=newnode^.left
-              else
-               newnode:=newnode^.right;
-            end;
-         end;
-        speedsearch:=nil;
-      end;
-
-
-{****************************************************************************
-                                tdynamicarray
-****************************************************************************}
-
-    constructor tdynamicarray.init(Aelemlen,Agrow:longint);
-      begin
-        inherited init;
-        {$IFDEF TP}setparent(typeof(Tobject));{$ENDIF}
-        elemlen:=Aelemlen;
-        growcount:=Agrow;
-        grow;
-      end;
-
-    function  tdynamicarray.size:longint;
-      begin
-        size:=limit*elemlen;
-      end;
-
-    function  tdynamicarray.usedsize:longint;
-      begin
-        usedsize:=count*elemlen;
-      end;
-
-    procedure tdynamicarray.grow;
-      var
-        osize : longint;
-        odata : pchar;
-      begin
-        osize:=size;
-        odata:=data;
-        inc(limit,growcount);
-        getmem(data,size);
-        if assigned(odata) then
-         begin
-           move(odata^,data^,osize);
-           freemem(odata,osize);
-         end;
-        fillchar(data[osize],growcount*elemlen,0);
-      end;
-
-    procedure tdynamicarray.align(i:longint);
-      var
-        j : longint;
-      begin
-        j:=(posn*elemlen mod i);
-        if j<>0 then
-         begin
-           j:=i-j;
-           while limit<(posn+j) do
-            grow;
-           inc(posn,j);
-           if (posn>count) then
-            count:=posn;
-         end;
-      end;
-
-    procedure tdynamicarray.seek(i:longint);
-      begin
-        while limit<i do
-         grow;
-        posn:=i;
-        if (posn>count) then
-         count:=posn;
-      end;
-
-    procedure tdynamicarray.write(var d;len:longint);
-      begin
-        while limit<(posn+len) do
-         grow;
-        move(d,data[posn*elemlen],len*elemlen);
-        inc(posn,len);
-        if (posn>count) then
-         count:=posn;
-      end;
-
-    procedure tdynamicarray.read(var d;len:longint);
-      begin
-        move(data[posn*elemlen],d,len*elemlen);
-        inc(posn,len);
-        if (posn>count) then
-         count:=posn;
-      end;
-
-    procedure tdynamicarray.writepos(pos:longint;var d;len:longint);
-      begin
-        while limit<(pos+len) do
-         grow;
-        move(d,data[pos*elemlen],len*elemlen);
-        posn:=pos+len;
-        if (posn>count) then
-         count:=posn;
-      end;
-
-    procedure tdynamicarray.readpos(pos:longint;var d;len:longint);
-      begin
-        while limit<(pos+len) do
-         grow;
-        move(data[pos*elemlen],d,len*elemlen);
-        posn:=pos+len;
-        if (posn>count) then
-         count:=posn;
-      end;
-
-    destructor tdynamicarray.done;
-      begin
-        if assigned(data) then
-         freemem(data,size);
-      end;
-
-{$ifdef BUFFEREDFILE}
-
-{****************************************************************************
-                               TBUFFEREDFILE
- ****************************************************************************}
-
-    Const
-       crcseed = $ffffffff;
-
-       crctable : array[0..255] of longint = (
-          $00000000,$77073096,$ee0e612c,$990951ba,$076dc419,$706af48f,
-          $e963a535,$9e6495a3,$0edb8832,$79dcb8a4,$e0d5e91e,$97d2d988,
-          $09b64c2b,$7eb17cbd,$e7b82d07,$90bf1d91,$1db71064,$6ab020f2,
-          $f3b97148,$84be41de,$1adad47d,$6ddde4eb,$f4d4b551,$83d385c7,
-          $136c9856,$646ba8c0,$fd62f97a,$8a65c9ec,$14015c4f,$63066cd9,
-          $fa0f3d63,$8d080df5,$3b6e20c8,$4c69105e,$d56041e4,$a2677172,
-          $3c03e4d1,$4b04d447,$d20d85fd,$a50ab56b,$35b5a8fa,$42b2986c,
-          $dbbbc9d6,$acbcf940,$32d86ce3,$45df5c75,$dcd60dcf,$abd13d59,
-          $26d930ac,$51de003a,$c8d75180,$bfd06116,$21b4f4b5,$56b3c423,
-          $cfba9599,$b8bda50f,$2802b89e,$5f058808,$c60cd9b2,$b10be924,
-          $2f6f7c87,$58684c11,$c1611dab,$b6662d3d,$76dc4190,$01db7106,
-          $98d220bc,$efd5102a,$71b18589,$06b6b51f,$9fbfe4a5,$e8b8d433,
-          $7807c9a2,$0f00f934,$9609a88e,$e10e9818,$7f6a0dbb,$086d3d2d,
-          $91646c97,$e6635c01,$6b6b51f4,$1c6c6162,$856530d8,$f262004e,
-          $6c0695ed,$1b01a57b,$8208f4c1,$f50fc457,$65b0d9c6,$12b7e950,
-          $8bbeb8ea,$fcb9887c,$62dd1ddf,$15da2d49,$8cd37cf3,$fbd44c65,
-          $4db26158,$3ab551ce,$a3bc0074,$d4bb30e2,$4adfa541,$3dd895d7,
-          $a4d1c46d,$d3d6f4fb,$4369e96a,$346ed9fc,$ad678846,$da60b8d0,
-          $44042d73,$33031de5,$aa0a4c5f,$dd0d7cc9,$5005713c,$270241aa,
-          $be0b1010,$c90c2086,$5768b525,$206f85b3,$b966d409,$ce61e49f,
-          $5edef90e,$29d9c998,$b0d09822,$c7d7a8b4,$59b33d17,$2eb40d81,
-          $b7bd5c3b,$c0ba6cad,$edb88320,$9abfb3b6,$03b6e20c,$74b1d29a,
-          $ead54739,$9dd277af,$04db2615,$73dc1683,$e3630b12,$94643b84,
-          $0d6d6a3e,$7a6a5aa8,$e40ecf0b,$9309ff9d,$0a00ae27,$7d079eb1,
-          $f00f9344,$8708a3d2,$1e01f268,$6906c2fe,$f762575d,$806567cb,
-          $196c3671,$6e6b06e7,$fed41b76,$89d32be0,$10da7a5a,$67dd4acc,
-          $f9b9df6f,$8ebeeff9,$17b7be43,$60b08ed5,$d6d6a3e8,$a1d1937e,
-          $38d8c2c4,$4fdff252,$d1bb67f1,$a6bc5767,$3fb506dd,$48b2364b,
-          $d80d2bda,$af0a1b4c,$36034af6,$41047a60,$df60efc3,$a867df55,
-          $316e8eef,$4669be79,$cb61b38c,$bc66831a,$256fd2a0,$5268e236,
-          $cc0c7795,$bb0b4703,$220216b9,$5505262f,$c5ba3bbe,$b2bd0b28,
-          $2bb45a92,$5cb36a04,$c2d7ffa7,$b5d0cf31,$2cd99e8b,$5bdeae1d,
-          $9b64c2b0,$ec63f226,$756aa39c,$026d930a,$9c0906a9,$eb0e363f,
-          $72076785,$05005713,$95bf4a82,$e2b87a14,$7bb12bae,$0cb61b38,
-          $92d28e9b,$e5d5be0d,$7cdcefb7,$0bdbdf21,$86d3d2d4,$f1d4e242,
-          $68ddb3f8,$1fda836e,$81be16cd,$f6b9265b,$6fb077e1,$18b74777,
-          $88085ae6,$ff0f6a70,$66063bca,$11010b5c,$8f659eff,$f862ae69,
-          $616bffd3,$166ccf45,$a00ae278,$d70dd2ee,$4e048354,$3903b3c2,
-          $a7672661,$d06016f7,$4969474d,$3e6e77db,$aed16a4a,$d9d65adc,
-          $40df0b66,$37d83bf0,$a9bcae53,$debb9ec5,$47b2cf7f,$30b5ffe9,
-          $bdbdf21c,$cabac28a,$53b39330,$24b4a3a6,$bad03605,$cdd70693,
-          $54de5729,$23d967bf,$b3667a2e,$c4614ab8,$5d681b02,$2a6f2b94,
-          $b40bbe37,$c30c8ea1,$5a05df1b,$2d02ef8d);
-
-    constructor tbufferedfile.init(const filename : string;_bufsize : longint);
-
-      begin
-         inherited init;
-         {$IFDEF TP}setparent(typeof(Tobject));{$ENDIF}
-         assign(f,filename);
-         bufsize:=_bufsize;
-         clear_crc;
-      end;
-
-    destructor tbufferedfile.done;
-
-      begin
-         close;
-      end;
-
-    procedure tbufferedfile.clear_crc;
-
-      begin
-         crc:=crcseed;
-      end;
-
-    procedure tbufferedfile.setbuf(p : pchar;s : longint);
-
-      begin
-         flush;
-         freemem(buf,bufsize);
-         bufsize:=s;
-         buf:=p;
-      end;
-
-    function tbufferedfile.reset:boolean;
-
-      var
-         ofm : byte;
-      begin
-         ofm:=filemode;
-         iomode:=1;
-         getmem(buf,bufsize);
-         filemode:=0;
-         {$I-}
-          system.reset(f,1);
-         {$I+}
-         reset:=(ioresult=0);
-         filemode:=ofm;
-      end;
-
-    procedure tbufferedfile.rewrite;
-
-      begin
-         iomode:=2;
-         getmem(buf,bufsize);
-         system.rewrite(f,1);
-      end;
-
-    procedure tbufferedfile.flush;
-
-      var
-{$ifdef FPC}
-         count : longint;
-{$else}
-         count : integer;
-{$endif}
-
-      begin
-         if iomode=2 then
-           begin
-              if bufpos=0 then
-                exit;
-              blockwrite(f,buf^,bufpos)
-           end
-         else if iomode=1 then
-            if buflast=bufpos then
-              begin
-                 blockread(f,buf^,bufsize,count);
-                 buflast:=count;
-              end;
-         bufpos:=0;
-      end;
-
-    function tbufferedfile.getftime : longint;
-
-      var
-         l : longint;
-{$ifdef Unix}
-         Info : Stat;
-{$endif}
-      begin
-{$ifndef Unix}
-         { this only works if the file is open !! }
-         dos.getftime(f,l);
-{$else}
-         Fstat(f,Info);
-         l:=info.mtime;
-{$endif}
-         getftime:=l;
-      end;
-
-    function tbufferedfile.getsize : longint;
-
-      begin
-        getsize:=filesize(f);
-      end;
-
-    procedure tbufferedfile.seek(l : longint);
-
-      begin
-         if iomode=2 then
-           begin
-              flush;
-              system.seek(f,l);
-           end
-         else if iomode=1 then
-           begin
-              { forces a reload }
-              bufpos:=buflast;
-              system.seek(f,l);
-              flush;
-           end;
-      end;
-
-    type
-{$ifdef tp}
-       bytearray1 = array [1..65535] of byte;
-{$else}
-       bytearray1 = array [1..10000000] of byte;
-{$endif}
-
-    procedure tbufferedfile.read_data(var data;bytes : longint;var count : longint);
-
-      var
-         p : pchar;
-         c,i : longint;
-
-      begin
-         p:=pchar(@data);
-         count:=0;
-         while bytes-count>0 do
-           begin
-              if bytes-count>buflast-bufpos then
-                begin
-                   move((buf+bufpos)^,(p+count)^,buflast-bufpos);
-                   inc(count,buflast-bufpos);
-                   bufpos:=buflast;
-                   flush;
-                   { can't we read anything ? }
-                   if bufpos=buflast then
-                     break;
-                end
-              else
-                begin
-                   move((buf+bufpos)^,(p+count)^,bytes-count);
-                   inc(bufpos,bytes-count);
-                   count:=bytes;
-                   break;
-                end;
-           end;
-         if do_crc then
-           begin
-              c:=crc;
-              for i:=1 to bytes do
-              c:=(c shr 8) xor crctable[byte(c) xor (bytearray1(data)[i])];
-              crc:=c;
-           end;
-      end;
-
-    procedure tbufferedfile.write_data(var data;count : longint);
-
-      var
-         c,i : longint;
-
-      begin
-         if bufpos+count>bufsize then
-           flush;
-         move(data,(buf+bufpos)^,count);
-         inc(bufpos,count);
-         if do_crc then
-           begin
-              c:=crc;
-              for i:=1 to count do
-                c:=(c shr 8) xor crctable[byte(c) xor (bytearray1(data)[i])];
-              crc:=c;
-           end;
-      end;
-
-    function tbufferedfile.getcrc : longint;
-
-      begin
-         getcrc:=crc xor crcseed;
-      end;
-
-    procedure tbufferedfile.write_string(const s : string);
-
-      begin
-        if bufpos+length(s)>bufsize then
-          flush;
-        { why is there not CRC here ??? }
-        move(s[1],(buf+bufpos)^,length(s));
-        inc(bufpos,length(s));
-         { should be
-        write_data(s[1],length(s)); }
-      end;
-
-    procedure tbufferedfile.write_pchar(p : pchar);
-
-      var
-         l : longint;
-
-      begin
-        l:=strlen(p);
-        if l>=bufsize then
-          runerror(222);
-        { why is there not CRC here ???}
-        if bufpos+l>bufsize then
-          flush;
-        move(p^,(buf+bufpos)^,l);
-        inc(bufpos,l);
-         { should be
-        write_data(p^,l); }
-      end;
-
-    procedure tbufferedfile.write_byte(b : byte);
-
-      begin
-         write_data(b,sizeof(byte));
-      end;
-
-    procedure tbufferedfile.write_long(l : longint);
-
-      var
-         w1,w2 : word;
-
-      begin
-         if change_endian then
-           begin
-              w1:=l and $ffff;
-              w2:=l shr 16;
-              l:=swap(w2)+(longint(swap(w1)) shl 16);
-           end;
-         write_data(l,sizeof(longint));
-      end;
-
-    procedure tbufferedfile.write_word(w : word);
-
-      begin
-         if change_endian then
-           begin
-              w:=swap(w);
-           end;
-         write_data(w,sizeof(word));
-      end;
-
-    procedure tbufferedfile.write_double(d : double);
-
-      begin
-         write_data(d,sizeof(double));
-      end;
-
-    function tbufferedfile.getpath : string;
-
-      begin
-{$ifdef dummy}
-         getpath:=strpas(filerec(f).name);
-{$endif}
-         getpath:='';
-      end;
-
-    procedure tbufferedfile.close;
-
-      begin
-         if iomode<>0 then
-           begin
-              flush;
-              system.close(f);
-              freemem(buf,bufsize);
-              buf:=nil;
-              iomode:=0;
-           end;
-      end;
-
-    procedure tbufferedfile.tempclose;
-
-      begin
-        if iomode<>0 then
-         begin
-           temppos:=system.filepos(f);
-           tempmode:=iomode;
-           tempclosed:=true;
-           system.close(f);
-           iomode:=0;
-         end
-        else
-         tempclosed:=false;
-      end;
-
-    procedure tbufferedfile.tempreopen;
-
-      var
-         ofm : byte;
-
-      begin
-         if tempclosed then
-           begin
-              case tempmode of
-               1 : begin
-                     ofm:=filemode;
-                     iomode:=1;
-                     filemode:=0;
-                     system.reset(f,1);
-                     filemode:=ofm;
-                   end;
-               2 : begin
-                     iomode:=2;
-                     system.rewrite(f,1);
-                   end;
-              end;
-              system.seek(f,temppos);
-              tempclosed:=false;
-           end;
-      end;
-
-{$endif BUFFEREDFILE}
-
-end.
-{
-  $Log$
-  Revision 1.2  2002-06-02 08:41:22  marco
-   * renamefest
-
-  Revision 1.1  2000/07/13 06:30:13  michael
-  + Initial import
-
-  Revision 1.3  2000/03/11 21:11:24  daniel
-    * Ported hcgdata to new symtable.
-    * Alignment code changed as suggested by Peter
-    + Usage of my is operator replacement, is_object
-
-  Revision 1.2  2000/03/01 11:43:55  daniel
-  * Some more work on the new symtable.
-  + Symtable stack unit 'symstack' added.
-
-  Revision 1.1  2000/02/28 17:23:58  daniel
-  * Current work of symtable integration committed. The symtable can be
-    activated by defining 'newst', but doesn't compile yet. Changes in type
-    checking and oop are completed. What is left is to write a new
-    symtablestack and adapt the parser to use it.
-}

compiler/new/symtable/defs.pas

@@ -1,3157 +0,0 @@
-{
-    $Id$
-
-    Copyright (C) 1998-2000 by Daniel Mantione
-     and other members of the Free Pascal development team
-
-    This unit handles 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.
- ****************************************************************************
-}
-{$ifdef TP}
-  {$N+,E+,F+}
-{$endif}
-
-unit defs;
-
-interface
-
-uses    symtable,objects,{$IFDEF TP}xobjects,{$ENDIF}
-        cobjects,symtablt,globtype
-{$ifdef i386}
-        ,cpubase
-{$endif}
-{$ifdef m68k}
-        ,m68k
-{$endif}
-{$ifdef alpha}
-        ,alpha
-{$endif};
-
-type    Targconvtyp=(act_convertable,act_equal,act_exact);
-
-        Tvarspez=(vs_value,vs_const,vs_var);
-
-        Tobjoption=(oo_has_abstract,         {The object/class has
-                                             an abstract method => no
-                                             instances can be created.}
-                    oo_is_class,            {The object is a class.}
-                    oo_has_virtual,         {The object/class has
-                                             virtual methods.}
-                    oo_isforward,           {The class is only a forward
-                                             declared yet.}
-                    oo_can_have_published,  {True, if the class has rtti, i.e.
-                                             you can publish properties.}
-                    oo_has_constructor,     {The object/class has a
-                                             constructor.}
-                    oo_has_destructor,      {The object/class has a
-                                             destructor.}
-
-                    {When has_virtual is set, has_vmt is also set....
-                    oo_has_vmt,             The object/class has a vmt.}
-                    oo_has_msgstr,
-                    oo_has_msgint,
-                    oo_cppvmt);             {The object/class uses an C++
-                                             compatible vmt, all members of
-                                             the same class tree, must use
-                                             then a C++ compatible vmt.}
-        Tobjoptionset=set of Tobjoption;
-
-        {Calling convention for tprocdef and Tprocvardef.}
-        Tproccalloption=(po_call_none,
-                         po_call_clearstack,    {Use IBM flat calling
-                                                 convention. (Used by GCC.)}
-                         po_call_leftright,     {Push parameters from left to
-                                                 right.}
-                         po_call_cdecl,         {Procedure uses C styled
-                                                 calling.}
-                         po_call_register,      {Procedure uses register
-                                                 (fastcall) calling.}
-                         po_call_stdcall,       {Procedure uses stdcall
-                                                 call.}
-                         po_call_safecall,      {Safe call calling
-                                                 conventions.}
-                         po_call_palmossyscall, {Procedure is a PalmOS
-                                                 system call.}
-                         po_call_system,
-                         po_call_inline,        {Procedure is an assembler
-                                                 macro.}
-                         po_call_internproc,    {Procedure has compiler
-                                                 magic.}
-                         po_call_internconst);  {Procedure has constant
-                                                 evaluator intern.}
-        Tproccalloptionset=set of Tproccalloption;
-
-        {Basic type for tprocdef and tprocvardef }
-        Tproctypeoption=(po_type_none,
-                         po_type_proginit,      {Program initialization.}
-                         po_type_unitinit,      {Unit initialization.}
-                         po_type_unitfinalize,  {Unit finalization.}
-                         po_type_constructor,   {Procedure is a constructor.}
-                         po_type_destructor,    {Procedure is a destructor.}
-                         po_type_operator);     {Procedure defines an
-                                                 operator.}
-
-        {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_staticmethod,        {Static method.}
-            po_overridingmethod,    {Method with override directive.}
-            po_methodpointer,       {Method pointer, only in procvardef, also
-                                     used for 'with object do'.}
-            po_containsself,        {Self is passed explicit to the
-                                     compiler.}
-            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_savestdregs,         {Save std regs cdecl and stdcall need
-                                     that!}
-            po_saveregisters);      {Save all registers }
-        Tprocoptionset=set of Tprocoption;
-
-        Tarrayoption=(ap_variant,ap_constructor,ap_arrayofconst);
-        Tarrayoptionset=set of Tarrayoption;
-
-        Pparameter=^Tparameter;
-        Tparameter=object(Tobject)
-            data:Psym;
-            paratyp:Tvarspez;
-            argconvtyp:Targconvtyp;
-            convertlevel:byte;
-            register:Tregister;
-        end;
-
-        Tfiletype=(ft_text,ft_typed,ft_untyped);
-
-        Pfiledef=^Tfiledef;
-        Tfiledef=object(Tdef)
-            filetype:Tfiletype;
-            definition:Pdef;
-            constructor init(Aowner:Pcontainingsymtable;
-                             ft:Tfiletype;tas:Pdef);
-            constructor load(var s:Tstream);
-            procedure deref;virtual;
-            function gettypename:string;virtual;
-            procedure setsize;
-{$ifdef GDB}
-            function stabstring:Pchar;virtual;
-            procedure concatstabto(asmlist:Paasmoutput);virtual;
-{$endif GDB}
-            procedure store(var s:Tstream);virtual;
-        end;
-
-        Pformaldef=^Tformaldef;
-        Tformaldef=object(Tdef)
-            constructor init(Aowner:Pcontainingsymtable);
-            constructor load(var s:Tstream);
-            procedure store(var s:Tstream);virtual;
-{$ifdef GDB}
-            function stabstring:Pchar;virtual;
-            procedure concatstabto(asmlist:Paasmoutput);virtual;
-{$endif GDB}
-            function gettypename:string;virtual;
-        end;
-
-        Perrordef=^Terrordef;
-        Terrordef=object(Tdef)
-{$IFDEF TP}
-            constructor init(Aowner:Pcontainingsymtable);
-{$ENDIF}
-{$ifdef GDB}
-            function stabstring:Pchar;virtual;
-{$endif GDB}
-            function gettypename:string;virtual;
-        end;
-
-        Pabstractpointerdef=^Tabstractpointerdef;
-        Tabstractpointerdef=object(Tdef)
-            definition:Pdef;
-            defsym:Psym;
-            constructor init(Aowner:Pcontainingsymtable;def:Pdef);
-            constructor load(var s:Tstream);
-            procedure deref;virtual;
-            procedure store(var s:Tstream);virtual;
-{$ifdef GDB}
-            function  stabstring:Pchar;virtual;
-            procedure concatstabto(asmlist:Paasmoutput);virtual;
-{$endif GDB}
-        end;
-
-        Ppointerdef=^Tpointerdef;
-        Tpointerdef=object(Tabstractpointerdef)
-            is_far:boolean;
-            constructor initfar(Aowner:Pcontainingsymtable;def:Pdef);
-            constructor load(var s:Tstream);
-            procedure store(var s:Tstream);virtual;
-            function gettypename:string;virtual;
-        end;
-
-        Pclassrefdef=^Tclassrefdef;
-        Tclassrefdef=object(Tpointerdef)
-{$IFDEF TP}
-            constructor init(Aowner:Pcontainingsymtable;def:Pdef);
-{$ENDIF TP}
-{$ifdef GDB}
-            function stabstring : pchar;virtual;
-            procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-            function gettypename:string;virtual;
-        end;
-
-        Pvmtentry=^Tvmtentry;
-        Pglobalvmtentry=^Tglobalvmtentry;
-        Plocalvmtentry=^Tlocalvmtentry;
-        Pobjectdef=^Tobjectdef;
-        Pabstractprocdef=^Pabstractprocdef;
-        Pprocvardef=^Tprocvardef;
-        Pprocdef = ^Tprocdef;
-
-        Tvmtentry=object(Tobject)
-            owner:Pobjectdef;
-            constructor init(Aowner:Pobjectdef);
-            function mangledname:string;virtual;
-        end;
-
-        Tglobalvmtentry=object(Tvmtentry)
-            constructor init(Aowner:Pobjectdef;proc:Pprocdef);
-            function mangledname:string;virtual;
-        private
-            def:Pprocdef;
-        end;
-
-        Tlocalvmtentry=object(Tvmtentry)
-            constructor init(Aowner:Pobjectdef;proc:Pprocdef);
-            function mangledname:string;virtual;
-        private
-            name:Pstring;
-        end;
-
-        Tobjectdef=object(Tdef)
-            childof:Pobjectdef;
-            objname:Pstring;
-            privatesyms,
-            protectedsyms,
-            publicsyms:Pobjectsymtable;
-            options:Tobjoptionset;
-            {To be able to have a variable vmt position
-             and no vmt field for objects without virtuals.}
-            vmt_offset:longint;
-            {Contains Tvmtentry objects to describe the layout of the vmt.}
-            vmt_layout:Pcollection;
-            constructor init(const n:string;Aowner:Pcontainingsymtable;
-                             parent:Pobjectdef;isclass:boolean);
-            constructor load(var s:Tstream);
-            procedure check_forwards;
-            function insert(Asym:Psym):boolean;
-            procedure insertvmt;
-            function is_related(d:Pobjectdef):boolean;
-            function search(const s:string;search_protected:boolean):Psym;
-            function speedsearch(const s:string;speedvalue:longint;
-                                 search_protected:boolean):Psym;virtual;
-            function size:longint;virtual;
-            procedure store(var s:Tstream);virtual;
-            function vmt_mangledname : string;
-            function rtti_name : string;
-
-            procedure set_parent(parent:Pobjectdef);
-{$ifdef GDB}
-            function stabstring : pchar;virtual;
-{$endif GDB}
-            procedure deref;virtual;
-
-            function  needs_inittable:boolean;virtual;
-            procedure write_init_data;virtual;
-            procedure write_child_init_data;virtual;
-
-            {Rtti }
-            function  get_rtti_label:string;virtual;
-            procedure generate_rtti;virtual;
-            procedure write_rtti_data;virtual;
-            procedure write_child_rtti_data;virtual;
-            function next_free_name_index:longint;
-            function is_publishable:boolean;virtual;
-            destructor done;virtual;
-        end;
-
-        Parraydef=^Tarraydef;
-        Tarraydef=object(Tdef)
-            lowrange,
-            highrange:Tconstant;
-            definition:Pdef;
-            rangedef:Pdef;
-            options:Tarrayoptionset;
-            constructor init(const l,h:Tconstant;rd:Pdef;
-                             Aowner:Pcontainingsymtable);
-            constructor load(var s:Tstream);
-            function elesize:longint;
-            function gettypename:string;virtual;
-            procedure store(var s:Tstream);virtual;
-{$ifdef GDB}
-            function stabstring : pchar;virtual;
-            procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-            procedure deref;virtual;
-            function size : longint;virtual;
-            { generates the ranges needed by the asm instruction BOUND (i386)
-              or CMP2 (Motorola) }
-            procedure genrangecheck;
-
-            { returns the label of the range check string }
-            function getrangecheckstring : string;
-            function needs_inittable : boolean;virtual;
-            procedure write_rtti_data;virtual;
-            procedure write_child_rtti_data;virtual;
-        private
-            rangenr:longint;
-        end;
-
-        Penumdef=^Tenumdef;
-        Tenumdef=object(Tdef)
-            rangenr,
-            minval,
-            maxval:longint;
-            has_jumps:boolean;
-            symbols:Pcollection;
-            basedef:Penumdef;
-            constructor init(Aowner:Pcontainingsymtable);
-            constructor init_subrange(Abasedef:Penumdef;Amin,Amax:longint;
-                                      Aowner:Pcontainingsymtable);
-            constructor load(var s:Tstream);
-            procedure deref;virtual;
-            procedure calcsavesize;
-            function getrangecheckstring:string;
-            procedure genrangecheck;
-            procedure setmax(Amax:longint);
-            procedure setmin(Amin:longint);
-            procedure store(var s:Tstream);virtual;
-{$ifdef GDB}
-            function stabstring:Pchar;virtual;
-{$endif GDB}
-            procedure write_child_rtti_data;virtual;
-            procedure write_rtti_data;virtual;
-            function is_publishable : boolean;virtual;
-            function  gettypename:string;virtual;
-        end;
-
-        Tbasetype=(uauto,uvoid,uchar,
-                   u8bit,u16bit,u32bit,
-                   s8bit,s16bit,s32bit,
-                   bool8bit,bool16bit,bool32bit,
-                   s64bit,u64bit,s64bitint,uwidechar);
-
-        Porddef=^Torddef;
-        Torddef=object(Tdef)
-            low,high:Tconstant;
-            rangenr:longint;
-            typ:Tbasetype;
-            constructor init(t:tbasetype;l,h:Tconstant;
-                             Aowner:Pcontainingsymtable);
-            constructor load(var s:Tstream);
-            procedure store(var s:Tstream);virtual;
-            procedure setsize;
-
-            { generates the ranges needed by the asm instruction BOUND }
-            { or CMP2 (Motorola)                                       }
-            procedure genrangecheck;
-            { returns the label of the range check string }
-            function getrangecheckstring : string;
-            procedure write_rtti_data;virtual;
-            function is_publishable:boolean;virtual;
-            function gettypename:string;virtual;
-{$ifdef GDB}
-            function stabstring:Pchar;virtual;
-{$endif GDB}
-        end;
-
-        {S80real is dependant on the cpu, s64comp is also
-         dependant on the size (tp = 80bit for both)
-         The EXTENDED format exists on the motorola FPU
-         but it uses 96 bits instead of 80, with some
-         unused bits within the number itself! Pretty
-         complicated to support, so no support for the
-         moment.
-         S64comp is considered as a real because all
-         calculations are done by the fpu.}
-
-        Tfloattype=(s32real,s64real,s80real,s64comp,f16bit,f32bit);
-
-        Pfloatdef=^Tfloatdef;
-        Tfloatdef=object(tdef)
-            typ:Tfloattype;
-            constructor init(t:Tfloattype;Aowner:Pcontainingsymtable);
-            constructor load(var s:Tstream);
-            function is_publishable : boolean;virtual;
-            procedure setsize;
-{$ifdef GDB}
-            function stabstring:Pchar;virtual;
-{$endif GDB}
-            procedure store(var s:Tstream);virtual;
-            procedure write_rtti_data;virtual;
-            function gettypename:string;virtual;
-        end;
-
-        Tsettype=(normset,smallset,varset);
-
-        Psetdef=^Tsetdef;
-        Tsetdef=object(Tdef)
-            definition:Pdef;
-            settype:Tsettype;
-            constructor init(s:Pdef;high:longint;Aowner:Pcontainingsymtable);
-            constructor load(var s:Tstream);
-            procedure store(var s:Tstream);virtual;
-{$ifdef GDB}
-            function stabstring : pchar;virtual;
-            procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-            procedure deref;virtual;
-            function is_publishable : boolean;virtual;
-            procedure write_rtti_data;virtual;
-            procedure write_child_rtti_data;virtual;
-            function gettypename:string;virtual;
-        end;
-
-        Precorddef=^Trecorddef;
-        Trecorddef=object(Tdef)
-            symtable:Precordsymtable;
-            constructor init(s:Precordsymtable;Aowner:Pcontainingsymtable);
-            constructor load(var s:Tstream);
-            procedure store(var s:Tstream);virtual;
-{$ifdef GDB}
-            function stabstring : pchar;virtual;
-            procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-            procedure deref;virtual;
-            function  needs_inittable : boolean;virtual;
-            procedure write_rtti_data;virtual;
-            procedure write_init_data;virtual;
-            procedure write_child_rtti_data;virtual;
-            procedure write_child_init_data;virtual;
-            function gettypename:string;virtual;
-            destructor done;virtual;
-        end;
-
-        {String types}
-        Tstringtype=(st_default,st_shortstring,st_longstring,
-                     st_ansistring,st_widestring);
-
-        {This object needs to be splitted into multiple objects,
-         one for each stringtype. This is because all code in this
-         object is different for all string types.}
-        Pstringdef=^Tstringdef;
-        Tstringdef=object(Tdef)
-            string_typ:Tstringtype;
-            len:longint;
-            constructor shortinit(l:byte;Aowner:Pcontainingsymtable);
-            constructor shortload(var s:Tstream);
-            constructor longinit(l:longint;Aowner:Pcontainingsymtable);
-            constructor longload(var s:Tstream);
-            constructor ansiinit(l:longint;Aowner:Pcontainingsymtable);
-            constructor ansiload(var s:Tstream);
-            constructor wideinit(l:longint;Aowner:Pcontainingsymtable);
-            constructor wideload(var s:Tstream);
-            function  stringtypname:string;
-            function  size:longint;virtual;
-            procedure store(var s:Tstream);virtual;
-            function  gettypename:string;virtual;
-            function  is_publishable : boolean;virtual;
-            { debug }
-        {$ifdef GDB}
-            function  stabstring:Pchar;virtual;
-            procedure concatstabto(asmlist : Paasmoutput);virtual;
-        {$endif GDB}
-            { init/final }
-            function  needs_inittable : boolean;virtual;
-            { rtti }
-            procedure write_rtti_data;virtual;
-        end;
-
-        Tabstractprocdef=object(Tdef)
-            {Saves a definition to the return type }
-            retdef:Pdef;
-            fpu_used:byte;              {How many stack fpu must be empty.}
-            proctype:Tproctypeoption;
-            options:Tprocoptionset;     {Save the procedure options.}
-            calloptions:Tproccalloptionset;
-            parameters:Pcollection;
-            constructor init(Aowner:Pcontainingsymtable);
-            constructor load(var s:Tstream);
-            destructor done;virtual;
-            procedure deref;virtual;
-            function demangled_paras:string;
-            function para_size:longint;
-            procedure store(var s:Tstream);virtual;
-            procedure test_if_fpu_result;
-{$ifdef GDB}
-            function stabstring : pchar;virtual;
-            procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-        end;
-
-        Tprocvardef=object(Tabstractprocdef)
-{$IFDEF TP}
-            constructor init(Aowner:Pcontainingsymtable);
-{$ENDIF TP}
-            function size:longint;virtual;
-{$ifdef GDB}
-            function stabstring:Pchar;virtual;
-            procedure concatstabto(asmlist:Paasmoutput); virtual;
-{$endif GDB}
-            procedure write_child_rtti_data;virtual;
-            function is_publishable:boolean;virtual;
-            procedure write_rtti_data;virtual;
-            function gettypename:string;virtual;
-        end;
-
-        {This datastructure is used to store the message information
-         when a procedure is declared as:
-          ;message 'str';
-          ;message int;
-          ;virtual int;
-        }
-        Tmessageinf=record
-            case integer of
-                0:(str:Pchar);
-                1:(i:longint);
-        end;
-
-        {This object can be splitted into a Tprocdef, for normal procedures,
-         a Tmethoddef for methods, and a Tinlinedprocdef and a
-         Tinlinedmethoddef for inlined procedures.}
-        Tprocdef = object(tabstractprocdef)
-           messageinf:Tmessageinf;
-           { where is this function defined, needed here because there
-             is only one symbol for all overloaded functions }
-           fileinfo:Tfileposinfo;
-           { pointer to the local symbol table }
-           localst:Pprocsymtable;
-           _mangledname:Pstring;
-           { it's a tree, but this not easy to handle }
-           { used for inlined procs                   }
-           code : pointer;
-           vmt_index:longint;
-           { true, if the procedure is only declared }
-           { (forward procedure) }
-           references:Pcollection;
-           forwarddef,
-           { true if the procedure is declared in the interface }
-           interfacedef : boolean;
-           { check the problems of manglednames }
-           count      : boolean;
-           is_used    : boolean;
-           { set which contains the modified registers }
-           usedregisters:Tregisterset;
-           constructor init(Aowner:Pcontainingsymtable);
-           constructor load(var s:Tstream);
-           procedure store(var s:Tstream);virtual;
-{$ifdef GDB}
-           function cplusplusmangledname : string;
-           function stabstring : pchar;virtual;
-           procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-           procedure deref;virtual;
-           function mangledname:string;
-           procedure setmangledname(const s:string);
-           procedure load_references;
-           function  write_references:boolean;
-           destructor done;virtual;
-        end;
-
-        Pforwarddef=^Tforwarddef;
-        Tforwarddef=object(Tdef)
-           tosymname:string;
-           forwardpos:Tfileposinfo;
-           constructor init(Aowner:Pcontainingsymtable;
-                            const s:string;const pos:Tfileposinfo);
-           function gettypename:string;virtual;
-        end;
-
-        {Relevant options for assigning a proc or a procvar to a procvar.}
-const   po_compatibility_options=[
-          po_classmethod,
-          po_staticmethod,
-          po_methodpointer,
-          po_containsself,
-          po_interrupt,
-          po_iocheck,
-          po_exports
-        ];
-
-var     cformaldef:Pformaldef;      {Unique formal definition.}
-        voiddef:Porddef;            {Pointer to void (procedure) type.}
-        cchardef:Porddef;           {Pointer to char type.}
-        booldef:Porddef;            {Pointer to boolean type.}
-        u8bitdef:Porddef;           {Pointer to 8-bit unsigned type.}
-        u16bitdef:Porddef;          {Pointer to 16-bit unsigned type.}
-        u32bitdef:Porddef;          {Pointer to 32-bit unsigned type.}
-        s32bitdef:Porddef;          {Pointer to 32-bit signed type.}
-        cu64bitdef:Porddef;         {Pointer to 64 bit unsigned def.}
-        cs64bitdef:Porddef;         {Pointer to 64 bit signed def.}
-
-        voidpointerdef,             {Pointer for Void-Pointerdef.}
-        charpointerdef,             {Pointer for Char-Pointerdef.}
-        voidfarpointerdef:ppointerdef;
-
-
-        s32floatdef : pfloatdef;    {Pointer for realconstn.}
-        s64floatdef : pfloatdef;    {Pointer for realconstn.}
-        s80floatdef : pfloatdef;    {Pointer to type of temp. floats.}
-        s32fixeddef : pfloatdef;    {Pointer to type of temp. fixed.}
-
-        cshortstringdef,            {Pointer to type of short string const.}
-        openshortstringdef,         {Pointer to type of an openshortstring,
-                                     needed for readln().}
-        clongstringdef,             {Pointer to type of long string const.}
-        cansistringdef,             {Pointer to type of ansi string const.}
-        cwidestringdef:Pstringdef;  {Pointer to type of wide string const.}
-        openchararraydef:Parraydef; {Pointer to type of an open array of
-                                     char, needed for readln().}
-
-        cfiledef:Pfiledef;          {Get the same definition for all files
-                                     used for stabs.}
-
-implementation
-
-uses    systems,symbols,verbose,globals,aasm,files,strings;
-
-const   {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;
-
-        otsbyte         = 0;
-        otubyte         = 1;
-        otsword         = 2;
-        otuword         = 3;
-        otslong         = 4;
-        otulong         = 5;
-
-        ftsingle        = 0;
-        ftdouble        = 1;
-        ftextended      = 2;
-        ftcomp          = 3;
-        ftcurr          = 4;
-        ftfixed16       = 5;
-        ftfixed32       = 6;
-
-{****************************************************************************
-                                Tfiledef
-****************************************************************************}
-
-constructor Tfiledef.init(Aowner:Pcontainingsymtable;ft:Tfiletype;tas:Pdef);
-
-begin
-    inherited init(Aowner);
-    {$IFDEF TP}setparent(typeof(Tdef));{$ENDIF}
-    filetype:=ft;
-    definition:=tas;
-    setsize;
-end;
-
-constructor Tfiledef.load(var s:Tstream);
-
-begin
-    inherited load(s);
-{   filetype:=tfiletype(readbyte);
-    if filetype=ft_typed then
-        typed_as:=readdefref
-    else
-        typed_as:=nil;}
-    setsize;
-end;
-
-
-procedure Tfiledef.deref;
-
-begin
-{   if filetype=ft_typed then
-        resolvedef(typed_as);}
-end;
-
-
-procedure Tfiledef.setsize;
-
-begin
-    case filetype of
-        ft_text:
-            savesize:=572;
-        ft_typed,ft_untyped:
-            savesize:=316;
-    end;
-end;
-
-
-procedure Tfiledef.store(var s:Tstream);
-
-begin
-{   inherited store(s);
-    writebyte(byte(filetype));
-    if filetype=ft_typed then
-        writedefref(typed_as);
-    current_ppu^.writeentry(ibfiledef);}
-end;
-
-
-function Tfiledef.gettypename : string;
-
-begin
-    case filetype of
-        ft_untyped:
-            gettypename:='File';
-        ft_typed:
-            gettypename:='File Of '+definition^.typename;
-        ft_text:
-            gettypename:='Text'
-    end;
-end;
-
-{****************************************************************************
-                                Tformaldef
-****************************************************************************}
-
-{Tformaldef is used for var parameters without a type.}
-
-constructor Tformaldef.init(Aowner:Pcontainingsymtable);
-
-begin
-    inherited init(Aowner);
-    {$IFDEF TP}setparent(typeof(Tdef));{$ENDIF}
-    savesize:=target_os.size_of_pointer;
-end;
-
-
-constructor Tformaldef.load(var s:Tstream);
-
-begin
-    inherited load(s);
-    savesize:=target_os.size_of_pointer;
-end;
-
-
-procedure Tformaldef.store(var s:Tstream);
-
-begin
-    inherited store(s);
-{   current_ppu^.writeentry(ibformaldef);}
-end;
-
-function Tformaldef.gettypename:string;
-
-begin
-    gettypename:='Var';
-end;
-
-{****************************************************************************
-                                  Terrordef
-****************************************************************************}
-
-{$IFDEF TP}
-constructor Terrordef.init(Aowner:Pcontainingsymtable);
-
-begin
-    inherited init(Aowner);
-    setparent(typeof(Tdef));
-end;
-{$ENDIF TP}
-
-function Terrordef.gettypename:string;
-
-begin
-    gettypename:='<erroneous type>';
-end;
-
-{****************************************************************************
-                             Tabstractpointerdef
-****************************************************************************}
-
-constructor Tabstractpointerdef.init(Aowner:Pcontainingsymtable;def:Pdef);
-
-begin
-    inherited init(Aowner);
-    {$IFDEF TP}setparent(typeof(Tdef));{$ENDIF}
-    include(properties,dp_ret_in_acc);
-    definition:=def;
-    savesize:=target_os.size_of_pointer;
-end;
-
-constructor Tabstractpointerdef.load(var s:Tstream);
-
-begin
-    inherited load(s);
-(*  {The real address in memory is calculated later (deref).}
-    definition:=readdefref;             *)
-    savesize:=target_os.size_of_pointer;
-end;
-
-
-procedure Tabstractpointerdef.deref;
-
-begin
-{   resolvedef(definition);}
-end;
-
-
-procedure Tabstractpointerdef.store(var s:Tstream);
-
-begin
-    inherited store(s);
-{   writedefref(definition);
-    current_ppu^.writeentry(ibpointerdef);}
-end;
-
-
-{****************************************************************************
-                                 Tpointerdef
-****************************************************************************}
-
-constructor Tpointerdef.initfar(Aowner:Pcontainingsymtable;def:Pdef);
-
-begin
-   inherited init(Aowner,def);
-    {$IFDEF TP}setparent(typeof(Tabstractpointerdef));{$ENDIF}
-   is_far:=true;
-end;
-
-constructor Tpointerdef.load(var s:Tstream);
-
-begin
-    inherited load(s);
-{   is_far:=(readbyte<>0);}
-end;
-
-function Tpointerdef.gettypename : string;
-
-begin
-   gettypename:='^'+definition^.typename;
-end;
-
-procedure Tpointerdef.store(var s:Tstream);
-
-begin
-    inherited store(s);
-{   writebyte(byte(is_far));}
-end;
-
-{****************************************************************************
-                              Tclassrefdef
-****************************************************************************}
-
-{$IFDEF TP}
-constructor Tclassrefdef.init(Aowner:Pcontainingsymtable;def:Pdef);
-
-begin
-    inherited init(Aowner,def);
-    setparent(typeof(Tpointerdef));
-end;
-{$ENDIF TP}
-
-function Tclassrefdef.gettypename:string;
-
-begin
-   gettypename:='Class of '+definition^.typename;
-end;
-
-{***************************************************************************
-                                TVMTENTRY
-***************************************************************************}
-
-constructor Tvmtentry.init(Aowner:Pobjectdef);
-
-begin
-    inherited init;
-    {$IFDEF TP}setparent(typeof(Tobject));{$ENDIF}
-    owner:=Aowner;
-end;
-
-function Tvmtentry.mangledname:string;
-
-begin
-    abstract;
-end;
-
-{***************************************************************************
-                             TGLOBALVMTENTRY
-******************************************************* *******************}
-
-constructor Tglobalvmtentry.init(Aowner:Pobjectdef;proc:Pprocdef);
-
-begin
-    inherited init(Aowner);
-    {$IFDEF TP}setparent(typeof(Tvmtentry));{$ENDIF TP}
-    def:=proc;
-end;
-
-function Tglobalvmtentry.mangledname:string;
-
-begin
-    mangledname:=def^.mangledname;
-end;
-
-{***************************************************************************
-                              TLOCALVMTENTRY
-***************************************************************************}
-
-constructor Tlocalvmtentry.init(Aowner:Pobjectdef;proc:Pprocdef);
-
-begin
-    inherited init(Aowner);
-    {$IFDEF TP}setparent(typeof(Tvmtentry));{$ENDIF TP}
-    if po_abstractmethod in proc^.options then
-        name:=stringdup('FPC_ABSTRACTERROR')
-    else
-        name:=stringdup(proc^.mangledname);
-end;
-
-function Tlocalvmtentry.mangledname:string;
-
-begin
-    mangledname:=name^;
-end;
-
-{***************************************************************************
-                                TOBJECTDEF
-***************************************************************************}
-
-constructor Tobjectdef.init(const n:string;Aowner:Pcontainingsymtable;
-                            parent:Pobjectdef;isclass:boolean);
-
-begin
-    inherited init(Aowner);
-    {$IFDEF TP}setparent(typeof(Tdef));{$ENDIF}
-    new(publicsyms,init);
-    publicsyms^.name:=stringdup(n);
-    publicsyms^.defowner:=@self;
-    set_parent(parent);
-    objname:=stringdup(n);
-    if isclass then
-        begin
-            include(properties,dp_ret_in_acc);
-            include(options,oo_is_class);
-        end;
-end;
-
-
-procedure tobjectdef.set_parent(parent:Pobjectdef);
-
-const   inherited_options=[oo_has_virtual,
-                           oo_has_constructor,oo_has_destructor];
-
-begin
-    {Nothing to do if the parent was not forward !}
-    if childof=nil then
-        begin
-            childof:=parent;
-            {Some options are inherited...}
-            if parent<>nil then
-                begin
-                    options:=options+parent^.options*inherited_options;
-                    {Add the data of the anchestor class.}
-                    inc(publicsyms^.datasize,parent^.publicsyms^.datasize);
-                    if parent^.privatesyms<>nil then
-                        begin
-                            if privatesyms=nil then
-                                new(privatesyms,init);
-                            inc(privatesyms^.datasize,
-                             parent^.privatesyms^.datasize);
-                        end;
-                    if parent^.protectedsyms<>nil then
-                        begin
-                            if protectedsyms<>nil then
-                                new(protectedsyms,init);
-                            inc(protectedsyms^.datasize,
-                             parent^.protectedsyms^.datasize);
-                        end;
-                    if oo_has_virtual in (options*parent^.options) then
-                        publicsyms^.datasize:=publicsyms^.datasize-
-                         target_os.size_of_pointer;
-                    {If parent has a vmt field then
-                     the offset is the same for the child PM }
-                     if [oo_has_virtual,oo_is_class]*parent^.options<>[] then
-                        begin
-                            vmt_offset:=parent^.vmt_offset;
-                            include(options,oo_has_virtual);
-                        end;
-                end;
-            savesize:=publicsyms^.datasize;
-        end;
-end;
-
-constructor Tobjectdef.load(var s:Tstream);
-
-var oldread_member:boolean;
-
-begin
-    inherited load(s);
-(*  savesize:=readlong;
-    vmt_offset:=readlong;
-    objname:=stringdup(readstring);
-    childof:=pobjectdef(readdefref);
-    options:=readlong;
-    oldread_member:=read_member;
-    read_member:=true;
-    publicsyms:=new(psymtable,loadas(objectsymtable));
-    read_member:=oldread_member;
-    publicsyms^.defowner:=@self;
-    { publicsyms^.datasize:=savesize; }
-    publicsyms^.name := stringdup(objname^);
-
-    { handles the predefined class tobject  }
-    { the last TOBJECT which is loaded gets }
-    { it !                                  }
-    if (objname^='TOBJECT') and
-      isclass and (childof=nil) then
-      class_tobject:=@self;
-    has_rtti:=true;*)
-end;
-
-
-procedure Tobjectdef.insertvmt;
-
-var o:Pobjectdef;
-    c:Pcollection;
-    i:word;
-
-begin
-    if vmt_layout<>nil then
-        internalerror($990803);
-    {Make room for a vmtlink in the object.
-     First round up to aktpakrecords.}
-    publicsyms^.datasize:=align(publicsyms^.datasize,
-     packrecordalignment[aktpackrecords]);
-    vmt_offset:=publicsyms^.datasize;
-    publicsyms^.datasize:=publicsyms^.datasize+
-     target_os.size_of_pointer;
-    {Set up the vmt layout collection.
-     First search for a vmt in a parent object.}
-    o:=childof;
-    c:=nil;
-    while o<>nil do
-        begin
-            if o^.vmt_layout<>nil then
-                begin
-                    c:=vmt_layout;
-                    break;
-                end;
-            o:=o^.childof;
-        end;
-    if c=nil then
-        new(vmt_layout,init(8,8))
-    else
-        begin
-            {We should copy the vmt layout of our parent object. Our vmt
-             layout will change as soon as methods are overridden or when
-             new virtual methods are added.}
-            new(vmt_layout,init(c^.limit,8));
-            for i:=0 to c^.count-1 do
-                vmt_layout^.insert(c^.at(i));
-        end;
-end;
-
-procedure Tobjectdef.check_forwards;
-
-begin
-    publicsyms^.check_forwards;
-    if oo_isforward in options then
-        begin
-            { ok, in future, the forward can be resolved }
-            message1(sym_e_class_forward_not_resolved,objname^);
-            exclude(options,oo_isforward);
-        end;
-end;
-
-{ true, if self inherits from d (or if they are equal) }
-function Tobjectdef.is_related(d:Pobjectdef):boolean;
-
-var hp:Pobjectdef;
-
-begin
-    hp:=@self;
-    is_related:=false;
-    while assigned(hp) do
-        begin
-            if hp=d then
-                begin
-                    is_related:=true;
-                    break;
-                end;
-            hp:=hp^.childof;
-        end;
-end;
-
-function Tobjectdef.insert(Asym:Psym):boolean;
-
-var speedvalue:longint;
-    s:Psym;
-    op:Tobjpropset;
-
-begin
-    {First check if the symbol already exists.}
-    s:=privatesyms^.speedsearch(Asym^.name,Asym^.speedvalue);
-    if s=nil then
-        protectedsyms^.speedsearch(Asym^.name,Asym^.speedvalue);
-    if s=nil then
-        publicsyms^.speedsearch(Asym^.name,Asym^.speedvalue);
-    if s<>nil then
-        duplicatesym(sym)
-    else
-        begin
-            {Asym is a Tprocsym, Tvarsym or Tpropertysym.}
-            if Asym^.is_object(typeof(Tprocsym)) then
-                op:=Pprocsym(Asym)^.objprop
-            else if Asym^.is_object(typeof(Tvarsym)) then
-                op:=Pvarsym(Asym)^.objprop
-            else if Asym^.is_object(typeof(Tpropertysym)) then
-                op:=Ppropertysym(Asym)^.objprop;
-            if sp_private in op then
-               insert:=privatesyms^.insert(Asym)
-            else if sp_protected in op then
-               insert:=protectedsyms^.insert(Asym)
-            else if sp_public in op then
-               insert:=publicsyms^.insert(Asym);
-        end;
-end;
-
-function Tobjectdef.search(const s:string;search_protected:boolean):Psym;
-
-begin
-    search:=speedsearch(s,getspeedvalue(s),search_protected);
-end;
-
-function Tobjectdef.speedsearch(const s:string;speedvalue:longint;
-                                search_protected:boolean):Psym;
-
-var r:Psym;
-
-begin
-    r:=publicsyms^.speedsearch(s,speedvalue);
-    {Privatesyms should be set to nil after compilation of the unit.
-     This way, private syms are not found by objects in other units.}
-    if (r=nil) and (privatesyms<>nil) then
-        r:=privatesyms^.speedsearch(s,speedvalue);
-    if (r=nil) and search_protected and (protectedsyms<>nil) then
-        r:=protectedsyms^.speedsearch(s,speedvalue);
-end;
-
-function Tobjectdef.size:longint;
-
-begin
-    if oo_is_class in options then
-        size:=target_os.size_of_pointer
-    else
-        size:=publicsyms^.datasize;
-end;
-
-
-procedure tobjectdef.deref;
-
-var oldrecsyms:Psymtable;
-
-begin
-{   resolvedef(pdef(childof));
-    oldrecsyms:=aktrecordsymtable;
-    aktrecordsymtable:=publicsyms;
-    publicsyms^.deref;
-    aktrecordsymtable:=oldrecsyms;}
-end;
-
-
-function Tobjectdef.vmt_mangledname:string;
-
-begin
-    if not(oo_has_virtual in options) then
-        message1(parser_object_has_no_vmt,objname^);
-    vmt_mangledname:='VMT_'+owner^.name^+'$_'+objname^;
-end;
-
-function Tobjectdef.rtti_name:string;
-
-begin
-    rtti_name:='RTTI_'+owner^.name^+'$_'+objname^;
-end;
-
-procedure Tobjectdef.store(var s:Tstream);
-
-var oldread_member:boolean;
-
-begin
-    inherited store(s);
-(*  writelong(size);
-    writelong(vmt_offset);
-    writestring(objname^);
-    writedefref(childof);
-    writelong(options);
-    current_ppu^.writeentry(ibobjectdef);
-
-    oldread_member:=read_member;
-    read_member:=true;
-    publicsyms^.writeas;
-    read_member:=oldread_member;*)
-end;
-
-procedure tobjectdef.write_child_init_data;
-
-begin
-end;
-
-
-procedure Tobjectdef.write_init_data;
-
-var b:byte;
-
-begin
-    if oo_is_class in options then
-        b:=tkclass
-    else
-        b:=tkobject;
-    rttilist^.concat(new(Pai_const,init_8bit(b)));
-
-    { generate the name }
-    rttilist^.concat(new(Pai_const,init_8bit(length(objname^))));
-    rttilist^.concat(new(Pai_string,init(objname^)));
-
-(*  rttilist^.concat(new(Pai_const,init_32bit(size)));
-    publicsyms^.foreach({$ifndef TP}@{$endif}count_inittable_fields);
-    rttilist^.concat(new(Pai_const,init_32bit(count)));
-    publicsyms^.foreach({$ifndef TP}@{$endif}write_field_inittable);*)
-end;
-
-
-function Tobjectdef.needs_inittable:boolean;
-
-var oldb:boolean;
-
-begin
-    { there are recursive calls to needs_inittable possible, }
-    { so we have to change to old value how else should      }
-    { we do that ? check_rec_rtti can't be a nested          }
-    { procedure of needs_rtti !                              }
-(*  oldb:=binittable;
-    binittable:=false;
-    publicsyms^.foreach({$ifndef TP}@{$endif}check_rec_inittable);
-    needs_inittable:=binittable;
-    binittable:=oldb;*)
-end;
-
-destructor Tobjectdef.done;
-
-var i:longint;
-    ve:Pvmtentry;
-
-begin
-    {We should be carefull when disposing the vmt_layout; there are
-     vmt entries in it which are from methods of our ancestor, we
-     should not dispose these. So first set them to nil.}
-    for i:=0 to vmt_layout^.count do
-        if Pvmtentry(vmt_layout^.at(i))^.owner<>@self then
-            vmt_layout^.atput(i,nil);
-    dispose(vmt_layout,done);
-
-    if publicsyms<>nil then
-        dispose(publicsyms,done);
-    if privatesyms<>nil then
-        dispose(privatesyms,done);
-    if protectedsyms<>nil then
-        dispose(protectedsyms,done);
-    if oo_isforward in options then
-        message1(sym_e_class_forward_not_resolved,objname^);
-    stringdispose(objname);
-    inherited done;
-end;
-
-var count:longint;
-
-procedure count_published_properties(sym:Pnamedindexobject);
-                                    {$ifndef fpc}far;{$endif}
-
-begin
-    if sym^.is_object(typeof(Tpropertysym)) and
-     (ppo_published in Ppropertysym(sym)^.properties) then
-        inc(count);
-end;
-
-
-procedure write_property_info(sym:Pnamedindexobject);{$ifndef fpc}far;{$endif}
-
-var proctypesinfo:byte;
-
-    procedure writeproc(proc:Pcollection;shiftvalue:byte);
-
-    var typvalue:byte;
-
-    begin
-        if proc=nil then
-            begin
-                rttilist^.concat(new(pai_const,init_32bit(1)));
-                typvalue:=3;
-            end
-        else if Psym(proc^.at(0))^.is_object(typeof(Tvarsym)) then
-            begin
-                rttilist^.concat(new(pai_const,init_32bit(
-                 Pvarsym(sym)^.address)));
-                typvalue:=0;
-            end
-        else
-            begin
-    (*          if (pprocdef(def)^.options and povirtualmethod)=0 then
-                    begin
-                        rttilist^.concat(new(pai_const_symbol,initname(pprocdef(def)^.mangledname)));
-                        typvalue:=1;
-                    end
-                else
-                    begin
-                        {Virtual method, write vmt offset.}
-                        rttilist^.concat(new(pai_const,
-                         init_32bit(Pprocdef(def)^.extnumber*4+12)));
-                        typvalue:=2;
-                    end;*)
-            end;
-        proctypesinfo:=proctypesinfo or (typvalue shl shiftvalue);
-    end;
-
-begin
-    if (typeof(sym^)=typeof(Tpropertysym)) and
-     (ppo_indexed in Ppropertysym(sym)^.properties) then
-        proctypesinfo:=$40
-    else
-        proctypesinfo:=0;
-    if (typeof(sym^)=typeof(Tpropertysym)) and
-            (ppo_published in Ppropertysym(sym)^.properties) then
-        begin
-            rttilist^.concat(new(pai_const_symbol,initname(
-             Ppropertysym(sym)^.definition^.get_rtti_label)));
-            writeproc(Ppropertysym(sym)^.readaccess,0);
-            writeproc(Ppropertysym(sym)^.writeaccess,2);
-            { isn't it stored ? }
-            if (ppo_stored in Ppropertysym(sym)^.properties) then
-                begin
-                    rttilist^.concat(new(pai_const,init_32bit(1)));
-                    proctypesinfo:=proctypesinfo or (3 shl 4);
-                end
-            else
-                writeproc(ppropertysym(sym)^.storedaccess,4);
-            rttilist^.concat(new(pai_const,
-             init_32bit(ppropertysym(sym)^.index)));
-            rttilist^.concat(new(pai_const,
-             init_32bit(ppropertysym(sym)^.default)));
-            rttilist^.concat(new(pai_const,
-             init_16bit(count)));
-            inc(count);
-            rttilist^.concat(new(pai_const,init_8bit(proctypesinfo)));
-            rttilist^.concat(new(pai_const,
-             init_8bit(length(ppropertysym(sym)^.name))));
-            rttilist^.concat(new(pai_string,init(ppropertysym(sym)^.name)));
-        end;
-end;
-
-
-procedure generate_published_child_rtti(sym:Pnamedindexobject);
-                                        {$ifndef fpc}far;{$endif}
-
-begin
-    if (typeof(sym^)=typeof(Tpropertysym)) and
-     (ppo_published in Ppropertysym(sym)^.properties) then
-        Ppropertysym(sym)^.definition^.get_rtti_label;
-end;
-
-
-procedure tobjectdef.write_child_rtti_data;
-
-begin
-    publicsyms^.foreach({$ifndef TP}@{$endif}generate_published_child_rtti);
-end;
-
-
-procedure Tobjectdef.generate_rtti;
-
-begin
-{   getdatalabel(rtti_label);
-    write_child_rtti_data;
-    rttilist^.concat(new(pai_symbol,initname_global(rtti_name)));
-    rttilist^.concat(new(pai_label,init(rtti_label)));
-    write_rtti_data;}
-end;
-
-
-function Tobjectdef.next_free_name_index : longint;
-
-var i:longint;
-
-begin
-    if (childof<>nil) and (oo_can_have_published in childof^.options) then
-        i:=childof^.next_free_name_index
-    else
-        i:=0;
-    count:=0;
-    publicsyms^.foreach({$ifndef TP}@{$endif}count_published_properties);
-    next_free_name_index:=i+count;
-end;
-
-
-procedure tobjectdef.write_rtti_data;
-
-begin
-    if oo_is_class in options then
-        rttilist^.concat(new(pai_const,init_8bit(tkclass)))
-    else
-        rttilist^.concat(new(pai_const,init_8bit(tkobject)));
-
-    {Generate the name }
-    rttilist^.concat(new(pai_const,init_8bit(length(objname^))));
-    rttilist^.concat(new(pai_string,init(objname^)));
-
-    {Write class type }
-    rttilist^.concat(new(pai_const_symbol,initname(vmt_mangledname)));
-
-    { write owner typeinfo }
-    if (childof<>nil) and (oo_can_have_published in childof^.options) then
-        rttilist^.concat(new(pai_const_symbol,
-         initname(childof^.get_rtti_label)))
-    else
-        rttilist^.concat(new(pai_const,init_32bit(0)));
-
-    {Count total number of properties }
-    if (childof<>nil) and (oo_can_have_published in childof^.options) then
-        count:=childof^.next_free_name_index
-    else
-        count:=0;
-
-    {Write it>}
-    publicsyms^.foreach({$ifndef TP}@{$endif}count_published_properties);
-    rttilist^.concat(new(Pai_const,init_16bit(count)));
-
-    { write unit name }
-    if owner^.name<>nil then
-        begin
-            rttilist^.concat(new(Pai_const,init_8bit(length(owner^.name^))));
-            rttilist^.concat(new(Pai_string,init(owner^.name^)));
-        end
-    else
-        rttilist^.concat(new(Pai_const,init_8bit(0)));
-
-    { write published properties count }
-    count:=0;
-    publicsyms^.foreach({$ifndef TP}@{$endif}count_published_properties);
-    rttilist^.concat(new(pai_const,init_16bit(count)));
-
-    { count is used to write nameindex   }
-    { but we need an offset of the owner }
-    { to give each property an own slot  }
-    if (childof<>nil) and (oo_can_have_published in childof^.options) then
-        count:=childof^.next_free_name_index
-    else
-        count:=0;
-    publicsyms^.foreach({$ifndef TP}@{$endif}write_property_info);
-end;
-
-
-function Tobjectdef.is_publishable:boolean;
-
-begin
-    is_publishable:=oo_is_class in options;
-end;
-
-function Tobjectdef.get_rtti_label:string;
-
-begin
-    get_rtti_label:=rtti_name;
-end;
-
-{***************************************************************************
-                           TARRAYDEF
-***************************************************************************}
-
-constructor Tarraydef.init(const l,h:Tconstant;rd:Pdef;
-                           Aowner:Pcontainingsymtable);
-
-begin
-    inherited init(Aowner);
-    {$IFDEF TP}setparent(typeof(Tdef));{$ENDIF}
-    lowrange:=l;
-    highrange:=h;
-    rangedef:=rd;
-end;
-
-
-constructor Tarraydef.load(var s:Tstream);
-
-begin
-    inherited load(s);
-(*  deftype:=arraydef;
-    { the addresses are calculated later }
-    definition:=readdefref;
-    rangedef:=readdefref;
-    lowrange:=readlong;
-    highrange:=readlong;
-    IsArrayOfConst:=boolean(readbyte);*)
-end;
-
-
-function Tarraydef.getrangecheckstring:string;
-
-begin
-    if (cs_create_smart in aktmoduleswitches) then
-        getrangecheckstring:='R_'+current_module^.modulename^+tostr(rangenr)
-    else
-        getrangecheckstring:='R_'+tostr(rangenr);
-end;
-
-
-procedure Tarraydef.genrangecheck;
-
-begin
-    if rangenr=0 then
-        begin
-            {Generates the data for range checking }
-            getlabelnr(rangenr);
-            if (cs_create_smart in aktmoduleswitches) then
-                datasegment^.concat(new(pai_symbol,
-                 initname_global(getrangecheckstring,10)))
-            else
-                datasegment^.concat(new(pai_symbol,
-                 initname(getrangecheckstring,10)));
-            datasegment^.concat(new(Pai_const,
-             init_8bit(byte(lowrange.signed))));
-            datasegment^.concat(new(Pai_const,
-             init_32bit(lowrange.values)));
-            datasegment^.concat(new(Pai_const,
-             init_8bit(byte(highrange.signed))));
-            datasegment^.concat(new(Pai_const,
-             init_32bit(highrange.values)));
-        end;
-end;
-
-
-procedure Tarraydef.deref;
-
-begin
-{   resolvedef(definition);
-    resolvedef(rangedef);}
-end;
-
-procedure Tarraydef.store(var s:Tstream);
-
-begin
-    inherited store(s);
-(*  writedefref(definition);
-    writedefref(rangedef);
-    writelong(lowrange);
-    writelong(highrange);
-    writebyte(byte(IsArrayOfConst));
-    current_ppu^.writeentry(ibarraydef);*)
-end;
-
-function Tarraydef.elesize:longint;
-
-begin
-    elesize:=definition^.size;
-end;
-
-
-function Tarraydef.size:longint;
-
-begin
-    if (lowrange.signed) and (lowrange.values=-1) then
-        internalerror($990804);
-    if highrange.signed then
-        begin
-            {Check for overflow.}
-            if (highrange.values-lowrange.values=$7fffffff) or
-              (($7fffffff div elesize+elesize-1)>
-               (highrange.values-lowrange.values)) then
-                begin
-{                   message(sym_segment_too_large);}
-                    size:=1;
-                end
-            else
-                size:=(highrange.values-lowrange.values+1)*elesize;
-        end
-    else
-        begin
-            {Check for overflow.}
-            if (highrange.valueu-lowrange.valueu=$7fffffff) or
-              (($7fffffff div elesize+elesize-1)>
-               (highrange.valueu-lowrange.valueu)) then
-                begin
-{                   message(sym_segment_too_small);}
-                    size:=1;
-                end
-            else
-                size:=(highrange.valueu-lowrange.valueu+1)*elesize;
-        end;
-end;
-
-
-function Tarraydef.needs_inittable:boolean;
-
-begin
-    needs_inittable:=definition^.needs_inittable;
-end;
-
-
-procedure Tarraydef.write_child_rtti_data;
-
-begin
-    definition^.get_rtti_label;
-end;
-
-
-procedure tarraydef.write_rtti_data;
-
-begin
-    rttilist^.concat(new(Pai_const,init_8bit(13)));
-    write_rtti_name;
-    { size of elements }
-    rttilist^.concat(new(Pai_const,init_32bit(definition^.size)));
-    { count of elements }
-    rttilist^.concat(new(Pai_const,
-     init_32bit(highrange.values-lowrange.values+1)));
-    { element type }
-    rttilist^.concat(new(Pai_const_symbol,
-     initname(definition^.get_rtti_label)));
-end;
-
-function Tarraydef.gettypename:string;
-
-var r:string;
-
-begin
-    if [ap_arrayofconst,ap_constructor]*options<>[] then
-        gettypename:='array of const'
-    else if (lowrange.signed) and (lowrange.values=-1) then
-        gettypename:='Array Of '+definition^.typename
-    else
-        begin
-            r:='array[$1..$2 Of $3]';
-            if typeof(rangedef^)=typeof(Tenumdef) then
-                with Penumdef(rangedef)^.symbols^ do
-                    begin
-                        replace(r,'$1',Penumsym(at(0))^.name);
-                        replace(r,'$2',Penumsym(at(count-1))^.name);
-                    end
-            else
-                begin
-                    if lowrange.signed then
-                        replace(r,'$1',tostr(lowrange.values))
-                    else
-                        replace(r,'$1',tostru(lowrange.valueu));
-                    if highrange.signed then
-                        replace(r,'$2',tostr(highrange.values))
-                    else
-                        replace(r,'$2',tostr(highrange.valueu));
-                    replace(r,'$3',definition^.typename);
-                end;
-            gettypename:=r;
-        end;
-end;
-
-{****************************************************************************
-                                 Tenumdef
-****************************************************************************}
-
-constructor Tenumdef.init(Aowner:Pcontainingsymtable);
-
-begin
-    inherited init(Aowner);
-    {$IFDEF TP}setparent(typeof(Tdef));{$ENDIF}
-    include(properties,dp_ret_in_acc);
-    new(symbols,init(8,8));
-    calcsavesize;
-end;
-
-constructor Tenumdef.init_subrange(Abasedef:Penumdef;Amin,Amax:longint;
-                                   Aowner:Pcontainingsymtable);
-
-begin
-    inherited init(Aowner);
-    minval:=Amin;
-    maxval:=Amax;
-    basedef:=Abasedef;
-    symbols:=Abasedef^.symbols;
-    calcsavesize;
-end;
-
-
-constructor Tenumdef.load(var s:Tstream);
-
-begin
-    inherited load(s);
-(*  basedef:=penumdef(readdefref);
-    minval:=readlong;
-    maxval:=readlong;
-    savesize:=readlong;*)
-end;
-
-
-procedure Tenumdef.calcsavesize;
-
-begin
-    if (aktpackenum=4) or (minval<0) or (maxval>65535) then
-        savesize:=4
-    else if (aktpackenum=2) or (minval<0) or (maxval>255) then
-        savesize:=2
-    else
-        savesize:=1;
-end;
-
-
-procedure Tenumdef.setmax(Amax:longint);
-
-begin
-    maxval:=Amax;
-    calcsavesize;
-end;
-
-
-procedure Tenumdef.setmin(Amin:longint);
-
-begin
-    minval:=Amin;
-    calcsavesize;
-end;
-
-
-procedure tenumdef.deref;
-
-begin
-{   resolvedef(pdef(basedef));}
-end;
-
-
-procedure Tenumdef.store(var s:Tstream);
-
-begin
-    inherited store(s);
-(*  writedefref(basedef);
-    writelong(min);
-    writelong(max);
-    writelong(savesize);
-    current_ppu^.writeentry(ibenumdef);*)
-end;
-
-
-function tenumdef.getrangecheckstring : string;
-begin
-   if (cs_create_smart in aktmoduleswitches) then
-     getrangecheckstring:='R_'+current_module^.modulename^+tostr(rangenr)
-   else
-     getrangecheckstring:='R_'+tostr(rangenr);
-end;
-
-
-procedure tenumdef.genrangecheck;
-begin
-   if rangenr=0 then
-     begin
-        { generate two constant for bounds }
-        getlabelnr(rangenr);
-        if (cs_create_smart in aktmoduleswitches) then
-          datasegment^.concat(new(Pai_symbol,
-                              initname_global(getrangecheckstring,8)))
-        else
-          datasegment^.concat(new(Pai_symbol,
-                              initname(getrangecheckstring,8)));
-        datasegment^.concat(new(pai_const,init_32bit(minval)));
-        datasegment^.concat(new(pai_const,init_32bit(maxval)));
-     end;
-end;
-
-procedure Tenumdef.write_child_rtti_data;
-
-begin
-   if assigned(basedef) then
-        basedef^.get_rtti_label;
-end;
-
-
-procedure Tenumdef.write_rtti_data;
-
-var i:word;
-
-begin
-    rttilist^.concat(new(pai_const,init_8bit(tkEnumeration)));
-    write_rtti_name;
-    case savesize of
-        1:
-            rttilist^.concat(new(Pai_const,init_8bit(otUByte)));
-        2:
-            rttilist^.concat(new(Pai_const,init_8bit(otUWord)));
-        4:
-            rttilist^.concat(new(Pai_const,init_8bit(otULong)));
-    end;
-    rttilist^.concat(new(pai_const,init_32bit(minval)));
-    rttilist^.concat(new(pai_const,init_32bit(maxval)));
-    if assigned(basedef) then
-        rttilist^.concat(new(pai_const_symbol,initname(basedef^.get_rtti_label)))
-    else
-        rttilist^.concat(new(pai_const,init_32bit(0)));
-    for i:=0 to symbols^.count-1 do
-        begin
-            rttilist^.concat(new(Pai_const,
-             init_8bit(length(Penumsym(symbols^.at(i))^.name))));
-            rttilist^.concat(new(Pai_string,
-             init(globals.lower(Penumsym(symbols^.at(i))^.name))));
-        end;
-    rttilist^.concat(new(pai_const,init_8bit(0)));
-end;
-
-
-function Tenumdef.is_publishable:boolean;
-
-begin
-    is_publishable:=true;
-end;
-
-function Tenumdef.gettypename:string;
-
-var i:word;
-    v:longint;
-    r:string;
-
-begin
-    r:='(';
-    for i:=0 to symbols^.count-1 do
-        begin
-            v:=Penumsym(symbols^.at(i))^.value;
-            if (v>=minval) and (v<=maxval) then
-                r:=r+Penumsym(symbols^.at(i))^.name+',';
-        end;
-    {Turn ',' into ')'.}
-    r[length(r)]:=')';
-end;
-
-{****************************************************************************
-                                 Torddef
-****************************************************************************}
-
-
-constructor Torddef.init(t:Tbasetype;l,h:Tconstant;
-                         Aowner:Pcontainingsymtable);
-
-begin
-    inherited init(Aowner);
-    {$IFDEF TP}setparent(typeof(Tdef));{$ENDIF}
-    include(properties,dp_ret_in_acc);
-    low:=l;
-    high:=h;
-    typ:=t;
-    setsize;
-end;
-
-constructor Torddef.load(var s:Tstream);
-
-begin
-    inherited load(s);
-(*  typ:=tbasetype(readbyte);
-    low:=readlong;
-    high:=readlong;*)
-    setsize;
-end;
-
-
-procedure Torddef.setsize;
-
-begin
-   if typ=uauto then
-        begin
-            {Generate a unsigned range if high<0 and low>=0 }
-            if (low.values>=0) and (high.values<=255) then
-                typ:=u8bit
-            else if (low.signed) and (low.values>=-128) and (high.values<=127) then
-                typ:=s8bit
-            else if (low.values>=0) and (high.values<=65536) then
-                typ:=u16bit
-            else if (low.signed) and (low.values>=-32768) and (high.values<=32767) then
-                typ:=s16bit
-            else if low.signed then
-                typ:=s32bit
-            else
-                typ:=u32bit
-        end;
-    case typ of
-        u8bit,s8bit,uchar,bool8bit:
-            savesize:=1;
-
-        u16bit,s16bit,bool16bit:
-            savesize:=2;
-
-        s32bit,u32bit,bool32bit:
-            savesize:=4;
-
-        u64bit,s64bitint:
-            savesize:=8;
-        else
-            savesize:=0;
-    end;
-   rangenr:=0;
-end;
-
-function Torddef.getrangecheckstring:string;
-
-begin
-    if (cs_create_smart in aktmoduleswitches) then
-        getrangecheckstring:='R_'+current_module^.modulename^+tostr(rangenr)
-    else
-        getrangecheckstring:='R_'+tostr(rangenr);
-end;
-
-procedure Torddef.genrangecheck;
-
-begin
-   if rangenr=0 then
-        begin
-            {Generate two constant for bounds.}
-            getlabelnr(rangenr);
-            if (cs_create_smart in aktmoduleswitches) then
-              datasegment^.concat(new(Pai_symbol,
-               initname_global(getrangecheckstring,10)))
-            else
-              datasegment^.concat(new(Pai_symbol,
-               initname(getrangecheckstring,10)));
-            datasegment^.concat(new(Pai_const,init_8bit(byte(low.signed))));
-            datasegment^.concat(new(Pai_const,init_32bit(low.values)));
-            datasegment^.concat(new(Pai_const,init_8bit(byte(high.signed))));
-            datasegment^.concat(new(Pai_const,init_32bit(high.values)));
-        end;
-end;
-
-
-procedure Torddef.store(var s:Tstream);
-
-begin
-    inherited store(s);
-(*  writebyte(byte(typ));
-    writelong(low);
-    writelong(high);
-    current_ppu^.writeentry(iborddef);*)
-end;
-
-
-procedure Torddef.write_rtti_data;
-
-const   trans:array[uchar..bool8bit] of byte=
-            (otubyte,otubyte,otuword,otulong,
-             otsbyte,otsword,otslong,otubyte);
-
-begin
-    case typ of
-        bool8bit:
-            rttilist^.concat(new(Pai_const,init_8bit(tkbool)));
-        uchar:
-            rttilist^.concat(new(Pai_const,init_8bit(tkchar)));
-        else
-            rttilist^.concat(new(Pai_const,init_8bit(tkinteger)));
-    end;
-    write_rtti_name;
-    rttilist^.concat(new(Pai_const,init_8bit(byte(trans[typ]))));
-    rttilist^.concat(new(Pai_const,init_32bit(low.values)));
-    rttilist^.concat(new(Pai_const,init_32bit(high.values)));
-end;
-
-function Torddef.is_publishable:boolean;
-
-begin
-    is_publishable:=typ in [uchar..bool8bit];
-end;
-
-function Torddef.gettypename:string;
-
-const   names:array[Tbasetype] of string[20]=('<unknown type>',
-                'untyped','char','byte','word','dword','shortInt',
-                'smallint','longInt','boolean','wordbool',
-                'longbool','qword','int64','card64','widechar');
-
-begin
-    gettypename:=names[typ];
-end;
-
-{****************************************************************************
-                                Tfloatdef
-****************************************************************************}
-
-constructor Tfloatdef.init(t:Tfloattype;Aowner:Pcontainingsymtable);
-
-begin
-    inherited init(Aowner);
-    {$IFDEF TP}setparent(typeof(Tdef));{$ENDIF}
-    if t=f32bit then
-        include(properties,dp_ret_in_acc);
-    typ:=t;
-    setsize;
-end;
-
-
-constructor Tfloatdef.load(var s:Tstream);
-
-begin
-    inherited load(s);
-(*  typ:=Tfloattype(readbyte);*)
-    setsize;
-end;
-
-
-procedure tfloatdef.setsize;
-
-begin
-    case typ of
-        f16bit:
-            savesize:=2;
-        f32bit,
-        s32real:
-            savesize:=4;
-        s64real:
-            savesize:=8;
-        s80real:
-            savesize:=extended_size;
-        s64comp:
-            savesize:=8;
-        else
-            savesize:=0;
-    end;
-end;
-
-
-procedure Tfloatdef.store(var s:Tstream);
-
-begin
-    inherited store(s);
-(*  writebyte(byte(typ));
-    current_ppu^.writeentry(ibfloatdef);*)
-end;
-
-procedure Tfloatdef.write_rtti_data;
-
-const   translate:array[Tfloattype] of byte=
-            (ftsingle,ftdouble,ftextended,ftcomp,ftfixed16,ftfixed32);
-begin
-    rttilist^.concat(new(Pai_const,init_8bit(tkfloat)));
-    write_rtti_name;
-    rttilist^.concat(new(Pai_const,init_8bit(translate[typ])));
-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','comp','fixed','shortfixed');
-
-begin
-   gettypename:=names[typ];
-end;
-
-{***************************************************************************
-                                   Tsetdef
-***************************************************************************}
-
-{ For i386 smallsets work,
-  for m68k there are problems
-  can be test by compiling with -dusesmallset PM }
-{$ifdef i386}
-{$define usesmallset}
-{$endif i386}
-
-constructor Tsetdef.init(s:Pdef;high:longint;Aowner:Pcontainingsymtable);
-
-begin
-    inherited init(Aowner);
-    {$IFDEF TP}setparent(typeof(Tdef));{$ENDIF}
-    definition:=s;
-    if high<32 then
-        begin
-            settype:=smallset;
-            savesize:=4;
-            include(properties,dp_ret_in_acc);
-        end
-    else if high<256 then
-            begin
-                settype:=normset;
-                savesize:=32;
-            end
-{$ifdef testvarsets}
-    else if high<$10000 then
-        begin
-            settype:=varset;
-            savesize:=4*((high+31) div 32);
-        end
-{$endif testvarsets}
-    else
-        message(sym_e_ill_type_decl_set);
-end;
-
-
-constructor Tsetdef.load(var s:Tstream);
-
-begin
-    inherited load(s);
-(*  setof:=readdefref;
-    settype:=tsettype(readbyte);
-    case settype of
-        normset:
-            savesize:=32;
-        varset:
-            savesize:=readlong;
-        smallset:
-            savesize:=sizeof(longint);
-    end;*)
-end;
-
-
-procedure Tsetdef.store(var s:Tstream);
-
-begin
-    inherited store(s);
-(*  writedefref(setof);
-    writebyte(byte(settype));
-    if settype=varset then
-        writelong(savesize);
-    current_ppu^.writeentry(ibsetdef);*)
-end;
-
-
-procedure Tsetdef.deref;
-
-begin
-{   resolvedef(setof);}
-end;
-
-
-procedure Tsetdef.write_rtti_data;
-
-begin
-    rttilist^.concat(new(pai_const,init_8bit(tkset)));
-    write_rtti_name;
-    rttilist^.concat(new(pai_const,init_8bit(otuLong)));
-    rttilist^.concat(new(pai_const_symbol,initname(definition^.get_rtti_label)));
-end;
-
-
-procedure Tsetdef.write_child_rtti_data;
-
-begin
-    definition^.get_rtti_label;
-end;
-
-
-function Tsetdef.is_publishable:boolean;
-
-begin
-    is_publishable:=settype=smallset;
-end;
-
-function Tsetdef.gettypename:string;
-
-begin
-   gettypename:='set of '+definition^.typename;
-end;
-{***************************************************************************
-                                  Trecorddef
-***************************************************************************}
-
-constructor Trecorddef.init(s:Precordsymtable;Aowner:Pcontainingsymtable);
-
-begin
-    inherited init(Aowner);
-    {$IFDEF TP}setparent(typeof(Tdef));{$ENDIF}
-    symtable:=s;
-    savesize:=symtable^.datasize;
-end;
-
-
-constructor Trecorddef.load(var s:Tstream);
-
-var oldread_member:boolean;
-begin
-(*  inherited load(s);
-    savesize:=readlong;
-    oldread_member:=read_member;
-    read_member:=true;
-    symtable:=new(psymtable,loadas(recordsymtable));
-    read_member:=oldread_member;
-    symtable^.defowner := @self;*)
-end;
-
-
-destructor Trecorddef.done;
-
-begin
-    if symtable<>nil then
-        dispose(symtable,done);
-    inherited done;
-end;
-
-var
- binittable : boolean;
-
-procedure check_rec_inittable(s:Pnamedindexobject);
-
-begin
-    if (typeof(s^)=typeof(Tvarsym)) and
-     ((typeof((Pvarsym(s)^.definition^))<>typeof(Tobjectdef)) or
-      not (oo_is_class in Pobjectdef(Pvarsym(s)^.definition)^.options)) then
-        binittable:=pvarsym(s)^.definition^.needs_inittable;
-end;
-
-
-function Trecorddef.needs_inittable:boolean;
-
-var oldb:boolean;
-
-begin
-    { there are recursive calls to needs_rtti possible, }
-    { so we have to change to old value how else should }
-    { we do that ? check_rec_rtti can't be a nested     }
-    { procedure of needs_rtti !                         }
-    oldb:=binittable;
-    binittable:=false;
-    symtable^.foreach({$ifndef TP}@{$endif}check_rec_inittable);
-    needs_inittable:=binittable;
-    binittable:=oldb;
-end;
-
-
-procedure Trecorddef.deref;
-
-var oldrecsyms:Psymtable;
-
-begin
-(*   oldrecsyms:=aktrecordsymtable;
-   aktrecordsymtable:=symtable;
-   { now dereference the definitions }
-   symtable^.deref;
-   aktrecordsymtable:=oldrecsyms;*)
-end;
-
-
-procedure Trecorddef.store(var s:Tstream);
-
-var oldread_member:boolean;
-
-begin
-(*  oldread_member:=read_member;
-    read_member:=true;
-    inherited store(s);
-    writelong(savesize);
-    current_ppu^.writeentry(ibrecorddef);
-    self.symtable^.writeas;
-    read_member:=oldread_member;*)
-end;
-
-procedure count_inittable_fields(sym:Pnamedindexobject);
-                                {$ifndef fpc}far;{$endif}
-
-begin
-   if (typeof(sym^)=typeof(Tvarsym)) and
-    (Pvarsym(sym)^.definition^.needs_inittable) then
-        inc(count);
-end;
-
-
-procedure count_fields(sym:Pnamedindexobject);{$ifndef fpc}far;{$endif}
-
-begin
-   inc(count);
-end;
-
-
-procedure write_field_inittable(sym:Pnamedindexobject);
-                                {$ifndef fpc}far;{$endif}
-
-begin
-    if (typeof(sym^)=typeof(Tvarsym)) and
-     Pvarsym(sym)^.definition^.needs_inittable then
-        begin
-            rttilist^.concat(new(Pai_const_symbol,
-             init(pvarsym(sym)^.definition^.get_inittable_label)));
-            rttilist^.concat(new(Pai_const,
-             init_32bit(pvarsym(sym)^.address)));
-        end;
-end;
-
-
-procedure write_field_rtti(sym:Pnamedindexobject);{$ifndef fpc}far;{$endif}
-
-begin
-    rttilist^.concat(new(Pai_const_symbol,
-     initname(Pvarsym(sym)^.definition^.get_rtti_label)));
-    rttilist^.concat(new(Pai_const,
-     init_32bit(Pvarsym(sym)^.address)));
-end;
-
-
-procedure generate_child_inittable(sym:Pnamedindexobject);
-                                   {$ifndef fpc}far;{$endif}
-
-
-begin
-    if (typeof(sym^)=typeof(Tvarsym)) and
-        Pvarsym(sym)^.definition^.needs_inittable then
-    {Force inittable generation }
-        Pvarsym(sym)^.definition^.get_inittable_label;
-end;
-
-
-procedure generate_child_rtti(sym:Pnamedindexobject);
-                              {$ifndef fpc}far;{$endif}
-
-begin
-    Pvarsym(sym)^.definition^.get_rtti_label;
-end;
-
-procedure Trecorddef.write_child_rtti_data;
-
-begin
-    symtable^.foreach({$ifndef TP}@{$endif}generate_child_rtti);
-end;
-
-
-procedure Trecorddef.write_child_init_data;
-
-begin
-    symtable^.foreach({$ifndef TP}@{$endif}generate_child_inittable);
-end;
-
-
-procedure Trecorddef.write_rtti_data;
-
-begin
-    rttilist^.concat(new(pai_const,init_8bit(tkrecord)));
-    write_rtti_name;
-    rttilist^.concat(new(pai_const,init_32bit(size)));
-    count:=0;
-    symtable^.foreach({$ifndef TP}@{$endif}count_fields);
-    rttilist^.concat(new(pai_const,init_32bit(count)));
-    symtable^.foreach({$ifndef TP}@{$endif}write_field_rtti);
-end;
-
-
-procedure Trecorddef.write_init_data;
-
-begin
-    rttilist^.concat(new(pai_const,init_8bit(14)));
-    write_rtti_name;
-    rttilist^.concat(new(pai_const,init_32bit(size)));
-    count:=0;
-    symtable^.foreach({$ifndef TP}@{$endif}count_inittable_fields);
-    rttilist^.concat(new(pai_const,init_32bit(count)));
-    symtable^.foreach({$ifndef TP}@{$endif}write_field_inittable);
-end;
-
-function Trecorddef.gettypename:string;
-
-begin
-    gettypename:='<record type>'
-end;
-
-{***************************************************************************
-                             Tstringprocdef
-***************************************************************************}
-
-constructor Tstringdef.shortinit(l:byte;Aowner:Pcontainingsymtable);
-
-begin
-    inherited init(Aowner);
-    {$IFDEF TP}setparent(typeof(Tdef));{$ENDIF}
-    string_typ:=st_shortstring;
-    len:=l;
-    savesize:=len+1;
-end;
-
-
-constructor Tstringdef.shortload(var s:Tstream);
-
-begin
-    inherited load(s);
-    string_typ:=st_shortstring;
-{   len:=readbyte;
-    savesize:=len+1;}
-end;
-
-
-constructor Tstringdef.longinit(l:longint;Aowner:Pcontainingsymtable);
-
-begin
-    inherited init(Aowner);
-    string_typ:=st_longstring;
-    len:=l;
-    savesize:=target_os.size_of_pointer;
-end;
-
-
-constructor Tstringdef.longload(var s:Tstream);
-
-begin
-    inherited load(s);
-    string_typ:=st_longstring;
-{   len:=readlong;
-    savesize:=target_os.size_of_pointer;}
-end;
-
-
-constructor tstringdef.ansiinit(l:longint;Aowner:Pcontainingsymtable);
-
-begin
-    inherited init(Aowner);
-    include(properties,dp_ret_in_acc);
-    string_typ:=st_ansistring;
-    len:=l;
-    savesize:=target_os.size_of_pointer;
-end;
-
-
-constructor Tstringdef.ansiload(var s:Tstream);
-
-begin
-    inherited load(s);
-    string_typ:=st_ansistring;
-{   len:=readlong;
-    savesize:=target_os.size_of_pointer;}
-end;
-
-
-constructor Tstringdef.wideinit(l:longint;Aowner:Pcontainingsymtable);
-begin
-    inherited init(Aowner);
-    include(properties,dp_ret_in_acc);
-    string_typ:=st_widestring;
-    len:=l;
-    savesize:=target_os.size_of_pointer;
-end;
-
-
-constructor Tstringdef.wideload(var s:Tstream);
-
-begin
-    inherited load(s);
-    string_typ:=st_widestring;
-{   len:=readlong;
-    savesize:=target_os.size_of_pointer;}
-end;
-
-
-function Tstringdef.stringtypname:string;
-
-const   typname:array[tstringtype] of string[8]=
-            ('','SHORTSTR','LONGSTR','ANSISTR','WIDESTR');
-
-begin
-    stringtypname:=typname[string_typ];
-end;
-
-
-function tstringdef.size:longint;
-
-begin
-    size:=savesize;
-end;
-
-
-procedure Tstringdef.store(var s:Tstream);
-
-begin
-    inherited store(s);
-{   if string_typ=st_shortstring then
-        writebyte(len)
-    else
-        writelong(len);
-    case string_typ of
-        st_shortstring:
-            current_ppu^.writeentry(ibshortstringdef);
-        st_longstring:
-            current_ppu^.writeentry(iblongstringdef);
-        st_ansistring:
-            current_ppu^.writeentry(ibansistringdef);
-        st_widestring:
-            current_ppu^.writeentry(ibwidestringdef);
-    end;}
-end;
-
-
-{$ifdef GDB}
-function tstringdef.stabstring : pchar;
-var
-  bytest,charst,longst : string;
-begin
-  case string_typ of
-     st_shortstring:
-       begin
-         charst := typeglobalnumber('char');
-         { this is what I found in stabs.texinfo but
-           gdb 4.12 for go32 doesn't understand that !! }
-       {$IfDef GDBknowsstrings}
-         stabstring := strpnew('n'+charst+';'+tostr(len));
-       {$else}
-         bytest := typeglobalnumber('byte');
-         stabstring := strpnew('s'+tostr(len+1)+'length:'+bytest
-            +',0,8;st:ar'+bytest
-            +';1;'+tostr(len)+';'+charst+',8,'+tostr(len*8)+';;');
-       {$EndIf}
-       end;
-     st_longstring:
-       begin
-         charst := typeglobalnumber('char');
-         { this is what I found in stabs.texinfo but
-           gdb 4.12 for go32 doesn't understand that !! }
-       {$IfDef GDBknowsstrings}
-         stabstring := strpnew('n'+charst+';'+tostr(len));
-       {$else}
-         bytest := typeglobalnumber('byte');
-         longst := typeglobalnumber('longint');
-         stabstring := strpnew('s'+tostr(len+5)+'length:'+longst
-            +',0,32;dummy:'+bytest+',32,8;st:ar'+bytest
-            +';1;'+tostr(len)+';'+charst+',40,'+tostr(len*8)+';;');
-       {$EndIf}
-       end;
-     st_ansistring:
-       begin
-         { an ansi string looks like a pchar easy !! }
-         stabstring:=strpnew('*'+typeglobalnumber('char'));
-       end;
-     st_widestring:
-       begin
-         { an ansi string looks like a pchar easy !! }
-         stabstring:=strpnew('*'+typeglobalnumber('char'));
-       end;
-end;
-end;
-
-
-procedure tstringdef.concatstabto(asmlist : paasmoutput);
-begin
-  inherited concatstabto(asmlist);
-end;
-{$endif GDB}
-
-
-function tstringdef.needs_inittable : boolean;
-begin
-   needs_inittable:=string_typ in [st_ansistring,st_widestring];
-end;
-
-function tstringdef.gettypename : string;
-
-const
-   names : array[tstringtype] of string[20] = ('',
-     'ShortString','LongString','AnsiString','WideString');
-
-begin
-   gettypename:=names[string_typ];
-end;
-
-procedure tstringdef.write_rtti_data;
-begin
-   case string_typ of
-      st_ansistring:
-        begin
-           rttilist^.concat(new(pai_const,init_8bit(tkAString)));
-           write_rtti_name;
-        end;
-      st_widestring:
-        begin
-           rttilist^.concat(new(pai_const,init_8bit(tkWString)));
-           write_rtti_name;
-        end;
-      st_longstring:
-        begin
-           rttilist^.concat(new(pai_const,init_8bit(tkLString)));
-           write_rtti_name;
-        end;
-      st_shortstring:
-        begin
-           rttilist^.concat(new(pai_const,init_8bit(tkSString)));
-           write_rtti_name;
-           rttilist^.concat(new(pai_const,init_8bit(len)));
-        end;
-   end;
-end;
-
-
-function tstringdef.is_publishable : boolean;
-begin
-   is_publishable:=true;
-end;
-
-
-{***************************************************************************
-                            Tabstractprocdef
-***************************************************************************}
-
-constructor Tabstractprocdef.init(Aowner:Pcontainingsymtable);
-
-begin
-    inherited init(Aowner);
-    {$IFDEF TP}setparent(typeof(Tdef));{$ENDIF}
-    include(properties,dp_ret_in_acc);
-    retdef:=voiddef;
-    savesize:=target_os.size_of_pointer;
-end;
-
-constructor Tabstractprocdef.load(var s:Tstream);
-
-var count,i:word;
-
-begin
-    inherited load(s);
-(*  retdef:=readdefref;
-    fpu_used:=readbyte;
-    options:=readlong;
-    count:=readword;
-    new(parameters);
-    savesize:=target_os.size_of_pointer;
-    for i:=1 to count do
-        parameters^.readsymref;*)
-end;
-
-{ all functions returning in FPU are
-  assume to use 2 FPU registers
-  until the function implementation
-  is processed   PM }
-procedure Tabstractprocdef.test_if_fpu_result;
-
-begin
-    if (retdef<>nil) and (typeof(retdef^)=typeof(Tfloatdef)) and
-     (Pfloatdef(retdef)^.typ in [f32bit,f16bit]) then
-        fpu_used:=2;
-end;
-
-procedure Tabstractprocdef.deref;
-
-var i:longint;
-
-begin
-    inherited deref;
-{   resolvedef(retdef);}
-    for i:=0 to parameters^.count-1 do
-        Psym(parameters^.at(i))^.deref;
-end;
-
-function Tabstractprocdef.para_size:longint;
-
-var i,l:longint;
-
-begin
-    l:=0;
-    for i:=0 to parameters^.count-1 do
-        inc(l,Pparamsym(parameters^.at(i))^.getpushsize);
-    para_size:=l;
-end;
-
-procedure Tabstractprocdef.store(var s:Tstream);
-
-var count,i:word;
-
-begin
-    inherited store(s);
-{   writedefref(retdef);
-    current_ppu^.do_interface_crc:=false;
-    writebyte(fpu_used);
-    writelong(options);
-    writeword(parameters^.count);
-    for i:=0 to parameters^.count-1 do
-        begin
-            writebyte(byte(hp^.paratyp));
-            writesymfref(hp^.data);
-        end;}
-end;
-
-
-function Tabstractprocdef.demangled_paras:string;
-
-var i:longint;
-    s:string;
-
-procedure doconcat(p:Pparameter);
-
-begin
-    s:=s+p^.data^.name;
-    if p^.paratyp=vs_var then
-        s:=s+'var'
-    else if p^.paratyp=vs_const then
-        s:=s+'const';
-end;
-
-begin
-    s:='(';
-    for i:=0 to parameters^.count-1 do
-        doconcat(parameters^.at(i));
-    s[length(s)]:=')';
-    demangled_paras:=s;
-end;
-
-destructor Tabstractprocdef.done;
-
-begin
-    dispose(parameters,done);
-    inherited done;
-end;
-
-{***************************************************************************
-                                  TPROCDEF
-***************************************************************************}
-
-constructor Tprocdef.init(Aowner:Pcontainingsymtable);
-
-begin
-    inherited init(Aowner);
-    {$IFDEF TP}setparent(typeof(Tabstractprocdef));{$ENDIF}
-    fileinfo:=aktfilepos;
-    vmt_index:=-1;
-    new(localst,init);
-    if (cs_browser in aktmoduleswitches) and make_ref then
-        begin
-            new(references,init(2*owner^.index_growsize,
-                                owner^.index_growsize));
-            references^.insert(new(Pref,init(tokenpos)));
-        end;
-    {First, we assume that all registers are used }
-    usedregisters:=[low(Tregister)..high(Tregister)];
-    forwarddef:=true;
-end;
-
-
-constructor Tprocdef.load(var s:Tstream);
-
-var a:string;
-
-begin
-    inherited load(s);
-(*  usedregisters:=readlong;
-
-    a:=readstring;
-    setstring(_mangledname,s);
-
-    extnumber:=readlong;
-    nextoerloaded:=pprocdef(readdefref);
-    _class := pobjectdef(readdefref);
-    readposinfo(fileinfo);
-
-    if (cs_link_deffile in aktglobalswitches)
-     and (poexports in options) then
-        deffile.ddexport(mangledname);
-
-    count:=true;*)
-end;
-
-
-const local_symtable_index : longint = $8001;
-
-procedure tprocdef.load_references;
-
-var pos:Tfileposinfo;
-    pdo:Pobjectdef;
-    move_last:boolean;
-
-begin
-(*  move_last:=lastwritten=lastref;
-    while (not current_ppu^.endofentry) do
-        begin
-            readposinfo(pos);
-            inc(refcount);
-            lastref:=new(pref,init(lastref,@pos));
-            lastref^.is_written:=true;
-            if refcount=1 then
-                defref:=lastref;
-        end;
-    if move_last then
-        lastwritten:=lastref;
-    if ((current_module^.flags and uf_local_browser)<>0)
-     and is_in_current then
-        begin
-{$ifndef NOLOCALBROWSER}
-            pdo:=_class;
-            new(parast,loadas(parasymtable));
-            parast^.next:=owner;
-            parast^.load_browser;
-            new(localst,loadas(localsymtable));
-            localst^.next:=parast;
-            localst^.load_browser;
-{$endif NOLOCALBROWSER}
-        end;*)
-end;
-
-
-function Tprocdef.write_references:boolean;
-
-var ref:Pref;
-    pdo:Pobjectdef;
-    move_last:boolean;
-
-begin
-(*  move_last:=lastwritten=lastref;
-    if move_last and (((current_module^.flags and uf_local_browser)=0)
-     or not is_in_current) then
-        exit;
-    {Write address of this symbol }
-    writedefref(@self);
-    {Write refs }
-    if assigned(lastwritten) then
-        ref:=lastwritten
-    else
-        ref:=defref;
-    while assigned(ref) do
-        begin
-            if ref^.moduleindex=current_module^.unit_index then
-                begin
-                    writeposinfo(ref^.posinfo);
-                    ref^.is_written:=true;
-                    if move_last then
-                        lastwritten:=ref;
-                end
-            else if not ref^.is_written then
-                move_last:=false
-            else if move_last then
-                lastwritten:=ref;
-            ref:=ref^.nextref;
-        end;
-    current_ppu^.writeentry(ibdefref);
-    write_references:=true;
-    if ((current_module^.flags and uf_local_browser)<>0)
-     and is_in_current then
-        begin
-            pdo:=_class;
-            if (owner^.symtabletype<>localsymtable) then
-            while assigned(pdo) do
-                begin
-                    if pdo^.publicsyms<>aktrecordsymtable then
-                        begin
-                            pdo^.publicsyms^.unitid:=local_symtable_index;
-                            inc(local_symtable_index);
-                        end;
-                    pdo:=pdo^.childof;
-                end;
-
-            {We need TESTLOCALBROWSER para and local symtables
-             PPU files are then easier to read PM.}
-            inc(local_symtable_index);
-            parast^.write_browser;
-            if not assigned(localst) then
-                localst:=new(psymtable,init);
-            localst^.writeas;
-            localst^.unitid:=local_symtable_index;
-            inc(local_symtable_index);
-            localst^.write_browser;
-            {Decrement for.}
-            local_symtable_index:=local_symtable_index-2;
-            pdo:=_class;
-            if (owner^.symtabletype<>localsymtable) then
-                while assigned(pdo) do
-                    begin
-                        if pdo^.publicsyms<>aktrecordsymtable then
-                            dec(local_symtable_index);
-                        pdo:=pdo^.childof;
-                    end;
-        end;*)
-end;
-
-destructor Tprocdef.done;
-
-begin
-    if po_msgstr in options then
-        strdispose(messageinf.str);
-    if references<>nil then
-        dispose(references,done);
-    if (localst<>nil) and (typeof(localst^)<>typeof(Timplsymtable)) then
-        dispose(localst,done);
-{   if (poinline in options) and (code,nil) then
-        disposetree(ptree(code));}
-    if _mangledname<>nil then
-        disposestr(_mangledname);
-    inherited done;
-end;
-
-
-procedure Tprocdef.store(var s:Tstream);
-
-begin
-(*  inherited store(s);
-    current_ppu^.do_interface_crc:=false;
-    writelong(usedregisters);
-    writestring(mangledname);
-    current_ppu^.do_interface_crc:=true;
-    writelong(extnumber);
-    if (options and pooperator) = 0 then
-        writedefref(nextoverloaded)
-    else
-        begin
-            {Only write the overloads from the same unit }
-            if assigned(nextoverloaded) and
-             (nextoverloaded^.owner=owner) then
-                writedefref(nextoverloaded)
-            else
-                writedefref(nil);
-        end;
-    writedefref(_class);
-    writeposinfo(fileinfo);
-    if (poinline and options) then
-        begin
-            {We need to save
-                - the para and the local symtable
-                - the code ptree !! PM
-               writesymtable(parast);
-               writesymtable(localst);
-               writeptree(ptree(code));
-               }
-        end;
-    current_ppu^.writeentry(ibprocdef);*)
-end;
-
-procedure Tprocdef.deref;
-
-begin
-{   inherited deref;
-    resolvedef(pdef(nextoverloaded));
-    resolvedef(pdef(_class));}
-end;
-
-
-function Tprocdef.mangledname:string;
-
-var i:word;
-    a:byte;
-    s:Pprocsym;
-    r:string;
-
-begin
-    if _mangledname<>nil then
-        mangledname:=_mangledname^
-    else
-        begin
-            {If the procedure is in a unit, we start with the unitname.}
-            if current_module^.is_unit then
-                r:='_'+current_module^.modulename^
-            else
-                r:='';
-            a:=length(r);
-            {If we are a method we add the name of the object we are
-             belonging to.}
-            if (Pprocsym(sym)^._class<>nil) then
-                r:=r+'_M'+Pprocsym(sym)^._class^.sym^.name+'_M';
-            {Then we add the names of the procedures we are defined in
-             (for the case we are a nested procedure).}
-            s:=Pprocsym(sym)^.sub_of;
-            while typeof(s^.owner^)=typeof(Tprocsymtable) do
-                begin
-                    insert('_$'+s^.name,r,a);
-                    s:=s^.sub_of;
-                end;
-            r:=r+'_'+sym^.name;
-            {Add the types of all parameters.}
-            for i:=0 to parameters^.count-1 do
-                begin
-                    r:=r+'$'+Pparameter(parameters^.at(i))^.data^.name;
-                end;
-        end;
-end;
-
-procedure Tprocdef.setmangledname(const s:string);
-
-begin
-    if _mangledname<>nil then
-        disposestr(_mangledname);
-    _mangledname:=stringdup(s);
-    if localst<>nil then
-        begin
-            stringdispose(localst^.name);
-            localst^.name:=stringdup('locals of '+s);
-        end;
-end;
-
-{***************************************************************************
-                                 Tprocvardef
-***************************************************************************}
-
-{$IFDEF TP}
-constructor Tprocvardef.init(Aowner:Pcontainingsymtable);
-
-begin
-    setparent(typeof(Tabstractprocdef));
-end;
-{$ENDIF TP}
-
-
-function Tprocvardef.size:longint;
-
-begin
-    if po_methodpointer in options then
-        size:=2*target_os.size_of_pointer
-    else
-        size:=target_os.size_of_pointer;
-end;
-
-
-{$ifdef GDB}
-function tprocvardef.stabstring : pchar;
-var
-   nss : pchar;
-   i : word;
-   param : pdefcoll;
-begin
-  i := 0;
-  param := para1;
-  while assigned(param) do
-    begin
-    inc(i);
-    param := param^.next;
-    end;
-  getmem(nss,1024);
-  { it is not a function but a function pointer !! (PM) }
-
-  strpcopy(nss,'*f'+retdef^.numberstring{+','+tostr(i)}+';');
-  param := para1;
-  i := 0;
-  { this confuses gdb !!
-    we should use 'F' instead of 'f' but
-    as we use c++ language mode
-    it does not like that either
-    Please do not remove this part
-    might be used once
-    gdb for pascal is ready PM }
-  (* while assigned(param) do
-    begin
-    inc(i);
-    if param^.paratyp = vs_value then vartyp := '1' else vartyp := '0';
-    {Here we have lost the parameter names !!}
-    pst := strpnew('p'+tostr(i)+':'+param^.data^.numberstring+','+vartyp+';');
-    strcat(nss,pst);
-    strdispose(pst);
-    param := param^.next;
-    end; *)
-  {strpcopy(strend(nss),';');}
-  stabstring := strnew(nss);
-  freemem(nss,1024);
-end;
-
-
-procedure tprocvardef.concatstabto(asmlist : paasmoutput);
-begin
-   if ( not assigned(sym) or sym^.isusedinstab or (cs_gdb_dbx in aktglobalswitches))
-     and not is_def_stab_written then
-     inherited concatstabto(asmlist);
-   is_def_stab_written:=true;
-end;
-{$endif GDB}
-
-
-procedure Tprocvardef.write_rtti_data;
-begin
-   {!!!!!!!}
-end;
-
-
-procedure Tprocvardef.write_child_rtti_data;
-begin
-   {!!!!!!!!}
-end;
-
-
-function Tprocvardef.is_publishable:boolean;
-
-begin
-    is_publishable:=po_methodpointer in options;
-end;
-
-function Tprocvardef.gettypename:string;
-
-begin
-   gettypename:='<procedure variable type>'
-end;
-
-{****************************************************************************
-                                Tforwarddef
-****************************************************************************}
-
-constructor tforwarddef.init(Aowner:Pcontainingsymtable;
-                             const s:string;const pos:Tfileposinfo);
-
-var oldregisterdef:boolean;
-
-begin
-    { never register the forwarddefs, they are disposed at the
-      end of the type declaration block }
-{   oldregisterdef:=registerdef;
-    registerdef:=false;}
-    inherited init(Aowner);
-    {$IFDEF TP}setparent(typeof(Tdef));{$ENDIF}
-{   registerdef:=oldregisterdef;}
-    tosymname:=s;
-    forwardpos:=pos;
-end;
-
-
-function tforwarddef.gettypename:string;
-
-begin
-    gettypename:='unresolved forward to '+tosymname;
-end;
-
-end.
-
-{
-  $Log$
-  Revision 1.2  2002-05-16 19:46:52  carl
-  + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
-  + try to fix temp allocation (still in ifdef)
-  + generic constructor calls
-  + start of tassembler / tmodulebase class cleanup
-
-  Revision 1.1  2000/07/13 06:30:13  michael
-  + Initial import
-
-  Revision 1.6  2000/03/16 12:52:47  daniel
-    *  Changed names of procedures flags
-    *  Changed VMT generation
-
-  Revision 1.5  2000/03/11 21:11:24  daniel
-    * Ported hcgdata to new symtable.
-    * Alignment code changed as suggested by Peter
-    + Usage of my is operator replacement, is_object
-
-  Revision 1.4  2000/03/01 11:43:55  daniel
-  * Some more work on the new symtable.
-  + Symtable stack unit 'symstack' added.
-
-}

compiler/new/symtable/hcgdata.pas

@@ -1,444 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 by Daniel Mantione,
-     and other members of the Free Pascal development team
-
-    Routines for the code generation of data structures
-    like VMT,Messages
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-unit hcgdata;
-interface
-
-    uses
-       symtable,aasm,defs;
-
-    { generates the message tables for a class }
-    function genstrmsgtab(_class : pobjectdef) : pasmlabel;
-    function genintmsgtab(_class : pobjectdef) : pasmlabel;
-    { generates the method name table }
-    function genpublishedmethodstable(Aclass:Pobjectdef):Pasmlabel;
-
-    { generates a VMT for _class }
-    procedure genvmt(list : paasmoutput;_class : pobjectdef);
-
-{$ifdef WITHDMT}
-    { generates a DMT for _class }
-    function gendmt(_class : pobjectdef) : pasmlabel;
-{$endif WITHDMT}
-
-implementation
-
-    uses
-       strings,cobjects,globtype,globals,verbose,
-       types,hcodegen,symbols,objects,xobjects;
-
-
-{*****************************************************************************
-                                Message
-*****************************************************************************}
-
-    type
-       pprocdeftree = ^tprocdeftree;
-       tprocdeftree = record
-          p   : pprocdef;
-          nl  : pasmlabel;
-          l,r : pprocdeftree;
-       end;
-
-    var
-       root : pprocdeftree;
-       count : longint;
-
-    procedure insertstr(p : pprocdeftree;var at : pprocdeftree);
-
-      var
-         i : longint;
-
-      begin
-         if at=nil then
-           begin
-              at:=p;
-              inc(count);
-           end
-         else
-           begin
-              i:=strcomp(p^.p^.messageinf.str,at^.p^.messageinf.str);
-              if i<0 then
-                insertstr(p,at^.l)
-              else if i>0 then
-                insertstr(p,at^.r)
-              else
-                Message1(parser_e_duplicate_message_label,strpas(p^.p^.messageinf.str));
-           end;
-      end;
-
-    procedure disposeprocdeftree(p : pprocdeftree);
-
-      begin
-         if assigned(p^.l) then
-           disposeprocdeftree(p^.l);
-         if assigned(p^.r) then
-           disposeprocdeftree(p^.r);
-         dispose(p);
-      end;
-
-    procedure insertmsgstr(p:pnamedindexobject);{$ifndef FPC}far;{$endif FPC}
-
-        procedure inserter(p:pointer);{$IFDEF TP}far;{$ENDIF}
-
-        var pt:Pprocdeftree;
-
-        begin
-            if po_msgstr in Pprocdef(p)^.options then
-                begin
-                    new(pt);
-                    pt^.p:=p;
-                    pt^.l:=nil;
-                    pt^.r:=nil;
-                    insertstr(pt,root);
-                end;
-        end;
-
-    begin
-        if typeof(p^)=typeof(Tprocsym) then
-            Pprocsym(p)^.foreach(@inserter);
-    end;
-
-    procedure insertint(p : pprocdeftree;var at : pprocdeftree);
-
-      begin
-         if at=nil then
-           begin
-              at:=p;
-              inc(count);
-           end
-         else
-           begin
-              if p^.p^.messageinf.i<at^.p^.messageinf.i then
-                insertint(p,at^.l)
-              else if p^.p^.messageinf.i>at^.p^.messageinf.i then
-                insertint(p,at^.r)
-              else
-                Message1(parser_e_duplicate_message_label,tostr(p^.p^.messageinf.i));
-           end;
-      end;
-
-    procedure insertmsgint(p:pnamedindexobject);{$ifndef FPC}far;{$endif FPC}
-
-        procedure inserter(p:pointer);{$IFDEF TP}far;{$ENDIF}
-
-        var pt:Pprocdeftree;
-
-        begin
-            if po_msgint in Pprocdef(p)^.options then
-                begin
-                    new(pt);
-                    pt^.p:=p;
-                    pt^.l:=nil;
-                    pt^.r:=nil;
-                    insertint(pt,root);
-                end;
-        end;
-
-    begin
-        if typeof(p^)=typeof(Tprocsym) then
-            Pprocsym(p)^.foreach(@inserter);
-    end;
-
-    procedure writenames(p : pprocdeftree);
-
-      begin
-         getdatalabel(p^.nl);
-         if assigned(p^.l) then
-           writenames(p^.l);
-         datasegment^.concat(new(pai_label,init(p^.nl)));
-         datasegment^.concat(new(pai_const,init_8bit(strlen(p^.p^.messageinf.str))));
-         datasegment^.concat(new(pai_string,init_pchar(p^.p^.messageinf.str)));
-         if assigned(p^.r) then
-           writenames(p^.r);
-      end;
-
-    procedure writestrentry(p : pprocdeftree);
-
-      begin
-         if assigned(p^.l) then
-           writestrentry(p^.l);
-
-         { write name label }
-         datasegment^.concat(new(pai_const_symbol,init(p^.nl)));
-         datasegment^.concat(new(pai_const_symbol,initname(p^.p^.mangledname)));
-
-         if assigned(p^.r) then
-           writestrentry(p^.r);
-      end;
-
-    function genstrmsgtab(_class : pobjectdef) : pasmlabel;
-
-
-      var
-         r : pasmlabel;
-
-      begin
-         root:=nil;
-         count:=0;
-         if _class^.privatesyms<>nil then
-            _class^.privatesyms^.foreach({$ifndef TP}@{$endif}insertmsgstr);
-         if _class^.privatesyms<>nil then
-            _class^.protectedsyms^.foreach({$ifndef TP}@{$endif}insertmsgstr);
-         if _class^.privatesyms<>nil then
-            _class^.publicsyms^.foreach({$ifndef TP}@{$endif}insertmsgstr);
-
-         { write all names }
-         if assigned(root) then
-           writenames(root);
-
-         { now start writing of the message string table }
-         getdatalabel(r);
-         datasegment^.concat(new(pai_label,init(r)));
-         genstrmsgtab:=r;
-         datasegment^.concat(new(pai_const,init_32bit(count)));
-         if assigned(root) then
-           begin
-              writestrentry(root);
-              disposeprocdeftree(root);
-           end;
-      end;
-
-
-    procedure writeintentry(p : pprocdeftree);
-
-      begin
-         if assigned(p^.l) then
-           writeintentry(p^.l);
-
-         { write name label }
-         datasegment^.concat(new(pai_const,init_32bit(p^.p^.messageinf.i)));
-         datasegment^.concat(new(pai_const_symbol,initname(p^.p^.mangledname)));
-
-         if assigned(p^.r) then
-           writeintentry(p^.r);
-      end;
-
-    function genintmsgtab(_class : pobjectdef) : pasmlabel;
-
-      var
-         r : pasmlabel;
-
-      begin
-         root:=nil;
-         count:=0;
-         if _class^.privatesyms<>nil then
-            _class^.privatesyms^.foreach({$ifndef TP}@{$endif}insertmsgint);
-         if _class^.privatesyms<>nil then
-            _class^.protectedsyms^.foreach({$ifndef TP}@{$endif}insertmsgint);
-         if _class^.privatesyms<>nil then
-            _class^.publicsyms^.foreach({$ifndef TP}@{$endif}insertmsgint);
-
-         { now start writing of the message string table }
-         getdatalabel(r);
-         datasegment^.concat(new(pai_label,init(r)));
-         genintmsgtab:=r;
-         datasegment^.concat(new(pai_const,init_32bit(count)));
-         if assigned(root) then
-           begin
-              writeintentry(root);
-              disposeprocdeftree(root);
-           end;
-      end;
-
-{$ifdef WITHDMT}
-
-    procedure insertdmtentry(p : pnamedindexobject);{$ifndef FPC}far;{$endif FPC}
-
-      var
-         hp : pprocdef;
-         pt : pprocdeftree;
-
-      begin
-         if psym(p)^.typ=procsym then
-           begin
-              hp:=pprocsym(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 writedmtindexentry(p : pprocdeftree);
-
-      begin
-         if assigned(p^.l) then
-           writedmtindexentry(p^.l);
-         datasegment^.concat(new(pai_const,init_32bit(p^.p^.messageinf.i)));
-         if assigned(p^.r) then
-           writedmtindexentry(p^.r);
-      end;
-
-    procedure writedmtaddressentry(p : pprocdeftree);
-
-      begin
-         if assigned(p^.l) then
-           writedmtaddressentry(p^.l);
-         datasegment^.concat(new(pai_const_symbol,initname(p^.p^.mangledname)));
-         if assigned(p^.r) then
-           writedmtaddressentry(p^.r);
-      end;
-
-    function gendmt(_class : pobjectdef) : pasmlabel;
-
-      var
-         r : pasmlabel;
-
-      begin
-         root:=nil;
-         count:=0;
-         gendmt:=nil;
-         { insert all message handlers into a tree, sorted by number }
-         _class^.symtable^.foreach({$ifndef TP}@{$endif}insertdmtentry);
-
-         if count>0 then
-           begin
-              getdatalabel(r);
-              gendmt:=r;
-              datasegment^.concat(new(pai_label,init(r)));
-              { entries for caching }
-              datasegment^.concat(new(pai_const,init_32bit(0)));
-              datasegment^.concat(new(pai_const,init_32bit(0)));
-
-              datasegment^.concat(new(pai_const,init_32bit(count)));
-              if assigned(root) then
-                begin
-                   writedmtindexentry(root);
-                   writedmtaddressentry(root);
-                   disposeprocdeftree(root);
-                end;
-           end;
-      end;
-
-{$endif WITHDMT}
-
-    procedure genpubmethodtableentry(p : pnamedindexobject);{$ifndef FPC}far;{$endif}
-
-        procedure do_concat(q:pointer);{$ifndef FPC}far;{$endif}
-
-        var l:Pasmlabel;
-
-        begin
-            if (sp_published in Pprocsym(p)^.objprop) then
-                begin
-                   getlabel(l);
-
-                   consts^.concat(new(pai_label,init(l)));
-                   consts^.concat(new(pai_const,init_8bit(length(p^.name))));
-                   consts^.concat(new(pai_string,init(p^.name)));
-
-                   datasegment^.concat(new(pai_const_symbol,init(l)));
-                   datasegment^.concat(new(pai_const_symbol,initname(Pprocdef(q)^.mangledname)));
-                end;
-        end;
-
-    begin
-        if p^.is_object(typeof(Tprocsym)) then
-            Pprocsym(p)^.foreach(@do_concat);
-    end;
-
-    procedure sym_do_count(p:Pnamedindexobject);{$ifndef FPC}far;{$endif}
-
-        procedure def_do_count(p:pointer);{$ifndef FPC}far;{$endif}
-
-        begin
-            if (sp_published in Pprocsym(p)^.objprop) then
-             inc(count);
-        end;
-
-    begin
-        if Pobject(p)^.is_object(typeof(Tprocsym)) then
-            Pprocsym(p)^.foreach(@def_do_count);
-    end;
-
-    function genpublishedmethodstable(Aclass:Pobjectdef):Pasmlabel;
-
-    var l:Pasmlabel;
-
-    begin
-        count:=0;
-        if Aclass^.privatesyms<>nil then
-            Aclass^.privatesyms^.foreach({$ifndef TP}@{$endif}sym_do_count);
-        if Aclass^.protectedsyms<>nil then
-            Aclass^.publicsyms^.foreach({$ifndef TP}@{$endif}sym_do_count);
-        if Aclass^.publicsyms<>nil then
-            Aclass^.publicsyms^.foreach({$ifndef TP}@{$endif}sym_do_count);
-        if count>0 then
-            begin
-                getlabel(l);
-                datasegment^.concat(new(pai_label,init(l)));
-                datasegment^.concat(new(pai_const,init_32bit(count)));
-                if Aclass^.privatesyms<>nil then
-                    Aclass^.privatesyms^.foreach({$ifndef TP}@{$endif}genpubmethodtableentry);
-                if Aclass^.protectedsyms<>nil then
-                    Aclass^.protectedsyms^.foreach({$ifndef TP}@{$endif}genpubmethodtableentry);
-                if Aclass^.publicsyms<>nil then
-                    Aclass^.publicsyms^.foreach({$ifndef TP}@{$endif}genpubmethodtableentry);
-                genpublishedmethodstable:=l;
-            end
-        else
-            genpublishedmethodstable:=nil;
-    end;
-
-{*****************************************************************************
-                                    VMT
-*****************************************************************************}
-
-
-procedure genvmt(list:Paasmoutput;_class:Pobjectdef);
-
-var i:longint;
-
-begin
-    for i:=0 to _class^.vmt_layout^.count-1 do
-        list^.concat(new(pai_const_symbol,
-         initname(Pvmtentry(_class^.vmt_layout^.at(i))^.mangledname)));
-end;
-
-
-end.
-{
-  $Log$
-  Revision 1.1  2000-07-13 06:30:13  michael
-  + Initial import
-
-  Revision 1.2  2000/03/16 12:52:48  daniel
-    *  Changed names of procedures flags
-    *  Changed VMT generation
-
-  Revision 1.1  2000/03/11 21:11:25  daniel
-    * Ported hcgdata to new symtable.
-    * Alignment code changed as suggested by Peter
-    + Usage of my is operator replacement, is_object
-
-}

compiler/new/symtable/htypechk.pas

@@ -1,980 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 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;
-
-{The isconvertable can better be handled inside the symtable, this
- would result is much better maintenance possibilities.}
-
-interface
-
-    uses
-      tree,symtable,defs,symbols;
-
-    const
-    { firstcallparan without varspez we don't count the ref }
-{$ifdef extdebug}
-       count_ref : boolean = true;
-{$endif def extdebug}
-       get_para_resulttype : boolean = false;
-       allow_array_constructor : boolean = false;
-
-
-    { Conversion }
-    function isconvertable(def_from,def_to : pdef;
-             var doconv : tconverttype;fromtreetype : ttreetyp;
-             explicit : boolean) : byte;
-
-    { Register Allocation }
-    procedure make_not_regable(p : ptree);
-    procedure left_right_max(p : ptree);
-    procedure calcregisters(p : ptree;r32,fpu,mmx : word);
-
-    { subroutine handling }
-(*  procedure test_protected_sym(sym : psym);
-    procedure test_protected(p : ptree);*)
-    function  valid_for_formal_var(p : ptree) : boolean;
-    function  valid_for_formal_const(p : ptree) : boolean;
-    function  is_procsym_load(p:Ptree):boolean;
-    function  is_procsym_call(p:Ptree):boolean;
-    function  assignment_overloaded(from_def,to_def : pdef) : pprocdef;
-    procedure test_local_to_procvar(from_def:pprocvardef;to_def:pdef);
-    function  valid_for_assign(p:ptree;allowprop:boolean):boolean;
-
-
-implementation
-
-    uses
-       globtype,systems,tokens,
-       cobjects,verbose,globals,
-       types,pass_1,cpubase,symtablt,
-{$ifdef newcg}
-       cgbase
-{$else}
-       hcodegen
-{$endif}
-       ;
-
-{****************************************************************************
-                             Convert
-****************************************************************************}
-
-    { Returns:
-       0 - Not convertable
-       1 - Convertable
-       2 - Convertable, but not first choice }
-    function isconvertable(def_from,def_to : pdef;
-             var doconv : tconverttype;fromtreetype : ttreetyp;
-             explicit : boolean) : byte;
-
-      { Tbasetype:  uauto,uvoid,uchar,
-                    u8bit,u16bit,u32bit,
-                    s8bit,s16bit,s32,
-                    bool8bit,bool16bit,bool32bit,
-                    u64bit,s64bitint }
-      type
-        tbasedef=(bvoid,bchar,bint,bbool);
-      const
-        basedeftbl:array[tbasetype] of tbasedef =
-          (bvoid,bvoid,bchar,
-           bint,bint,bint,
-           bint,bint,bint,
-           bbool,bbool,bbool,bint,bint,bint,bchar);
-
-        basedefconverts : array[tbasedef,tbasedef] of tconverttype =
-         ((tc_not_possible,tc_not_possible,tc_not_possible,tc_not_possible),
-          (tc_not_possible,tc_equal,tc_not_possible,tc_not_possible),
-          (tc_not_possible,tc_not_possible,tc_int_2_int,tc_int_2_bool),
-          (tc_not_possible,tc_not_possible,tc_bool_2_int,tc_bool_2_bool));
-
-      var
-         b : byte;
-         hd1,hd2 : pdef;
-         hct : tconverttype;
-      begin
-    {!!!! This code should never be called with nil parameters. If you really
-     want to check this, make it an internalerror instead of an exit!! (DM)
-        if not(assigned(def_from) and assigned(def_to)) then
-          begin
-            isconvertable:=0;
-            exit;
-          end;}
-
-       { tp7 procvar def support, in tp7 a procvar is always called, if the
-         procvar is passed explicit a addrn would be there }
-         if (m_tp_procvar in aktmodeswitches) and
-            (def_from^.is_object(typeof(Tprocvardef))) and
-            (fromtreetype=loadn) then
-          begin
-            def_from:=pprocvardef(def_from)^.retdef;
-          end;
-
-       { we walk the wanted (def_to) types and check then the def_from
-         types if there is a conversion possible }
-         b:=0;
-         if def_to^.is_object(typeof(Torddef)) then
-            begin
-              if def_from^.is_object(typeof(Torddef)) then
-                 begin
-                   doconv:=basedefconverts[basedeftbl[Tbasetype(porddef(def_from)^.typ)],basedeftbl[porddef(def_to)^.typ]];
-                   b:=1;
-                   if (doconv=tc_not_possible) or
-                      ((doconv=tc_int_2_bool) and
-                       (not explicit) and
-                       (not is_boolean(def_from))) or
-                      ((doconv=tc_bool_2_int) and
-                       (not explicit) and
-                       (not is_boolean(def_to))) then
-                     b:=0;
-                 end
-              else if def_from^.is_object(typeof(Tenumdef)) then
-                 begin
-                   { needed for char(enum) }
-                   if explicit then
-                    begin
-                      doconv:=tc_int_2_int;
-                      b:=1;
-                    end;
-                 end;
-            end
-         else if def_to^.is_object(typeof(Tstringdef)) then
-             begin
-               if def_from^.is_object(typeof(Tstringdef)) then
-                   begin
-                     doconv:=tc_string_2_string;
-                     b:=1;
-                   end
-               else if def_from^.is_object(typeof(Torddef)) then
-                   begin
-                   { char to string}
-                     if is_char(def_from) then
-                      begin
-                        doconv:=tc_char_2_string;
-                        b:=1;
-                      end;
-                   end
-               else if def_from^.is_object(typeof(Tarraydef)) then
-                   begin
-                   { array of char to string, the length check is done by the firstpass of this node }
-                     if is_chararray(def_from) then
-                      begin
-                        doconv:=tc_chararray_2_string;
-                        if (not(cs_ansistrings in aktlocalswitches) and
-                            is_shortstring(def_to)) or
-                           ((cs_ansistrings in aktlocalswitches) and
-                            is_ansistring(def_to)) then
-                         b:=1
-                        else
-                         b:=2;
-                      end;
-                   end
-               else if def_from^.is_object(typeof(Tpointerdef)) then
-                   begin
-                   { pchar can be assigned to short/ansistrings }
-                     if is_pchar(def_from) and not(m_tp in aktmodeswitches) then
-                      begin
-                        doconv:=tc_pchar_2_string;
-                        b:=1;
-                      end;
-                   end;
-             end
-         else if def_to^.is_object(typeof(Tfloatdef)) then
-             begin
-               if def_from^.is_object(typeof(Torddef)) then
-                   begin { ordinal to real }
-                     if is_integer(def_from) then
-                       begin
-                          if pfloatdef(def_to)^.typ=f32bit then
-                            doconv:=tc_int_2_fix
-                          else
-                            doconv:=tc_int_2_real;
-                          b:=1;
-                       end;
-                   end
-               else if def_from^.is_object(typeof(Tfloatdef)) then
-                   begin { 2 float types ? }
-                     if pfloatdef(def_from)^.typ=pfloatdef(def_to)^.typ then
-                       doconv:=tc_equal
-                     else
-                       begin
-                          if pfloatdef(def_from)^.typ=f32bit then
-                            doconv:=tc_fix_2_real
-                          else
-                            if pfloatdef(def_to)^.typ=f32bit then
-                              doconv:=tc_real_2_fix
-                            else
-                              doconv:=tc_real_2_real;
-                       end;
-                     b:=1;
-                   end;
-             end
-         else if def_to^.is_object(typeof(Tenumdef)) then
-             begin
-               if def_from^.is_object(typeof(Tenumdef)) then
-                begin
-                  if assigned(penumdef(def_from)^.basedef) then
-                   hd1:=penumdef(def_from)^.basedef
-                  else
-                   hd1:=def_from;
-                  if assigned(penumdef(def_to)^.basedef) then
-                   hd2:=penumdef(def_to)^.basedef
-                  else
-                   hd2:=def_to;
-                  if (hd1=hd2) then
-                   b:=1;
-                end;
-             end
-         else if def_to^.is_object(typeof(Tarraydef)) then
-             begin
-             { open array is also compatible with a single element of its base type }
-               if is_open_array(def_to) and
-                  is_equal(parraydef(def_to)^.definition,def_from) then
-                begin
-                  doconv:=tc_equal;
-                  b:=1;
-                end
-               else
-                begin
-                  if def_from^.is_object(typeof(Tarraydef)) then
-                      begin
-                        { array constructor -> open array }
-                        if is_open_array(def_to) and
-                           is_array_constructor(def_from) then
-                         begin
-                           if is_void(parraydef(def_from)^.definition) or
-                              is_equal(parraydef(def_to)^.definition,parraydef(def_from)^.definition) then
-                            begin
-                              doconv:=tc_equal;
-                              b:=1;
-                            end
-                           else
-                            if isconvertable(parraydef(def_to)^.definition,
-                                             parraydef(def_from)^.definition,hct,nothingn,false)<>0 then
-                             begin
-                               doconv:=hct;
-                               b:=2;
-                             end;
-                         end;
-                      end
-                  else if def_from^.is_object(typeof(Tpointerdef)) then
-                      begin
-                        if is_zero_based_array(def_to) and
-                           is_equal(ppointerdef(def_from)^.definition,parraydef(def_to)^.definition) then
-                         begin
-                           doconv:=tc_pointer_2_array;
-                           b:=1;
-                         end;
-                      end
-                  else if def_from^.is_object(typeof(Tstringdef)) then
-                      begin
-                        { string to array of char}
-                        if (not(is_special_array(def_to)) or is_open_array(def_to)) and
-                          is_equal(parraydef(def_to)^.definition,cchardef) then
-                         begin
-                           doconv:=tc_string_2_chararray;
-                           b:=1;
-                         end;
-                      end;
-                end;
-             end
-         else if def_to^.is_object(typeof(Tpointerdef)) then
-             begin
-               if def_from^.is_object(typeof(Tstringdef)) then
-                   begin
-                     { string constant to zero terminated string constant }
-                     if (fromtreetype=stringconstn) and
-                        is_pchar(def_to) then
-                      begin
-                        doconv:=tc_cstring_2_pchar;
-                        b:=1;
-                      end;
-                   end
-               else if def_from^.is_object(typeof(Torddef)) then
-                   begin
-                     { char constant to zero terminated string constant }
-                     if (fromtreetype=ordconstn) then
-                      begin
-                        if is_equal(def_from,cchardef) and
-                           is_pchar(def_to) then
-                         begin
-                           doconv:=tc_cchar_2_pchar;
-                           b:=1;
-                         end
-                        else
-                         if is_integer(def_from) then
-                          begin
-                            doconv:=tc_cord_2_pointer;
-                            b:=1;
-                          end;
-                      end;
-                   end
-               else if def_from^.is_object(typeof(Tarraydef)) then
-                   begin
-                     { chararray to pointer }
-                     if is_zero_based_array(def_from) and
-                        is_equal(parraydef(def_from)^.definition,ppointerdef(def_to)^.definition) then
-                      begin
-                        doconv:=tc_array_2_pointer;
-                        b:=1;
-                      end;
-                   end
-               else if def_from^.is_object(typeof(Tpointerdef)) then
-                   begin
-                     { child class pointer can be assigned to anchestor pointers }
-                     if (
-                         (Ppointerdef(def_from)^.definition^.is_object(typeof(Tobjectdef))) and
-                         (Ppointerdef(def_to)^.definition^.is_object(typeof(Tobjectdef))) and
-                         pobjectdef(ppointerdef(def_from)^.definition)^.is_related(
-                           pobjectdef(ppointerdef(def_to)^.definition))
-                        ) or
-                        { all pointers can be assigned to void-pointer }
-                        is_equal(ppointerdef(def_to)^.definition,voiddef) or
-                        { in my opnion, is this not clean pascal }
-                        { well, but it's handy to use, it isn't ? (FK) }
-                        is_equal(ppointerdef(def_from)^.definition,voiddef) then
-                       begin
-                         doconv:=tc_equal;
-                         b:=1;
-                       end;
-                   end
-               else if def_from^.is_object(typeof(Tprocvardef)) then
-                   begin
-                     { procedure variable can be assigned to an void pointer }
-                     { Not anymore. Use the @ operator now.}
-                     if not(m_tp_procvar in aktmodeswitches) and
-                        (typeof((Ppointerdef(def_to)^.definition^))=typeof(Torddef)) and
-                        (porddef(ppointerdef(def_to)^.definition)^.typ=uvoid) then
-                      begin
-                        doconv:=tc_equal;
-                        b:=1;
-                      end;
-                   end
-               else if def_from^.is_object(typeof(Tclassrefdef)) or
-                def_from^.is_object(typeof(Tobjectdef)) then
-                   begin
-                     { class types and class reference type
-                       can be assigned to void pointers      }
-                     if (
-                         (def_from^.is_object(typeof(Tobjectdef)) and
-                         (oo_is_class in pobjectdef(def_from)^.options))) or
-                         (def_from^.is_object(typeof(Tclassrefdef))
-                        ) and
-                         ppointerdef(def_to)^.definition^.is_object(typeof(Torddef)) and
-                        (porddef(ppointerdef(def_to)^.definition)^.typ=uvoid) then
-                       begin
-                         doconv:=tc_equal;
-                         b:=1;
-                       end;
-                   end;
-             end
-         else if def_to^.is_object(typeof(Tsetdef)) then
-             begin
-               { automatic arrayconstructor -> set conversion }
-               if is_array_constructor(def_from) then
-                begin
-                  doconv:=tc_arrayconstructor_2_set;
-                  b:=1;
-                end;
-             end
-         else if def_to^.is_object(typeof(Tprocvardef)) then
-             begin
-               { proc -> procvar }
-               if def_from^.is_object(typeof(Tprocdef)) then
-                begin
-                  doconv:=tc_proc_2_procvar;
-                  if proc_to_procvar_equal(pprocdef(def_from),pprocvardef(def_to)) then
-                   b:=1;
-                end
-               else
-                { for example delphi allows the assignement from pointers }
-                { to procedure variables                                  }
-                if (m_pointer_2_procedure in aktmodeswitches) and
-                  def_from^.is_object(typeof(Tpointerdef)) and
-                  ppointerdef(def_from)^.definition^.is_object(typeof(Torddef)) and
-                  (porddef(ppointerdef(def_from)^.definition)^.typ=uvoid) then
-                begin
-                   doconv:=tc_equal;
-                   b:=1;
-                end
-               else
-               { nil is compatible with procvars }
-                if (fromtreetype=niln) then
-                 begin
-                   doconv:=tc_equal;
-                   b:=1;
-                 end;
-             end
-         else if def_to^.is_object(typeof(Tobjectdef)) then
-             begin
-               { object pascal objects }
-               if def_from^.is_object(typeof(Tobjectdef)) then
-                begin
-                  doconv:=tc_equal;
-                  if pobjectdef(def_from)^.is_related(pobjectdef(def_to)) then
-                   b:=1;
-                end
-               else
-               { Class specific }
-                if (oo_is_class in pobjectdef(def_to)^.options) then
-                 begin
-                   { void pointer also for delphi mode }
-                   if (m_delphi in aktmodeswitches) and
-                      is_voidpointer(def_from) then
-                    begin
-                      doconv:=tc_equal;
-                      b:=1;
-                    end
-                   else
-                   { nil is compatible with class instances }
-                    if (fromtreetype=niln) and (oo_is_class in pobjectdef(def_to)^.options) then
-                     begin
-                       doconv:=tc_equal;
-                       b:=1;
-                     end;
-                 end;
-             end
-         else if def_to^.is_object(typeof(Tclassrefdef)) then
-             begin
-               { class reference types }
-               if def_from^.is_object(typeof(Tclassrefdef)) then
-                begin
-                  doconv:=tc_equal;
-                  if pobjectdef(pclassrefdef(def_from)^.definition)^.is_related(
-                       pobjectdef(pclassrefdef(def_to)^.definition)) then
-                   b:=1;
-                end
-               else
-                { nil is compatible with class references }
-                if (fromtreetype=niln) then
-                 begin
-                   doconv:=tc_equal;
-                   b:=1;
-                 end;
-             end
-         else if def_to^.is_object(typeof(Tfiledef)) then
-             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 (typeof(def_from^)=typeof(Tfiledef)) and
-                  (
-                   (
-                    (pfiledef(def_from)^.filetype = ft_typed) and
-                    (pfiledef(def_to)^.filetype = ft_typed) and
-                    (
-                     (pfiledef(def_from)^.definition=pdef(voiddef)) or
-                     (pfiledef(def_to)^.definition=pdef(voiddef))
-                    )
-                   ) or
-                   (
-                    (
-                     (pfiledef(def_from)^.filetype = ft_untyped) and
-                     (pfiledef(def_to)^.filetype = ft_typed)
-                    ) or
-                    (
-                     (pfiledef(def_from)^.filetype = ft_typed) and
-                     (pfiledef(def_to)^.filetype = ft_untyped)
-                    )
-                   )
-                  ) then
-                 begin
-                    doconv:=tc_equal;
-                    b:=1;
-                 end
-             end
-
-           else
-             begin
-             { assignment overwritten ?? }
-               if assignment_overloaded(def_from,def_to)<>nil then
-                b:=2;
-             end;
-        isconvertable:=b;
-      end;
-
-
-{****************************************************************************
-                          Register Calculation
-****************************************************************************}
-
-    { marks an lvalue as "unregable" }
-    procedure make_not_regable(p : ptree);
-      begin
-         case p^.treetype of
-            typeconvn :
-              make_not_regable(p^.left);
-            loadn :
-              if typeof(p^.symtableentry^)=typeof(Tvarsym) then
-                pvarsym(p^.symtableentry)^.properties:=
-                 pvarsym(p^.symtableentry)^.properties-[vo_regable,vo_fpuregable];
-         end;
-      end;
-
-
-    procedure left_right_max(p : ptree);
-      begin
-        if assigned(p^.left) then
-         begin
-           if assigned(p^.right) then
-            begin
-              p^.registers32:=max(p^.left^.registers32,p^.right^.registers32);
-              p^.registersfpu:=max(p^.left^.registersfpu,p^.right^.registersfpu);
-{$ifdef SUPPORT_MMX}
-              p^.registersmmx:=max(p^.left^.registersmmx,p^.right^.registersmmx);
-{$endif SUPPORT_MMX}
-            end
-           else
-            begin
-              p^.registers32:=p^.left^.registers32;
-              p^.registersfpu:=p^.left^.registersfpu;
-{$ifdef SUPPORT_MMX}
-              p^.registersmmx:=p^.left^.registersmmx;
-{$endif SUPPORT_MMX}
-            end;
-         end;
-      end;
-
-    { calculates the needed registers for a binary operator }
-    procedure calcregisters(p : ptree;r32,fpu,mmx : word);
-
-      begin
-         left_right_max(p);
-
-      { Only when the difference between the left and right registers < the
-        wanted registers allocate the amount of registers }
-
-        if assigned(p^.left) then
-         begin
-           if assigned(p^.right) then
-            begin
-              if (abs(p^.left^.registers32-p^.right^.registers32)<r32) then
-               inc(p^.registers32,r32);
-              if (abs(p^.left^.registersfpu-p^.right^.registersfpu)<fpu) then
-               inc(p^.registersfpu,fpu);
-{$ifdef SUPPORT_MMX}
-              if (abs(p^.left^.registersmmx-p^.right^.registersmmx)<mmx) then
-               inc(p^.registersmmx,mmx);
-{$endif SUPPORT_MMX}
-              { the following is a little bit guessing but I think }
-              { it's the only way to solve same internalerrors:    }
-              { if the left and right node both uses registers     }
-              { and return a mem location, but the current node    }
-              { doesn't use an integer register we get probably    }
-              { trouble when restoring a node                      }
-              if (p^.left^.registers32=p^.right^.registers32) and
-                 (p^.registers32=p^.left^.registers32) and
-                 (p^.registers32>0) and
-                (p^.left^.location.loc in [LOC_REFERENCE,LOC_MEM]) and
-                (p^.right^.location.loc in [LOC_REFERENCE,LOC_MEM]) then
-                inc(p^.registers32);
-            end
-           else
-            begin
-              if (p^.left^.registers32<r32) then
-               inc(p^.registers32,r32);
-              if (p^.left^.registersfpu<fpu) then
-               inc(p^.registersfpu,fpu);
-{$ifdef SUPPORT_MMX}
-              if (p^.left^.registersmmx<mmx) then
-               inc(p^.registersmmx,mmx);
-{$endif SUPPORT_MMX}
-            end;
-         end;
-
-         { error CGMessage, if more than 8 floating point }
-         { registers are needed                         }
-         if p^.registersfpu>8 then
-          CGMessage(cg_e_too_complex_expr);
-      end;
-
-{****************************************************************************
-                          Subroutine Handling
-****************************************************************************}
-
-{ protected field handling
-  protected field can not appear in
-  var parameters of function !!
-  this can only be done after we have determined the
-  overloaded function
-  this is the reason why it is not in the parser, PM }
-
-(*  procedure test_protected_sym(sym : Pprocsym);
-      begin
-         if (sp_protected in sym^.symoptions) and
-            ((sym^.owner^.symtabletype=unitsymtable) or
-             ((sym^.owner^.symtabletype=objectsymtable) and
-             (pobjectdef(sym^.owner^.defowner)^.owner^.symtabletype=unitsymtable))
-            ) then
-          CGMessage(parser_e_cant_access_protected_member);
-      end;
-
-
-    procedure test_protected(p : ptree);
-      begin
-        case p^.treetype of
-         loadn : test_protected_sym(p^.symtableentry);
-     typeconvn : test_protected(p^.left);
-        derefn : test_protected(p^.left);
-    subscriptn : begin
-                 { test_protected(p^.left);
-                   Is a field of a protected var
-                   also protected ???  PM }
-                   test_protected_sym(p^.vs);
-                 end;
-        end;
-      end;*)
-
-   function  valid_for_formal_var(p : ptree) : boolean;
-     var
-        v : boolean;
-     begin
-        case p^.treetype of
-         loadn : v:=(typeof(p^.symtableentry^)=typeof(Ttypedconstsym)) or
-                      (typeof(p^.symtableentry^)=typeof(Tvarsym));
-     typeconvn : v:=valid_for_formal_var(p^.left);
-         typen : v:=false;
-     derefn,subscriptn,vecn,
-     funcretn,selfn : v:=true;
-        { procvars are callnodes first }
-         calln : v:=assigned(p^.right) and not assigned(p^.left);
-        { should this depend on mode ? }
-         addrn : v:=true;
-        { no other node accepted (PM) }
-        else v:=false;
-        end;
-        valid_for_formal_var:=v;
-     end;
-
-   function  valid_for_formal_const(p : ptree) : boolean;
-     var
-        v : boolean;
-     begin
-        { p must have been firstpass'd before }
-        { accept about anything but not a statement ! }
-        v:=true;
-        if (p^.treetype in [calln,statementn]) then
-      {  if not assigned(p^.resulttype) or (p^.resulttype=pdef(voiddef)) then }
-          v:=false;
-        valid_for_formal_const:=v;
-     end;
-
-    function is_procsym_load(p:Ptree):boolean;
-      begin
-         is_procsym_load:=((p^.treetype=loadn) and (typeof(p^.symtableentry^)=typeof(Tprocsym)) or
-                          ((p^.treetype=addrn) and (p^.left^.treetype=loadn)
-                          and (typeof(p^.left^.symtableentry^)=typeof(Tprocsym))));
-      end;
-
-   { change a proc call to a procload for assignment to a procvar }
-   { this can only happen for proc/function without arguments }
-    function is_procsym_call(p:Ptree):boolean;
-      begin
-        is_procsym_call:=(p^.treetype=calln) and (p^.left=nil) and
-             (((typeof(p^.symtableprocentry^)=typeof(Tprocsym)) and (p^.right=nil)) or
-             ((p^.right<>nil) and (typeof(p^.right^.symtableprocentry^)=typeof(Tvarsym))));
-      end;
-
-
-    function assignment_overloaded(from_def,to_def : pdef) : pprocdef;
-
-        function matches(item:pointer):boolean;{$IFDEF TP}far;{$ENDIF TP}
-
-        var first_param_def:Pdef;
-            convtyp:Tconverttype;
-
-        begin
-            {The right assignment overload had been found when:
-             - The retdef of item equals the to_def.
-             - The definition of the first parameter equals the from_def
-               or it can be converted to from_def.}
-            first_param_def:=Pparamsym(Pparameter(Pprocdef(item)^.
-             parameters^.at(0))^.data)^.definition;
-            if is_equal(Pprocdef(item)^.retdef,to_def) and
-             (is_equal(first_param_def,from_def) or
-             (isconvertable(from_def,first_param_def,
-              convtyp,ordconstn,false)=1)) then
-                matches:=true;
-        end;
-
-    var passproc:Pprocdef;
-
-    begin
-        assignment_overloaded:=nil;
-        if overloaded_operators[_assignment]<>nil then
-            assignment_overloaded:=overloaded_operators[_assignment]^.
-             firstthat(@matches);
-    end;
-
-
-    { local routines can't be assigned to procvars }
-    procedure test_local_to_procvar(from_def:pprocvardef;to_def:pdef);
-
-    begin
-        if (typeof(from_def^.owner^)=typeof(Tprocsymtable)) and
-         (typeof(to_def^)=typeof(Tprocvardef)) then
-            CGMessage(type_e_cannot_local_proc_to_procvar);
-    end;
-
-
-    function valid_for_assign(p:ptree;allowprop:boolean):boolean;
-      var
-        hp : ptree;
-        gotsubscript,
-        gotpointer,
-        gotclass,
-        gotderef : boolean;
-      begin
-        valid_for_assign:=false;
-        gotsubscript:=false;
-        gotderef:=false;
-        gotclass:=false;
-        gotpointer:=false;
-        hp:=p;
-        while assigned(hp) do
-         begin
-           { property allowed? calln has a property check itself }
-           if (not allowprop) and
-              (hp^.isproperty) and
-              (hp^.treetype<>calln) then
-            begin
-              CGMessagePos(hp^.fileinfo,type_e_argument_cant_be_assigned);
-              exit;
-            end;
-           case hp^.treetype of
-             derefn :
-               begin
-                 gotderef:=true;
-                 hp:=hp^.left;
-               end;
-             typeconvn :
-                begin
-                    if typeof(hp^.resulttype^)=typeof(Tpointerdef) then
-                        gotpointer:=true
-                    else if typeof(hp^.resulttype^)=typeof(Tobjectdef) then
-                        gotclass:=oo_is_class in Pobjectdef(hp^.resulttype)^.options
-                    else if typeof(hp^.resulttype^)=typeof(Tclassrefdef) then
-                        gotclass:=true
-                    else if (typeof(hp^.resulttype^)=typeof(Tarraydef)) and
-                     (typeof(hp^.left^.resulttype^)=typeof(Tpointerdef)) then
-                        gotderef:=true;
-                    hp:=hp^.left;
-                end;
-             vecn,
-             asn :
-               hp:=hp^.left;
-             subscriptn :
-               begin
-                 gotsubscript:=true;
-                 hp:=hp^.left;
-               end;
-             subn,
-             addn :
-               begin
-                 { Allow add/sub operators on a pointer, or an integer
-                   and a pointer typecast and deref has been found }
-                 if (typeof(hp^.resulttype^)=typeof(Tpointerdef)) or
-                    (is_integer(hp^.resulttype) and gotpointer and gotderef) then
-                  valid_for_assign:=true
-                 else
-                  CGMessagePos(hp^.fileinfo,type_e_variable_id_expected);
-                 exit;
-               end;
-             addrn :
-               begin
-                 if not(gotderef) and
-                    not(hp^.procvarload) then
-                  CGMessagePos(hp^.fileinfo,type_e_no_assign_to_addr);
-                 exit;
-               end;
-             selfn,
-             funcretn :
-               begin
-                 valid_for_assign:=true;
-                 exit;
-               end;
-             calln :
-               begin
-                    { check return type }
-                    if typeof(hp^.resulttype^)=typeof(Tpointerdef) then
-                        gotpointer:=true
-                    else if typeof(hp^.resulttype^)=typeof(Tobjectdef) then
-                        gotclass:=oo_is_class in Pobjectdef(hp^.resulttype)^.options
-                    else if typeof(hp^.resulttype^)=typeof(Tclassrefdef) then
-                        gotclass:=true;
-
-                    { 1. if it returns a pointer and we've found a deref,
-                      2. if it returns a class and a subscription is found,
-                      3. property is allowed }
-                    if (gotpointer and gotderef) or
-                     (gotclass and gotsubscript) or
-                     (hp^.isproperty and allowprop) then
-                        valid_for_assign:=true
-                    else
-                        CGMessagePos(hp^.fileinfo,type_e_argument_cant_be_assigned);
-                    exit;
-               end;
-             loadn :
-               begin
-                 if (typeof(hp^.symtableentry^)=typeof(Tabsolutesym)) or
-                  (typeof(hp^.symtableentry^)=typeof(Tparamsym)) or
-                  (typeof(hp^.symtableentry^)=typeof(Tvarsym)) then
-                     begin
-                       if (typeof(hp^.symtableentry^)=typeof(Tparamsym)) and
-                        (Pparamsym(hp^.symtableentry)^.varspez=vs_const) then
-                           begin
-                             { allow p^:= constructions with p is const parameter }
-                             if gotderef then
-                              valid_for_assign:=true
-                             else
-                              CGMessagePos(hp^.fileinfo,type_e_no_assign_to_const);
-                             exit;
-                           end;
-                       { Are we at a with symtable, then we need to process the
-                         withrefnode also to check for maybe a const load }
-                       if typeof(hp^.symtable^)=typeof(Twithsymtable) then
-                        begin
-                          { continue with processing the withref node }
-                          hp:=ptree(pwithsymtable(hp^.symtable)^.withrefnode);
-                        end
-                       else
-                        begin
-                          { set the assigned flag for varsyms }
-                          if (pvarsym(hp^.symtableentry)^.state=vs_declared) then
-                           pvarsym(hp^.symtableentry)^.state:=vs_assigned;
-                          valid_for_assign:=true;
-                          exit;
-                        end;
-                     end;
-                 if (typeof(hp^.symtableentry^)=typeof(Tfuncretsym)) or
-                  (typeof(hp^.symtableentry^)=typeof(Ttypedconstsym)) then
-                     begin
-                       valid_for_assign:=true;
-                       exit;
-                     end;
-               end;
-             else
-                 CGMessagePos(hp^.fileinfo,type_e_variable_id_expected);
-                 exit;
-            end;
-         end;
-      end;
-
-end.
-{
-  $Log$
-  Revision 1.1  2000-07-13 06:30:13  michael
-  + Initial import
-
-  Revision 1.2  2000/03/11 21:11:25  daniel
-    * Ported hcgdata to new symtable.
-    * Alignment code changed as suggested by Peter
-    + Usage of my is operator replacement, is_object
-
-  Revision 1.1  2000/02/28 17:23:58  daniel
-  * Current work of symtable integration committed. The symtable can be
-    activated by defining 'newst', but doesn't compile yet. Changes in type
-    checking and oop are completed. What is left is to write a new
-    symtablestack and adapt the parser to use it.
-
-  Revision 1.59  2000/02/18 16:13:29  florian
-    * optimized ansistring compare with ''
-    * fixed 852
-
-  Revision 1.58  2000/02/09 13:22:53  peter
-    * log truncated
-
-  Revision 1.57  2000/02/05 12:11:50  peter
-    * property check for assigning fixed for calln
-
-  Revision 1.56  2000/02/01 09:41:27  peter
-    * allow class -> voidpointer for delphi mode
-
-  Revision 1.55  2000/01/07 01:14:27  peter
-    * updated copyright to 2000
-
-  Revision 1.54  1999/12/31 14:26:27  peter
-    * fixed crash with empty array constructors
-
-  Revision 1.53  1999/12/18 14:55:21  florian
-    * very basic widestring support
-
-  Revision 1.52  1999/12/16 19:12:04  peter
-    * allow constant pointer^ also for assignment
-
-  Revision 1.51  1999/12/09 09:35:54  peter
-    * allow assigning to self
-
-  Revision 1.50  1999/11/30 10:40:43  peter
-    + ttype, tsymlist
-
-  Revision 1.49  1999/11/18 15:34:45  pierre
-    * Notes/Hints for local syms changed to
-      Set_varstate function
-
-  Revision 1.48  1999/11/09 14:47:03  peter
-    * pointer->array is allowed for all pointer types in FPC, fixed assign
-      check for it.
-
-  Revision 1.47  1999/11/09 13:29:33  peter
-    * valid_for_assign allow properties with calln
-
-  Revision 1.46  1999/11/08 22:45:33  peter
-    * allow typecasting to integer within pointer typecast+deref
-
-  Revision 1.45  1999/11/06 14:34:21  peter
-    * truncated log to 20 revs
-
-  Revision 1.44  1999/11/04 23:11:21  peter
-    * fixed pchar and deref detection for assigning
-
-  Revision 1.43  1999/10/27 16:04:45  peter
-    * valid_for_assign support for calln,asn
-
-  Revision 1.42  1999/10/26 12:30:41  peter
-    * const parameter is now checked
-    * better and generic check if a node can be used for assigning
-    * export fixes
-    * procvar equal works now (it never had worked at least from 0.99.8)
-    * defcoll changed to linkedlist with pparaitem so it can easily be
-      walked both directions
-
-  Revision 1.41  1999/10/14 14:57:52  florian
-    - removed the hcodegen use in the new cg, use cgbase instead
-
-  Revision 1.40  1999/09/26 21:30:15  peter
-    + constant pointer support which can happend with typecasting like
-      const p=pointer(1)
-    * better procvar parsing in typed consts
-
-  Revision 1.39  1999/09/17 17:14:04  peter
-    * @procvar fixes for tp mode
-    * @<id>:= gives now an error
-
-  Revision 1.38  1999/08/17 13:26:07  peter
-    * arrayconstructor -> arrayofconst fixed when arraycosntructor was not
-      variant.
-
-}

compiler/new/symtable/types.pas

@@ -1,1044 +0,0 @@
-{
-    $Id$
-    Copyright (C) 1998-2000 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 types;
-interface
-
-    uses
-       objects,cobjects,symtable,defs;
-
-    type
-       tmmxtype = (mmxno,mmxu8bit,mmxs8bit,mmxu16bit,mmxs16bit,
-                   mmxu32bit,mmxs32bit,mmxfixed16,mmxsingle);
-
-    const
-       { true if we must never copy this parameter }
-       never_copy_const_param : boolean = false;
-
-{*****************************************************************************
-                          Basic type functions
- *****************************************************************************}
-
-    { returns true, if def defines an ordinal type }
-    function is_ordinal(def : pdef) : boolean;
-
-    { returns the min. value of the type }
-    function get_min_value(def : pdef) : longint;
-
-    { returns true, if def defines an ordinal type }
-    function is_integer(def : pdef) : boolean;
-
-    { true if p is a boolean }
-    function is_boolean(def : pdef) : boolean;
-
-    { true if p is a char }
-    function is_char(def : pdef) : boolean;
-
-    { true if p is a void}
-    function is_void(def : pdef) : boolean;
-
-    { true if p is a smallset def }
-    function is_smallset(p : pdef) : boolean;
-
-    { returns true, if def defines a signed data type (only for ordinal types) }
-    function is_signed(def : pdef) : boolean;
-
-{*****************************************************************************
-                              Array helper functions
- *****************************************************************************}
-
-    { true, if p points to a zero based (non special like open or
-      dynamic array def, mainly this is used to see if the array
-      is convertable to a pointer }
-    function is_zero_based_array(p : pdef) : boolean;
-
-    { true if p points to an open array def }
-    function is_open_array(p : pdef) : boolean;
-
-    { true, if p points to an array of const def }
-    function is_array_constructor(p : pdef) : boolean;
-
-    { true, if p points to a variant array }
-    function is_variant_array(p : pdef) : boolean;
-
-    { true, if p points to an array of const }
-    function is_array_of_const(p : pdef) : boolean;
-
-    { true, if p points any kind of special array }
-    function is_special_array(p : pdef) : boolean;
-
-    { true if p is a char array def }
-    function is_chararray(p : pdef) : boolean;
-
-{*****************************************************************************
-                          String helper functions
- *****************************************************************************}
-
-    { true if p points to an open string def }
-    function is_open_string(p : pdef) : boolean;
-
-    { true if p is an ansi string def }
-    function is_ansistring(p : pdef) : boolean;
-
-    { true if p is a long string def }
-    function is_longstring(p : pdef) : boolean;
-
-    { true if p is a wide string def }
-    function is_widestring(p : pdef) : boolean;
-
-    { true if p is a short string def }
-    function is_shortstring(p : pdef) : boolean;
-
-    { true if p is a pchar def }
-    function is_pchar(p : pdef) : boolean;
-
-    { true if p is a voidpointer def }
-    function is_voidpointer(p : pdef) : boolean;
-
-    { returns true, if def uses FPU }
-    function is_fpu(def : pdef) : boolean;
-
-    { true, if def is a 64 bit int type }
-    function is_64bitint(def : pdef) : boolean;
-
-    function push_high_param(def : pdef) : boolean;
-
-    { true if a parameter is too large to copy and only the address is pushed }
-    function push_addr_param(def : pdef) : boolean;
-
-    { true, if def1 and def2 are semantical the same }
-    function is_equal(def1,def2 : pdef) : 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: pdef): boolean;
-
-    { same as is_equal, but with error message if failed }
-    function CheckTypes(def1,def2 : pdef) : boolean;
-
-    { true, if two parameter lists are equal        }
-    { if value_equal_const is true, call by value   }
-    { and call by const parameter are assumed as    }
-    { equal                                         }
-    function equal_paras(paralist1,paralist2:Pcollection;value_equal_const:boolean):boolean;
-
-
-    { true if a type can be allowed for another one
-      in a func var }
-    function convertable_paras(paralist1,paralist2:Pcollection;value_equal_const:boolean):boolean;
-
-    { true if a function can be assigned to a procvar }
-    function proc_to_procvar_equal(def1:pprocdef;def2:pprocvardef) : boolean;
-
-    { if l isn't in the range of def a range check error is generated and
-      the value is placed within the range }
-    procedure testrange(def : pdef;var l : longint);
-
-    { returns the range of def }
-    procedure getrange(def : pdef;var l : longint;var h : longint);
-
-    { some type helper routines for MMX support }
-    function is_mmx_able_array(p : pdef) : boolean;
-
-    { returns the mmx type }
-    function mmx_type(p : pdef) : tmmxtype;
-
-    { returns true, if sym needs an entry in the proplist of a class rtti }
-    function needs_prop_entry(sym : psym) : boolean;
-
-implementation
-
-uses    strings,globtype,globals,htypechk,tree,verbose,symbols,symtablt;
-
-function needs_prop_entry(sym : psym) : boolean;
-
-begin
-    needs_prop_entry:=(((typeof(sym^)=typeof(Tpropertysym)) and
-     (sp_published in Ppropertysym(sym)^.objprop)) or
-     (((typeof(sym^)=typeof(Tvarsym)) and
-     (sp_published in Pvarsym(sym)^.objprop))));
-end;
-
-function equal_paras(paralist1,paralist2:Pcollection;
-                   value_equal_const:boolean):boolean;
-
-var def1,def2:Pparameter;
-    i:word;
-
-begin
-    equal_paras:=true;
-    if paralist1^.count=paralist2^.count then
-        for i:=1 to paralist1^.count do
-            begin
-                if (not is_equal(Pvarsym(def1^.data)^.definition,
-                                 Pvarsym(def2^.data)^.definition)) or
-                 (def1^.paratyp<>def2^.paratyp) then
-                    begin
-                        if (not value_equal_const) or
-                         ((def1^.paratyp<>vs_var) and
-                          (def2^.paratyp<>vs_var)) then
-                        equal_paras:=false;
-                        break;
-                    end;
-          end
-    else
-        equal_paras:=false;
-end;
-
-function convertable_paras(paralist1,paralist2:Pcollection;
-                           value_equal_const : boolean):boolean;
-
-var def1,def2:Pparameter;
-    doconv:Tconverttype;
-    i:word;
-
-begin
-    convertable_paras:=true;
-    if paralist1^.count=paralist2^.count then
-        for i:=1 to paralist1^.count do
-            begin
-                if (isconvertable(Pvarsym(def1^.data)^.definition,
-                                   Pvarsym(def2^.data)^.definition,
-                                   doconv,callparan,false)=0) or
-                 (def1^.paratyp<>def2^.paratyp) then
-                    begin
-                        if (not value_equal_const) or
-                         ((def1^.paratyp<>vs_var) and
-                          (def2^.paratyp<>vs_var)) then
-                        convertable_paras:=false;
-                        break;
-                    end;
-          end
-    else
-        convertable_paras:=false;
-end;
-
-
-{ true if a function can be assigned to a procvar }
-function proc_to_procvar_equal(def1:pprocdef;def2:pprocvardef):boolean;
-
-const   po_comp=po_compatibility_options-[po_methodpointer];
-
-var ismethod:boolean;
-
-begin
-    proc_to_procvar_equal:=false;
-    {!!!! This code should never be called with nil parameters. If you really
-     want to check this, make it an internalerror instead of an exit!! (DM)
-    if not(assigned(def1)) or not(assigned(def2)) then
-        exit;}
-    {Check for method pointer.}
-    ismethod:=(def1^.owner<>nil) and
-     (typeof(def1^.owner^)=typeof(Tobjectsymtable));
-    if (ismethod and not (po_methodpointer in def2^.options)) or
-     (not(ismethod) and (po_methodpointer in def2^.options)) then
-        begin
-            message(type_e_no_method_and_procedure_not_compatible);
-            exit;
-        end;
-    { check return value and para's and options, methodpointer is already checked
-      parameters may also be convertable }
-    proc_to_procvar_equal:=is_equal(def1^.retdef,def2^.retdef) and
-     (equal_paras(def1^.parameters,def2^.parameters,false) or
-      convertable_paras(def1^.parameters,def2^.parameters,false)) and
-     ((po_comp*def1^.options)=(po_comp*def2^.options));
-end;
-
-
-{ returns true, if def uses FPU }
-function is_fpu(def : pdef) : boolean;
-
-begin
-    is_fpu:=(typeof(def^)=typeof(Tfloatdef)) and (Pfloatdef(def)^.typ<>f32bit);
-end;
-
-
-{ true if p is an ordinal }
-function is_ordinal(def : pdef) : boolean;
-
-var dt : tbasetype;
-begin
-    if typeof(def^)=typeof(Torddef) then
-        begin
-            dt:=porddef(def)^.typ;
-            is_ordinal:=dt in [uchar,
-                               u8bit,u16bit,u32bit,u64bit,
-                               s8bit,s16bit,s32bit,s64bit,
-                               bool8bit,bool16bit,bool32bit];
-        end
-    else
-        is_ordinal:=typeof(def^)=typeof(Tenumdef);
-end;
-
-
-{ returns the min. value of the type }
-function get_min_value(def:pdef) : longint;
-
-begin
-    if typeof(def^)=typeof(Torddef) then
-        get_min_value:=porddef(def)^.low.values
-    else if typeof(def^)=typeof(Tenumdef) then
-        get_min_value:=penumdef(def)^.minval
-    else
-        internalerror($00022701);
-end;
-
-
-{ true if p is an integer }
-function is_integer(def : pdef) : boolean;
-
-begin
-    is_integer:=(typeof(Tdef)=typeof(Torddef)) and
-                (Porddef(def)^.typ in [uauto,u8bit,u16bit,u32bit,u64bit,
-                                       s8bit,s16bit,s32bit,s64bit]);
-end;
-
-
-{ true if p is a boolean }
-function is_boolean(def : pdef) : boolean;
-begin
-  is_boolean:=(typeof(def^)=typeof(Torddef)) and
-              (porddef(def)^.typ in [bool8bit,bool16bit,bool32bit]);
-end;
-
-
-{ true if p is a void }
-function is_void(def : pdef) : boolean;
-begin
-  is_void:=(typeof(def^)=typeof(Torddef)) and
-           (porddef(def)^.typ=uvoid);
-end;
-
-
-{ true if p is a char }
-function is_char(def : pdef):boolean;
-begin
-  is_char:=(typeof(def^)=typeof(Torddef)) and
-           (porddef(def)^.typ=uchar);
-end;
-
-
-{ true if p is signed (integer) }
-function is_signed(def : pdef) : boolean;
-
-var dt:Tbasetype;
-
-begin
-    if typeof(def^)=typeof(Torddef) then
-        begin
-            dt:=porddef(def)^.typ;
-            is_signed:=(dt in [s8bit,s16bit,s32bit,s64bit]);
-        end
-    else
-        is_signed:=false;
-end;
-
-
-{ true, if p points to an open string def }
-
-function is_open_string(p:Pdef):boolean;
-
-begin
-   is_open_string:=(typeof(p^)=typeof(Tstringdef)) and
-                   (pstringdef(p)^.string_typ=st_shortstring) and
-                   (pstringdef(p)^.len=0);
-end;
-
-
-{ true, if p points to a zero based array def }
-function is_zero_based_array(p : pdef) : boolean;
-begin
-   is_zero_based_array:=(typeof(p^)=typeof(Tarraydef)) and
-                        (parraydef(p)^.lowrange.values=0) and
-                        not(is_special_array(p));
-end;
-
-{ true, if p points to an open array def }
-function is_open_array(p : pdef) : boolean;
-begin
-   is_open_array:=(typeof(p^)=typeof(Tarraydef)) and
-                  (parraydef(p)^.lowrange.values=0) and
-                  (Parraydef(p)^.highrange.signed) and
-                  (parraydef(p)^.highrange.values=-1) and
-                  not(ap_constructor in Parraydef(p)^.options) and
-                  not(ap_variant in Parraydef(p)^.options) and
-                  not(ap_arrayofconst in Parraydef(p)^.options);
-end;
-
-{ true, if p points to an array of const def }
-function is_array_constructor(p : pdef) : boolean;
-
-begin
-    is_array_constructor:=(typeof(p^)=typeof(Tarraydef)) and
-                  (ap_constructor in Parraydef(p)^.options);
-end;
-
-{ true, if p points to a variant array }
-function is_variant_array(p : pdef) : boolean;
-
-begin
-    is_variant_array:=(typeof(p^)=typeof(Tarraydef)) and
-                  (ap_variant in Parraydef(p)^.options);
-end;
-
-{ true, if p points to an array of const }
-function is_array_of_const(p : pdef) : boolean;
-begin
-    is_array_of_const:=(typeof(p^)=typeof(Tarraydef)) and
-                  (ap_arrayofconst in Parraydef(p)^.options);
-end;
-
-{ true, if p points to a special array }
-
-function is_special_array(p : pdef) : boolean;
-
-begin
-    is_special_array:=(typeof(p^)=typeof(Tarraydef)) and
-                  ((ap_variant in Parraydef(p)^.options) or
-                   (ap_arrayofconst in Parraydef(p)^.options) or
-                   (ap_constructor in Parraydef(p)^.options) or
-                   is_open_array(p)
-                  );
-end;
-
-{ true if p is an ansi string def }
-function is_ansistring(p : pdef) : boolean;
-begin
-    is_ansistring:=(typeof(p^)=typeof(Tstringdef)) and
-                  (pstringdef(p)^.string_typ=st_ansistring);
-end;
-
-
-{ true if p is an long string def }
-function is_longstring(p : pdef) : boolean;
-begin
-    is_longstring:=(typeof(p^)=typeof(Tstringdef)) and
-                  (pstringdef(p)^.string_typ=st_longstring);
-end;
-
-
-{ true if p is an wide string def }
-function is_widestring(p : pdef) : boolean;
-begin
-    is_widestring:=(typeof(p^)=typeof(Tstringdef)) and
-                  (pstringdef(p)^.string_typ=st_widestring);
-end;
-
-
-{ true if p is an short string def }
-function is_shortstring(p : pdef) : boolean;
-begin
-    is_shortstring:=(typeof(p^)=typeof(Tstringdef)) and
-                   (pstringdef(p)^.string_typ=st_shortstring);
-end;
-
-{ true if p is a char array def }
-function is_chararray(p : pdef) : boolean;
-begin
-    is_chararray:=(typeof(p^)=typeof(Tarraydef)) and
-                is_equal(parraydef(p)^.definition,cchardef) and
-                not(is_special_array(p));
-end;
-
-
-{ true if p is a pchar def }
-function is_pchar(p : pdef) : boolean;
-begin
-    is_pchar:=(typeof(p^)=typeof(Tpointerdef)) and
-            is_equal(Ppointerdef(p)^.definition,cchardef);
-end;
-
-
-{ true if p is a voidpointer def }
-function is_voidpointer(p : pdef) : boolean;
-begin
-    is_voidpointer:=(typeof(p^)=typeof(Tpointerdef)) and
-                  is_equal(Ppointerdef(p)^.definition,voiddef);
-end;
-
-
-{ true if p is a smallset def }
-function is_smallset(p : pdef) : boolean;
-
-begin
-    is_smallset:=(typeof(p^)=typeof(Tsetdef)) and
-               (psetdef(p)^.settype=smallset);
-end;
-
-
-{ true, if def is a 64 bit int type }
-function is_64bitint(def : pdef) : boolean;
-
-begin
-    is_64bitint:=(typeof(def^)=typeof(Torddef)) and
-     (porddef(def)^.typ in [u64bit,s64bit])
-end;
-
-
-function push_high_param(def : pdef) : boolean;
-
-begin
-    push_high_param:=is_open_array(def) or
-                    is_open_string(def) or
-                    is_array_of_const(def);
-end;
-
-
-{ true if a parameter is too large to copy and only the address is pushed }
-function push_addr_param(def : pdef) : boolean;
-
-var r:boolean;
-
-begin
-    push_addr_param:=false;
-    if never_copy_const_param then
-     push_addr_param:=true
-    else
-     begin
-        if typeof(def^)=typeof(Tformaldef) then
-           push_addr_param:=true
-        else if typeof(def^)=typeof(Trecorddef) then
-           push_addr_param:=(def^.size>4)
-        else if typeof(def^)=typeof(Tarraydef) then
-            begin
-                r:=is_open_array(def) or is_array_of_const(def) or
-                 is_array_constructor(def);
-                if Parraydef(def)^.highrange.signed then
-                    r:=r or ((Parraydef(def)^.highrange.values>
-                     Parraydef(def)^.lowrange.values) and (def^.size>4))
-                else
-                    r:=r or ((Parraydef(def)^.highrange.valueu>
-                     Parraydef(def)^.lowrange.valueu) and (def^.size>4));
-            end
-        else if typeof(def^)=typeof(Tobjectdef) then
-           push_addr_param:=not (oo_is_class in Pobjectdef(def)^.options)
-        else if typeof(def^)=typeof(Tstringdef) then
-           push_addr_param:=pstringdef(def)^.string_typ in [st_shortstring,st_longstring]
-        else if typeof(def^)=typeof(Tprocvardef) then
-           push_addr_param:=(po_methodpointer in pprocvardef(def)^.options)
-        else if typeof(def^)=typeof(Tsetdef) then
-           push_addr_param:=(psetdef(def)^.settype<>smallset);
-     end;
-end;
-
-{ test if l is in the range of def, outputs error if out of range }
-procedure testrange(def : pdef;var l:longint);
-
-var lsv,hsv:longint;
-{$IFDEF TP}
-    luv:longint absolute lsv;
-    huv:longint absolute hsv;
-{$ELSE}
-    luv:cardinal absolute lsv;
-    huv:cardinal absolute hsv;
-{$ENDIF TP}
-
-begin
-   { for 64 bit types we need only to check if it is less than }
-   { zero, if def is a qword node                              }
-   if is_64bitint(def) then
-     begin
-        if (l<0) and (porddef(def)^.typ=u64bit) then
-          begin
-             l:=0;
-             if (cs_check_range in aktlocalswitches) then
-               Message(parser_e_range_check_error)
-             else
-               Message(parser_w_range_check_error);
-          end;
-     end
-   else
-     begin
-        getrange(def,lsv,hsv);
-        if (typeof(def^)=typeof(Torddef)) and
-           (porddef(def)^.typ=u32bit) then
-          begin
-              if (l<luv) or (l>huv) then
-                begin
-                   if (cs_check_range in aktlocalswitches) then
-                     Message(parser_e_range_check_error)
-                   else
-                     Message(parser_w_range_check_error);
-                end;
-          end
-        else if (l<lsv) or (l>hsv) then
-          begin
-             if (typeof(def^)=typeof(Tenumdef)) or
-                (cs_check_range in aktlocalswitches) then
-               Message(parser_e_range_check_error)
-             else
-               Message(parser_w_range_check_error);
-             { Fix the value to fit in the allocated space for this type of variable }
-               case def^.size of
-                 1: l := l and $ff;
-                 2: l := l and $ffff;
-               end
-          end;
-     end;
-end;
-
-
-{ return the range from def in l and h }
-procedure getrange(def : pdef;var l:longint;var h : longint);
-
-{Needs fixing for u32bit; low.signed etc....}
-
-begin
-    if typeof(def^)=typeof(Torddef) then
-        begin
-          l:=porddef(def)^.low.values;
-          h:=porddef(def)^.high.values;
-        end
-    else if typeof(def^)=typeof(Tenumdef) then
-        begin
-          l:=penumdef(def)^.minval;
-          h:=penumdef(def)^.maxval;
-        end
-    else if typeof(def^)=typeof(Tarraydef) then
-        begin
-          l:=parraydef(def)^.lowrange.values;
-          h:=parraydef(def)^.highrange.values;
-        end
-    else
-        internalerror(987);
-end;
-
-
-function mmx_type(p : pdef) : tmmxtype;
-begin
-   mmx_type:=mmxno;
-   if is_mmx_able_array(p) then
-     begin
-        if typeof((Parraydef(p)^.definition^))=typeof(Tfloatdef) then
-          case pfloatdef(parraydef(p)^.definition)^.typ of
-            s32real:
-              mmx_type:=mmxsingle;
-            f16bit:
-              mmx_type:=mmxfixed16
-          end
-        else
-          case porddef(parraydef(p)^.definition)^.typ 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_mmx_able_array(p : pdef) : boolean;
-begin
-{$ifdef SUPPORT_MMX}
-   if (cs_mmx_saturation in aktlocalswitches) then
-     begin
-        is_mmx_able_array:=(p^.deftype=arraydef) and
-          not(is_special_array(p)) and
-          (
-           (
-            (parraydef(p)^.elementtype.def^.deftype=orddef) and
-            (
-             (
-              (parraydef(p)^.lowrange=0) and
-              (parraydef(p)^.highrange=1) and
-              (porddef(parraydef(p)^.elementtype.def)^.typ in [u32bit,s32bit])
-             )
-             or
-             (
-              (parraydef(p)^.lowrange=0) and
-              (parraydef(p)^.highrange=3) and
-              (porddef(parraydef(p)^.elementtype.def)^.typ in [u16bit,s16bit])
-             )
-            )
-           )
-           or
-          (
-           (
-            (parraydef(p)^.elementtype.def^.deftype=floatdef) and
-            (
-             (parraydef(p)^.lowrange=0) and
-             (parraydef(p)^.highrange=3) and
-             (pfloatdef(parraydef(p)^.elementtype.def)^.typ=f16bit)
-            ) or
-            (
-             (parraydef(p)^.lowrange=0) and
-             (parraydef(p)^.highrange=1) and
-             (pfloatdef(parraydef(p)^.elementtype.def)^.typ=s32real)
-            )
-           )
-          )
-        );
-     end
-   else
-     begin
-        is_mmx_able_array:=(p^.deftype=arraydef) and
-          (
-           (
-            (parraydef(p)^.elementtype.def^.deftype=orddef) and
-            (
-             (
-              (parraydef(p)^.lowrange=0) and
-              (parraydef(p)^.highrange=1) and
-              (porddef(parraydef(p)^.elementtype.def)^.typ in [u32bit,s32bit])
-             )
-             or
-             (
-              (parraydef(p)^.lowrange=0) and
-              (parraydef(p)^.highrange=3) and
-              (porddef(parraydef(p)^.elementtype.def)^.typ in [u16bit,s16bit])
-             )
-             or
-             (
-              (parraydef(p)^.lowrange=0) and
-              (parraydef(p)^.highrange=7) and
-              (porddef(parraydef(p)^.elementtype.def)^.typ in [u8bit,s8bit])
-             )
-            )
-           )
-           or
-           (
-            (parraydef(p)^.elementtype.def^.deftype=floatdef) and
-            (
-             (
-              (parraydef(p)^.lowrange=0) and
-              (parraydef(p)^.highrange=3) and
-              (pfloatdef(parraydef(p)^.elementtype.def)^.typ=f32bit)
-             )
-             or
-             (
-              (parraydef(p)^.lowrange=0) and
-              (parraydef(p)^.highrange=1) and
-              (pfloatdef(parraydef(p)^.elementtype.def)^.typ=s32real)
-             )
-            )
-           )
-          );
-     end;
-{$else SUPPORT_MMX}
-   is_mmx_able_array:=false;
-{$endif SUPPORT_MMX}
-end;
-
-
-function is_equal(def1,def2 : pdef) : boolean;
-
-var b : boolean;
-    hd : pdef;
-    d1type,d2type:pointer;
-
-begin
-    {!!!! This code should never be called with nil parameters. If you really
-     want to check this, make it an internalerror instead of an exit!! (DM)
-    if not (assigned(def1) and assigned(def2)) then
-     begin
-       is_equal:=false;
-       exit;
-     end;}
-
-    { be sure, that if there is a stringdef, that this is def1 }
-    if typeof(def2^)=typeof(Tstringdef) then
-        begin
-            hd:=def1;
-            def1:=def2;
-            def2:=hd;
-        end;
-    b:=false;
-    d1type:=typeof(def1^);
-    d2type:=typeof(def2^);
-
-    { both point to the same definition ? }
-    if def1=def2 then
-      b:=true
-    else
-    { pointer with an equal definition are equal }
-      if (d1type=typeof(Tpointerdef)) and (d1type=d2type) then
-        begin
-           { here a problem detected in tabsolutesym }
-           { the types can be forward type !!        }
-           if assigned(def1^.sym) and
-            (typeof((Ppointerdef(def1)^.definition^))=typeof(Tforwarddef)) then
-             b:=(def1^.sym=def2^.sym)
-           else
-             b:=ppointerdef(def1)^.definition=ppointerdef(def2)^.definition;
-        end
-    else
-    { ordinals are equal only when the ordinal type is equal }
-      if (d1type=typeof(Torddef)) and (d1type=d2type) then
-        begin
-           case porddef(def1)^.typ of
-           u8bit,u16bit,u32bit,
-           s8bit,s16bit,s32bit:
-             b:=((porddef(def1)^.typ=porddef(def2)^.typ) and
-              (porddef(def1)^.low.values=porddef(def2)^.low.values) and
-              (porddef(def1)^.high.values=porddef(def2)^.high.values));
-           uvoid,uchar,
-           bool8bit,bool16bit,bool32bit:
-             b:=(porddef(def1)^.typ=porddef(def2)^.typ);
-           end;
-        end
-    else
-      if (d1type=typeof(Tfloatdef)) and (d1type=d2type) then
-        b:=pfloatdef(def1)^.typ=pfloatdef(def2)^.typ
-    else
-      { strings with the same length are equal }
-      if (d1type=typeof(Tstringdef)) and (d1type=d2type) and
-         (pstringdef(def1)^.string_typ=pstringdef(def2)^.string_typ) then
-        begin
-           b:=not(is_shortstring(def1)) or
-              (pstringdef(def1)^.len=pstringdef(def2)^.len);
-        end
-    else
-      if (d1type=typeof(Tformaldef)) and (d1type=d2type) then
-        b:=true
-    { file types with the same file element type are equal }
-    { this is a problem for assign !!                      }
-    { changed to allow if one is untyped                   }
-    { all typed files are equal to the special             }
-    { typed file that has voiddef as elemnt type           }
-    { but must NOT match for text file !!!                 }
-    else
-       if (d1type=typeof(Tfiledef)) and (d1type=d2type) then
-         b:=(pfiledef(def1)^.filetype=pfiledef(def2)^.filetype) and
-            ((
-            ((pfiledef(def1)^.definition=nil) and
-             (pfiledef(def2)^.definition=nil)) or
-            (
-             (pfiledef(def1)^.definition<>nil) and
-             (pfiledef(def2)^.definition<>nil) and
-             is_equal(pfiledef(def1)^.definition,pfiledef(def2)^.definition)
-            ) or
-            ( (pfiledef(def1)^.definition=pdef(voiddef)) or
-              (pfiledef(def2)^.definition=pdef(voiddef))
-            )))
-    { sets with the same element type are equal }
-    else
-      if (d1type=typeof(Tsetdef)) and (d1type=d2type) then
-        begin
-            if assigned(psetdef(def1)^.definition) and
-            assigned(psetdef(def2)^.definition) then
-                b:=(typeof((psetdef(def1)^.definition^))=
-                 typeof((psetdef(def2)^.definition^)))
-            else
-                b:=true;
-        end
-    else
-      if (d1type=typeof(Tprocvardef)) and (d1type=d2type) then
-        begin
-           { poassembler isn't important for compatibility }
-           { if a method is assigned to a methodpointer    }
-           { is checked before                             }
-           b:=(pprocvardef(def1)^.options=pprocvardef(def2)^.options) and
-              (pprocvardef(def1)^.calloptions=pprocvardef(def2)^.calloptions) and
-              ((pprocvardef(def1)^.options*po_compatibility_options)=
-               (pprocvardef(def2)^.options*po_compatibility_options)) and
-              is_equal(pprocvardef(def1)^.retdef,pprocvardef(def2)^.retdef) and
-              equal_paras(pprocvardef(def1)^.parameters,pprocvardef(def2)^.parameters,false);
-        end
-    else
-      if (d1type=typeof(Tarraydef)) and (d1type=d2type) then
-        begin
-          if is_open_array(def1) or is_open_array(def2) or
-             is_array_of_const(def1) or is_array_of_const(def2) then
-           begin
-             if (ap_arrayofconst in parraydef(def1)^.options) or
-              (ap_arrayofconst in parraydef(def2)^.options) then
-                b:=true
-             else
-                b:=is_equal(parraydef(def1)^.definition,parraydef(def2)^.definition);
-           end
-          else
-           begin
-             b:=not(m_tp in aktmodeswitches) and
-                not(m_delphi in aktmodeswitches) and
-                (parraydef(def1)^.lowrange.values=parraydef(def2)^.lowrange.values) and
-                (parraydef(def1)^.highrange.values=parraydef(def2)^.highrange.values) and
-                is_equal(parraydef(def1)^.definition,parraydef(def2)^.definition) and
-                is_equal(parraydef(def1)^.rangedef,parraydef(def2)^.rangedef);
-           end;
-        end
-    else
-        if (d1type=typeof(Tclassrefdef)) and (d1type=d2type) then
-        begin
-            {Similar to pointerdef:}
-            if (def1^.sym<>nil) and (typeof((pclassrefdef(def1)^.definition^))=
-             typeof(Tforwarddef)) then
-                b:=(def1^.sym=def2^.sym)
-            else
-                b:=is_equal(pclassrefdef(def1)^.definition,pclassrefdef(def2)^.definition);
-        end;
-    is_equal:=b;
-end;
-
-
-function is_subequal(def1, def2: pdef): boolean;
-
-begin
-    is_subequal := false;
-    if (typeof(def1^)=typeof(Torddef)) and (typeof(def2^)=typeof(Torddef)) then
-        { see p.47 of Turbo Pascal 7.01 manual for the separation of types }
-        { range checking for case statements is done with testrange        }
-        case porddef(def1)^.typ of
-            u8bit,u16bit,u32bit,
-            s8bit,s16bit,s32bit:
-                is_subequal:=(porddef(def2)^.typ in
-                 [s32bit,u32bit,u8bit,s8bit,s16bit,u16bit]);
-            bool8bit,bool16bit,bool32bit :
-                is_subequal:=(porddef(def2)^.typ in
-                 [bool8bit,bool16bit,bool32bit]);
-            uchar:
-                is_subequal:=(porddef(def2)^.typ=uchar);
-        end
-    else
-        { I assume that both enumerations are equal when the first }
-        { pointers are equal.                                      }
-        if (typeof(def1^)=typeof(Tenumdef)) and (typeof(def2^)=typeof(Tenumdef)) then
-          Begin
-            if penumdef(def1)^.symbols=penumdef(def2)^.symbols then
-               is_subequal := TRUE;
-          end;
-end;
-
-function CheckTypes(def1,def2 : pdef) : boolean;
-
-var
-   s1,s2 : string;
-
-begin
-    if not is_equal(def1,def2) then
-        begin
-            s1:=def1^.typename;
-            s2:=def2^.typename;
-            if (s1<>'<unknown type>') and (s2<>'<unknown type>') then
-                Message2(type_e_not_equal_types,s1,s2)
-            else
-                Message(type_e_mismatch);
-            CheckTypes:=false;
-        end
-    else
-        CheckTypes:=true;
-end;
-
-end.
-{
-  $Log$
-  Revision 1.1  2000-07-13 06:30:14  michael
-  + Initial import
-
-  Revision 1.2  2000/03/16 12:52:48  daniel
-    *  Changed names of procedures flags
-    *  Changed VMT generation
-
-  Revision 1.1  2000/02/28 17:23:58  daniel
-  * Current work of symtable integration committed. The symtable can be
-    activated by defining 'newst', but doesn't compile yet. Changes in type
-    checking and oop are completed. What is left is to write a new
-    symtablestack and adapt the parser to use it.
-
-  Revision 1.97  2000/02/09 13:23:09  peter
-    * log truncated
-
-  Revision 1.96  2000/02/01 09:44:03  peter
-    * is_voidpointer
-
-  Revision 1.95  2000/01/07 01:14:49  peter
-    * updated copyright to 2000
-
-  Revision 1.94  2000/01/04 16:35:58  jonas
-    * when range checking is off, constants that are out of bound are no longer
-      truncated to their max/min legal value but left alone (jsut an "and" is done to
-      make sure they fit in the allocated space if necessary)
-
-  Revision 1.93  1999/12/31 14:26:28  peter
-    * fixed crash with empty array constructors
-
-  Revision 1.92  1999/11/30 10:40:59  peter
-    + ttype, tsymlist
-
-  Revision 1.91  1999/11/06 14:34:31  peter
-    * truncated log to 20 revs
-
-  Revision 1.90  1999/10/26 12:30:46  peter
-    * const parameter is now checked
-    * better and generic check if a node can be used for assigning
-    * export fixes
-    * procvar equal works now (it never had worked at least from 0.99.8)
-    * defcoll changed to linkedlist with pparaitem so it can easily be
-      walked both directions
-
-  Revision 1.89  1999/10/01 10:04:07  peter
-    * fixed is_equal for proc -> procvar which didn't check the
-      callconvention and type anymore since the splitting of procoptions
-
-  Revision 1.88  1999/10/01 08:02:51  peter
-    * forward type declaration rewritten
-
-  Revision 1.87  1999/09/15 22:09:27  florian
-    + rtti is now automatically generated for published classes, i.e.
-      they are handled like an implicit property
-
-  Revision 1.86  1999/09/11 09:08:35  florian
-    * fixed bug 596
-    * fixed some problems with procedure variables and procedures of object,
-      especially in TP mode. Procedure of object doesn't apply only to classes,
-      it is also allowed for objects !!
-
-  Revision 1.85  1999/08/13 21:27:08  peter
-    * more fixes for push_addr
-
-  Revision 1.84  1999/08/13 15:38:23  peter
-    * fixed push_addr_param for records < 4, the array high<low range check
-      broke this code.
-
-  Revision 1.83  1999/08/07 14:21:06  florian
-    * some small problems fixed
-
-  Revision 1.82  1999/08/07 13:36:56  daniel
-  * Recommitted the arraydef overflow bugfix.
-
-  Revision 1.80  1999/08/05 22:42:49  daniel
-  * Fixed potential bug for open arrays (Their size is not known at
-    compilation time).
-
-  Revision 1.79  1999/08/03 22:03:41  peter
-    * moved bitmask constants to sets
-    * some other type/const renamings
-
-  Revision 1.78  1999/07/30 12:26:42  peter
-    * array is_equal disabled for tp,delphi mode
-
-  Revision 1.77  1999/07/29 11:41:51  peter
-    * array is_equal extended
-
-  Revision 1.76  1999/07/27 23:39:15  peter
-    * open array checks also for s32bitdef, because u32bit also has a
-      high range of -1
-
-}

compiler/new/symtable/xobjects.pas

@@ -1,81 +0,0 @@
-unit xobjects;
-{
-    $Id$
-    Copyright (c) 2000 by Daniel Mantione
-     member of the Free Pascal development team
-
-    This unit provides an extends the Tobject type with additional methods
-    to check the type of an object. It should only be used within
-    Turbo Pascal, the Free Pascal objects unit already contains this
-    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.
-
- ****************************************************************************
-}
-interface
-
-{As TP does not store a link to the parent's VMT in the VMT, a function like
- is_object would be impossible.
-
- We use a very dirty trick to get it done; in an objects constructor the
- setparent procedure should be called, which stores the link to the parent
- into the DMT link. (!!!)}
-
-uses    objects;
-
-type    Pobject=^Tobject;
-        Tobject=object(objects.Tobject)
-            function is_object(typ:pointer):boolean;
-            procedure setparent(typ:pointer);
-        end;
-
-implementation
-
-type    vmt=record
-            size,negsize:word;
-            dmtlink:pointer;
-        end;
-
-function Tobject.is_object(typ:pointer):boolean;assembler;
-
-asm
-    les di,self
-    mov bx,[es:di]  {Get vmt link.}
-    jmp @a3
-@a2:
-    mov bx,[bx+4]   {Get dmt link, offset.}
-    or bx,bx
-    mov al,0
-    jz @a1
-@a3:
-    cmp bx,typ.word {Compare with typ.}
-    jne @a2
-    mov al,1
-@a1:
-end;
-
-procedure Tobject.setparent(typ:pointer);assembler;
-
-asm
-    les di,self
-    mov bx,[es:di]  {Get vmt link.}
-    mov ax,typ.word
-    mov cx,typ+2.word
-    mov [bx+4],ax
-    mov [bx+6],cx
-end;
-
-end.

compiler/new/temp_gen.pas

@@ -1,41 +0,0 @@
-{
-    $Id$
-    Copyright (C) 1998-2000 by Florian Klaempfl
-
-    Dummy
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-unit temp_gen;
-
-  interface
-
-  implementation
-
-end.
-{
-  $Log$
-  Revision 1.1  2000-07-13 06:30:08  michael
-  + Initial import
-
-  Revision 1.2  2000/01/07 01:14:54  peter
-    * updated copyright to 2000
-
-  Revision 1.1  1999/08/02 17:15:43  florian
-    + dummy implementation
-
-}

compiler/new/tempgen.inc

@@ -1,34 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 by Florian Klaempfl
-
-    This file includes the appropriate temp gen.
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-
-,temp_gen
-{$ifdef i386}
-,tgeni386
-{$else}
-,tgcpu
-{$endif i386}
-  $Log$
-  Revision 1.2  2000-07-13 11:32:55  michael
-  + removed logs
- 
-}

compiler/new/tgobj.pas

@@ -1,729 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 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.
-
- ****************************************************************************
-}
-
-unit tgobj;
-
-  interface
-
-    uses
-      cpubase,
-      cpuinfo,
-      cpuasm,
-      tainst,
-      cobjects,globals,tree,cgbase,verbose,files,aasm;
-
-    type
-       tregisterset = set of tregister;
-
-       tpushed = array[firstreg..lastreg] of boolean;
-       tsaved = array[firstreg..lastreg] of longint;
-
-       ttemptype = (tt_none,tt_free,tt_normal,tt_persistant,tt_ansistring,tt_freeansistring,tt_widestring,tt_freewidestring);
-       ttemptypeset = set of ttemptype;
-
-       ptemprecord = ^ttemprecord;
-       ttemprecord = record
-          temptype   : ttemptype;
-          pos    : longint;
-          size       : longint;
-          next       : ptemprecord;
-          nextfree   : ptemprecord; { for faster freeblock checking }
- {$ifdef EXTDEBUG}
-          posinfo,
-          releaseposinfo : tfileposinfo;
- {$endif}
-       end;
-
-       ttgobj = object
-          unusedregsint,availabletempregsint : tregisterset;
-          unusedregsfpu,availabletempregsfpu : tregisterset;
-          unusedregsmm,availabletempregsmm : tregisterset;
-          countusableregsint,
-  	  countusableregsfpu,
- 	  countusableregsmm : byte;
-          c_countusableregsint,
-          c_countusableregsfpu,
-          c_countusableregsmm : byte;
-
-          usedinproc : tregisterset;
-
-          reg_pushes : array[firstreg..lastreg] of longint;
-          is_reg_var : array[firstreg..lastreg] of boolean;
-          { contains all temps }
-          templist      : ptemprecord;
-          { contains all free temps using nextfree links }
-          tempfreelist  : ptemprecord;
-          { Offsets of the first/last temp }
-          firsttemp,
-          lasttemp      : longint;
-          constructor init;
-          { generates temporary variables }
-          procedure resettempgen;
-          procedure setfirsttemp(l : longint);
-          function gettempsize : longint;
-          function newtempofsize(size : longint) : longint;
-          function gettempofsize(size : longint) : longint;
-          { special call for inlined procedures }
-          function gettempofsizepersistant(size : longint) : longint;
-          { for parameter func returns }
-          procedure normaltemptopersistant(pos : longint);
-          procedure persistanttemptonormal(pos : longint);
-          procedure ungetpersistanttemp(pos : longint);
-          procedure gettempofsizereference(l : longint;var ref : treference);
-          function istemp(const ref : treference) : boolean;virtual;
-          procedure ungetiftemp(const ref : treference);
-          function ungetiftempansi(const ref : treference) : boolean;
-          function gettempansistringreference(var ref : treference):boolean;
-
-          { the following methods must be overriden }
-          function getregisterint : tregister;virtual;
-          procedure ungetregisterint(r : tregister);virtual;
-          { tries to allocate the passed register, if possible }
-          function getexplicitregisterint(r : tregister) : tregister;virtual;
-
-          procedure ungetregister(r : tregister);virtual;
-
-          procedure cleartempgen;virtual;
-          procedure del_reference(const ref : treference);virtual;
-          procedure del_locref(const location : tlocation);virtual;
-          procedure del_location(const l : tlocation);virtual;
-
-          { pushs and restores registers }
-          procedure pushusedregisters(var pushed : tpushed;b : byte);virtual;
-          procedure popusedregisters(const pushed : tpushed);virtual;
-
-          { saves and restores used registers to temp. values }
-          procedure saveusedregisters(var saved : tsaved;b : byte);virtual;
-          procedure restoreusedregisters(const saved : tsaved);virtual;
-
-          procedure clearregistercount;virtual;
-          procedure resetusableregisters;virtual;
-       private
-          function ungettemp(pos:longint;allowtype:ttemptype):ttemptype;
-       end;
-
-  implementation
-
-    uses
-       scanner,systems;
-
-    constructor ttgobj.init;
-
-     begin
-       tempfreelist:=nil;
-       templist:=nil;
-     end;
-
-    procedure ttgobj.resettempgen;
-      var
-         hp : ptemprecord;
-      begin
-        { Clear the old templist }
-        while assigned(templist) do
-         begin
-{$ifdef EXTDEBUG}
-           case templist^.temptype of
-             tt_normal,
-             tt_persistant :
-               Comment(V_Warning,'temporary assignment of size '+
-                       tostr(templist^.size)+' from pos '+tostr(templist^.posinfo.line)+
-                       ':'+tostr(templist^.posinfo.column)+
-                       ' at pos '+tostr(templist^.pos)+
-                       ' not freed at the end of the procedure');
-             tt_ansistring :
-               Comment(V_Warning,'temporary ANSI assignment of size '+
-                       tostr(templist^.size)+' from pos '+tostr(templist^.posinfo.line)+
-                       ':'+tostr(templist^.posinfo.column)+
-                       ' at pos '+tostr(templist^.pos)+
-                     ' not freed at the end of the procedure');
-           end;
-{$endif}
-           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 < 0 then
-          Begin
-            if odd(l) then
-             Dec(l);
-          end
-         else
-          Begin
-            if odd(l) then
-             Inc(l);
-          end;
-         firsttemp:=l;
-         lasttemp:=l;
-      end;
-
-
-    function ttgobj.newtempofsize(size : longint) : longint;
-      var
-        tl : ptemprecord;
-      begin
-        { Just extend the temp, everything below has been use
-          already }
-        dec(lasttemp,size);
-        { now we can create the templist entry }
-        new(tl);
-        tl^.temptype:=tt_normal;
-        tl^.pos:=lasttemp;
-        tl^.size:=size;
-        tl^.next:=templist;
-        tl^.nextfree:=nil;
-        templist:=tl;
-        newtempofsize:=tl^.pos;
-      end;
-
-
-    function ttgobj.gettempofsize(size : longint) : longint;
-      var
-         tl,
-         bestslot,bestprev,
-         hprev,hp : ptemprecord;
-         bestsize,ofs : longint;
-      begin
-         bestprev:=nil;
-         bestslot:=nil;
-         tl:=nil;
-         bestsize:=0;
-         { Align needed size on 4 bytes }
-         if (size mod 4)<>0 then
-           size:=size+(4-(size mod 4));
-         { First check the tmpfreelist }
-         if assigned(tempfreelist) then
-          begin
-            { Check for a slot with the same size first }
-            hprev:=nil;
-            hp:=tempfreelist;
-            while assigned(hp) do
-             begin
-{$ifdef EXTDEBUG}
-               if hp^.temptype<>tt_free then
-                 Comment(V_Warning,'Temp in freelist is not set to tt_free');
-{$endif}
-               if hp^.size>=size then
-                begin
-                  { Slot is the same size, then leave immediatly }
-                  if hp^.size=size then
-                   begin
-                     bestprev:=hprev;
-                     bestslot:=hp;
-                     bestsize:=size;
-                     break;
-                   end
-                  else
-                   begin
-                     if (bestsize=0) or (hp^.size<bestsize) then
-                      begin
-                        bestprev:=hprev;
-                        bestslot:=hp;
-                        bestsize:=hp^.size;
-                      end;
-                   end;
-                end;
-               hprev:=hp;
-               hp:=hp^.nextfree;
-             end;
-          end;
-         { Reuse an old temp ? }
-         if assigned(bestslot) then
-          begin
-            if bestsize=size then
-             begin
-               bestslot^.temptype:=tt_normal;
-               ofs:=bestslot^.pos;
-               tl:=bestslot;
-               { Remove from the tempfreelist }
-               if assigned(bestprev) then
-                 bestprev^.nextfree:=bestslot^.nextfree
-               else
-                 tempfreelist:=bestslot^.nextfree;
-             end
-            else
-             begin
-               { Resize the old block }
-               dec(bestslot^.size,size);
-               { Create new block and link after bestslot }
-               new(tl);
-               tl^.temptype:=tt_normal;
-               tl^.pos:=bestslot^.pos+bestslot^.size;
-               ofs:=tl^.pos;
-               tl^.size:=size;
-               tl^.nextfree:=nil;
-               { link the new block }
-               tl^.next:=bestslot^.next;
-               bestslot^.next:=tl;
-             end;
-          end
-         else
-          begin
-             ofs:=newtempofsize(size);
-{$ifdef EXTDEBUG}
-             tl:=templist;
-{$endif}
-          end;
-{$ifdef EXTDEBUG}
-         tl^.posinfo:=aktfilepos;
-{$endif}
-         exprasmlist^.concat(new(paitempalloc,alloc(ofs,size)));
-         gettempofsize:=ofs;
-      end;
-
-
-    function ttgobj.gettempofsizepersistant(size : longint) : longint;
-      var
-         l : longint;
-      begin
-         l:=gettempofsize(size);
-         templist^.temptype:=tt_persistant;
-{$ifdef EXTDEBUG}
-         Comment(V_Debug,'temp managment  : call to gettempofsizepersistant()'+
-                     ' with size '+tostr(size)+' returned '+tostr(l));
-{$endif}
-         gettempofsizepersistant:=l;
-      end;
-
-
-    function ttgobj.gettempsize : longint;
-      begin
-        gettempsize:=Align(-lasttemp,target_os.stackalignment);
-      end;
-
-
-    procedure ttgobj.gettempofsizereference(l : longint;var ref : treference);
-      begin
-         { do a reset, because the reference isn't used }
-         reset_reference(ref);
-         ref.offset:=gettempofsize(l);
-         ref.base:=procinfo^.framepointer;
-      end;
-
-
-    function ttgobj.gettempansistringreference(var ref : treference):boolean;
-      var
-         foundslot,tl : ptemprecord;
-      begin
-         { do a reset, because the reference isn't used }
-         reset_reference(ref);
-         ref.base:=procinfo^.framepointer;
-         { Reuse old ansi slot ? }
-         foundslot:=nil;
-         tl:=templist;
-         while assigned(tl) do
-          begin
-            if tl^.temptype=tt_freeansistring then
-             begin
-               foundslot:=tl;
-{$ifdef EXTDEBUG}
-               tl^.posinfo:=aktfilepos;
-{$endif}
-               break;
-             end;
-            tl:=tl^.next;
-          end;
-         if assigned(foundslot) then
-          begin
-            foundslot^.temptype:=tt_ansistring;
-            ref.offset:=foundslot^.pos;
-            { we're reusing an old slot then set the function result to true
-              so that we can call a decr_ansistr }
-            gettempansistringreference:=true;
-          end
-         else
-          begin
-            ref.offset:=newtempofsize(target_os.size_of_pointer);
-{$ifdef EXTDEBUG}
-            templist^.posinfo:=aktfilepos;
-{$endif}
-            templist^.temptype:=tt_ansistring;
-            { set result to false, we don't need an decr_ansistr }
-            gettempansistringreference:=true;
-          end;
-         exprasmlist^.concat(new(paitempalloc,alloc(ref.offset,target_os.size_of_pointer)));
-      end;
-
-
-    function ttgobj.ungetiftempansi(const ref : treference) : boolean;
-      var
-         tl : ptemprecord;
-      begin
-        ungetiftempansi:=false;
-        tl:=templist;
-        while assigned(tl) do
-         begin
-           if tl^.pos=ref.offset then
-            begin
-              if tl^.temptype=tt_ansistring then
-               begin
-                 tl^.temptype:=tt_freeansistring;
-                 ungetiftempansi:=true;
-                 exprasmlist^.concat(new(paitempalloc,dealloc(tl^.pos,tl^.size)));
-                 exit;
-{$ifdef EXTDEBUG}
-               end
-              else if (tl^.temptype=tt_freeansistring) then
-               begin
-                 Comment(V_Debug,'temp ansi managment problem : ungetiftempansi()'+
-                     ' at pos '+tostr(ref.offset)+ ' already free !');
-{$endif}
-               end;
-            end;
-           tl:=tl^.next;
-         end;
-      end;
-
-    function ttgobj.istemp(const ref : treference) : boolean;
-
-      begin
-         istemp:=((ref.base=procinfo^.framepointer) and
-                  (ref.offset<firsttemp));
-      end;
-
-
-    procedure ttgobj.persistanttemptonormal(pos : longint);
-      var
-        hp : ptemprecord;
-      begin
-         hp:=templist;
-         while assigned(hp) do
-           if (hp^.pos=pos) and (hp^.temptype=tt_persistant) then
-             begin
-{$ifdef EXTDEBUG}
-               Comment(V_Debug,'temp managment : persistanttemptonormal()'+
-                  ' at pos '+tostr(pos)+ ' found !');
-{$endif}
-                hp^.temptype:=tt_normal;
-                exit;
-             end
-           else
-             hp:=hp^.next;
-{$ifdef EXTDEBUG}
-         Comment(V_Debug,'temp managment problem : persistanttemptonormal()'+
-            ' at pos '+tostr(pos)+ ' not found !');
-{$endif}
-      end;
-
-
-    procedure ttgobj.normaltemptopersistant(pos : longint);
-      var
-        hp : ptemprecord;
-      begin
-         hp:=templist;
-         while assigned(hp) do
-           if (hp^.pos=pos) and (hp^.temptype=tt_normal) then
-             begin
-{$ifdef EXTDEBUG}
-               Comment(V_Debug,'temp managment : normaltemptopersistant()'+
-                  ' at pos '+tostr(pos)+ ' found !');
-{$endif}
-                hp^.temptype:=tt_persistant;
-                exit;
-             end
-           else
-             hp:=hp^.next;
-{$ifdef EXTDEBUG}
-         Comment(V_Debug,'temp managment problem : normaltemptopersistant()'+
-            ' at pos '+tostr(pos)+ ' not found !');
-{$endif}
-      end;
-
-
-    function ttgobj.ungettemp(pos:longint;allowtype:ttemptype):ttemptype;
-      var
-         hp,hnext,hprev,hprevfree : ptemprecord;
-      begin
-         ungettemp:=tt_none;
-         hp:=templist;
-         hprev:=nil;
-         hprevfree:=nil;
-         while assigned(hp) do
-          begin
-            if (hp^.pos=pos) then
-             begin
-               { check type }
-               ungettemp:=hp^.temptype;
-               if hp^.temptype<>allowtype then
-                begin
-                  exit;
-                end;
-               exprasmlist^.concat(new(paitempalloc,dealloc(hp^.pos,hp^.size)));
-               { set this block to free }
-               hp^.temptype:=tt_free;
-               { Update tempfreelist }
-               if assigned(hprevfree) then
-                begin
-                  { Connect with previous? }
-                  if assigned(hprev) and (hprev^.temptype=tt_free) then
-                   begin
-                     inc(hprev^.size,hp^.size);
-                     hprev^.next:=hp^.next;
-                     dispose(hp);
-                     hp:=hprev;
-                   end
-                  else
-                   hprevfree^.nextfree:=hp;
-                end
-               else
-                begin
-                  hp^.nextfree:=tempfreelist;
-                  tempfreelist:=hp;
-                end;
-               { Next block free ? Yes, then concat }
-               hnext:=hp^.next;
-               if assigned(hnext) and (hnext^.temptype=tt_free) then
-                begin
-                  inc(hp^.size,hnext^.size);
-                  hp^.nextfree:=hnext^.nextfree;
-                  hp^.next:=hnext^.next;
-                  dispose(hnext);
-                end;
-               exit;
-             end;
-            if (hp^.temptype=tt_free) then
-             hprevfree:=hp;
-            hprev:=hp;
-            hp:=hp^.next;
-          end;
-        ungettemp:=tt_none;
-      end;
-
-
-    procedure ttgobj.ungetpersistanttemp(pos : longint);
-      begin
-{$ifdef EXTDEBUG}
-        if ungettemp(pos,tt_persistant)<>tt_persistant then
-          Comment(V_Warning,'temp managment problem : ungetpersistanttemp()'+
-                  ' at pos '+tostr(pos)+ ' not found !');
-{$else}
-        ungettemp(pos,tt_persistant);
-{$endif}
-      end;
-
-
-    procedure ttgobj.ungetiftemp(const ref : treference);
-      var
-         tt : ttemptype;
-      begin
-         if istemp(ref) then
-           begin
-              { first check if ansistring }
-              if ungetiftempansi(ref) then
-                exit;
-              tt:=ungettemp(ref.offset,tt_normal);
-{$ifdef EXTDEBUG}
-              if tt=tt_persistant then
-                Comment(V_Debug,'temp at pos '+tostr(ref.offset)+ ' not released because persistant!');
-              if tt=tt_none then
-                Comment(V_Warning,'temp not found for release at offset '+tostr(ref.offset));
-{$endif}
-           end;
-      end;
-
-    function ttgobj.getregisterint : tregister;
-
-      var
-         i : tregister;
-
-      begin
-         if countusableregsint=0 then
-           internalerror(10);
-         for i:=firstreg to lastreg do
-           begin
-              if i in unusedregsint then
-                begin
-                   exclude(unusedregsint,i);
-                   include(usedinproc,i);
-                   dec(countusableregsint);
-                   exprasmlist^.concat(new(pairegalloc,alloc(i)));
-                   exit;
-                end;
-           end;
-         internalerror(28991);
-      end;
-
-    procedure ttgobj.ungetregisterint(r : tregister);
-
-      begin
-         { takes much time }
-         if not(r in availabletempregsint) then
-           exit;
-         include(unusedregsint,r);
-         inc(countusableregsint);
-         exprasmlist^.concat(new(pairegalloc,dealloc(r)));
-      end;
-
-    { tries to allocate the passed register, if possible }
-    function ttgobj.getexplicitregisterint(r : tregister) : tregister;
-
-      begin
-         if r in unusedregsint then
-           begin
-              dec(countusableregsint);
-              exclude(unusedregsint,r);
-              include(usedinproc,r);
-              exprasmlist^.concat(new(pairegalloc,alloc(r)));
-              getexplicitregisterint:=r;
-           end
-         else
-           getexplicitregisterint:=getregisterint;
-      end;
-
-    procedure ttgobj.ungetregister(r : tregister);
-
-      begin
-         if r in intregs then
-           ungetregisterint(r)
-	 {!!!!!!!!
-         else if r in fpuregs then
-           ungetregisterfpu(r)
-         else if r in mmregs then
-           ungetregistermm(r)
-         }
-         else internalerror(18);
-      end;
-
-    procedure ttgobj.cleartempgen;
-
-      begin
-         countusableregsint:=c_countusableregsint;
-         countusableregsfpu:=c_countusableregsfpu;
-         countusableregsmm:=c_countusableregsmm;
-         unusedregsint:=availabletempregsint;
-         {!!!!!!!!
-         unusedregsfpu:=availabletempregsfpu;
-         unusedregsmm:=availabletempregsmm;
-         }
-      end;
-
-    procedure ttgobj.del_reference(const ref : treference);
-
-      begin
-         ungetregister(ref.base);
-      end;
-
-    procedure ttgobj.del_locref(const location : tlocation);
-
-      begin
-         if (location.loc<>LOC_MEM) and (location.loc<>LOC_REFERENCE) then
-           exit;
-         del_reference(location.reference);
-      end;
-
-    procedure ttgobj.del_location(const l : tlocation);
-
-      begin
-         case l.loc of
-           LOC_REGISTER :
-             ungetregister(l.register);
-           LOC_MEM,LOC_REFERENCE :
-             del_reference(l.reference);
-         end;
-      end;
-
-    { pushs and restores registers }
-    procedure ttgobj.pushusedregisters(var pushed : tpushed;b : byte);
-
-      begin
-         runerror(255);
-      end;
-
-    procedure ttgobj.popusedregisters(const pushed : tpushed);
-
-      begin
-         runerror(255);
-      end;
-
-    { saves and restores used registers to temp. values }
-    procedure ttgobj.saveusedregisters(var saved : tsaved;b : byte);
-
-      begin
-         runerror(255);
-      end;
-
-    procedure ttgobj.restoreusedregisters(const saved : tsaved);
-
-      begin
-         runerror(255);
-      end;
-
-    procedure ttgobj.clearregistercount;
-
-      begin
-         runerror(255);
-      end;
-
-    procedure ttgobj.resetusableregisters;
-
-      begin
-         runerror(255);
-      end;
-
-end.
-{
-  $Log$
-  Revision 1.1  2000-07-13 06:30:09  michael
-  + Initial import
-
-  Revision 1.10  2000/02/17 14:48:36  florian
-     * updated to use old firstpass
-
-  Revision 1.9  2000/01/07 01:14:55  peter
-    * updated copyright to 2000
-
-  Revision 1.8  1999/10/14 14:57:54  florian
-    - removed the hcodegen use in the new cg, use cgbase instead
-
-  Revision 1.7  1999/10/12 21:20:47  florian
-    * new codegenerator compiles again
-
-  Revision 1.6  1999/09/10 18:48:11  florian
-    * some bug fixes (e.g. must_be_valid and procinfo.funcret_is_valid)
-    * most things for stored properties fixed
-
-  Revision 1.5  1999/08/06 16:04:06  michael
-  + introduced tainstruction
-
-  Revision 1.4  1999/08/03 00:33:23  michael
-  + Added cpuasm for alpha
-
-  Revision 1.3  1999/08/03 00:32:13  florian
-    * reg_vars and reg_pushes is now in tgobj
-
-  Revision 1.2  1999/08/02 23:13:22  florian
-    * more changes to compile for the Alpha
-
-  Revision 1.1  1999/08/02 17:14:12  florian
-    + changed the temp. generator to an object
-
-}

compiler/new/transn.pas

@@ -1,98 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 by Florian Klaempfl
-
-    This unit does node transformations
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-
-unit transn;
-
-  interface
-
-  implementation
-
-{ The following stuff needs to be implemented: }
-
-{$ifdef dummy}
-blockn:
-
-
-         count:=0;
-         hp:=p^.left;
-         while assigned(hp) do
-           begin
-              if cs_regalloc in aktglobalswitches then
-                begin
-                   { Codeumstellungen }
-
-                   { Funktionsresultate an exit anh„ngen }
-                   { this is wrong for string or other complex
-                     result types !!! }
-                   if ret_in_acc(procinfo^.retdef) and
-                      assigned(hp^.left) and
-                      (hp^.left^.right^.treetype=exitn) and
-                      (hp^.right^.treetype=assignn) and
-                      (hp^.right^.left^.treetype=funcretn) then
-                      begin
-                         if assigned(hp^.left^.right^.left) then
-                           CGMessage(cg_n_inefficient_code)
-                         else
-                           begin
-                              hp^.left^.right^.left:=getcopy(hp^.right^.right);
-                              disposetree(hp^.right);
-                              hp^.right:=nil;
-                           end;
-                      end
-                   { warning if unreachable code occurs and elimate this }
-                   else if (hp^.right^.treetype in
-                     [exitn,breakn,continuen,goton]) and
-                     assigned(hp^.left) and
-                     (hp^.left^.treetype<>labeln) then
-                     begin
-                        { use correct line number }
-                        aktfilepos:=hp^.left^.fileinfo;
-                        disposetree(hp^.left);
-                        hp^.left:=nil;
-                        CGMessage(cg_w_unreachable_code);
-                        { old lines }
-                        aktfilepos:=hp^.right^.fileinfo;
-                     end;
-                end;
-              hp:=hp^.left;
-           end;
-{$endif dummy}
-
-end.
-
-{
-  $Log$
-  Revision 1.1  2000-07-13 06:30:09  michael
-  + Initial import
-
-  Revision 1.3  2000/01/07 01:14:55  peter
-    * updated copyright to 2000
-
-  Revision 1.2  1999/10/12 21:20:47  florian
-    * new codegenerator compiles again
-
-  Revision 1.1  1999/01/23 23:35:02  florian
-    + first versions
-
-}
-