diff options
| author | peter <peter@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2005-10-20 19:20:38 +0000 |
|---|---|---|
| committer | peter <peter@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2005-10-20 19:20:38 +0000 |
| commit | 5ed980d600661e3e77f429a510f093f4a001dee9 (patch) | |
| tree | 40d655e7921c1019d039da654a9df550de3cd249 /compiler/utils | |
| parent | 907c764cb881dab769452696fc5e6bee076c2656 (diff) | |
| download | fpc-unitrw.tar.gz | |
* retag for unitrwunitrw
git-svn-id: http://svn.freepascal.org/svn/fpc/branches/unitrw@1551 3ad0048d-3df7-0310-abae-a5850022a9f2
Diffstat (limited to 'compiler/utils')
32 files changed, 12953 insertions, 0 deletions
diff --git a/compiler/utils/Makefile b/compiler/utils/Makefile new file mode 100644 index 0000000000..0d14063a26 --- /dev/null +++ b/compiler/utils/Makefile @@ -0,0 +1,2021 @@ +# +# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/10/20] +# +default: all +MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince powerpc64-linux +BSDs = freebsd netbsd openbsd darwin +UNIXs = linux $(BSDs) solaris qnx +LIMIT83fs = go32v2 os2 emx watcom +FORCE: +.PHONY: FORCE +override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH))) +ifneq ($(findstring darwin,$(OSTYPE)),) +inUnix=1 #darwin +SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH))) +else +ifeq ($(findstring ;,$(PATH)),) +inUnix=1 +SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH))) +else +SEARCHPATH:=$(subst ;, ,$(PATH)) +endif +endif +SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE)))) +PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH)))) +ifeq ($(PWD),) +PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH)))) +ifeq ($(PWD),) +$(error You need the GNU utils package to use this Makefile) +else +PWD:=$(firstword $(PWD)) +SRCEXEEXT= +endif +else +PWD:=$(firstword $(PWD)) +SRCEXEEXT=.exe +endif +ifndef inUnix +ifeq ($(OS),Windows_NT) +inWinNT=1 +else +ifdef OS2_SHELL +inOS2=1 +endif +endif +else +ifneq ($(findstring cygdrive,$(PATH)),) +inCygWin=1 +endif +endif +ifdef inUnix +SRCBATCHEXT=.sh +else +ifdef inOS2 +SRCBATCHEXT=.cmd +else +SRCBATCHEXT=.bat +endif +endif +ifdef inUnix +PATHSEP=/ +else +PATHSEP:=$(subst /,\,/) +ifdef inCygWin +PATHSEP=/ +endif +endif +ifdef PWD +BASEDIR:=$(subst \,/,$(shell $(PWD))) +ifdef inCygWin +ifneq ($(findstring /cygdrive/,$(BASEDIR)),) +BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR)) +BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR))) +BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR)) +endif +endif +else +BASEDIR=. +endif +ifdef inOS2 +ifndef ECHO +ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(ECHO),) +ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(ECHO),) +ECHO=echo +else +ECHO:=$(firstword $(ECHO)) +endif +else +ECHO:=$(firstword $(ECHO)) +endif +endif +export ECHO +endif +override DEFAULT_FPCDIR=../.. +ifndef FPC +ifdef PP +FPC=$(PP) +endif +endif +ifndef FPC +FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH)))) +ifneq ($(FPCPROG),) +FPCPROG:=$(firstword $(FPCPROG)) +FPC:=$(shell $(FPCPROG) -PB) +ifneq ($(findstring Error,$(FPC)),) +override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH))))) +endif +else +override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH))))) +endif +endif +override FPC:=$(subst $(SRCEXEEXT),,$(FPC)) +override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT) +FOUNDFPC:=$(strip $(wildcard $(FPC))) +ifeq ($(FOUNDFPC),) +FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH)))) +ifeq ($(FOUNDFPC),) +$(error Compiler $(FPC) not found) +endif +endif +ifndef FPC_COMPILERINFO +FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO) +endif +ifndef FPC_VERSION +FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO)) +endif +export FPC FPC_VERSION FPC_COMPILERINFO +unexport CHECKDEPEND ALLDEPENDENCIES +ifndef CPU_TARGET +ifdef CPU_TARGET_DEFAULT +CPU_TARGET=$(CPU_TARGET_DEFAULT) +endif +endif +ifndef OS_TARGET +ifdef OS_TARGET_DEFAULT +OS_TARGET=$(OS_TARGET_DEFAULT) +endif +endif +ifneq ($(words $(FPC_COMPILERINFO)),5) +FPC_COMPILERINFO+=$(shell $(FPC) -iSP) +FPC_COMPILERINFO+=$(shell $(FPC) -iTP) +FPC_COMPILERINFO+=$(shell $(FPC) -iSO) +FPC_COMPILERINFO+=$(shell $(FPC) -iTO) +endif +ifndef CPU_SOURCE +CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO)) +endif +ifndef CPU_TARGET +CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO)) +endif +ifndef OS_SOURCE +OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO)) +endif +ifndef OS_TARGET +OS_TARGET:=$(word 5,$(FPC_COMPILERINFO)) +endif +FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET) +FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE) +ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),) +TARGETSUFFIX=$(OS_TARGET) +SOURCESUFFIX=$(OS_SOURCE) +else +TARGETSUFFIX=$(FULL_TARGET) +SOURCESUFFIX=$(FULL_SOURCE) +endif +ifneq ($(FULL_TARGET),$(FULL_SOURCE)) +CROSSCOMPILE=1 +endif +ifeq ($(findstring makefile,$(MAKECMDGOALS)),) +ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),) +$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first) +endif +endif +ifneq ($(findstring $(OS_TARGET),$(BSDs)),) +BSDhier=1 +endif +ifeq ($(OS_TARGET),linux) +linuxHier=1 +endif +export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE +ifdef FPCDIR +override FPCDIR:=$(subst \,/,$(FPCDIR)) +ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) +override FPCDIR=wrong +endif +else +override FPCDIR=wrong +endif +ifdef DEFAULT_FPCDIR +ifeq ($(FPCDIR),wrong) +override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR)) +ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) +override FPCDIR=wrong +endif +endif +endif +ifeq ($(FPCDIR),wrong) +ifdef inUnix +override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION) +ifeq ($(wildcard $(FPCDIR)/units),) +override FPCDIR=/usr/lib/fpc/$(FPC_VERSION) +endif +else +override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH)))))) +override FPCDIR:=$(FPCDIR)/.. +ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) +override FPCDIR:=$(FPCDIR)/.. +ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) +override FPCDIR:=$(BASEDIR) +ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) +override FPCDIR=c:/pp +endif +endif +endif +endif +endif +ifndef CROSSBINDIR +CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX)) +endif +ifndef BINUTILSPREFIX +ifndef CROSSBINDIR +ifdef CROSSCOMPILE +BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)- +endif +endif +endif +UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX)) +ifeq ($(UNITSDIR),) +UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET)) +endif +PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra) +ifeq ($(FULL_TARGET),i386-linux) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),i386-go32v2) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),i386-win32) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),i386-os2) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),i386-freebsd) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),i386-beos) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),i386-netbsd) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),i386-solaris) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),i386-qnx) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),i386-netware) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),i386-openbsd) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),i386-wdosx) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),i386-emx) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),i386-watcom) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),i386-netwlibc) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),i386-wince) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),m68k-linux) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),m68k-freebsd) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),m68k-netbsd) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),m68k-amiga) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),m68k-atari) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),m68k-openbsd) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),m68k-palmos) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),powerpc-linux) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),powerpc-netbsd) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),powerpc-macos) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),powerpc-darwin) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),powerpc-morphos) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),sparc-linux) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),sparc-netbsd) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),sparc-solaris) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),x86_64-linux) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),x86_64-freebsd) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),x86_64-win64) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),arm-linux) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),arm-wince) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +override TARGET_PROGRAMS+=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +endif +ifeq ($(FULL_TARGET),i386-linux) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-go32v2) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-win32) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-os2) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-freebsd) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-beos) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-netbsd) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-solaris) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-qnx) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-netware) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-openbsd) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-wdosx) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-emx) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-watcom) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-netwlibc) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-wince) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),m68k-linux) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),m68k-freebsd) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),m68k-netbsd) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),m68k-amiga) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),m68k-atari) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),m68k-openbsd) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),m68k-palmos) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),powerpc-linux) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),powerpc-netbsd) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),powerpc-macos) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),powerpc-darwin) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),powerpc-morphos) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),sparc-linux) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),sparc-netbsd) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),sparc-solaris) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),x86_64-linux) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),x86_64-freebsd) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),x86_64-win64) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),arm-linux) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),arm-wince) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +override CLEAN_UNITS+=ppu crc usubst +endif +override INSTALL_FPCPACKAGE=y +ifeq ($(FULL_TARGET),i386-linux) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-go32v2) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-win32) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-os2) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-freebsd) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-beos) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-netbsd) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-solaris) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-qnx) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-netware) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-openbsd) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-wdosx) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-emx) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-watcom) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-netwlibc) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-wince) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),m68k-linux) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),m68k-freebsd) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),m68k-netbsd) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),m68k-amiga) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),m68k-atari) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),m68k-openbsd) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),m68k-palmos) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc-linux) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc-netbsd) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc-macos) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc-darwin) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc-morphos) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),sparc-linux) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),sparc-netbsd) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),sparc-solaris) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),x86_64-linux) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),x86_64-freebsd) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),x86_64-win64) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),arm-linux) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),arm-wince) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-linux) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-go32v2) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-win32) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-os2) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-freebsd) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-beos) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-netbsd) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-solaris) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-qnx) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-netware) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-openbsd) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-wdosx) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-emx) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-watcom) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-netwlibc) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-wince) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),m68k-linux) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),m68k-freebsd) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),m68k-netbsd) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),m68k-amiga) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),m68k-atari) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),m68k-openbsd) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),m68k-palmos) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc-linux) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc-netbsd) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc-macos) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc-darwin) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc-morphos) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),sparc-linux) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),sparc-netbsd) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),sparc-solaris) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),x86_64-linux) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),x86_64-freebsd) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),x86_64-win64) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),arm-linux) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),arm-wince) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +override COMPILER_SOURCEDIR+=.. +endif +ifdef REQUIRE_UNITSDIR +override UNITSDIR+=$(REQUIRE_UNITSDIR) +endif +ifdef REQUIRE_PACKAGESDIR +override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR) +endif +ifdef ZIPINSTALL +ifneq ($(findstring $(OS_TARGET),$(UNIXs)),) +UNIXHier=1 +endif +else +ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),) +UNIXHier=1 +endif +endif +ifndef INSTALL_PREFIX +ifdef PREFIX +INSTALL_PREFIX=$(PREFIX) +endif +endif +ifndef INSTALL_PREFIX +ifdef UNIXHier +INSTALL_PREFIX=/usr/local +else +ifdef INSTALL_FPCPACKAGE +INSTALL_BASEDIR:=/pp +else +INSTALL_BASEDIR:=/$(PACKAGE_NAME) +endif +endif +endif +export INSTALL_PREFIX +ifdef INSTALL_FPCSUBDIR +export INSTALL_FPCSUBDIR +endif +ifndef DIST_DESTDIR +DIST_DESTDIR:=$(BASEDIR) +endif +export DIST_DESTDIR +ifndef COMPILER_UNITTARGETDIR +ifdef PACKAGEDIR_MAIN +COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX) +else +COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX) +endif +endif +ifndef COMPILER_TARGETDIR +COMPILER_TARGETDIR=. +endif +ifndef INSTALL_BASEDIR +ifdef UNIXHier +ifdef INSTALL_FPCPACKAGE +INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION) +else +INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME) +endif +else +INSTALL_BASEDIR:=$(INSTALL_PREFIX) +endif +endif +ifndef INSTALL_BINDIR +ifdef UNIXHier +INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin +else +INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin +ifdef INSTALL_FPCPACKAGE +ifdef CROSSCOMPILE +ifdef CROSSINSTALL +INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX) +else +INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX) +endif +else +INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX) +endif +endif +endif +endif +ifndef INSTALL_UNITDIR +INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX) +ifdef INSTALL_FPCPACKAGE +ifdef PACKAGE_NAME +INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME) +endif +endif +endif +ifndef INSTALL_LIBDIR +ifdef UNIXHier +INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib +else +INSTALL_LIBDIR:=$(INSTALL_UNITDIR) +endif +endif +ifndef INSTALL_SOURCEDIR +ifdef UNIXHier +ifdef BSDhier +SRCPREFIXDIR=share/src +else +ifdef linuxHier +SRCPREFIXDIR=share/src +else +SRCPREFIXDIR=src +endif +endif +ifdef INSTALL_FPCPACKAGE +ifdef INSTALL_FPCSUBDIR +INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME) +else +INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME) +endif +else +INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION) +endif +else +ifdef INSTALL_FPCPACKAGE +ifdef INSTALL_FPCSUBDIR +INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME) +else +INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME) +endif +else +INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source +endif +endif +endif +ifndef INSTALL_DOCDIR +ifdef UNIXHier +ifdef BSDhier +DOCPREFIXDIR=share/doc +else +ifdef linuxHier +DOCPREFIXDIR=share/doc +else +DOCPREFIXDIR=doc +endif +endif +ifdef INSTALL_FPCPACKAGE +INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME) +else +INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION) +endif +else +ifdef INSTALL_FPCPACKAGE +INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME) +else +INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc +endif +endif +endif +ifndef INSTALL_EXAMPLEDIR +ifdef UNIXHier +ifdef INSTALL_FPCPACKAGE +ifdef BSDhier +INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME) +else +ifdef linuxHier +INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples +else +INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME) +endif +endif +else +ifdef BSDhier +INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION) +else +ifdef linuxHier +INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION) +else +INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION) +endif +endif +endif +else +ifdef INSTALL_FPCPACKAGE +INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME) +else +INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples +endif +endif +endif +ifndef INSTALL_DATADIR +INSTALL_DATADIR=$(INSTALL_BASEDIR) +endif +ifdef CROSSCOMPILE +ifndef CROSSBINDIR +CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX)) +ifeq ($(CROSSBINDIR),) +CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE)) +endif +endif +else +CROSSBINDIR= +endif +BATCHEXT=.bat +LOADEREXT=.as +EXEEXT=.exe +PPLEXT=.ppl +PPUEXT=.ppu +OEXT=.o +ASMEXT=.s +SMARTEXT=.sl +STATICLIBEXT=.a +SHAREDLIBEXT=.so +STATICLIBPREFIX=libp +RSTEXT=.rst +ifeq ($(findstring 1.0.,$(FPC_VERSION)),) +ifeq ($(OS_TARGET),go32v1) +STATICLIBPREFIX= +SHORTSUFFIX=v1 +endif +ifeq ($(OS_TARGET),go32v2) +STATICLIBPREFIX= +SHORTSUFFIX=dos +endif +ifeq ($(OS_TARGET),watcom) +STATICLIBPREFIX= +OEXT=.obj +ASMEXT=.asm +SHAREDLIBEXT=.dll +SHORTSUFFIX=wat +endif +ifeq ($(OS_TARGET),linux) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=lnx +endif +ifeq ($(OS_TARGET),freebsd) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=fbs +endif +ifeq ($(OS_TARGET),netbsd) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=nbs +endif +ifeq ($(OS_TARGET),openbsd) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=obs +endif +ifeq ($(OS_TARGET),win32) +SHAREDLIBEXT=.dll +SHORTSUFFIX=w32 +endif +ifeq ($(OS_TARGET),os2) +BATCHEXT=.cmd +AOUTEXT=.out +STATICLIBPREFIX= +SHAREDLIBEXT=.dll +SHORTSUFFIX=os2 +ECHO=echo +endif +ifeq ($(OS_TARGET),emx) +BATCHEXT=.cmd +AOUTEXT=.out +STATICLIBPREFIX= +SHAREDLIBEXT=.dll +SHORTSUFFIX=emx +ECHO=echo +endif +ifeq ($(OS_TARGET),amiga) +EXEEXT= +SHAREDLIBEXT=.library +SHORTSUFFIX=amg +endif +ifeq ($(OS_TARGET),morphos) +EXEEXT= +SHAREDLIBEXT=.library +SHORTSUFFIX=mos +endif +ifeq ($(OS_TARGET),atari) +EXEEXT=.ttp +SHORTSUFFIX=ata +endif +ifeq ($(OS_TARGET),beos) +BATCHEXT=.sh +EXEEXT= +SHORTSUFFIX=be +endif +ifeq ($(OS_TARGET),solaris) +BATCHEXT=.sh +EXEEXT= +SHORTSUFFIX=sun +endif +ifeq ($(OS_TARGET),qnx) +BATCHEXT=.sh +EXEEXT= +SHORTSUFFIX=qnx +endif +ifeq ($(OS_TARGET),netware) +EXEEXT=.nlm +STATICLIBPREFIX= +SHORTSUFFIX=nw +endif +ifeq ($(OS_TARGET),netwlibc) +EXEEXT=.nlm +STATICLIBPREFIX= +SHORTSUFFIX=nwl +endif +ifeq ($(OS_TARGET),macos) +BATCHEXT= +EXEEXT= +DEBUGSYMEXT=.xcoff +SHORTSUFFIX=mac +endif +ifeq ($(OS_TARGET),darwin) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=dwn +endif +else +ifeq ($(OS_TARGET),go32v1) +PPUEXT=.pp1 +OEXT=.o1 +ASMEXT=.s1 +SMARTEXT=.sl1 +STATICLIBEXT=.a1 +SHAREDLIBEXT=.so1 +STATICLIBPREFIX= +SHORTSUFFIX=v1 +endif +ifeq ($(OS_TARGET),go32v2) +STATICLIBPREFIX= +SHORTSUFFIX=dos +endif +ifeq ($(OS_TARGET),watcom) +STATICLIBPREFIX= +SHORTSUFFIX=wat +endif +ifeq ($(OS_TARGET),linux) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=lnx +endif +ifeq ($(OS_TARGET),freebsd) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=fbs +endif +ifeq ($(OS_TARGET),netbsd) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=nbs +endif +ifeq ($(OS_TARGET),openbsd) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=obs +endif +ifeq ($(OS_TARGET),win32) +PPUEXT=.ppw +OEXT=.ow +ASMEXT=.sw +SMARTEXT=.slw +STATICLIBEXT=.aw +SHAREDLIBEXT=.dll +SHORTSUFFIX=w32 +endif +ifeq ($(OS_TARGET),os2) +BATCHEXT=.cmd +PPUEXT=.ppo +ASMEXT=.so2 +OEXT=.oo2 +AOUTEXT=.out +SMARTEXT=.sl2 +STATICLIBPREFIX= +STATICLIBEXT=.ao2 +SHAREDLIBEXT=.dll +SHORTSUFFIX=os2 +ECHO=echo +endif +ifeq ($(OS_TARGET),amiga) +EXEEXT= +PPUEXT=.ppu +ASMEXT=.asm +OEXT=.o +SMARTEXT=.sl +STATICLIBEXT=.a +SHAREDLIBEXT=.library +SHORTSUFFIX=amg +endif +ifeq ($(OS_TARGET),atari) +PPUEXT=.ppu +ASMEXT=.s +OEXT=.o +SMARTEXT=.sl +STATICLIBEXT=.a +EXEEXT=.ttp +SHORTSUFFIX=ata +endif +ifeq ($(OS_TARGET),beos) +BATCHEXT=.sh +PPUEXT=.ppu +ASMEXT=.s +OEXT=.o +SMARTEXT=.sl +STATICLIBEXT=.a +EXEEXT= +SHORTSUFFIX=be +endif +ifeq ($(OS_TARGET),solaris) +BATCHEXT=.sh +PPUEXT=.ppu +ASMEXT=.s +OEXT=.o +SMARTEXT=.sl +STATICLIBEXT=.a +EXEEXT= +SHORTSUFFIX=sun +endif +ifeq ($(OS_TARGET),qnx) +BATCHEXT=.sh +PPUEXT=.ppu +ASMEXT=.s +OEXT=.o +SMARTEXT=.sl +STATICLIBEXT=.a +EXEEXT= +SHORTSUFFIX=qnx +endif +ifeq ($(OS_TARGET),netware) +STATICLIBPREFIX= +PPUEXT=.ppu +OEXT=.o +ASMEXT=.s +SMARTEXT=.sl +STATICLIBEXT=.a +SHAREDLIBEXT=.nlm +EXEEXT=.nlm +SHORTSUFFIX=nw +endif +ifeq ($(OS_TARGET),netwlibc) +STATICLIBPREFIX= +PPUEXT=.ppu +OEXT=.o +ASMEXT=.s +SMARTEXT=.sl +STATICLIBEXT=.a +SHAREDLIBEXT=.nlm +EXEEXT=.nlm +SHORTSUFFIX=nwl +endif +ifeq ($(OS_TARGET),macos) +BATCHEXT= +PPUEXT=.ppu +ASMEXT=.s +OEXT=.o +SMARTEXT=.sl +STATICLIBEXT=.a +EXEEXT= +DEBUGSYMEXT=.xcoff +SHORTSUFFIX=mac +endif +endif +ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),) +FPCMADE=fpcmade.$(SHORTSUFFIX) +ZIPSUFFIX=$(SHORTSUFFIX) +ZIPCROSSPREFIX= +ZIPSOURCESUFFIX=src +ZIPEXAMPLESUFFIX=exm +else +FPCMADE=fpcmade.$(TARGETSUFFIX) +ZIPSOURCESUFFIX=.source +ZIPEXAMPLESUFFIX=.examples +ifdef CROSSCOMPILE +ZIPSUFFIX=.$(SOURCESUFFIX) +ZIPCROSSPREFIX=$(TARGETSUFFIX)- +else +ZIPSUFFIX=.$(TARGETSUFFIX) +ZIPCROSSPREFIX= +endif +endif +ifndef ECHO +ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(ECHO),) +ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(ECHO),) +ECHO= __missing_command_ECHO +else +ECHO:=$(firstword $(ECHO)) +endif +else +ECHO:=$(firstword $(ECHO)) +endif +endif +export ECHO +ifndef DATE +DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(DATE),) +DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(DATE),) +DATE= __missing_command_DATE +else +DATE:=$(firstword $(DATE)) +endif +else +DATE:=$(firstword $(DATE)) +endif +endif +export DATE +ifndef GINSTALL +GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(GINSTALL),) +GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(GINSTALL),) +GINSTALL= __missing_command_GINSTALL +else +GINSTALL:=$(firstword $(GINSTALL)) +endif +else +GINSTALL:=$(firstword $(GINSTALL)) +endif +endif +export GINSTALL +ifndef CPPROG +CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(CPPROG),) +CPPROG= __missing_command_CPPROG +else +CPPROG:=$(firstword $(CPPROG)) +endif +endif +export CPPROG +ifndef RMPROG +RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(RMPROG),) +RMPROG= __missing_command_RMPROG +else +RMPROG:=$(firstword $(RMPROG)) +endif +endif +export RMPROG +ifndef MVPROG +MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(MVPROG),) +MVPROG= __missing_command_MVPROG +else +MVPROG:=$(firstword $(MVPROG)) +endif +endif +export MVPROG +ifndef MKDIRPROG +MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(MKDIRPROG),) +MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(MKDIRPROG),) +MKDIRPROG= __missing_command_MKDIRPROG +else +MKDIRPROG:=$(firstword $(MKDIRPROG)) +endif +else +MKDIRPROG:=$(firstword $(MKDIRPROG)) +endif +endif +export MKDIRPROG +ifndef ECHOREDIR +ifndef inUnix +ECHOREDIR=echo +else +ECHOREDIR=$(ECHO) +endif +endif +ifndef COPY +COPY:=$(CPPROG) -fp +endif +ifndef COPYTREE +COPYTREE:=$(CPPROG) -Rfp +endif +ifndef MKDIRTREE +MKDIRTREE:=$(MKDIRPROG) -p +endif +ifndef MOVE +MOVE:=$(MVPROG) -f +endif +ifndef DEL +DEL:=$(RMPROG) -f +endif +ifndef DELTREE +DELTREE:=$(RMPROG) -rf +endif +ifndef INSTALL +ifdef inUnix +INSTALL:=$(GINSTALL) -c -m 644 +else +INSTALL:=$(COPY) +endif +endif +ifndef INSTALLEXE +ifdef inUnix +INSTALLEXE:=$(GINSTALL) -c -m 755 +else +INSTALLEXE:=$(COPY) +endif +endif +ifndef MKDIR +MKDIR:=$(GINSTALL) -m 755 -d +endif +export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR +ifndef PPUMOVE +PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(PPUMOVE),) +PPUMOVE= __missing_command_PPUMOVE +else +PPUMOVE:=$(firstword $(PPUMOVE)) +endif +endif +export PPUMOVE +ifndef FPCMAKE +FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(FPCMAKE),) +FPCMAKE= __missing_command_FPCMAKE +else +FPCMAKE:=$(firstword $(FPCMAKE)) +endif +endif +export FPCMAKE +ifndef ZIPPROG +ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(ZIPPROG),) +ZIPPROG= __missing_command_ZIPPROG +else +ZIPPROG:=$(firstword $(ZIPPROG)) +endif +endif +export ZIPPROG +ifndef TARPROG +TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(TARPROG),) +TARPROG= __missing_command_TARPROG +else +TARPROG:=$(firstword $(TARPROG)) +endif +endif +export TARPROG +ASNAME=$(BINUTILSPREFIX)as +LDNAME=$(BINUTILSPREFIX)ld +ARNAME=$(BINUTILSPREFIX)ar +RCNAME=$(BINUTILSPREFIX)rc +ifneq ($(findstring 1.0.,$(FPC_VERSION)),) +ifeq ($(OS_TARGET),win32) +ifeq ($(CROSSBINDIR),) +ASNAME=asw +LDNAME=ldw +ARNAME=arw +endif +endif +endif +ifndef ASPROG +ifdef CROSSBINDIR +ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT) +else +ASPROG=$(ASNAME) +endif +endif +ifndef LDPROG +ifdef CROSSBINDIR +LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT) +else +LDPROG=$(LDNAME) +endif +endif +ifndef RCPROG +ifdef CROSSBINDIR +RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT) +else +RCPROG=$(RCNAME) +endif +endif +ifndef ARPROG +ifdef CROSSBINDIR +ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT) +else +ARPROG=$(ARNAME) +endif +endif +AS=$(ASPROG) +LD=$(LDPROG) +RC=$(RCPROG) +AR=$(ARPROG) +PPAS=ppas$(SRCBATCHEXT) +ifdef inUnix +LDCONFIG=ldconfig +else +LDCONFIG= +endif +ifdef DATE +DATESTR:=$(shell $(DATE) +%Y%m%d) +else +DATESTR= +endif +ifndef UPXPROG +ifeq ($(OS_TARGET),go32v2) +UPXPROG:=1 +endif +ifeq ($(OS_TARGET),win32) +UPXPROG:=1 +endif +ifdef UPXPROG +UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(UPXPROG),) +UPXPROG= +else +UPXPROG:=$(firstword $(UPXPROG)) +endif +else +UPXPROG= +endif +endif +export UPXPROG +ZIPOPT=-9 +ZIPEXT=.zip +ifeq ($(USETAR),bz2) +TAROPT=vj +TAREXT=.tar.bz2 +else +TAROPT=vz +TAREXT=.tar.gz +endif +override REQUIRE_PACKAGES=rtl +ifeq ($(FULL_TARGET),i386-linux) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-go32v2) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-win32) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-os2) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-freebsd) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-beos) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-netbsd) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-solaris) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-qnx) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-netware) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-openbsd) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-wdosx) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-emx) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-watcom) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-netwlibc) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-wince) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),m68k-linux) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),m68k-freebsd) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),m68k-netbsd) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),m68k-amiga) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),m68k-atari) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),m68k-openbsd) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),m68k-palmos) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),powerpc-linux) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),powerpc-netbsd) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),powerpc-macos) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),powerpc-darwin) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),powerpc-morphos) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),sparc-linux) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),sparc-netbsd) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),sparc-solaris) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),x86_64-linux) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),x86_64-freebsd) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),x86_64-win64) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),arm-linux) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),arm-wince) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +REQUIRE_PACKAGES_RTL=1 +endif +ifdef REQUIRE_PACKAGES_RTL +PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR)))))) +ifneq ($(PACKAGEDIR_RTL),) +ifneq ($(wildcard $(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX)),) +UNITDIR_RTL=$(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX) +else +UNITDIR_RTL=$(PACKAGEDIR_RTL) +endif +ifdef CHECKDEPEND +$(PACKAGEDIR_RTL)/$(FPCMADE): + $(MAKE) -C $(PACKAGEDIR_RTL) $(FPCMADE) +override ALLDEPENDENCIES+=$(PACKAGEDIR_RTL)/$(FPCMADE) +endif +else +PACKAGEDIR_RTL= +UNITDIR_RTL:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /rtl/Package.fpc,$(UNITSDIR))))) +ifneq ($(UNITDIR_RTL),) +UNITDIR_RTL:=$(firstword $(UNITDIR_RTL)) +else +UNITDIR_RTL= +endif +endif +ifdef UNITDIR_RTL +override COMPILER_UNITDIR+=$(UNITDIR_RTL) +endif +endif +ifndef NOCPUDEF +override FPCOPTDEF=$(CPU_TARGET) +endif +ifneq ($(OS_TARGET),$(OS_SOURCE)) +override FPCOPT+=-T$(OS_TARGET) +endif +ifeq ($(OS_SOURCE),openbsd) +override FPCOPT+=-FD$(NEW_BINUTILS_PATH) +endif +ifndef CROSSBOOTSTRAP +ifneq ($(BINUTILSPREFIX),) +override FPCOPT+=-XP$(BINUTILSPREFIX) -Xc +endif +ifneq ($(BINUTILSPREFIX),) +override FPCOPT+=-Xr$(RLINKPATH) +endif +endif +ifdef UNITDIR +override FPCOPT+=$(addprefix -Fu,$(UNITDIR)) +endif +ifdef LIBDIR +override FPCOPT+=$(addprefix -Fl,$(LIBDIR)) +endif +ifdef OBJDIR +override FPCOPT+=$(addprefix -Fo,$(OBJDIR)) +endif +ifdef INCDIR +override FPCOPT+=$(addprefix -Fi,$(INCDIR)) +endif +ifdef LINKSMART +override FPCOPT+=-XX +endif +ifdef CREATESMART +override FPCOPT+=-CX +endif +ifdef DEBUG +override FPCOPT+=-gl +override FPCOPTDEF+=DEBUG +endif +ifdef RELEASE +ifeq ($(CPU_TARGET),i386) +FPCCPUOPT:=-OG2p3 +else +ifeq ($(CPU_TARGET),powerpc) +FPCCPUOPT:=-O1r +else +FPCCPUOPT:= +endif +endif +override FPCOPT+=-Ur -Xs $(FPCCPUOPT) -n +override FPCOPTDEF+=RELEASE +endif +ifdef STRIP +override FPCOPT+=-Xs +endif +ifdef OPTIMIZE +ifeq ($(CPU_TARGET),i386) +override FPCOPT+=-OG2p3 +endif +endif +ifdef VERBOSE +override FPCOPT+=-vwni +endif +ifdef COMPILER_OPTIONS +override FPCOPT+=$(COMPILER_OPTIONS) +endif +ifdef COMPILER_UNITDIR +override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR)) +endif +ifdef COMPILER_LIBRARYDIR +override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR)) +endif +ifdef COMPILER_OBJECTDIR +override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR)) +endif +ifdef COMPILER_INCLUDEDIR +override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR)) +endif +ifdef CROSSBINDIR +override FPCOPT+=-FD$(CROSSBINDIR) +endif +ifdef COMPILER_TARGETDIR +override FPCOPT+=-FE$(COMPILER_TARGETDIR) +ifeq ($(COMPILER_TARGETDIR),.) +override TARGETDIRPREFIX= +else +override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/ +endif +endif +ifdef COMPILER_UNITTARGETDIR +override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR) +ifeq ($(COMPILER_UNITTARGETDIR),.) +override UNITTARGETDIRPREFIX= +else +override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/ +endif +else +ifdef COMPILER_TARGETDIR +override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR) +override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX) +endif +endif +ifeq ($(OS_TARGET),linux) +ifeq ($(FPC_VERSION),1.0.6) +override FPCOPTDEF+=HASUNIX +endif +endif +ifdef OPT +override FPCOPT+=$(OPT) +endif +ifdef FPCOPTDEF +override FPCOPT+=$(addprefix -d,$(FPCOPTDEF)) +endif +ifdef CFGFILE +override FPCOPT+=@$(CFGFILE) +endif +ifdef USEENV +override FPCEXTCMD:=$(FPCOPT) +override FPCOPT:=!FPCEXTCMD +export FPCEXTCMD +endif +override COMPILER:=$(FPC) $(FPCOPT) +ifeq (,$(findstring -s ,$(COMPILER))) +EXECPPAS= +else +ifeq ($(FULL_SOURCE),$(FULL_TARGET)) +EXECPPAS:=@$(PPAS) +endif +endif +.PHONY: fpc_exes +ifndef CROSSINSTALL +ifneq ($(TARGET_PROGRAMS),) +override EXEFILES=$(addsuffix $(EXEEXT),$(TARGET_PROGRAMS)) +override EXEOFILES:=$(addsuffix $(OEXT),$(TARGET_PROGRAMS)) $(addprefix $(STATICLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_PROGRAMS))) +override ALLTARGET+=fpc_exes +override INSTALLEXEFILES+=$(EXEFILES) +override CLEANEXEFILES+=$(EXEFILES) $(EXEOFILES) +ifeq ($(OS_TARGET),os2) +override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_PROGRAMS)) +endif +ifeq ($(OS_TARGET),emx) +override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_PROGRAMS)) +endif +endif +endif +fpc_exes: $(COMPILER_TARGETDIR) $(COMPILER_UNITTARGETDIR) $(EXEFILES) +ifdef TARGET_RSTS +override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS)) +override CLEANRSTFILES+=$(RSTFILES) +endif +.PHONY: fpc_all fpc_smart fpc_debug fpc_release +$(FPCMADE): $(ALLDEPENDENCIES) $(ALLTARGET) + @$(ECHOREDIR) Compiled > $(FPCMADE) +fpc_all: $(FPCMADE) +fpc_smart: + $(MAKE) all LINKSMART=1 CREATESMART=1 +fpc_debug: + $(MAKE) all DEBUG=1 +fpc_release: + $(MAKE) all RELEASE=1 +.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lpr .dpr .pp .rc .res +$(COMPILER_UNITTARGETDIR): + $(MKDIRTREE) $(COMPILER_UNITTARGETDIR) +$(COMPILER_TARGETDIR): + $(MKDIRTREE) $(COMPILER_TARGETDIR) +%$(PPUEXT): %.pp + $(COMPILER) $< + $(EXECPPAS) +%$(PPUEXT): %.pas + $(COMPILER) $< + $(EXECPPAS) +%$(EXEEXT): %.pp + $(COMPILER) $< + $(EXECPPAS) +%$(EXEEXT): %.pas + $(COMPILER) $< + $(EXECPPAS) +%$(EXEEXT): %.lpr + $(COMPILER) $< + $(EXECPPAS) +%$(EXEEXT): %.dpr + $(COMPILER) $< + $(EXECPPAS) +%.res: %.rc + windres -i $< -o $@ +vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR) +vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR) +vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR) +vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR) +vpath %$(OEXT) $(COMPILER_UNITTARGETDIR) +vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR) +.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall +ifdef INSTALL_UNITS +override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS)) +endif +ifdef INSTALL_BUILDUNIT +override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES)) +endif +ifdef INSTALLPPUFILES +override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))) +ifneq ($(UNITTARGETDIRPREFIX),) +override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES))) +override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES)))) +endif +override INSTALL_CREATEPACKAGEFPC=1 +endif +ifdef INSTALLEXEFILES +ifneq ($(TARGETDIRPREFIX),) +override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES))) +endif +endif +fpc_install: all $(INSTALLTARGET) +ifdef INSTALLEXEFILES + $(MKDIR) $(INSTALL_BINDIR) +ifdef UPXPROG + -$(UPXPROG) $(INSTALLEXEFILES) +endif + $(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR) +endif +ifdef INSTALL_CREATEPACKAGEFPC +ifdef FPCMAKE +ifdef PACKAGE_VERSION +ifneq ($(wildcard Makefile.fpc),) + $(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc + $(MKDIR) $(INSTALL_UNITDIR) + $(INSTALL) Package.fpc $(INSTALL_UNITDIR) +endif +endif +endif +endif +ifdef INSTALLPPUFILES + $(MKDIR) $(INSTALL_UNITDIR) + $(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR) +ifneq ($(INSTALLPPULINKFILES),) + $(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR) +endif +ifneq ($(wildcard $(LIB_FULLNAME)),) + $(MKDIR) $(INSTALL_LIBDIR) + $(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR) +ifdef inUnix + ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME) +endif +endif +endif +ifdef INSTALL_FILES + $(MKDIR) $(INSTALL_DATADIR) + $(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR) +endif +fpc_sourceinstall: distclean + $(MKDIR) $(INSTALL_SOURCEDIR) + $(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR) +fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS)) +ifdef HASEXAMPLES + $(MKDIR) $(INSTALL_EXAMPLEDIR) +endif +ifdef EXAMPLESOURCEFILES + $(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR) +endif +ifdef TARGET_EXAMPLEDIRS + $(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR) +endif +.PHONY: fpc_clean fpc_cleanall fpc_distclean +ifdef EXEFILES +override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES)) +endif +ifdef CLEAN_UNITS +override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS)) +endif +ifdef CLEANPPUFILES +override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))) +ifdef DEBUGSYMEXT +override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES)) +endif +override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES)) +override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES))) +endif +fpc_clean: $(CLEANTARGET) +ifdef CLEANEXEFILES + -$(DEL) $(CLEANEXEFILES) +endif +ifdef CLEANPPUFILES + -$(DEL) $(CLEANPPUFILES) +endif +ifneq ($(CLEANPPULINKFILES),) + -$(DEL) $(CLEANPPULINKFILES) +endif +ifdef CLEANRSTFILES + -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES)) +endif +ifdef CLEAN_FILES + -$(DEL) $(CLEAN_FILES) +endif +ifdef LIB_NAME + -$(DEL) $(LIB_NAME) $(LIB_FULLNAME) +endif + -$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE) + -$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT) +fpc_cleanall: $(CLEANTARGET) +ifdef CLEANEXEFILES + -$(DEL) $(CLEANEXEFILES) +endif +ifdef COMPILER_UNITTARGETDIR +ifdef CLEANPPUFILES + -$(DEL) $(CLEANPPUFILES) +endif +ifneq ($(CLEANPPULINKFILES),) + -$(DEL) $(CLEANPPULINKFILES) +endif +ifdef CLEANRSTFILES + -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES)) +endif +endif + -$(DELTREE) units + -$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT) +ifneq ($(PPUEXT),.ppu) + -$(DEL) *.o *.ppu *.a +endif + -$(DELTREE) *$(SMARTEXT) + -$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE) + -$(DEL) *_ppas$(BATCHEXT) +ifdef AOUTEXT + -$(DEL) *$(AOUTEXT) +endif +ifdef DEBUGSYMEXT + -$(DEL) *$(DEBUGSYMEXT) +endif +fpc_distclean: cleanall +.PHONY: fpc_baseinfo +override INFORULES+=fpc_baseinfo +fpc_baseinfo: + @$(ECHO) + @$(ECHO) == Package info == + @$(ECHO) Package Name..... $(PACKAGE_NAME) + @$(ECHO) Package Version.. $(PACKAGE_VERSION) + @$(ECHO) + @$(ECHO) == Configuration info == + @$(ECHO) + @$(ECHO) FPC.......... $(FPC) + @$(ECHO) FPC Version.. $(FPC_VERSION) + @$(ECHO) Source CPU... $(CPU_SOURCE) + @$(ECHO) Target CPU... $(CPU_TARGET) + @$(ECHO) Source OS.... $(OS_SOURCE) + @$(ECHO) Target OS.... $(OS_TARGET) + @$(ECHO) Full Source.. $(FULL_SOURCE) + @$(ECHO) Full Target.. $(FULL_TARGET) + @$(ECHO) SourceSuffix. $(SOURCESUFFIX) + @$(ECHO) TargetSuffix. $(TARGETSUFFIX) + @$(ECHO) + @$(ECHO) == Directory info == + @$(ECHO) + @$(ECHO) Required pkgs... $(REQUIRE_PACKAGES) + @$(ECHO) + @$(ECHO) Basedir......... $(BASEDIR) + @$(ECHO) FPCDir.......... $(FPCDIR) + @$(ECHO) CrossBinDir..... $(CROSSBINDIR) + @$(ECHO) UnitsDir........ $(UNITSDIR) + @$(ECHO) PackagesDir..... $(PACKAGESDIR) + @$(ECHO) + @$(ECHO) GCC library..... $(GCCLIBDIR) + @$(ECHO) Other library... $(OTHERLIBDIR) + @$(ECHO) + @$(ECHO) == Tools info == + @$(ECHO) + @$(ECHO) As........ $(AS) + @$(ECHO) Ld........ $(LD) + @$(ECHO) Ar........ $(AR) + @$(ECHO) Rc........ $(RC) + @$(ECHO) + @$(ECHO) Mv........ $(MVPROG) + @$(ECHO) Cp........ $(CPPROG) + @$(ECHO) Rm........ $(RMPROG) + @$(ECHO) GInstall.. $(GINSTALL) + @$(ECHO) Echo...... $(ECHO) + @$(ECHO) Shell..... $(SHELL) + @$(ECHO) Date...... $(DATE) + @$(ECHO) FPCMake... $(FPCMAKE) + @$(ECHO) PPUMove... $(PPUMOVE) + @$(ECHO) Upx....... $(UPXPROG) + @$(ECHO) Zip....... $(ZIPPROG) + @$(ECHO) + @$(ECHO) == Object info == + @$(ECHO) + @$(ECHO) Target Loaders........ $(TARGET_LOADERS) + @$(ECHO) Target Units.......... $(TARGET_UNITS) + @$(ECHO) Target Implicit Units. $(TARGET_IMPLICITUNITS) + @$(ECHO) Target Programs....... $(TARGET_PROGRAMS) + @$(ECHO) Target Dirs........... $(TARGET_DIRS) + @$(ECHO) Target Examples....... $(TARGET_EXAMPLES) + @$(ECHO) Target ExampleDirs.... $(TARGET_EXAMPLEDIRS) + @$(ECHO) + @$(ECHO) Clean Units......... $(CLEAN_UNITS) + @$(ECHO) Clean Files......... $(CLEAN_FILES) + @$(ECHO) + @$(ECHO) Install Units....... $(INSTALL_UNITS) + @$(ECHO) Install Files....... $(INSTALL_FILES) + @$(ECHO) + @$(ECHO) == Install info == + @$(ECHO) + @$(ECHO) DateStr.............. $(DATESTR) + @$(ECHO) ZipName.............. $(ZIPNAME) + @$(ECHO) ZipPrefix............ $(ZIPPREFIX) + @$(ECHO) ZipCrossPrefix....... $(ZIPCROSSPREFIX) + @$(ECHO) ZipSuffix............ $(ZIPSUFFIX) + @$(ECHO) FullZipName.......... $(FULLZIPNAME) + @$(ECHO) Install FPC Package.. $(INSTALL_FPCPACKAGE) + @$(ECHO) + @$(ECHO) Install base dir..... $(INSTALL_BASEDIR) + @$(ECHO) Install binary dir... $(INSTALL_BINDIR) + @$(ECHO) Install library dir.. $(INSTALL_LIBDIR) + @$(ECHO) Install units dir.... $(INSTALL_UNITDIR) + @$(ECHO) Install source dir... $(INSTALL_SOURCEDIR) + @$(ECHO) Install doc dir...... $(INSTALL_DOCDIR) + @$(ECHO) Install example dir.. $(INSTALL_EXAMPLEDIR) + @$(ECHO) Install data dir..... $(INSTALL_DATADIR) + @$(ECHO) + @$(ECHO) Dist destination dir. $(DIST_DESTDIR) + @$(ECHO) Dist zip name........ $(DIST_ZIPNAME) + @$(ECHO) +.PHONY: fpc_info +fpc_info: $(INFORULES) +.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \ + fpc_makefile_dirs +fpc_makefile: + $(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc +fpc_makefile_sub1: +ifdef TARGET_DIRS + $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS)) +endif +ifdef TARGET_EXAMPLEDIRS + $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS)) +endif +fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS)) +fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2 +fpc_makefiles: fpc_makefile fpc_makefile_dirs +ifndef DATA2INC +DATA2INC:=$(strip $(wildcard $(addsuffix /data2inc$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(DATA2INC),) +DATA2INC= __missing_command_DATA2INC +else +DATA2INC:=$(firstword $(DATA2INC)) +endif +endif +export DATA2INC +all: fpc_all +debug: fpc_debug +smart: fpc_smart +release: fpc_release +units: fpc_units +examples: +shared: +install: fpc_install +sourceinstall: fpc_sourceinstall +exampleinstall: fpc_exampleinstall +distinstall: +zipinstall: +zipsourceinstall: +zipexampleinstall: +zipdistinstall: +clean: fpc_clean +distclean: fpc_distclean +cleanall: fpc_cleanall +info: fpc_info +makefiles: fpc_makefiles +.PHONY: all debug smart release units examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info makefiles +ifneq ($(wildcard fpcmake.loc),) +include fpcmake.loc +endif +ppu$(PPUEXT): ppu.pas +ppufiles$(EXEEXT): ppufiles.pp ppu$(PPUEXT) +ppudump$(EXEEXT): ppudump.pp ppu$(PPUEXT) +ppumove$(EXEEXT): ppumove.pp ppu$(PPUEXT) +fpcsubst$(EXEEXT): fpcsubst.pp usubst.pp +fpcmkcfg$(EXEEXT): fpcmkcfg.pp usubst.pp fpccfg.inc +ifneq ($(DATA2INC),) +fpccfg.inc: fpc.cft + $(DATA2INC) -b -s fpc.cft fpccfg.inc DefaultConfig +endif +unexport PPUFILES PPUMOVE diff --git a/compiler/utils/Makefile.fpc b/compiler/utils/Makefile.fpc new file mode 100644 index 0000000000..1aacfc3c25 --- /dev/null +++ b/compiler/utils/Makefile.fpc @@ -0,0 +1,52 @@ +# +# Makefile.fpc for Free Pascal Compiler Utils +# + +[target] +programs=fpc fppkg ppufiles ppudump ppumove fpcsubst fpcmkcfg +rst=fppkg fpcmkcfg fpcsubst + +[clean] +units=ppu crc usubst + +[compiler] +unitdir=.. +sourcedir=.. + +[install] +fpcpackage=y + +[require] +tools=data2inc + +[default] +fpcdir=../.. + + +[rules] +# +# PPU Tools +# +ppu$(PPUEXT): ppu.pas + +ppufiles$(EXEEXT): ppufiles.pp ppu$(PPUEXT) + +ppudump$(EXEEXT): ppudump.pp ppu$(PPUEXT) + +ppumove$(EXEEXT): ppumove.pp ppu$(PPUEXT) + +fpcsubst$(EXEEXT): fpcsubst.pp usubst.pp + +fpcmkcfg$(EXEEXT): fpcmkcfg.pp usubst.pp fpccfg.inc + +ifneq ($(DATA2INC),) +fpccfg.inc: fpc.cft + $(DATA2INC) -b -s fpc.cft fpccfg.inc DefaultConfig +endif + +# +# Don't export some tools, which are found in the current dir if it's in +# the path, so are not valid for the subdirs +# + +unexport PPUFILES PPUMOVE diff --git a/compiler/utils/README b/compiler/utils/README new file mode 100644 index 0000000000..ab7a13eefa --- /dev/null +++ b/compiler/utils/README @@ -0,0 +1,20 @@ +This dirctory contains some utilities that are used during the +development of the Free Pascal Compiler. + +msg2inc : Convert a compiler message file (errorX.msg) to .inc files to + include it as the default language in the compiler. It can + also convert the .msg to .tex for inclusion the documentation + +nasmconv : Convert a Nasm insns.dat to i386tab.inc so it can be used with + the compiler + +makecfg : This script will make the samplecfg for linux installations + +msgdif : analyzes the differences between two msg files + msgdif errore.msg errord.msg + will print out new error msg, removed old ones + and will create a new file new.msg that will + contain the new error messages (supposing TeX comment is after + the message line itself) + removed messages are prepended by "%%% " + (they can be useful in case on error enum renaming !) diff --git a/compiler/utils/fixlog.pp b/compiler/utils/fixlog.pp new file mode 100644 index 0000000000..4f5a7a932a --- /dev/null +++ b/compiler/utils/fixlog.pp @@ -0,0 +1,174 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + Remove all revision logs from source files after X revisions or + older than date X + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} +program fixlog; + +{$mode objfpc} +{$H+} + +uses + sysutils; + +const + bufsize = 32*1024; + +var + maxrevs,myear,mmonth,mday : integer; + +procedure Date2Int(const date:string;var year,month,day:integer); +begin + year:=StrToInt(Copy(date,1,4)); + month:=StrToInt(Copy(date,6,2)); + day:=StrToInt(Copy(date,9,2)); + if (year=0) or (month=0) or (day=0) then + begin + writeln('wrong date "',date,'", use yyyy/mm/dd'); + halt(2); + end; +end; + + +procedure dofile(const fn:string); +var + t,f : text; + s : string; + skip, truncated : boolean; + year,month,day, + found,revs,i : integer; + fbuf,tbuf : pointer; +begin + getmem(fbuf,bufsize); + getmem(tbuf,bufsize); + write('processing ',fn,': '); + assign(t,fn); + assign(f,'fixlog.tmp'); + {$I-} + reset(t); + {$I+} + if ioresult<>0 then + begin + writeln('error!'); + exit; + end; + rewrite(f); + settextbuf(t,tbuf^,bufsize); + settextbuf(f,fbuf^,bufsize); + found:=0; + revs:=0; + skip:=false; + truncated:=false; + while not eof(t) do + begin + readln(t,s); + case found of + 0 : + begin + if pos('$Log: ',s)>0 then + found:=1; + skip:=false; + writeln(f,s); + end; + 1 : + begin + i:=pos('Revision',s); + if i>0 then + begin + inc(revs); + if revs>maxrevs then + begin + skip:=true; + truncated:=true; + found:=2; + end + else + begin + inc(i,10); + while (i<length(s)) and (s[i]<>' ') do + inc(i); + while (i<length(s)) and (s[i]=' ') do + inc(i); + if (i<length(s)) and (s[i] in ['0'..'9']) then + begin + Date2Int(Copy(s,i,10),year,month,day); + if (year<Myear) or + ((year=MYear) and (month<Mmonth)) or + ((year=MYear) and (month=Mmonth) and (day<Mday)) then + begin + skip:=true; + truncated:=true; + found:=2; +// write(year,'/',month,'/',day,' date'); + end; + end; + end; + end + else + if pos('}',s)>0 then + begin + skip:=false; + found:=0; + end; + if not skip then + writeln(f,s); + end; + 2 : + begin + if pos('}',s)>0 then + begin + skip:=false; + found:=0; + end; + if not skip then + writeln(f,s); + end; + end; + end; + close(t); + close(f); + if revs=0 then + writeln(' no log found') + else + if truncated then + writeln(revs-1,' revisions') + else + writeln(revs,' revisions'); + erase(t); + rename(f,fn); + freemem(tbuf); + freemem(fbuf); +end; + +var + dir : tsearchrec; + i : integer; + path : string; +begin + writeln('fixlog v1.01 (C) 1999-2002 Peter Vreman'); + if paramcount<3 then + begin + writeln('usage: fixlog <revisions> <yyyy-mm-dd> <files> [files]'); + halt(1); + end; + MaxRevs:=StrToInt(ParamStr(1)); + Date2Int(ParamStr(2),MYear,MMonth,MDay); + for i:=3 to paramcount do + begin + path:=ExtractFilePath(paramstr(i)); + if findfirst(paramstr(i),faAnyFile,dir)=0 then + repeat + dofile(path+dir.name); + until findnext(dir)<>0; + findclose(dir); + end; +end. diff --git a/compiler/utils/fixmsg.pp b/compiler/utils/fixmsg.pp new file mode 100644 index 0000000000..6bd1cfbe2c --- /dev/null +++ b/compiler/utils/fixmsg.pp @@ -0,0 +1,66 @@ +type + trtabrec=record + name : string[12]; + idx : longint; + end; + +const + trtab : array[0..10] of trtabrec=( + (name:'general';idx:1000), + (name:'scan';idx:2000), + (name:'parser';idx:3000), + (name:'type';idx:4000), + (name:'sym';idx:5000), + (name:'cg';idx:6000), + (name:'asmr';idx:7000), + (name:'asmw';idx:8000), + (name:'exec';idx:9000), + (name:'unit';idx:10000), + (name:'option';idx:11000) + ); + +var + t,f : text; + s,hs : string; + i,j,k : longint; +begin + assign(t,paramstr(1)); + reset(t); + assign(f,'New.msg'); + rewrite(f); + while not eof(t) do + begin + readln(t,s); + if (s<>'') and not(s[1] in ['#','%']) then + begin + for i:=0 to 10 do + if Copy(s,1,length(trtab[i].name))=trtab[i].name then + begin + j:=pos('=',s); + if j>0 then + begin + inc(j); + if s[j] in ['0'..'9'] then + begin + k:=j; + while (s[k] in ['0'..'9']) do + inc(k); + if s[k]='_' then + inc(k); + delete(s,j,k-j); + end; + str(trtab[i].idx,hs); + while length(hs)<5 do + hs:='0'+hs; + hs:=hs+'_'; + inc(trtab[i].idx); + insert(hs,s,j); + end; + break; + end; + end; + writeln(f,s); + end; + close(f); + close(t); +end. diff --git a/compiler/utils/fixnasm.pp b/compiler/utils/fixnasm.pp new file mode 100644 index 0000000000..01041ede83 --- /dev/null +++ b/compiler/utils/fixnasm.pp @@ -0,0 +1,99 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + Convert insns.dat from Nasm to an i386ins.dat for usage with + the Free pascal compiler + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} +program fixnasm; + +{$ifndef FPC} + procedure readln(var t:text;var s:string); + var + c : char; + i : longint; + begin + c:=#0; + i:=0; + while (not eof(t)) and (c<>#10) do + begin + read(t,c); + if c<>#10 then + begin + inc(i); + s[i]:=c; + end; + end; + if (i>0) and (s[i]=#13) then + dec(i); + s[0]:=chr(i); + end; +{$endif} + +const + spaces=' '; +var + t,f : text; + para,bytes,flags, + opcode,lastop, + s : string; + i,j : longint; +begin + writeln('Fixing insns.dat -> i386ins.dat'); + assign(t,'insns.dat'); + reset(t); + assign(f,'insns.new'); + rewrite(f); + lastop:=''; + while not eof(t) do + begin + readln(t,s); + if (s<>'') and (s[1]<>';') then + begin + i:=pos(' ',s); + j:=pos(',',s); + if (j>0) and (j<i) then + opcode:=Copy(s,1,j-1) + else + opcode:=Copy(s,1,i-1); + if opcode<>lastop then + begin + writeln(f,''); + writeln(f,'[',Copy(s,1,i-1),']'); + writeln(f,'(Ch_All, Ch_None, Ch_None)'); + lastop:=opcode; + end; + while (i<length(s)) and (s[i+1]=' ') do + inc(i); + Delete(s,1,i); + i:=pos(' ',s); + para:=Copy(s,1,i-1); + para:=para+Copy(spaces,1,22-length(para)); + while (i<length(s)) and (s[i+1]=' ') do + inc(i); + Delete(s,1,i); + i:=pos(' ',s); + bytes:=Copy(s,1,i-1); + bytes:=bytes+Copy(spaces,1,32-length(bytes)); + while (i<length(s)) and (s[i+1]=' ') do + inc(i); + Delete(s,1,i); + i:=pos(' ',s); + if i=0 then + i:=255; + flags:=Copy(s,1,i-1); + writeln(f,para,bytes,flags); + end + else + writeln(f,s); + end; + close(f); + close(t); +end. diff --git a/compiler/utils/fixtab.pp b/compiler/utils/fixtab.pp new file mode 100644 index 0000000000..89410c5836 --- /dev/null +++ b/compiler/utils/fixtab.pp @@ -0,0 +1,367 @@ +program FixTab; +uses Dos; + +const + {Files} + InputExt=''; + OutputExt='*'; + + +var +{General} + InFile, + OutFile : string[80]; + ParaFile : word; +{Specific} +const + TabSize : longint=8; + DosEol : boolean=false; + Verbose : boolean=false; + +{**************************************************************************** + Routines +****************************************************************************} + +const +{$IFDEF LINUX} + PathCh='/'; +{$ELSE} + PathCh='\'; +{$ENDIF} + +Function SplitPath(Const HStr:String):String; +var + i : byte; +begin + i:=Length(Hstr); + while (i>0) and (Hstr[i]<>PathCh) do + dec(i); + SplitPath:=Copy(Hstr,1,i); +end; + + + +Function SplitFileName(Const HStr:String):String; +var + i : byte; +begin + i:=Length(Hstr); + while (i>0) and (Hstr[i]<>PathCh) do + dec(i); + SplitFileName:=Copy(Hstr,i+1,255); +end; + + + +Function SplitName(Const HStr:String):String; +var + i,j : byte; +begin + i:=Length(Hstr); + j:=i; + while (i>0) and (Hstr[i]<>PathCh) do + dec(i); + while (j>0) and (Hstr[j]<>'.') do + dec(j); + if j<=i then + j:=255; + SplitName:=Copy(Hstr,i+1,j-(i+1)); +end; + + + +Function SplitExtension(Const HStr:String):String; +var + j,i : byte; +begin + i:=Length(Hstr); + j:=i; + while (i>0) and (Hstr[i]<>PathCh) do + dec(i); + while (j>0) and (Hstr[j]<>'.') do + dec(j); + if j<=i then + j:=254; + SplitExtension:=Copy(Hstr,j+1,255); +end; + + + +Function AddExtension(Const HStr,ext:String):String; +begin + if (Ext<>'') and (SplitExtension(HStr)='') then + AddExtension:=Hstr+'.'+Ext + else + AddExtension:=Hstr; +end; + + + +Function ForceExtension(Const HStr,ext:String):String; +var + j : byte; +begin + j:=length(Hstr); + while (j>0) and (Hstr[j]<>'.') do + dec(j); + if j=0 then + j:=255; + ForceExtension:=Copy(Hstr,1,j-1)+'.'+Ext; +end; + + +function UCase(Const Hstr:string):string; +var + i : byte; +begin + for i:=1to Length(Hstr) do + UCase[i]:=Upcase(Hstr[i]); + UCase[0]:=chr(Length(Hstr)); +end; + + + +Function ESpace(HStr:String;len:byte):String; +begin + while length(Hstr)<Len do + begin + inc(byte(Hstr[0])); + Hstr[Length(Hstr)]:=' '; + end; + ESpace:=Hstr; +end; + +{**************************************************************************** + Main Stuff +****************************************************************************} + +var + Done : array[0..1023] of string[32]; + Total : word; +Function FileDone(const fn:string):boolean; +var + i : word; +begin + i:=0; + while (i<Total) and (Done[i]<>fn) do + inc(i); + if Done[i]=fn then + FileDone:=true + else + begin + Done[Total]:=fn; + inc(Total); + FileDone:=false; + end; +end; + + + +procedure Convert(fn,nfn:string); +type + inbuftype=array[0..31999] of char; + outbuftype=array[0..63999] of char; +var + f,g : file; + inbuf : ^inbuftype; + outbuf : ^outbuftype; + Curr, + TabCol, + col, + i,last, + innum, + outnum : longint; + + procedure WriteBuf; + begin + if i>last then + begin + move(InBuf^[last],OutBuf^[OutNum],i-last); + inc(OutNum,(i-last)); + end; + Last:=i+1; + end; + +begin +{Create New FileName} + if SplitExtension(nfn)='*' then + nfn:=AddExtension(SplitPath(nfn)+SplitName(nfn),SplitExtension(fn)); + if SplitName(nfn)='*' then + begin + if SplitPath(nfn)='' then + nfn:=AddExtension(SplitPath(fn)+SplitName(fn),SplitExtension(nfn)) + else + nfn:=AddExtension(SplitPath(nfn)+SplitName(fn),SplitExtension(nfn)); + end; +{Done?} + if FileDone(nfn) then + exit; +{Open Files} + Write('Converting '+ESpace(fn,30)+' '); + if fn=nfn then + assign(g,ForceExtension(fn,'$T$')) + else + begin + Write('-> '+ESpace(nfn,30)+' '); + assign(g,nfn); + end; + new(inbuf); + new(outbuf); + assign(f,fn); + {$I-} + reset(f,1); + {$I+} + if ioresult<>0 then + exit; + {$I-} + rewrite(g,1); + {$I+} + if ioresult<>0 then + begin + close(f); + exit; + end; + Curr:=0; + col:=1; + last:=0; + repeat + blockread(f,InBuf^,sizeof(InBufType),innum); + outnum:=0; + if innum>0 then + begin + i:=0; + while (i<innum) do + begin + case InBuf^[i] of + #9 : begin + WriteBuf; + OutBuf^[OutNum]:=' '; + inc(OutNum); + inc(Col); + TabCol:=(((Col-1) div TabSize)+1)*TabSize; + while (Col<TabCol) do + begin + OutBuf^[OutNum]:=' '; + inc(OutNum); + inc(Col); + end; + end; + #13 : begin + WriteBuf; + while (outnum>0) and (outbuf^[outnum-1] in [' ',#9]) do + dec(outnum); + end; + #10 : begin + WriteBuf; + while (outnum>0) and (outbuf^[outnum-1] in [' ',#9]) do + dec(outnum); + if DosEol then + begin + OutBuf^[OutNum]:=#13; + inc(OutNum); + end; + OutBuf^[OutNum]:=#10; + inc(OutNum); + col:=0; + inc(Curr); + if (curr and 31)=0 then + Write(Curr:5,#8#8#8#8#8); + end; + else + inc(col); + end; + inc(i); + end; + WriteBuf; + last:=0; + end; + blockwrite(g,OutBuf^,outnum); + until innum=0; + WriteLn(Curr,' Lines'); + close(g); + close(f); + if fn=nfn then + begin + erase(f); + rename(g,fn); + end; + dispose(outbuf); + dispose(inbuf); +end; + + +{**************************************************************************** + General Stuff +****************************************************************************} + +procedure getpara; +var + ch : char; + para : string[128]; + i,j : word; + + procedure helpscreen; + begin + writeln('Usage : '+SplitName(ParamStr(0))+' [Options] <InFile(s)>'#10); + writeln('<Options> can be : -O<OutFile> Specify OutFile Mask'); + WriteLn(' -D Use MsDos #13#10 Eols'); + writeln(' -T<size> Set Size of Tabs'); + writeln(' -V be more verbose'); + writeln(' -? or -H This HelpScreen'); + halt(1); + end; + +begin + for i:=1to paramcount do + begin + para:=ucase(paramstr(i)); + if (para[1]='-') then + begin + ch:=para[2]; + delete(para,1,2); + case ch of + 'O' : OutFile:=AddExtension(Para,OutputExt); + 'D' : DosEol:=true; + 'T' : Val(Para,TabSize,j); + 'V' : verbose:=true; + '?','H' : helpscreen; + end; + end + else + begin + if ParaFile=0 then + ParaFile:=i; + end; + end; + if (ParaFile=0) then + HelpScreen; + if OutFile='' then + OutFile:=ForceExtension('*',OutPutExt); +end; + + + +var + Dir : SearchRec; + i : word; +begin + GetPara; +{Main} + if Verbose then + begin + Writeln('fixtab v1.01 (C) 1999-2002 Peter Vreman'); + Writeln('TabSize ',TabSize); + if DosEol then + WriteLn('Using MsDos Eols'); + end; + for i:=ParaFile to ParamCount do + begin + InFile:=AddExtension(ParamStr(i),InputExt); + FindFirst(InFile,$20,Dir); + while (DosError=0) do + begin + Convert(SplitPath(InFile)+Dir.Name,OutFile); + FindNext(Dir); + end; + end; +end. diff --git a/compiler/utils/fpc.cft b/compiler/utils/fpc.cft new file mode 100644 index 0000000000..e858c909c4 --- /dev/null +++ b/compiler/utils/fpc.cft @@ -0,0 +1,204 @@ +# +# Config file generated by fpcmkcfg on %BUILDDATE% - %BUILDTIME% +# Example fpc.cfg for Free Pascal Compiler +# + +# ---------------------- +# Defines (preprocessor) +# ---------------------- + +# +# nested #IFNDEF, #IFDEF, #ENDIF, #ELSE, #DEFINE, #UNDEF are allowed +# +# -d is the same as #DEFINE +# -u is the same as #UNDEF +# + +# +# Some examples (for switches see below, and the -? helppages) +# +# Try compiling with the -dRELEASE or -dDEBUG on the commandline +# + +# For a release compile with optimizes and strip debuginfo +#IFDEF RELEASE + -OG2p3 + -Xs + #WRITE Compiling Release Version +#ENDIF + +# For a debug version compile with debuginfo and all codegeneration checks on +#IFDEF DEBUG + -g + -Crtoi + #WRITE Compiling Debug Version +#ENDIF + +# ---------------- +# Parsing switches +# ---------------- + +# Pascal language mode +# -Mfpc free pascal dialect (default) +# -Mobjfpc switch some Delphi 2 extensions on +# -Mdelphi tries to be Delphi compatible +# -Mtp tries to be TP/BP 7.0 compatible +# -Mgpc tries to be gpc compatible +# -Mmacpas tries to be compatible to the macintosh pascal dialects +# +# Turn on Object Pascal extensions by default +#-Mobjfpc + +# Assembler reader mode +# -Rdefault use default assembler +# -Ratt read AT&T style assembler +# -Rintel read Intel style assembler +# +# All assembler blocks are AT&T styled by default +#-Ratt + +# Semantic checking +# -S2 same as -Mobjfpc +# -Sc supports operators like C (*=,+=,/= and -=) +# -Sa include assertion code. +# -Sd same as -Mdelphi +# -Se<x> compiler stops after the <x> errors (default is 1) +# -Sg allow LABEL and GOTO +# -Sh Use ansistrings +# -Si support C++ styled INLINE +# -SI<x> set interface style to <x> +# -SIcomCOM compatible interface (default) +# -SIcorbaCORBA compatible interface +# -Sm support macros like C (global) +# -So same as -Mtp +# -Sp same as -Mgpc +# -Ss constructor name must be init (destructor must be done) +# -St allow static keyword in objects +# +# Allow goto, inline, C-operators, C-vars +-Sgic + +# --------------- +# Code generation +# --------------- + +# Uncomment the next line if you always want static/dynamic units by default +# (can be overruled with -CD, -CS at the commandline) +#-CS +#-CD + +# Set the default heapsize to 8Mb +#-Ch8000000 + +# Set default codegeneration checks (iocheck, overflow, range, stack) +#-Ci +#-Co +#-Cr +#-Ct + +# Optimizer switches for i386 compiler +# -Og generate smaller code +# -OG generate faster code (default) +# -Or keep certain variables in registers (still BUGGY!!!) +# -Ou enable uncertain optimizations (see docs) +# -O1 level 1 optimizations (quick optimizations) +# -O2 level 2 optimizations (-O1 + slower optimizations) +# -O3 level 3 optimizations (same as -O2u) +# -Op target processor +# -Op1 set target processor to 386/486 +# -Op2 set target processor to Pentium/PentiumMMX (tm) +# -Op3 set target processor to PPro/PII/c6x86/K6 (tm) + +# Optimize always for Size and PII +#-OG2p3 + + +# ----------------------- +# Set Filenames and Paths +# ----------------------- + +# Both slashes and backslashes are allowed in paths + +# path to the messagefile, not necessary anymore but can be used to override +# the default language +#-Fr%basepath%/msg/errore.msg +#-Fr%basepath%/msg/errorn.msg +#-Fr%basepath%/msg/errores.msg +#-Fr%basepath%/msg/errord.msg +#-Fr%basepath%/msg/errorr.msg + +# path to the gcclib +#-Fl%basepath%/lib + +# searchpath for includefiles +#-Fi/pp/inc;/pp/rtl/inc + +# searchpath for includefiles +# release them only if you know what you do +# because this could cause a rebuild of the runtime library +# if you tell them compiler/ide to build the project (FK) +#-Fi%basepath%/source/rtl/inc;%basepath%/source/rtl/i386 + +# searchpath for objectfiles +#-Fo%basepath%/source/rtl/inc;%basepath%/source/rtl/i386 + +# searchpath for units and other system dependent things +-Fu%basepath%/units/$FPCTARGET/ +-Fu%basepath%/units/$FPCTARGET/* +-Fu%basepath%/units/$FPCTARGET/rtl + +# searchpath for libraries +#-Fl%basepath%/lib +#-Fl/lib;/usr/lib + +# searchpath for tools +-FD%basepath%/bin/$FPCTARGET + + +# ------------- +# Linking +# ------------- + +# generate always debugging information for GDB (slows down the compiling +# process) +# -gc generate checks for pointers +# -gd use dbx +# -gg use gsym +# -gh use heap trace unit (for memory leak debugging) +# -gl use line info unit to show more info for backtraces +# -gv generates programs tracable with valgrind +# -gw generate dwarf debugging info +# +# Enable debuginfo and use the line info unit by default +#-gl + +# always pass an option to the linker +#-k-s + +# Always strip debuginfo from the executable +-Xs + + +# ------------- +# Miscellaneous +# ------------- + +# Write always a nice FPC logo ;) +-l + +# Verbosity +# e : Show errors (default) d : Show debug info +# w : Show warnings u : Show unit info +# n : Show notes t : Show tried/used files +# h : Show hints m : Show defined macros +# i : Show general info p : Show compiled procedures +# l : Show linenumbers c : Show conditionals +# a : Show everything 0 : Show nothing (except errors) +# b : Show all procedure r : Rhide/GCC compatibility mode +# declarations if an error x : Executable info (Win32 only) +# occurs +# +# Display Info, Warnings, Notes and Hints +-viwn +# If you don't want so much verbosity use +#-vw diff --git a/compiler/utils/fpc.mpw b/compiler/utils/fpc.mpw new file mode 100644 index 0000000000..8ae99a7ee6 --- /dev/null +++ b/compiler/utils/fpc.mpw @@ -0,0 +1,2 @@ +# MPW script which mimics the fpc wrapper application +ppcppc {Parameters} diff --git a/compiler/utils/fpc.pp b/compiler/utils/fpc.pp new file mode 100644 index 0000000000..01511f7419 --- /dev/null +++ b/compiler/utils/fpc.pp @@ -0,0 +1,205 @@ +{ + Copyright (c) 2000-2002 by Florian Klaempfl + + This file is the "loader" for the Free Pascal compiler + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + ****************************************************************************} +program fpc; + +{$mode objfpc}{$H+} + + uses + Sysutils; + + const +{$ifdef UNIX} + exeext=''; +{$else UNIX} + {$ifdef AMIGA} + exeext=''; + {$else} + {$ifdef MORPHOS} + exeext=''; + {$else} + {$ifdef NETWARE} + exeext='.nlm'; + {$else} + exeext='.exe'; + {$endif NETWARE} + {$endif MORPHOS} + {$endif AMIGA} +{$endif UNIX} + + + procedure error(const s : string); + begin + writeln('Error: ',s); + halt(1); + end; + + + function SplitPath(Const HStr:String):String; + var + i : longint; + begin + i:=Length(Hstr); + while (i>0) and not(Hstr[i] in ['\','/']) do + dec(i); + SplitPath:=Copy(Hstr,1,i); + end; + + + function FileExists ( Const F : String) : Boolean; + var + Info : TSearchRec; + begin + FileExists:= findfirst(F,fareadonly+faarchive+fahidden,info)=0; + findclose(Info); + end; + + procedure findexe(var ppcbin:string); + var + path : string; + begin + { add .exe extension } + ppcbin:=ppcbin+exeext; + + { get path of fpc.exe } + path:=splitpath(paramstr(0)); + if FileExists(path+ppcbin) then + ppcbin:=path+ppcbin + else + begin + path:=FileSearch(ppcbin,getenvironmentvariable('PATH')); + if path<>'' then + ppcbin:=path; + + end; + end; + + var + s : ansistring; + processorname, + ppcbin, + versionStr, + processorstr : string; + ppccommandline : ansistring; + i : longint; + errorvalue : Longint; + begin + ppccommandline:=''; +{$ifdef i386} + ppcbin:='ppc386'; + processorname:='i386'; +{$endif i386} +{$ifdef m68k} + ppcbin:='ppc68k'; + processorname:='m68k'; +{$endif m68k} +{$ifdef alpha} + ppcbin:='ppcapx'; + processorname:='alpha'; +{$endif alpha} +{$ifdef powerpc} + ppcbin:='ppcppc'; + processorname:='powerpc'; +{$endif powerpc} +{$ifdef arm} + ppcbin:='ppcarm'; + processorname:='arm'; +{$endif arm} +{$ifdef sparc} + ppcbin:='ppcsparc'; + processorname:='sparc'; +{$endif sparc} +{$ifdef x86_64} + ppcbin:='ppcx64'; + processorname:='x86_64'; +{$endif x86_64} +{$ifdef ia64} + ppcbin:='ppcia64'; + processorname:='ia64'; +{$endif ia64} + versionstr:=''; { Default is just the name } + for i:=1 to paramcount do + begin + s:=paramstr(i); + if pos('-V',s)=1 then + versionstr:=copy(s,3,length(s)-2) + else + begin + if pos('-P',s)=1 then + begin + processorstr:=copy(s,3,length(s)-2); + { -PB is a special code that will show the + default compiler and exit immediatly. It's + main usage is for Makefile } + if processorstr='B' then + begin + { report the full name of the ppcbin } + findexe(ppcbin); + writeln(ppcbin); + halt(0); + end + { -PP is a special code that will show the + processor and exit immediatly. It's + main usage is for Makefile } + else if processorstr='P' then + begin + { report the processor } + writeln(processorname); + halt(0); + end + else if processorstr='i386' then + ppcbin:='ppc386' + else if processorstr='m68k' then + ppcbin:='ppc68k' + else if processorstr='alpha' then + ppcbin:='ppcapx' + else if processorstr='powerpc' then + ppcbin:='ppcppc' + else if processorstr='arm' then + ppcbin:='ppcarm' + else if processorstr='sparc' then + ppcbin:='ppcsparc' + else if processorstr='ia64' then + ppcbin:='ppcia64' + else if processorstr='x86_64' then + ppcbin:='ppcx64' + else error('Illegal processor type "'+processorstr+'"'); + end + else + ppccommandline:=ppccommandline+s+' '; + end; + end; + + if versionstr<>'' then + ppcbin:=ppcbin+'-'+versionstr; + { find the full path to the specified exe } + findexe(ppcbin); + + { call ppcXXX } + try + errorvalue:=ExecuteProcess(ppcbin,ppccommandline); + except + on e : exception do + error(ppcbin+' can''t be executed, error message: '+e.message); + end; + if errorvalue<>0 then + error(ppcbin+' returned an error exitcode (normal if you did not specify a source file to be compiled)'); + halt(errorvalue); + end. diff --git a/compiler/utils/fpccfg.inc b/compiler/utils/fpccfg.inc new file mode 100644 index 0000000000..103f32ab70 --- /dev/null +++ b/compiler/utils/fpccfg.inc @@ -0,0 +1,224 @@ +{$ifdef Delphi} +const DefaultConfig : array[0..24] of string[240]=( +{$else Delphi} +const DefaultConfig : array[0..24,1..240] of char=( +{$endif Delphi} + '#'#013#010+ + '# Config file generated by fpcmkcfg on %BUILDDATE% - %BUILDTIME%'#013#010+ + '# Example fpc.cfg for Free Pascal Compiler'#013#010+ + '#'#013#010+ + #013#010+ + '# ----------------------'#013#010+ + '# Defines (preprocessor)'#013#010+ + '# ----------------------'#013#010+ + #013#010+ + '#'#013#010+ + '# nested #IFNDEF, #IFDEF, #ENDIF, #ELSE',', #DEFINE, #UNDEF are allowed'+ + #013#010+ + '#'#013#010+ + '# -d is the same as #DEFINE'#013#010+ + '# -u is the same as #UNDEF'#013#010+ + '#'#013#010+ + #013#010+ + '#'#013#010+ + '# Some examples (for switches see below, and the -? helppages)'#013#010+ + '#'#013#010+ + '# Try compiling with the -dRELEASE or -dDEBUG on the commandline'#013#010+ + '#'#013#010+ + #013#010+ + '# F','or a release compile with optimizes and strip debuginfo'#013#010+ + '#IFDEF RELEASE'#013#010+ + ' -OG2p3'#013#010+ + ' -Xs'#013#010+ + ' #WRITE Compiling Release Version'#013#010+ + '#ENDIF'#013#010+ + #013#010+ + '# For a debug version compile with debuginfo and all codegeneration ch'+ + 'ecks on'#013#010+ + '#IFDEF DEBUG'#013#010+ + ' -g'#013#010+ + ' -Cr','toi'#013#010+ + ' #WRITE Compiling Debug Version'#013#010+ + '#ENDIF'#013#010+ + #013#010+ + '# ----------------'#013#010+ + '# Parsing switches'#013#010+ + '# ----------------'#013#010+ + #013#010+ + '# Pascal language mode'#013#010+ + '# -Mfpc free pascal dialect (default)'#013#010+ + '# -Mobjfpc switch some Delphi 2 extensions on'#013#010+ + '# ',' -Mdelphi tries to be Delphi compatible'#013#010+ + '# -Mtp tries to be TP/BP 7.0 compatible'#013#010+ + '# -Mgpc tries to be gpc compatible'#013#010+ + '# -Mmacpas tries to be compatible to the macintosh pascal diale'+ + 'cts'#013#010+ + '#'#013#010+ + '# Turn on Object ','Pascal extensions by default'#013#010+ + '#-Mobjfpc'#013#010+ + #013#010+ + '# Assembler reader mode'#013#010+ + '# -Rdefault use default assembler'#013#010+ + '# -Ratt read AT&T style assembler'#013#010+ + '# -Rintel read Intel style assembler'#013#010+ + '#'#013#010+ + '# All assembler blocks are AT&T style','d by default'#013#010+ + '#-Ratt'#013#010+ + #013#010+ + '# Semantic checking'#013#010+ + '# -S2 same as -Mobjfpc'#013#010+ + '# -Sc supports operators like C (*=,+=,/= and -=)'#013#010+ + '# -Sa include assertion code.'#013#010+ + '# -Sd same as -Mdelphi'#013#010+ + '# -Se<x> ',' compiler stops after the <x> errors (default is 1)'+ + #013#010+ + '# -Sg allow LABEL and GOTO'#013#010+ + '# -Sh Use ansistrings'#013#010+ + '# -Si support C++ styled INLINE'#013#010+ + '# -SI<x> set interface style to <x>'#013#010+ + '# -SIcomCOM c','ompatible interface (default)'#013#010+ + '# -SIcorbaCORBA compatible interface'#013#010+ + '# -Sm support macros like C (global)'#013#010+ + '# -So same as -Mtp'#013#010+ + '# -Sp same as -Mgpc'#013#010+ + '# -Ss constructor name must be init ','(destructor must be '+ + 'done)'#013#010+ + '# -St allow static keyword in objects'#013#010+ + '#'#013#010+ + '# Allow goto, inline, C-operators, C-vars'#013#010+ + '-Sgic'#013#010+ + #013#010+ + '# ---------------'#013#010+ + '# Code generation'#013#010+ + '# ---------------'#013#010+ + #013#010+ + '# Uncomment the next line if you always want sta','tic/dynamic units by'+ + ' default'#013#010+ + '# (can be overruled with -CD, -CS at the commandline)'#013#010+ + '#-CS'#013#010+ + '#-CD'#013#010+ + #013#010+ + '# Set the default heapsize to 8Mb'#013#010+ + '#-Ch8000000'#013#010+ + #013#010+ + '# Set default codegeneration checks (iocheck, overflow, range, stack)'#013+ + #010+ + '#-Ci'#013#010+ + '#-Co'#013#010+ + '#-Cr'#013#010+ + '#-','Ct'#013#010+ + #013#010+ + '# Optimizer switches for i386 compiler'#013#010+ + '# -Og generate smaller code'#013#010+ + '# -OG generate faster code (default)'#013#010+ + '# -Or keep certain variables in registers (still BUGGY!!!)'#013#010+ + '# -Ou enable uncertain optimizations (s','ee docs)'#013#010+ + '# -O1 level 1 optimizations (quick optimizations)'#013#010+ + '# -O2 level 2 optimizations (-O1 + slower optimizations)'#013#010+ + '# -O3 level 3 optimizations (same as -O2u)'#013#010+ + '# -Op target processor'#013#010+ + '# -Op1 set target pr','ocessor to 386/486'#013#010+ + '# -Op2 set target processor to Pentium/PentiumMMX (tm)'#013#010+ + '# -Op3 set target processor to PPro/PII/c6x86/K6 (tm)'#013#010+ + #013#010+ + '# Optimize always for Size and PII'#013#010+ + '#-OG2p3'#013#010+ + #013#010+ + #013#010+ + '# -----------------------'#013#010+ + '# Set Filenames and P','aths'#013#010+ + '# -----------------------'#013#010+ + #013#010+ + '# Both slashes and backslashes are allowed in paths'#013#010+ + #013#010+ + '# path to the messagefile, not necessary anymore but can be used to ov'+ + 'erride'#013#010+ + '# the default language'#013#010+ + '#-Fr%basepath%/msg/errore.msg'#013#010+ + '#-Fr%basepath%/ms','g/errorn.msg'#013#010+ + '#-Fr%basepath%/msg/errores.msg'#013#010+ + '#-Fr%basepath%/msg/errord.msg'#013#010+ + '#-Fr%basepath%/msg/errorr.msg'#013#010+ + #013#010+ + '# path to the gcclib'#013#010+ + '#-Fl%basepath%/lib'#013#010+ + #013#010+ + '# searchpath for includefiles'#013#010+ + '#-Fi/pp/inc;/pp/rtl/inc'#013#010+ + #013#010+ + '# searchpath for includefile','s'#013#010+ + '# release them only if you know what you do'#013#010+ + '# because this could cause a rebuild of the runtime library'#013#010+ + '# if you tell them compiler/ide to build the project (FK)'#013#010+ + '#-Fi%basepath%/source/rtl/inc;%basepath%/source/rtl/i386'#013#010+ + #013#010+ + '# searchpath',' for objectfiles'#013#010+ + '#-Fo%basepath%/source/rtl/inc;%basepath%/source/rtl/i386'#013#010+ + #013#010+ + '# searchpath for units and other system dependent things'#013#010+ + '-Fu%basepath%/units/$FPCTARGET/'#013#010+ + '-Fu%basepath%/units/$FPCTARGET/*'#013#010+ + '-Fu%basepath%/units/$FPCTARGET/rtl'#013#010+ + #013,#010+ + '# searchpath for libraries'#013#010+ + '#-Fl%basepath%/lib'#013#010+ + '#-Fl/lib;/usr/lib'#013#010+ + #013#010+ + '# searchpath for tools'#013#010+ + '-FD%basepath%/bin/$FPCTARGET'#013#010+ + #013#010+ + #013#010+ + '# -------------'#013#010+ + '# Linking'#013#010+ + '# -------------'#013#010+ + #013#010+ + '# generate always debugging information for GDB (slows down the c','omp'+ + 'iling'#013#010+ + '# process)'#013#010+ + '# -gc generate checks for pointers'#013#010+ + '# -gd use dbx'#013#010+ + '# -gg use gsym'#013#010+ + '# -gh use heap trace unit (for memory leak debugging)'#013#010+ + '# -gl use line info unit to show mor','e info for backtrace'+ + 's'#013#010+ + '# -gv generates programs tracable with valgrind'#013#010+ + '# -gw generate dwarf debugging info'#013#010+ + '#'#013#010+ + '# Enable debuginfo and use the line info unit by default'#013#010+ + '#-gl'#013#010+ + #013#010+ + '# always pass an option to the linker'#013,#010+ + '#-k-s'#013#010+ + #013#010+ + '# Always strip debuginfo from the executable'#013#010+ + '-Xs'#013#010+ + #013#010+ + #013#010+ + '# -------------'#013#010+ + '# Miscellaneous'#013#010+ + '# -------------'#013#010+ + #013#010+ + '# Write always a nice FPC logo ;)'#013#010+ + '-l'#013#010+ + #013#010+ + '# Verbosity'#013#010+ + '# e : Show errors (default) d : Show debug info'#013#010+ + '# w',' : Show warnings u : Show unit info'#013#010+ + '# n : Show notes t : Show tried/used files'#013#010+ + '# h : Show hints m : Show defined macros'#013#010+ + '# i : Show general info p : Show compiled pr','ocedures'#013+ + #010+ + '# l : Show linenumbers c : Show conditionals'#013#010+ + '# a : Show everything 0 : Show nothing (except errors'+ + ')'#013#010+ + '# b : Show all procedure r : Rhide/GCC compatibility mod'+ + 'e'#013#010+ + '# declaration','s if an error x : Executable info (Win32 on'+ + 'ly)'#013#010+ + '# occurs'#013#010+ + '#'#013#010+ + '# Display Info, Warnings, Notes and Hints'#013#010+ + '-viwn'#013#010+ + '# If you don'#039't want so much verbosity use'#013#010+ + '#-vw'#013#010 +); diff --git a/compiler/utils/fpcmkcfg.pp b/compiler/utils/fpcmkcfg.pp new file mode 100644 index 0000000000..802885b70d --- /dev/null +++ b/compiler/utils/fpcmkcfg.pp @@ -0,0 +1,230 @@ +{$mode objfpc} +{$H+} +{ + This file is part of Free Pascal Build tools + Copyright (c) 2005 by Michael Van Canneyt + + Create a configuration file + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} +program fpcmkcfg; + +uses usubst,SysUtils,Classes; + +{ + The fpccfg.inc file must be built from a template with the bin2obj + command. it needs options: + bin2obj -a -o fpccfg.inc -c DefaultConfig fpc.cft + where fpc.cft is the template file. +} + +{$i fpccfg.inc} + +Const + BuildVersion={$I %FPCVERSION%}; + BuildTarget={$I %FPCTARGET%}; + + +Resourcestring + SUsage00 = 'Usage: %s [options]'; + SUsage10 = 'Where options is one or more of'; + SUSage20 = ' -t filename Template file name. Default is built-in'; + SUSage30 = ' -o filename Set output file. Default is standard output.'; + SUsage40 = ' -d name=value define name=value pair.'; + SUsage50 = ' -h show this help and exit.'; + SUsage60 = ' -u name remove name from list of name/value pairs.'; + SUsage70 = ' -l filename read name/value pairs from filename'; + SUsage80 = ' -b show builtin template and exit.'; + SUsage90 = ' -v be verbose.'; + SErrUnknownOption = 'Error: Unknown option.'; + SErrArgExpected = 'Error: Option "%s" requires an argument.'; + SErrNoSuchFile = 'Error: File "%s" does not exist.'; + SErrBackupFailed = 'Error: Backup of file "%s" to "%s" failed.'; + SErrDelBackupFailed = 'Error: Delete of old backup file "%s" failed.'; + SWarnIgnoringFile = 'Warning: Ignoring non-existent file: '; + SWarnIgnoringPair = 'Warning: ignoring wrong name/value pair: '; + SStats = 'Replaced %d placeholders in %d lines.'; + SSubstInLine = 'Replaced %s placeholders in line %d.'; + + +Var + Verbose : Boolean; + SkipBackup : Boolean; + List,Cfg : TStringList; + TemplateFileName, + OutputFileName : String; + + + + +procedure Init; + +begin + Verbose:=False; + List:=TStringList.Create; + AddToList(List,'FPCVERSION',BuildVersion); + AddToList(List,'FPCTARGET',BuildTarget); + AddToList(List,'PWD',GetCurrentDir); + AddToList(List,'BUILDDATE',DateToStr(Date)); + AddToList(List,'BUILDTIME',TimeToStr(Time)); + Cfg:=TStringList.Create; + Cfg.Text:=StrPas(Addr(DefaultConfig)); +end; + +Procedure Done; + +begin + FreeAndNil(List); + FreeAndNil(Cfg); +end; + +Procedure Usage; + +begin + Writeln(Format(SUsage00,[ExtractFileName(Paramstr(0))])); + Writeln(SUsage10); + Writeln(SUsage20); + Writeln(SUsage30); + Writeln(SUsage40); + Writeln(SUsage50); + Writeln(SUsage60); + Writeln(SUsage70); + Writeln(SUsage80); + Writeln(SUsage90); + Halt(1); +end; + +Procedure UnknownOption(Const S : String); + +begin + Writeln(SErrUnknownOption,S); + Usage; +end; + +Procedure ShowBuiltIn; + +Var + I : Integer; + + +begin + For I:=0 to Cfg.Count-1 do + Writeln(Cfg[I]); +end; + + +Procedure ProcessCommandline; + +Var + I : Integer; + S : String; + + Function GetOptArg : String; + + begin + If I=ParamCount then + begin + Writeln(StdErr,Format(SErrArgExpected,[S])); + Halt(1); + end; + inc(I); + Result:=ParamStr(I); + end; + +begin + I:=1; + While( I<=ParamCount) do + begin + S:=Paramstr(i); + If Length(S)<=1 then + UnknownOption(S) + else + case S[2] of + 'v' : Verbose:=True; + 'h' : Usage; + 'b' : begin + ShowBuiltin; + halt(0); + end; + 't' : TemplateFileName:=GetOptArg; + 'd' : AddPair(List,GetOptArg); + 'u' : AddPair(List,GetOptArg+'='); + 'o' : OutputFileName:=GetoptArg; + 's' : SkipBackup:=True; + else + UnknownOption(S); + end; + Inc(I); + end; + If (TemplateFileName<>'') then + begin + If Not FileExists(TemplateFileName) then + begin + Writeln(StdErr,Format(SErrNoSuchFile,[TemplateFileName])); + Halt(1); + end; + Cfg.LoadFromFile(TemplateFileName); + AddToList(List,'TEMPLATEFILE',TemplateFileName); + end + else + AddToList(List,'TEMPLATEFILE','builtin'); +end; + + +Procedure CreateFile; + +Var + Fout : Text; + S,BFN : String; + I,RCount : INteger; + +begin + If (OutputFileName<>'') + and FileExists(OutputFileName) + and not SkipBackup then + begin + BFN:=ChangeFileExt(OutputFileName,'.bak'); + If FileExists(BFN) and not DeleteFile(BFN) then + begin + Writeln(StdErr,Format(SErrDelBackupFailed,[BFN])); + Halt(1); + end; + If not RenameFile(OutputFileName,BFN) then + begin + Writeln(StdErr,Format(SErrBackupFailed,[OutputFileName,BFN])); + Halt(1); + end; + end; + Assign(Fout,OutputFileName); + Rewrite(FOut); + Try + RCount:=0; + For I:=0 to Cfg.Count-1 do + begin + S:=Cfg[i]; + Inc(RCount,DoSubstitutions(List,S)); + Writeln(FOut,S); + end; + If Verbose then + Writeln(StdErr,Format(SStats,[RCount,Cfg.Count])); + Finally + Close(Fout); + end; +end; + +begin + Init; + Try + ProcessCommandLine; + CreateFile; + Finally + Done; + end; +end. diff --git a/compiler/utils/fpcsubst.pp b/compiler/utils/fpcsubst.pp new file mode 100644 index 0000000000..cb82a162bf --- /dev/null +++ b/compiler/utils/fpcsubst.pp @@ -0,0 +1,241 @@ +{$Mode objfpc} +{$H+} +program fpcsubst; + +uses SysUtils,Classes,Usubst; + +Const + BuildVersion={$I %FPCVERSION%}; + BuildTarget={$I %FPCTARGET%}; + +Resourcestring + SUsage00 = 'Usage: %s [options]'; + SUsage10 = 'Where options is one or more of'; + SUSage20 = ' -i filename Set input file. Default is standard input'; + SUSage30 = ' -o filename Set output file. Default is standard output.'; + SUsage40 = ' -d name=value define name=value pair.'; + SUsage50 = ' -h show this help and exit.'; + SUsage60 = ' -u name remove name from list of name/value pairs.'; + SUsage70 = ' -l filename read name/value pairs from filename'; + SUsage80 = ' -b show builtin list and exit.'; + SUsage90 = ' -v be verbose.'; + SErrUnknownOption = 'Error: Unknown option.'; + SErrArgExpected = 'Error: Option "%s" requires an argument.'; + SErrNoSuchFile = 'Error: File "%s" does not exist.'; + SErrBackupFailed = 'Error: Backup of file "%s" to "%s" failed.'; + SErrDelBackupFailed = 'Error: Delete of old backup file "%s" failed.'; + SWarnIgnoringFile = 'Warning: Ignoring non-existent file: '; + SWarnIgnoringPair = 'Warning: ignoring wrong name/value pair: '; + SStats = 'Replaced %d placeholders in %d lines.'; + SSubstInLine = 'Replaced %s placeholders in line %d.'; + + +Var + List : TStringList; + InputFileName : String; + OutputFileName : String; + Verbose : Boolean; + SkipBackup : Boolean; + + + + + +procedure Init; + +begin + Verbose:=False; + List:=TStringList.Create; + AddToList(List,'FPCVERSION',BuildVersion); + AddToList(List,'FPCTARGET',BuildTarget); + AddToList(List,'PWD',GetCurrentDir); + AddToList(List,'BUILDDATE',DateToStr(Date)); + AddToList(List,'BUILDTIME',TimeToStr(Time)); +end; + +Procedure Done; + +begin + FreeAndNil(List); +end; + +Procedure Usage; + +begin + Writeln(Format(SUsage00,[ExtractFileName(Paramstr(0))])); + Writeln(SUsage10); + Writeln(SUsage20); + Writeln(SUsage30); + Writeln(SUsage40); + Writeln(SUsage50); + Writeln(SUsage60); + Writeln(SUsage70); + Writeln(SUsage80); + Writeln(SUsage90); + Halt(1); +end; + +Procedure ShowBuiltIns; + +var + I : Integer; + +begin + for I:=0 to List.Count-1 do + Writeln(List[i]); +end; + + + + +Procedure AddFromFile(FN : String); + +Var + F : Text; + S : String; + +begin + If Not FileExists(FN) then + begin + Writeln(StdErr,SWarnIgnoringFile,FN); + Exit; + end; + Assign(F,FN); + Reset(F); + Try + While not EOF(F) do + begin + ReadLn(F,S); + If (Length(S)>0) and (not (S[1] in ['#',';'])) then + If not AddPair(List,S) then + If Verbose then + Writeln(StdErr,SWarnIgnoringPair,S) + end; + finally + Close(F); + end; +end; + +Procedure UnknownOption(Const S : String); + +begin + Writeln(SErrUnknownOption,S); + Usage; +end; + +Procedure ProcessCommandline; + +Var + I : Integer; + S : String; + + Function GetOptArg : String; + + begin + If I=ParamCount then + begin + Writeln(StdErr,Format(SErrArgExpected,[S])); + Halt(1); + end; + inc(I); + Result:=ParamStr(I); + end; + +begin + I:=1; + While( I<=ParamCount) do + begin + S:=Paramstr(i); + If (Length(S)<=1) or (S[1]<>'-') then + UnknownOption(S) + else + case S[2] of + 'v' : Verbose:=True; + 'h' : Usage; + 'b' : begin + ShowBuiltins; + halt(0); + end; + 'l' : AddFromFile(GetOptArg); + 'd' : AddPair(List,GetOptArg); + 'u' : AddPair(List,GetOptArg+'='); + 'i' : InputFileName:=GetOptArg; + 'o' : OutputFileName:=GetoptArg; + 's' : SkipBackup:=True; + else + UnknownOption(S); + end; + Inc(I); + end; +end; + + + +Procedure DoFile; + +Var + Fin,Fout : Text; + S,BFN : String; + N,LCount,RCount : Integer; + + +begin + If (InputFileName<>'') and not FileExists(InputFIleName) then + begin + Writeln(StdErr,Format(SErrNoSuchFile,[InputFileName])); + Halt(1) + end; + If (OutputFileName<>'') + and FileExists(OutputFileName) + and not SkipBackup then + begin + BFN:=ChangeFileExt(OutputFileName,'.bak'); + If FileExists(BFN) and not DeleteFile(BFN) then + begin + Writeln(StdErr,Format(SErrDelBackupFailed,[BFN])); + Halt(1); + end; + If not RenameFile(OutputFileName,BFN) then + begin + Writeln(StdErr,Format(SErrBackupFailed,[OutputFileName,BFN])); + Halt(1); + end; + end; + Assign(Fin,InputFileName); + Assign(Fout,OutputFileName); + Reset(Fin); + Try + Rewrite(FOut); + Try + LCount:=0; + RCount:=0; + While Not EOF(Fin) do + begin + Inc(LCount); + ReadLn(Fin,S); + N:=DoSubstitutions(List,S); + If Verbose and (N>0) then + Writeln(StdErr,Format(SSubstInLine,[N,LCount])); + Inc(RCount,N); + Writeln(Fout,S); + end; + If Verbose then + Writeln(StdErr,Format(SStats,[RCount,LCount])); + Finally + Close(Fout); + end; + Finally + Close(Fin); + end; + +end; + +begin + Init; + Try + ProcessCommandLine; + DoFile; + Finally + Done; + end; +end. diff --git a/compiler/utils/fpimpdef.pp b/compiler/utils/fpimpdef.pp new file mode 100644 index 0000000000..323cb3be95 --- /dev/null +++ b/compiler/utils/fpimpdef.pp @@ -0,0 +1,98 @@ +{$APPTYPE CONSOLE} +program FPimpdef; +{$DEFINE STANDALONE} +{$IFNDEF FPC} +uses + dmisc, + ImpDef; +{$ELSE} +uses + DOS, + ImpDef; +{$ENDIF} +var +binname:string; +function Ofound(const short,full:string):longint; +var + i:longint; +begin + Ofound:=-1; + for i:=1 to ParamCount do + if(paramstr(i)=short)or(paramstr(i)=full)then + begin + Ofound:=i; + exit; + end; +end; +function GetOption(const short,full:string):string; +var + i:longint; +begin + i:=Ofound(short,full); + if i>0 then + GetOption:=paramstr(succ(i)) + else + GetOption:=''; +end; +procedure help_info; +var + fn:string[255]; + jj:cardinal; +begin + fn:=paramstr(0); + for jj:=length(fn)downto 1 do + if fn[jj] in [':','\','/']then + begin + fn:=copy(fn,succ(jj),255); + break; + end; + writeln('Usage: ',fn,' [options]'); + writeln('Options:'); + writeln('-i | --input <file> - set input file;'); + writeln('-o | --output <file> - set output .def file'); + writeln('-l | --library <file> - set output static library'); + writeln('-s | --assembler <name> - use <name> for assembler (default asw)'); + writeln('-r | --archiver <name> - use <name> for archiver (default arw)'); + writeln('-h | --help - show this screen'); + halt; +end; +{$ifndef UNIX} +procedure AddExt(var s:string); + var + s1:string; + i:longint; + begin + s1:=copy(s,length(s)-3,4); + for i:=1 to length(s1)do + s1[i]:=upcase(s1[i]); + if s1<>'.EXE'then + s:=s+'.EXE'; + end; +{$endif} +var + EnvPath:string; +begin +binname:=GetOption('-i','--input'); +if(binname='')or(Ofound('-h','--help')>0)then + help_info; + as_name:=GetOption('-s','--assembler'); + if as_name='' then + as_name:='as'; + ar_name:=GetOption('-r','--archiver'); + if ar_name='' then + ar_name:='ar'; +{$ifndef UNIX} + AddExt(as_name); + AddExt(ar_name); +{$endif} + EnvPath:=GetEnv('Path'); + if EnvPath='' then + EnvPath:=GetEnv('PATH'); + as_name:=FSearch(as_name,EnvPath); + ar_name:=FSearch(ar_name,EnvPath); +if not makedef(binname,GetOption('-o','--output'),GetOption('-l','--library'))then + begin + writeln('Export names not found'); + halt(1); + end; +end. diff --git a/compiler/utils/fppkg.pp b/compiler/utils/fppkg.pp new file mode 100644 index 0000000000..eed82ff964 --- /dev/null +++ b/compiler/utils/fppkg.pp @@ -0,0 +1,963 @@ +program fppkg; + +{$mode objfpc}{$H+} + +uses + Classes, SysUtils, TypInfo + { add your units here }; + +Resourcestring + // SErrInValidArgument = 'Invalid command-line argument at position %d : %s'; + SErrNeedArgument = 'Option at position %d (%s) needs an argument'; + SErrMissingConfig = 'Missing configuration Makefile.fpc or fpmake.pp'; + SErrRunning = 'The FPC make tool encountered the following error: %s'; + SErrFailedToCompileFPCMake = 'Could not compile fpmake driver program'; + SLogGeneratingFPMake = 'Generating fpmake.pp'; + SLogCompilingFPMake = 'Compiling fpmake.pp: '; + SLogRunningFPMake = 'Running fpmake'; + +Type + + TRunMode = (rmHelp,rmCompile,rmBuild,rmInstall,rmArchive,rmClean,rmDownload); + + { TMakeTool } + + TMakeTool = Class(TObject) + Private + FConvertOnly, + FLogging : Boolean; + FCompiler : String; + FRunMode : TRunMode; + FHaveMakefile : Boolean; + FHaveFpmake : Boolean; + FFPMakeSrc : String; + FFPMakeBin : String; + Procedure Log(Msg : String); + Procedure Error(Msg : String); + Procedure Error(Fmt : String; Args : Array of const); + Function GetCompiler : String; + Public + Procedure ProcessCommandLine; + procedure CreateFPMake; + procedure CompileFPMake(Extra : Boolean); + Function RunFPMake : Integer; + Procedure Run; + end; + + EMakeToolError = Class(Exception); + + + { TMakeFileConverter } + TSectionType = (stNone,stPackage,stTarget,stclean,stinstall,stCompiler, + stDefault,stRequire,stRules,stPrerules); + + TMakeFileConverter = Class(TObject) + FSection : TSectionType; + FPackageName, + FpackageDir, + FPackageOptions, + FPackageDeps, + FBuilDUnit, + FSubName, + FPackageVersion : String; + // Reading; + procedure DoPackageLine(Const S : String); + Procedure DoTargetLine(Line : String; Var T,R,D : TStrings); + Procedure DoInstallLine(Line : String; Var IFL : TStrings); + procedure DoCleanLine(Line : String; Var CFL : TStrings); + procedure DoRequireLine(Line : String); + procedure DoCompilerLine(Line : String;Var SD : TStrings); + // Writing; + procedure WriteOSCPUCheck(Src: TStrings;OS,CPU : String); + procedure StartPackage(Src : TStrings; Dir,OS : String); + procedure EndPackage(Src : TStrings; Dir,OS : String); + procedure DoTargets(Src,T,R,SD : TStrings; Dir,Prefix : String); + procedure DoCleans(Src,CFL : TStrings); + procedure DoInstalls(Src,IFL : TStrings); + Procedure StartInstaller(Src : TStrings); + Procedure EndInstaller(Src : TStrings); + Function GetLine (L : TStrings; Var I : Integer) : String; + Public + procedure ConvertFile(const AFileName: String; Src: TStrings; Dir,OS : String); + Procedure ConvertFile(Const Source,Dest: String); + end; + +{ Auxiliary functions } + +Function GetWord(var S : String; Sep : Char) : String; + +Var + L : Integer; + +begin + L:=Pos(Sep,S); + If (L=0) then + L:=Length(S)+1; + Result:=Copy(S,1,L-1); + Delete(S,1,L); + S:=Trim(S); +end; + +Function GetWord(var S : String) : String; + +begin + Result:=GetWord(S,' '); +end; + + +Function IsCPU (S: String) : Boolean; + +begin + Result:=Pos(lowercase(S)+',','i386,powerpc,arm,alpha,sparc,')<>0 +end; + +Function GetOSCPU(L : String; var OS,CPU : String) : String; + + Procedure Add(Var A : String; ad : String); + + begin + If (A<>'') then + A:=A+','; + A:=A+ad; + end; + + +Var + S : String; + +begin + OS:=''; + CPU:=''; + S:=GetWord(L,','); + While (S<>'') do + begin + If (S<>'all') then + If IsCPU(S) then + Add(CPU,S) + else + Add(OS,S); + S:=GetWord(L,','); + end; +end; + + +{ TMakeFileConverter } + +procedure TMakeFileConverter.StartInstaller(Src: TStrings); + +begin + With Src do + begin + Add('{$mode objfpc}{$H+}'); + Add('program fpmake;'); + + Add(''); + Add(' { Generated automatically by '+ExtractFileName(Paramstr(0))+' on '+DateToStr(Sysutils.Date)+' }'); + Add(''); + Add('uses fpmkunit;'); + Add(''); + Add('Var'); + Add(' T : TTarget;'); + Add(''); + Add('begin'); + Add(' With Installer do '); + Add(' begin'); + end; +end; + +procedure TMakeFileConverter.EndInstaller(Src: TStrings); +begin + With Src do + begin + Add(' Run;'); + Add(' end;'); + Add('end.'); + Add(''); + end; +end; + +Function TMakeFileConverter.GetLine (L : TStrings; Var I : Integer) : String; + +Var + P : Integer; + OK : Boolean; + +begin + OK:=False; + Result:=''; + Repeat + Result:=Result+L[i]; + P:=Pos('#',Result); + If (P>0) then + Result:=Copy(Result,1,P-1); + Result:=Trim(Result); + P:=Length(Result); + If (P>0) and (Result[P]='\') then + Result:=Copy(Result,1,P-1) + else + OK:=(Result<>''); + if Not OK then + Inc(I); + Until OK or (I>L.Count-1); +end; + +Function SplitNamevalue(Const S : String; Var AName,AValue : String) : boolean; + +var + L : Integer; + +begin + L:=Pos('=',S); + Result:=(L<>0); + If Result then + begin + AName:=LowerCase(trim(Copy(S,1,L-1))); + AValue:=S; + Delete(AValue,1,L); + AValue:=Trim(Avalue); + end + else + begin + AName:=''; + AValue:=''; + end; +end; + + +procedure TMakeFileConverter.StartPackage(Src : TStrings; Dir,OS : String); + +Var + S : String; + +begin + With Src do + begin + Add(' { '); + Add(' '+FPackageName); + Add(' } '); + Add(' StartPackage('''+FPackageName+''');'); + If (Dir<>'') then + Add(' Directory:='''+ExcludeTrailingPathDelimiter(Dir)+''';'); + If (OS<>'') and (OS<>'all') then + Add(' OS:=['+OS+'];'); + If (FPackageVersion<>'') then + Add(' Version:='''+FPackageVersion+''';'); + If (FPackageOptions<>'') then + Add(' Options:='''+FPackageOptions+''';'); + If (FPackageDeps<>'') then + begin + S:=GetWord(FPackageDeps); + While S<>'' do + begin + Add(' Dependencies.Add('''+S+''');'); + S:=GetWord(FPackageDeps); + end; + end; + end; +end; + +procedure TMakeFileConverter.EndPackage(Src : TStrings; Dir,OS : String); + +begin + Src.add(' EndPackage;'); + FPackageName:=''; + FPackageVersion:=''; + FPackageOptions:=''; + FBuilDUnit:=''; + FPackageDeps:=''; +end; + + +procedure TMakeFileConverter.DoPackageLine(Const S : String); + +Var V,N : String; + +begin + SplitNameValue(S,N,V); + If (N='name') then + FPackageName:=V + else If (N='version') then + FPackageVersion:=V + else If (N='main') then + begin + FPackageName:='sub'; + FSubName:=V; + end + else + Writeln(StdErr,'Unknown name/value pair in package section :',N); +end; + + +{ + Convert various entries of type + XXYY_OSN=words + to entries of type + prefix_word=OS1,OS2,OS3 + OS is never empty, 'all' is default. + } +Procedure AddStrings(Var L : TStrings; Values,Prefix,OS : String) ; + +Var + S,O : String; + i : integer; + +begin + If (L=Nil) then + L:=TstringList.Create; + If prefix<>'' then + prefix:=prefix+'_'; + S:=GetWord(Values); + While (S<>'') do + begin + S:=Prefix+S; + I:=L.IndexOfName(S); + If (I<>-1) then + begin + O:=L.Values[S]; + If (O='all') then + O:=''; + If (O<>'') then + O:=O+','; + O:=O+OS; + L.Values[S]:=O; + end + else + L.Add(S+'='+OS); + S:=GetWord(Values); + end; +end; + + +procedure TMakeFileConverter.DoTargetLine(Line : String; Var T,R,D : TStrings); + +Var + V,N,OS : String; + P : Integer; + +begin + SplitNameValue(Line,N,V); + P:=Pos('_',N); + If (P=0) then + OS:='all' + else + begin + OS:=N; + Delete(OS,1,P); + N:=Copy(N,1,P-1); + end; + If (N='dirs') then + AddStrings(D,V,'',OS) + else If (N='units') then + AddStrings(T,V,'unit',OS) + else If (N='implicitunits') then + AddStrings(T,V,'unit',OS) + else If (N='programs') then + AddStrings(T,V,'program',OS) + else If (N='examples') then + AddStrings(T,V,'exampleunit',OS) + else If (N='rsts') then + AddStrings(R,V,'',OS) + else + Writeln(StdErr,'Unknown name/value pair in target section : ',Line); +end; + +procedure TMakeFileConverter.DoInstallLine(Line : String; Var IFL : TStrings); + +Var + S,V,N,OS : String; + P : Integer; + +begin + SplitNameValue(Line,N,V); + P:=Pos('_',N); + If (P=0) then + OS:='all' + else + begin + OS:=N; + Delete(OS,1,P); + N:=Copy(N,1,P-1); + end; + If (N='fpcpackage') then + P:=0 // temporary, needs fixing. + else If (N='buildunit') then + FBuildUnit:=V // temporary, needs fixing. + else If (N='units') then + begin + S:=GetWord(V); + While (S<>'') do + begin + AddStrings(IFL,S+'.o','',OS); + AddStrings(IFL,S+'.ppu','',OS); + S:=GetWord(V); + end; + end + else + Writeln(StdErr,'Unknown name/value pair in install section : ',N); +end; + +procedure TMakeFileConverter.DoCleanLine(Line : String; Var CFL : TStrings); + +Var + V,N,S,OS : String; + P : Integer; + +begin + SplitNameValue(Line,N,V); + P:=Pos('_',N); + If (P=0) then + OS:='all' + else + begin + OS:=N; + Delete(OS,1,P); + N:=Copy(N,1,P-1); + end; + If (N='fpcpackage') then + P:=0 // temporary, needs fixing. + else If (N='units') then + begin + S:=GetWord(V); + While (S<>'') do + begin + AddStrings(CFL,S+'.o','',OS); + AddStrings(CFL,S+'.ppu','',OS); + S:=GetWord(V); + end; + end + else + Writeln(StdErr,'Unknown name/value pair in clean section : ',N); +end; + +procedure TMakeFileConverter.DoRequireLine(Line : String); + +Var + V,N,OS : String; + P : Integer; + +begin + SplitNameValue(Line,N,V); + P:=Pos('_',N); + If (P=0) then + OS:='all' + else + begin + OS:=N; + Delete(OS,1,P); + N:=Copy(N,1,P-1); + end; + if (N='packages') then + FPackageDeps:=V + else If (N='libc') and (Upcase(V)='Y') then + P:=0 // Set options ? + else + Writeln(StdErr,'Unknown name/value pair in require section : ',N); +end; + + +procedure TMakeFileConverter.DoCompilerLine(Line : String;Var SD : TStrings); + +Var + V,N,OS : String; + P : Integer; + +begin + SplitNameValue(Line,N,V); + P:=Pos('_',N); + If (P=0) then + OS:='all' + else + begin + OS:=N; + Delete(OS,1,P); + N:=Copy(N,1,P-1); + end; + If (N='includedir') then + FPackageOptions:=Trim(FPackageOptions+' -Fi'+V) + else If (N='options') then + FPackageOptions:=Trim(FPackageOptions+' '+V) + else If (N='targetdir') then + P:=0 // Ignore + else if (N='sourcedir') or (N='unitdir') then + begin + If (SD=Nil) then + SD:=TStringList.Create; + SD.Add(OS+'='+V); + end + else + Writeln(StdErr,'Unknown name/value pair in compiler section : ',N); +end; + +Function SearchInDirs(Prefix,AName, Dirs : String) : string; + +Var + D,S : String; + +begin + S:=GetWord(Dirs); + Result:=''; + While (Result='') and (S<>'') do + begin + D:=Prefix+S+PathDelim; + If FileExists(D+AName+'.pp') or FileExists(D+AName+'.pas') then + Result:=S; + S:=GetWord(Dirs); + end; +end; + +procedure TMakeFileConverter.DoTargets(Src,T,R,SD : TStrings; Dir,Prefix : String); + +Var + I,J,P : Integer; + Pre,N,V,D,DOS,OS,CPU : String; + Res : Boolean; + +begin + If (Dir<>'') then + Dir:=IncludeTrailingPathDelimiter(Dir); + If (Prefix<>'') then + Prefix:=IncludeTrailingPathDelimiter(Prefix); + Dir:=Prefix+Dir; + Res:=False; + If Assigned(T) then + For I:=0 to T.Count-1 do + begin + T.GetNamevalue(I,N,V); + P:=Pos('_',N); + If (P<>0) then + begin + Pre:=Copy(N,1,P-1); + Delete(N,1,P); + end; + If Assigned(R) then + Res:=R.IndexOfName(N)<>-1; + GetOSCPU(V,OS,CPU); + Pre[1]:=Upcase(Pre[1]); + Src.Add(' T:=Targets.Add'+Pre+'('''+Prefix+N+''');'); + If (CPU<>'') then + Src.Add(' T.CPU:=['+CPU+'];'); + If (OS<>'') then + Src.Add(' T.OS:=['+OS+'];'); + If res then + Src.add(' T.ResourceStrings:=True;'); + If (CompareText(FBuildUnit,N)=0) then + Src.add(' T.Install:=False;'); + if Assigned(SD) then + for J:=0 to SD.Count-1 do + begin + SD.GetNameValue(J,DOS,D); + If (DOS<>'all') then + Src.Add(' if (Defaults.OS='+DOS+') then'); + Src.add(' T.Directory:='''+SearchInDirs(Dir,N,D)+''';'); + end; + end; +end; + +procedure TMakeFileConverter.WriteOSCPUCheck(Src: TStrings;OS,CPU : String); + +Var + S : String; + +begin + If (CPU<>'') then + S:='(Defaults.CPU='+CPU+')'; + If (OS<>'') then + begin + IF (S<>'') then + S:=S+' OR '; + S:=S+'(Defaults.OS='+CPU+')'; + end; + If (S<>'') then + Src.Add(' If '+S+' then'); +end; + +procedure TMakeFileConverter.DoInstalls(Src,IFL : TStrings); + +Var + I,J,P : Integer; + Pre,N,V,D,DOS,OS,CPU : String; + +begin + If Assigned(IFL) then + For I:=0 to IFL.Count-1 do + begin + IFL.GetNamevalue(I,N,V); + GetOSCPU(V,OS,CPU); + WriteOSCPUCheck(Src,OS,CPU); + Src.add(' InstallFiles.Add('''+N+''');'); + end; +end; + +procedure TMakeFileConverter.DoCleans(Src,CFL : TStrings); + +Var + I,J,P : Integer; + N,V,DOS,OS,CPU : String; + + +begin + If Assigned(CFL) then + For I:=0 to CFL.Count-1 do + begin + CFL.GetNamevalue(I,N,V); + GetOSCPU(V,OS,CPU); + WriteOSCPUCheck(Src,OS,CPU); + Src.add(' CleanFiles.Add('''+N+''');'); + end; +end; + + + +procedure TMakeFileConverter.ConvertFile(const AFileName: String; Src: TStrings; Dir,OS : String); + + Function IsSection(var S : String) : Boolean; + + Var + L : Integer; + + begin + L:=Length(S); + Result:=(L>0) and (S[1]='[') and (S[L]=']'); + If Result then + S:=trim(Copy(S,2,L-2)); + end; + +Var + R,L,T,D,S,SD,IFL,CFL : TStrings; + I,J : Integer; + Prefix,Line,DN : String; + B : Boolean; + +begin + Writeln('Converting '+AFileName); + T:=Nil; + D:=Nil; + S:=Nil; + SD:=Nil; + R:=Nil; + IFL:=Nil; + CFL:=Nil; + FPackageOptions:=''; + FPackageDir:=''; + L:=TStringList.Create; + try + L.LoadFromFile(AFileName); + I:=0; + While (I<L.Count) do + begin + Line:=GetLine(L,I); + If IsSection(Line) then + begin + J:=GetEnumValue(TypeInfo(TSectionType),'st'+Line); + If (J=-1) then + begin + FSection:=stNone; + Writeln(stdErr,'Unsupported section: ',Line); + end + else + FSection:=TSectiontype(J); + end + else + case FSection of + stPackage : DoPackageLine(Line); + stTarget : DoTargetLine(Line,T,R,D); + stInstall : DoInstallLine(Line,IFL); + stClean : DoCleanLine(Line,CFL); + stCompiler : DoCompilerLine(Line,SD); + strequire : DoRequireLine(Line); + end; + inc(I); + end; + // If there are only 'dir' entries, then there is no package name. + B:=False; + if (FPackageName<>'') then + begin + Prefix:=''; + B:=FPackageName<>'sub'; + If B then + StartPackage(Src,Dir,OS) + else + Prefix:=Dir; + DoTargets(Src,T,R,SD,Dir,Prefix); + DoInstalls(Src,IFL); + DoCleans(Src,CFL); + end; + If Assigned(D) then + begin + If (Dir<>'') then + Dir:=IncludeTrailingPathDelimiter(Dir); + For I:=0 to D.Count-1 do + begin + D.GetNameValue(I,DN,Line); + If (Line<>'all') and (Line<>'') then + OS:=Line; + DN:=Dir+DN+PathDelim; + If FileExists(DN+'Makefile.fpc') then + ConvertFile(DN+'Makefile.fpc',Src,DN,OS); + end; + end; + If B then + EndPackage(Src,Dir,OS); + Finally + S.Free; + IFL.Free; + CFL.Free; + D.Free; + SD.Free; + T.Free; + L.Free; + end; +end; + +procedure TMakeFileConverter.ConvertFile(const Source, Dest: String); + +Var + L : TStrings; + +begin + L:=TStringList.Create; + Try + StartInstaller(L); + ConvertFile(Source,L,'',''); + EndInstaller(L); + L.SaveToFile(Dest); + Finally + L.Free; + end; +end; + +{ TMakeTool } + +procedure TMakeTool.CompileFPMake(Extra: Boolean); + +Var + O,C : String; + +begin + C:=GetCompiler; + O:=FFPmakeSrc; + If Extra then + O:='-Fafpmkext '+O; + Log(SLogCompilingFPMake+C+' '+O); + If ExecuteProcess(C,O)<>0 then + Error(SErrFailedToCompileFPCMake) +end; + +procedure TMakeTool.CreateFPMake; +begin + Log(SLogGeneratingFPMake); + With TMakeFileConverter.Create do + try + ConvertFile('Makefile.fpc','fpmake.pp'); + finally + Free; + end; +end; + + +Function TMakeTool.RunFPMake : Integer; + + Function MaybeQuote(Const S : String) : String; + + begin + If Pos(' ',S)=0 then + Result:=S + else + Result:='"'+S+'"'; + end; + + +Var + I : integer; + D,O : String; + +begin + Log(SLogRunningFPMake); + D:=IncludeTrailingPathDelimiter(GetCurrentDir); + O:=''; + For I:=1 to ParamCount do + begin + If (O<>'') then + O:=O+' '; + O:=O+MaybeQuote(ParamStr(I)); + end; + Result:=ExecuteProcess(D+FFPMakeBin,O); +end; + +procedure TMakeTool.Log(Msg: String); +begin + If FLogging then + Writeln(stdErr,Msg); +end; + +procedure TMakeTool.Error(Msg: String); +begin + Raise EMakeToolError.Create(Msg); +end; + +procedure TMakeTool.Error(Fmt: String; Args: array of const); +begin + Raise EMakeToolError.CreateFmt(Fmt,Args); +end; + +function TMakeTool.GetCompiler: String; +begin + If (FCompiler='') then + begin + {$if defined(cpui386)} + FCompiler:='ppc386'; + {$elseif defined(cpuAlpha)} + FCompiler:='ppcaxp'; + {$elseif defined(cpusparc)} + FCompiler:='ppcsparc'; + {$elseif defined(cpuarm)} + FCompiler:='ppcarm'; + {$elseif defined(cpum68k)} + FCompiler:='ppcm68k'; + {$elseif defined(cpux86_64)} + FCompiler:='ppcx64'; + {$elseif defined(cpupowerpc)} + FCompiler:='ppcppc'; + {$else} + {$Fatal Unknown architecture} + {$endif} + end; + If (ExtractFilePath(FCompiler)<>'') then + Result:=FCompiler + else + begin + Result:=FileSearch(FCompiler,GetEnvironmentVariable('PATH')); + If (Result='') then + Result:=FCompiler; + end; +end; + + +procedure TMakeTool.ProcessCommandLine; + + Function CheckOption(Index : Integer;Short,Long : String): Boolean; + + var + O : String; + + begin + O:=Paramstr(Index); + Result:=(O='-'+short) or (O='--'+long) or (copy(O,1,Length(Long)+3)=('--'+long+'=')); + end; + + Function OptionArg(Var Index : Integer) : String; + + Var + P : Integer; + + begin + if (Length(ParamStr(Index))>1) and (Paramstr(Index)[2]<>'-') then + begin + If Index<ParamCount then + begin + Inc(Index); + Result:=Paramstr(Index); + end + else + Error(SErrNeedArgument,[Index,ParamStr(Index)]); + end + else If length(ParamStr(Index))>2 then + begin + P:=Pos('=',Paramstr(Index)); + If (P=0) then + Error(SErrNeedArgument,[Index,ParamStr(Index)]) + else + begin + Result:=Paramstr(Index); + Delete(Result,1,P); + end; + end; + end; + +Var + I : Integer; + +begin + I:=0; + FLogging:=False; + FRunMode:=rmhelp; + FConvertOnly:=False; + While (I<ParamCount) do + begin + Inc(I); + if Checkoption(I,'n','convert') then + FConvertOnly:=True + else if Checkoption(I,'m','compile') then + FRunMode:=rmCompile + else if Checkoption(I,'b','build') then + FRunMode:=rmBuild + else if CheckOption(I,'i','install') then + FRunMode:=rmInstall + else if CheckOption(I,'c','clean') then + FRunMode:=rmClean + else if CheckOption(I,'a','archive') then + FRunMode:=rmarchive + else if CheckOption(I,'d','download') then + FRunMode:=rmDownload + else if CheckOption(I,'h','help') then + FRunMode:=rmhelp + // Check. + else if CheckOption(I,'r','compiler') then + FCompiler:=OptionArg(I) + else if CheckOption(I,'v','verbose') then + Flogging:=Pos('info',Lowercase(OptionArg(I)))<>0; + end; +end; + + +procedure TMakeTool.Run; + + +begin + Try + ProcessCommandLine; + If FConvertOnly then + CreateFPMake + else + begin + FHaveMakefile:=FileExists('Makefile.fpc'); + FFPMakeSrc:='fpmake.pp'; + FHaveFpmake:=FileExists(FFPMakeSrc); + If Not FHaveFPMake then + begin + FHaveFPMake:=FileExists('fpmake.pas'); + If FHaveFPMake then + FFPMakeSrc:='fpmake.pas'; + end; + if Not (FHaveFPMake or FHaveMakeFile) then + Error(SErrMissingConfig); + If (Not FHaveFPMake) or (FileAge(FFPMakeSrc)<FileAge('Makefile.fpc')) then + CreateFPMake; + {$ifndef unix} + FFPMakeBin:='fpmake.exe'; + {$else} + FFPMakeBin:='fpmake'; + {$endif} + if FileAge(FFPMakeBin)<FileAge(FFPMakeSrc) then + CompileFPMake(FRunMode in [rmArchive,rmDownload]); + Halt(RunFPMake); + end; + except + On E : Exception do + begin + Writeln(StdErr,Format(SErrRunning,[E.Message])); + Halt(1); + end; + end; +end; + + +begin + With TMakeTool.Create do + try + run; + finally + Free; + end; +end. + diff --git a/compiler/utils/gppc386.pp b/compiler/utils/gppc386.pp new file mode 100644 index 0000000000..d2d1b45384 --- /dev/null +++ b/compiler/utils/gppc386.pp @@ -0,0 +1,138 @@ +{ + Copyright (c) 2000-2002 by Pierre Muller + + This program allows to run the Makefiles + with the compiler running inside GDB + + GDB only stops if there is something special + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + ****************************************************************************} + +program fpc_with_gdb; + +{ + This program uses several files : + + -- 'gdb4fpc.ini' contains the standard breakpoints (see below) + + -- 'gdb.fpc' is an optional file that can contain any other + instruction that GDB should do before starting. + Note that if gdb.fpc is present, no "run" command is + inserted if gdb4fpc.ini is found + but it can be inserted in gdb.fpc itself +} + +uses + dos; + +const +{$ifdef Unix} + GDBExeName = 'gdbpas'; + GDBIniName = '.gdbinit'; + DefaultCompilerName = 'ppc386'; +{$else} + GDBExeName = 'gdbpas.exe'; + GDBIniName = 'gdb.ini'; + DefaultCompilerName = 'ppc386.exe'; +{$endif not linux} + + { If you add a gdb.fpc file in a given directory } + { GDB will read it; this allows you to add } + { special tests in specific directories PM } + FpcGDBIniName = 'gdb.fpc'; + GDBIniTempName = 'gdb4fpc.ini'; + +var + fpcgdbini : text; + CompilerName,Dir,Name,Ext : String; + GDBError,GDBExitCode,i : longint; + +begin + + fsplit(paramstr(0),Dir,Name,Ext); + if (length(Name)>3) and (UpCase(Name[1])='G') then + CompilerName:=Copy(Name,2,255)+Ext + else + CompilerName:=DefaultCompilerName; + + { support for info functions directly : used in makefiles } + if (paramcount=1) and (pos('-i',Paramstr(1))=1) then + begin + Exec(fsearch(CompilerName,GetEnv('PATH')),Paramstr(1)); + exit; + end; + + if fsearch(GDBIniTempName,'./')<>'' then + begin + Assign(fpcgdbini,GDBIniTempName); + erase(fpcgdbini); + end; + Assign(fpcgdbini,GdbIniTempName); + Rewrite(fpcgdbini); + + Writeln(fpcgdbini,'set language pascal'); + Writeln(fpcgdbini,'b SYSTEM_EXIT'); + Writeln(fpcgdbini,'cond 1 EXITCODE <> 0'); + Writeln(fpcgdbini,'b INTERNALERROR'); + Writeln(fpcgdbini,'b HANDLEERRORADDRFRAME'); + Writeln(fpcgdbini,'set $_exitcode := -1'); + Write(fpcgdbini,'set args'); + + { this will not work correctly if there are " or '' inside the command line :( } + for i:=1 to Paramcount do + begin + if pos(' ',Paramstr(i))>0 then + Write(fpcgdbini,' "'+ParamStr(i)+'"') + else + Write(fpcgdbini,' '+ParamStr(i)); + end; + Writeln(fpcgdbini); + if fsearch(FpcGDBIniName,'./')<>'' then + begin + Writeln(fpcgdbini,'source '+FpcGDBIniName); + end + else + Writeln(fpcgdbini,'run'); + Writeln(fpcgdbini,'if ($_exitcode = -1)'); + Writeln(fpcgdbini,' echo Program not completed'); + Writeln(fpcgdbini,'else'); + Writeln(fpcgdbini,' quit'); + Writeln(fpcgdbini,'end'); + Close(fpcgdbini); + + Exec(fsearch(GDBExeName,GetEnv('PATH')), +{$ifdef win32} + '--nw '+ +{$endif win32} + '--nx --quiet --command='+GDBIniTempName+' '+CompilerName); + GDBError:=DosError; + GDBExitCode:=DosExitCode; + if (GDBError<>0) or (GDBExitCode<>0) then + begin + Writeln('Error running GDB'); + if (GDBError<>0) then + Writeln('DosError = ',GDBError); + if (GDBExitCode<>0) then + Writeln('DosExitCode = ',GDBExitCode); + if GDBExitCode<>0 then + RunError(GDBExitCode) + else + RunError(GDBError); + end + else + Erase(fpcgdbini); +end. diff --git a/compiler/utils/mk68kreg.pp b/compiler/utils/mk68kreg.pp new file mode 100644 index 0000000000..fd7eb76aa8 --- /dev/null +++ b/compiler/utils/mk68kreg.pp @@ -0,0 +1,334 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman and Florian Klaempfl + + Convert spreg.dat to several .inc files for usage with + the Free pascal compiler + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} +program mkspreg; + +const Version = '1.00'; + max_regcount = 200; + +var s : string; + i : longint; + line : longint; + regcount:byte; + regcount_bsstart:byte; + names, + regtypes, + supregs, + numbers, + stdnames, + gasnames, + stabs : array[0..max_regcount-1] of string[63]; + regnumber_index, + std_regname_index,gas_regname_index : array[0..max_regcount-1] of byte; + +{$ifndef FPC} + procedure readln(var t:text;var s:string); + var + c : char; + i : longint; + begin + c:=#0; + i:=0; + while (not eof(t)) and (c<>#10) do + begin + read(t,c); + if c<>#10 then + begin + inc(i); + s[i]:=c; + end; + end; + if (i>0) and (s[i]=#13) then + dec(i); + s[0]:=chr(i); + end; +{$endif} + +function tostr(l : longint) : string; + +begin + str(l,tostr); +end; + +function readstr : string; + + var + result : string; + + begin + result:=''; + while (s[i]<>',') and (i<=length(s)) do + begin + result:=result+s[i]; + inc(i); + end; + readstr:=result; + end; + + +procedure readcomma; + begin + if s[i]<>',' then + begin + writeln('Missing "," at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + inc(i); + end; + + +procedure skipspace; + + begin + while (s[i] in [' ',#9]) do + inc(i); + end; + +procedure openinc(var f:text;const fn:string); +begin + writeln('creating ',fn); + assign(f,fn); + rewrite(f); + writeln(f,'{ don''t edit, this file is generated from m68kreg.dat }'); +end; + + +procedure closeinc(var f:text); +begin + writeln(f); + close(f); +end; + +procedure build_regnum_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + regnumber_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if numbers[regnumber_index[j]]>=numbers[regnumber_index[i]] then + break; + t:=regnumber_index[i]; + regnumber_index[i]:=regnumber_index[j]; + regnumber_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + +procedure build_std_regname_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + std_regname_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if stdnames[std_regname_index[j]]>=stdnames[std_regname_index[i]] then + break; + t:=std_regname_index[i]; + std_regname_index[i]:=std_regname_index[j]; + std_regname_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + +procedure build_gas_regname_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + gas_regname_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if gasnames[gas_regname_index[j]]>=gasnames[gas_regname_index[i]] then + break; + t:=gas_regname_index[i]; + gas_regname_index[i]:=gas_regname_index[j]; + gas_regname_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + +procedure read_spreg_file; + +var infile:text; + +begin + { open dat file } + assign(infile,'m68kreg.dat'); + reset(infile); + while not(eof(infile)) do + begin + { handle comment } + readln(infile,s); + inc(line); + while (s[1]=' ') do + delete(s,1,1); + if (s='') or (s[1]=';') then + continue; + + i:=1; + names[regcount]:=readstr; + readcomma; + regtypes[regcount]:=readstr; + readcomma; + supregs[regcount]:=readstr; + readcomma; + stdnames[regcount]:=readstr; + readcomma; + gasnames[regcount]:=readstr; + readcomma; + stabs[regcount]:=readstr; + { Create register number } + if supregs[regcount][1]<>'$' then + begin + writeln('Missing $ before number, at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + numbers[regcount]:=regtypes[regcount]+'0000'+copy(supregs[regcount],2,255); + if i<length(s) then + begin + writeln('Extra chars at end of line, at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + inc(regcount); + if regcount>max_regcount then + begin + writeln('Error: Too much registers, please increase maxregcount in source'); + halt(2); + end; + end; + close(infile); +end; + +procedure write_inc_files; + +var + norfile,stdfile,gasfile,supfile, + numfile,stabfile,confile, + rnifile,srifile,grifile:text; + first:boolean; + +begin + { create inc files } + openinc(confile,'r68kcon.inc'); + openinc(supfile,'r68ksup.inc'); + openinc(numfile,'r68knum.inc'); + openinc(stdfile,'r68kstd.inc'); + openinc(gasfile,'r68kgas.inc'); + openinc(stabfile,'r68ksta.inc'); + openinc(norfile,'r68knor.inc'); + openinc(rnifile,'r68krni.inc'); + openinc(srifile,'r68ksri.inc'); + openinc(grifile,'r68kgri.inc'); + first:=true; + for i:=0 to regcount-1 do + begin + if not first then + begin + writeln(numfile,','); + writeln(stdfile,','); + writeln(gasfile,','); + writeln(stabfile,','); + writeln(rnifile,','); + writeln(srifile,','); + writeln(grifile,','); + end + else + first:=false; + writeln(supfile,'RS_',names[i],' = ',supregs[i],';'); + writeln(confile,'NR_'+names[i],' = ','tregister(',numbers[i],')',';'); + write(numfile,'tregister(',numbers[i],')'); + write(stdfile,'''',stdnames[i],''''); + write(gasfile,'''',gasnames[i],''''); + write(stabfile,stabs[i]); + write(rnifile,regnumber_index[i]); + write(srifile,std_regname_index[i]); + write(grifile,gas_regname_index[i]); + end; + write(norfile,regcount); + close(confile); + close(supfile); + closeinc(numfile); + closeinc(stdfile); + closeinc(gasfile); + closeinc(stabfile); + closeinc(norfile); + closeinc(rnifile); + closeinc(srifile); + closeinc(grifile); + writeln('Done!'); + writeln(regcount,' registers procesed'); +end; + + +begin + writeln('Register Table Converter Version ',Version); + line:=0; + regcount:=0; + read_spreg_file; + regcount_bsstart:=1; + while 2*regcount_bsstart<regcount do + regcount_bsstart:=regcount_bsstart*2; + build_regnum_index; + build_std_regname_index; + build_gas_regname_index; + write_inc_files; +end. diff --git a/compiler/utils/mkarmins.pp b/compiler/utils/mkarmins.pp new file mode 100644 index 0000000000..bfce0f2e5e --- /dev/null +++ b/compiler/utils/mkarmins.pp @@ -0,0 +1,432 @@ +{ + Copyright (c) 1998-2005 by Peter Vreman and Florian Klaempfl + + Convert i386ins.dat from Nasm to a .inc file for usage with + the Free pascal compiler + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} +program mkarmins; + +const + Version = '0.9'; + +var + s : string; + i : longint; + x86_64 : boolean; + +{$ifndef FPC} + procedure readln(var t:text;var s:string); + var + c : char; + i : longint; + begin + c:=#0; + i:=0; + while (not eof(t)) and (c<>#10) do + begin + read(t,c); + if c<>#10 then + begin + inc(i); + s[i]:=c; + end; + end; + if (i>0) and (s[i]=#13) then + dec(i); + s[0]:=chr(i); + end; +{$endif} + + function lower(const s : string) : string; + { + return lowercased string of s + } + var + i : longint; + begin + for i:=1 to length(s) do + if s[i] in ['A'..'Z'] then + lower[i]:=char(byte(s[i])+32) + else + lower[i]:=s[i]; + lower[0]:=s[0]; + end; + + function Replace(var s:string;const s1,s2:string):boolean; + var + i : longint; + begin + i:=pos(s1,s); + if i>0 then + begin + Delete(s,i,length(s1)); + Insert(s2,s,i); + Replace:=true; + end + else + Replace:=false; + end; + + +function formatop(s:string):string; + const + replaces=19; + replacetab : array[1..replaces,1..2] of string[32]=( + (':',' or ot_colon'), + ('mem8','mem or ot_bits8'), + ('mem16','mem or ot_bits16'), + ('mem32','mem or ot_bits32'), + ('mem64','mem or ot_bits64'), + ('mem80','mem or ot_bits80'), + ('mem','memory'), + ('memory_offs','mem_offs'), + ('imm8','imm or ot_bits8'), + ('imm16','imm or ot_bits16'), + ('imm32','imm or ot_bits32'), + ('imm64','imm or ot_bits64'), + ('imm80','imm or ot_bits80'), + ('imm','immediate'), + ('rm8','regmem or ot_bits8'), + ('rm16','regmem or ot_bits16'), + ('rm32','regmem or ot_bits32'), + ('rm64','regmem or ot_bits64'), + ('rm80','regmem or ot_bits80') + ); + var + i : longint; + begin + for i:=1to replaces do + replace(s,replacetab[i,1],replacetab[i,2]); + formatop:=s; + end; + + +function readnumber : longint; + + var + base : longint; + result : longint; + + begin + result:=0; + if s[i]='\' then + begin + base:=8; + inc(i); + if s[i]='x' then + begin + base:=16; + inc(i); + end; + end + else + base:=10; + s[i]:=upcase(s[i]); + while s[i] in ['0'..'9','A'..'F'] do + begin + case s[i] of + '0'..'9': + result:=result*base+ord(s[i])-ord('0'); + + 'A'..'F': + result:=result*base+ord(s[i])-ord('A')+10; + end; + inc(i); + end; + readnumber:=result; + end; + +function tostr(l : longint) : string; + + var + hs : string; + + begin + str(l,hs); + tostr:=hs; + end; + +function readstr : string; + + var + result : string; + + begin + result:=''; + while (s[i] in ['0'..'9','A'..'Z','a'..'z','_']) and (i<=length(s)) do + begin + result:=result+s[i]; + inc(i); + end; + readstr:=result; + end; + +procedure skipspace; + + begin + while (s[i] in [' ',#9]) do + inc(i); + end; + +procedure openinc(var f:text;const fn:string); +begin + writeln('creating ',fn); + assign(f,fn); + rewrite(f); + writeln(f,'{ don''t edit, this file is generated from armins.dat }'); + writeln(f,'('); +end; + + +procedure closeinc(var f:text); +begin + writeln(f); + writeln(f,');'); + close(f); +end; + + +var + attsuffix, + hs : string; + j : longint; + firstopcode, + first : boolean; + maxinfolen, + code : byte; + insns : longint; + attsuffile,propfile,opfile, + nopfile,attfile, + infile,insfile : text; + { instruction fields } + skip : boolean; + last, + ops : longint; + attopcode, + opcode, + codes, + flags : string; + optypes : array[1..4] of string; +begin + writeln('Narm Instruction Table Converter Version ',Version); + insns:=0; + maxinfolen:=0; + { open dat file } + assign(infile,'../arm/armins.dat'); + { create inc files } + openinc(insfile,'armtab.inc'); + openinc(opfile,'armop.inc'); + assign(nopfile,'armnop.inc'); + openinc(attfile,'armatt.inc'); + openinc(attsuffile,'armatts.inc'); + { + openinc(intfile,'i386int.inc'); + openinc(propfile,'i386prop.inc'); + } + rewrite(nopfile); + writeln(nopfile,'{ don''t edit, this file is generated from armins.dat }'); + reset(infile); + first:=true; + opcode:=''; + firstopcode:=true; + while not(eof(infile)) do + begin + { handle comment } + readln(infile,s); + while (s[1]=' ') do + delete(s,1,1); + if (s='') or (s[1]=';') then + continue; + if (s[1]='[') then + begin + i:=pos(',',s); + j:=pos(']',s); + if i=0 then + begin + opcode:='A_'+Copy(s,2,j-2); + attopcode:=Copy(s,2,j-2); + { Conditional } + if (attopcode[length(attopcode)]='c') and + (attopcode[length(attopcode)-1]='c') then + begin + dec(byte(attopcode[0]),2); + dec(byte(opcode[0]),2); + end; + attsuffix:='attsufNONE'; + end + else + begin + opcode:='A_'+Copy(s,2,i-2); + { intel conditional } + if (opcode[length(attopcode)]='c') and + (opcode[length(attopcode)-1]='c') then + dec(byte(opcode[0]),2); + attopcode:=Copy(s,i+1,j-i-1); + { att Suffix } + case attopcode[length(attopcode)] of + 'X' : + begin + dec(attopcode[0]); + attsuffix:='attsufINT'; + end; + 'F' : + begin + dec(attopcode[0]); + attsuffix:='attsufFPU'; + end; + 'R' : + begin + dec(attopcode[0]); + attsuffix:='attsufFPUint'; + end; + else + attsuffix:='attsufNONE'; + end; + { att Conditional } + if (attopcode[length(attopcode)]='C') and + (attopcode[length(attopcode)-1]='C') then + dec(byte(attopcode[0]),2); + end; + attopcode:=Lower(attopcode); + if firstopcode then + firstopcode:=false + else + begin + writeln(opfile,','); + writeln(attfile,','); + writeln(attsuffile,','); +{ writeln(propfile,','); } + end; + write(opfile,opcode); + write(attfile,'''',attopcode,''''); + write(attsuffile,attsuffix); + { read the next line which contains the Change options } + { + repeat + readln(infile,s); + until eof(infile) or ((s<>'') and (s[1]<>';')); + write(propfile,'(Ch: ',s,')'); + } + continue; + end; + { we must have an opcode } + if opcode='' then + runerror(234); + { clear } + ops:=0; + optypes[1]:=''; + optypes[2]:=''; + optypes[3]:=''; + optypes[4]:=''; + codes:=''; + flags:=''; + skip:=false; + { ops and optypes } + i:=1; + repeat + hs:=readstr; + if (hs='void') or (hs='ignore') then + break; + inc(ops); + optypes[ops]:=optypes[ops]+'ot_'+formatop(hs); +{ if s[i]=':' then + begin + inc(i); + optypes[ops]:=optypes[ops]+' or ot_'+formatop(readstr); + end;} + while s[i]='|' do + begin + inc(i); + optypes[ops]:=optypes[ops]+' or ot_'+formatop(readstr); + end; + if s[i] in [',',':'] then + inc(i) + else + break; + until false; + for j:=1 to 4-ops do + optypes[4-j+1]:='ot_none'; + { codes } + skipspace; + j:=0; + last:=0; + if s[i] in ['\','0'..'9'] then + begin + while not(s[i] in [' ',#9]) do + begin + code:=readnumber; +(* + { for some codes we want also to change the optypes, but not + if the last byte was a 1 then this byte belongs to a direct + copy } + if last<>1 then + begin + case code of + 12,13,14 : + optypes[code-11]:=optypes[code-11]+' or ot_signed'; + end; + end; +*) + codes:=codes+'#'+tostr(code); + last:=code; + inc(j); + end; + end + else + begin + readstr; + codes:='#0'; + end; + if j>maxinfolen then + maxinfolen:=j; + { flags } + skipspace; + while not(s[i] in [' ',#9,#13,#10]) and (i<=length(s)) do + begin + hs:=readstr; + if hs<>'ND' then + begin + if flags<>'' then + flags:=flags+' or '; + flags:=flags+'if_'+lower(hs); + end; + if (s[i]=',') and (i<=length(s)) then + inc(i) + else + break; + end; + { write instruction } + if not skip then + begin + if not(first) then + writeln(insfile,',') + else + first:=false; + writeln(insfile,' ('); + writeln(insfile,' opcode : ',opcode,';'); + writeln(insfile,' ops : ',ops,';'); + writeln(insfile,' optypes : (',optypes[1],',',optypes[2],',',optypes[3],',',optypes[4],');'); + writeln(insfile,' code : ',codes,';'); + writeln(insfile,' flags : ',flags); + write(insfile,' )'); + inc(insns); + end; + end; + close(infile); + closeinc(insfile); + closeinc(attfile); + closeinc(attsuffile); + closeinc(opfile); + writeln(nopfile,insns,';'); + close(nopfile); +{ closeinc(propfile); } + writeln(insns,' nodes procesed (maxinfolen=',maxinfolen,')'); +end. diff --git a/compiler/utils/mkarmreg.pp b/compiler/utils/mkarmreg.pp new file mode 100644 index 0000000000..01b4053d6c --- /dev/null +++ b/compiler/utils/mkarmreg.pp @@ -0,0 +1,298 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman and Florian Klaempfl + + Convert spreg.dat to several .inc files for usage with + the Free pascal compiler + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} +program mkspreg; + +const Version = '1.00'; + max_regcount = 200; + +var s : string; + i : longint; + line : longint; + regcount:byte; + regcount_bsstart:byte; + names, + regtypes, + supregs, + numbers, + stdnames, + stabs,dwarf : array[0..max_regcount-1] of string[63]; + regnumber_index, + std_regname_index : array[0..max_regcount-1] of byte; + +{$ifndef FPC} + procedure readln(var t:text;var s:string); + var + c : char; + i : longint; + begin + c:=#0; + i:=0; + while (not eof(t)) and (c<>#10) do + begin + read(t,c); + if c<>#10 then + begin + inc(i); + s[i]:=c; + end; + end; + if (i>0) and (s[i]=#13) then + dec(i); + s[0]:=chr(i); + end; +{$endif} + +function tostr(l : longint) : string; + +begin + str(l,tostr); +end; + +function readstr : string; + + var + result : string; + + begin + result:=''; + while (s[i]<>',') and (i<=length(s)) do + begin + result:=result+s[i]; + inc(i); + end; + readstr:=result; + end; + + +procedure readcomma; + begin + if s[i]<>',' then + begin + writeln('Missing "," at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + inc(i); + end; + + +procedure skipspace; + + begin + while (s[i] in [' ',#9]) do + inc(i); + end; + +procedure openinc(var f:text;const fn:string); +begin + writeln('creating ',fn); + assign(f,fn); + rewrite(f); + writeln(f,'{ don''t edit, this file is generated from armreg.dat }'); +end; + + +procedure closeinc(var f:text); +begin + writeln(f); + close(f); +end; + +procedure build_regnum_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + regnumber_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if numbers[regnumber_index[j]]>=numbers[regnumber_index[i]] then + break; + t:=regnumber_index[i]; + regnumber_index[i]:=regnumber_index[j]; + regnumber_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + +procedure build_std_regname_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + std_regname_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if stdnames[std_regname_index[j]]>=stdnames[std_regname_index[i]] then + break; + t:=std_regname_index[i]; + std_regname_index[i]:=std_regname_index[j]; + std_regname_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + + +procedure read_spreg_file; + +var infile:text; + +begin + { open dat file } + assign(infile,'armreg.dat'); + reset(infile); + while not(eof(infile)) do + begin + { handle comment } + readln(infile,s); + inc(line); + while (s[1]=' ') do + delete(s,1,1); + if (s='') or (s[1]=';') then + continue; + + i:=1; + names[regcount]:=readstr; + readcomma; + regtypes[regcount]:=readstr; + readcomma; + supregs[regcount]:=readstr; + readcomma; + stdnames[regcount]:=readstr; + readcomma; + stabs[regcount]:=readstr; + readcomma; + dwarf[regcount]:=readstr; + { Create register number } + if supregs[regcount][1]<>'$' then + begin + writeln('Missing $ before number, at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + numbers[regcount]:=regtypes[regcount]+'0000'+copy(supregs[regcount],2,255); + if i<length(s) then + begin + writeln('Extra chars at end of line, at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + inc(regcount); + if regcount>max_regcount then + begin + writeln('Error: Too much registers, please increase maxregcount in source'); + halt(2); + end; + end; + close(infile); +end; + +procedure write_inc_files; + +var + norfile,stdfile,supfile, + numfile,stabfile,dwarffile,confile, + rnifile,srifile:text; + first:boolean; + +begin + { create inc files } + openinc(confile,'rarmcon.inc'); + openinc(supfile,'rarmsup.inc'); + openinc(numfile,'rarmnum.inc'); + openinc(stdfile,'rarmstd.inc'); + openinc(stabfile,'rarmsta.inc'); + openinc(dwarffile,'rarmdwa.inc'); + openinc(norfile,'rarmnor.inc'); + openinc(rnifile,'rarmrni.inc'); + openinc(srifile,'rarmsri.inc'); + first:=true; + for i:=0 to regcount-1 do + begin + if not first then + begin + writeln(numfile,','); + writeln(stdfile,','); + writeln(stabfile,','); + writeln(dwarffile,','); + writeln(rnifile,','); + writeln(srifile,','); + end + else + first:=false; + writeln(supfile,'RS_',names[i],' = ',supregs[i],';'); + writeln(confile,'NR_'+names[i],' = ','tregister(',numbers[i],')',';'); + write(numfile,'tregister(',numbers[i],')'); + write(stdfile,'''',stdnames[i],''''); + write(stabfile,stabs[i]); + write(dwarffile,dwarf[i]); + write(rnifile,regnumber_index[i]); + write(srifile,std_regname_index[i]); + end; + write(norfile,regcount); + close(confile); + close(supfile); + closeinc(numfile); + closeinc(stdfile); + closeinc(stabfile); + closeinc(dwarffile); + closeinc(norfile); + closeinc(rnifile); + closeinc(srifile); + writeln('Done!'); + writeln(regcount,' registers procesed'); +end; + + +begin + writeln('Register Table Converter Version ',Version); + line:=0; + regcount:=0; + read_spreg_file; + regcount_bsstart:=1; + while 2*regcount_bsstart<regcount do + regcount_bsstart:=regcount_bsstart*2; + build_regnum_index; + build_std_regname_index; + write_inc_files; +end. diff --git a/compiler/utils/mkmpsreg.pp b/compiler/utils/mkmpsreg.pp new file mode 100644 index 0000000000..b8130bb511 --- /dev/null +++ b/compiler/utils/mkmpsreg.pp @@ -0,0 +1,349 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman and Florian Klaempfl + + Convert mipsreg.dat to several .inc files for usage with + the Free pascal compiler + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} +program mkmipsreg; + +const Version = '1.00'; + max_regcount = 200; + +var s : string; + i : longint; + line : longint; + regcount:byte; + regcount_bsstart:byte; + names, + regtypes, + supregs, + numbers, + stdnames, + gasnames, + dwarfs, + stabs : array[0..max_regcount-1] of string[63]; + regnumber_index, + std_regname_index, + gas_regname_index, + mot_regname_index : array[0..max_regcount-1] of byte; + +{$ifndef FPC} + procedure readln(var t:text;var s:string); + var + c : char; + i : longint; + begin + c:=#0; + i:=0; + while (not eof(t)) and (c<>#10) do + begin + read(t,c); + if c<>#10 then + begin + inc(i); + s[i]:=c; + end; + end; + if (i>0) and (s[i]=#13) then + dec(i); + s[0]:=chr(i); + end; +{$endif} + +function tostr(l : longint) : string; + +begin + str(l,tostr); +end; + +function readstr : string; + + var + result : string; + + begin + result:=''; + while (s[i]<>',') and (i<=length(s)) do + begin + result:=result+s[i]; + inc(i); + end; + readstr:=result; + end; + + +procedure readcomma; + begin + if s[i]<>',' then + begin + writeln('Missing "," at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + inc(i); + end; + + +procedure skipspace; + + begin + while (s[i] in [' ',#9]) do + inc(i); + end; + +procedure openinc(var f:text;const fn:string); +begin + writeln('creating ',fn); + assign(f,fn); + rewrite(f); + writeln(f,'{ don''t edit, this file is generated from mipsreg.dat }'); +end; + + +procedure closeinc(var f:text); +begin + writeln(f); + close(f); +end; + +procedure build_regnum_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + regnumber_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if numbers[regnumber_index[j]]>=numbers[regnumber_index[i]] then + break; + t:=regnumber_index[i]; + regnumber_index[i]:=regnumber_index[j]; + regnumber_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + +procedure build_std_regname_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + std_regname_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if stdnames[std_regname_index[j]]>=stdnames[std_regname_index[i]] then + break; + t:=std_regname_index[i]; + std_regname_index[i]:=std_regname_index[j]; + std_regname_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + + +procedure build_gas_regname_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + gas_regname_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if gasnames[gas_regname_index[j]]>=gasnames[gas_regname_index[i]] then + break; + t:=gas_regname_index[i]; + gas_regname_index[i]:=gas_regname_index[j]; + gas_regname_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + + +procedure read_mipsreg_file; + +var infile:text; + +begin + { open dat file } + assign(infile,'mipsreg.dat'); + reset(infile); + while not(eof(infile)) do + begin + { handle comment } + readln(infile,s); + inc(line); + while (s[1]=' ') do + delete(s,1,1); + if (s='') or (s[1]=';') then + continue; + + i:=1; + names[regcount]:=readstr; + readcomma; + regtypes[regcount]:=readstr; + readcomma; + supregs[regcount]:=readstr; + readcomma; + stdnames[regcount]:=readstr; + readcomma; + gasnames[regcount]:=readstr; + readcomma; + stabs[regcount]:=readstr; + readcomma; + dwarfs[regcount]:=readstr; + { Create register number } + if supregs[regcount][1]<>'$' then + begin + writeln('Missing $ before number, at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + numbers[regcount]:=regtypes[regcount]+'0000'+copy(supregs[regcount],2,255); + if i<length(s) then + begin + writeln('Extra chars at end of line, at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + inc(regcount); + if regcount>max_regcount then + begin + writeln('Error: Too much registers, please increase maxregcount in source'); + halt(2); + end; + end; + close(infile); +end; + +procedure write_inc_files; + +var + norfile,stdfile,supfile, + numfile,stabfile,confile,gasfile,dwarffile, + rnifile,srifile,mrifile,grifile : text; + first:boolean; + +begin + { create inc files } + openinc(confile,'rmipscon.inc'); + openinc(supfile,'rmipssup.inc'); + openinc(numfile,'rmipsnum.inc'); + openinc(stdfile,'rmipsstd.inc'); + openinc(gasfile,'rmipsgas.inc'); + openinc(stabfile,'rmipssta.inc'); + openinc(dwarffile,'rmipsdwf.inc'); + openinc(norfile,'rmipsnor.inc'); + openinc(rnifile,'rmipsrni.inc'); + openinc(srifile,'rmipssri.inc'); + openinc(grifile,'rmipsgri.inc'); + openinc(mrifile,'rmipsmri.inc'); + first:=true; + for i:=0 to regcount-1 do + begin + if not first then + begin + writeln(numfile,','); + writeln(stdfile,','); + writeln(gasfile,','); + writeln(stabfile,','); + writeln(dwarffile,','); + writeln(rnifile,','); + writeln(srifile,','); + writeln(grifile,','); + writeln(mrifile,','); + end + else + first:=false; + writeln(supfile,'RS_',names[i],' = ',supregs[i],';'); + writeln(confile,'NR_'+names[i],' = ','tregister(',numbers[i],')',';'); + write(numfile,'tregister(',numbers[i],')'); + write(stdfile,'''',stdnames[i],''''); + write(gasfile,'''',gasnames[i],''''); + write(stabfile,stabs[i]); + write(dwarffile,dwarfs[i]); + write(rnifile,regnumber_index[i]); + write(srifile,std_regname_index[i]); + write(grifile,gas_regname_index[i]); + write(mrifile,mot_regname_index[i]); + end; + write(norfile,regcount); + close(confile); + close(supfile); + closeinc(numfile); + closeinc(stdfile); + closeinc(gasfile); + closeinc(stabfile); + closeinc(dwarffile); + closeinc(norfile); + closeinc(rnifile); + closeinc(srifile); + closeinc(grifile); + closeinc(mrifile); + writeln('Done!'); + writeln(regcount,' registers procesed'); +end; + + +begin + writeln('Register Table Converter Version ',Version); + line:=0; + regcount:=0; + read_mipsreg_file; + regcount_bsstart:=1; + while 2*regcount_bsstart<regcount do + regcount_bsstart:=regcount_bsstart*2; + build_regnum_index; + build_std_regname_index; + build_gas_regname_index; + write_inc_files; +end. diff --git a/compiler/utils/mkppcreg.pp b/compiler/utils/mkppcreg.pp new file mode 100644 index 0000000000..de4bca26d0 --- /dev/null +++ b/compiler/utils/mkppcreg.pp @@ -0,0 +1,396 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman and Florian Klaempfl + + Convert ppcreg.dat to several .inc files for usage with + the Free pascal compiler + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} +program mkppcreg; + +const Version = '1.00'; + max_regcount = 200; + +var s : string; + i : longint; + line : longint; + regcount:byte; + regcount_bsstart:byte; + names, + regtypes, + supregs, + numbers, + stdnames, + gasnames, + gssnames, + motnames, + dwarfs, + stabs : array[0..max_regcount-1] of string[63]; + regnumber_index, + std_regname_index, + gas_regname_index, + mot_regname_index : array[0..max_regcount-1] of byte; + +{$ifndef FPC} + procedure readln(var t:text;var s:string); + var + c : char; + i : longint; + begin + c:=#0; + i:=0; + while (not eof(t)) and (c<>#10) do + begin + read(t,c); + if c<>#10 then + begin + inc(i); + s[i]:=c; + end; + end; + if (i>0) and (s[i]=#13) then + dec(i); + s[0]:=chr(i); + end; +{$endif} + +function tostr(l : longint) : string; + +begin + str(l,tostr); +end; + +function readstr : string; + + var + result : string; + + begin + result:=''; + while (s[i]<>',') and (i<=length(s)) do + begin + result:=result+s[i]; + inc(i); + end; + readstr:=result; + end; + + +procedure readcomma; + begin + if s[i]<>',' then + begin + writeln('Missing "," at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + inc(i); + end; + + +procedure skipspace; + + begin + while (s[i] in [' ',#9]) do + inc(i); + end; + +procedure openinc(var f:text;const fn:string); +begin + writeln('creating ',fn); + assign(f,fn); + rewrite(f); + writeln(f,'{ don''t edit, this file is generated from ppcreg.dat }'); +end; + + +procedure closeinc(var f:text); +begin + writeln(f); + close(f); +end; + +procedure build_regnum_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + regnumber_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if numbers[regnumber_index[j]]>=numbers[regnumber_index[i]] then + break; + t:=regnumber_index[i]; + regnumber_index[i]:=regnumber_index[j]; + regnumber_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + +procedure build_std_regname_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + std_regname_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if stdnames[std_regname_index[j]]>=stdnames[std_regname_index[i]] then + break; + t:=std_regname_index[i]; + std_regname_index[i]:=std_regname_index[j]; + std_regname_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + + +procedure build_gas_regname_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + gas_regname_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if gasnames[gas_regname_index[j]]>=gasnames[gas_regname_index[i]] then + break; + t:=gas_regname_index[i]; + gas_regname_index[i]:=gas_regname_index[j]; + gas_regname_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + + +procedure build_mot_regname_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + mot_regname_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if motnames[mot_regname_index[j]]>=motnames[mot_regname_index[i]] then + break; + t:=mot_regname_index[i]; + mot_regname_index[i]:=mot_regname_index[j]; + mot_regname_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + + +procedure read_ppcreg_file; + +var infile:text; + +begin + { open dat file } + assign(infile,'ppcreg.dat'); + reset(infile); + while not(eof(infile)) do + begin + { handle comment } + readln(infile,s); + inc(line); + while (s[1]=' ') do + delete(s,1,1); + if (s='') or (s[1]=';') then + continue; + + i:=1; + names[regcount]:=readstr; + readcomma; + regtypes[regcount]:=readstr; + readcomma; + supregs[regcount]:=readstr; + readcomma; + stdnames[regcount]:=readstr; + readcomma; + gasnames[regcount]:=readstr; + readcomma; + gssnames[regcount]:=readstr; + readcomma; + motnames[regcount]:=readstr; + readcomma; + stabs[regcount]:=readstr; + readcomma; + dwarfs[regcount]:=readstr; + { Create register number } + if supregs[regcount][1]<>'$' then + begin + writeln('Missing $ before number, at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + numbers[regcount]:=regtypes[regcount]+'0000'+copy(supregs[regcount],2,255); + if i<length(s) then + begin + writeln('Extra chars at end of line, at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + inc(regcount); + if regcount>max_regcount then + begin + writeln('Error: Too much registers, please increase maxregcount in source'); + halt(2); + end; + end; + close(infile); +end; + +procedure write_inc_files; + +var + norfile,stdfile,motfile,supfile, + numfile,stabfile,confile,gasfile,gssfile,dwarffile, + rnifile,srifile,mrifile,grifile : text; + first:boolean; + +begin + { create inc files } + openinc(confile,'rppccon.inc'); + openinc(supfile,'rppcsup.inc'); + openinc(numfile,'rppcnum.inc'); + openinc(stdfile,'rppcstd.inc'); + openinc(gasfile,'rppcgas.inc'); + openinc(gssfile,'rppcgss.inc'); + openinc(motfile,'rppcmot.inc'); + openinc(stabfile,'rppcstab.inc'); + openinc(dwarffile,'rppcdwrf.inc'); + openinc(norfile,'rppcnor.inc'); + openinc(rnifile,'rppcrni.inc'); + openinc(srifile,'rppcsri.inc'); + openinc(grifile,'rppcgri.inc'); + openinc(mrifile,'rppcmri.inc'); + first:=true; + for i:=0 to regcount-1 do + begin + if not first then + begin + writeln(numfile,','); + writeln(stdfile,','); + writeln(gasfile,','); + writeln(gssfile,','); + writeln(motfile,','); + writeln(stabfile,','); + writeln(dwarffile,','); + writeln(rnifile,','); + writeln(srifile,','); + writeln(grifile,','); + writeln(mrifile,','); + end + else + first:=false; + writeln(supfile,'RS_',names[i],' = ',supregs[i],';'); + writeln(confile,'NR_'+names[i],' = ','tregister(',numbers[i],')',';'); + write(numfile,'tregister(',numbers[i],')'); + write(stdfile,'''',stdnames[i],''''); + write(gasfile,'''',gasnames[i],''''); + write(gssfile,'''',gssnames[i],''''); + write(motfile,'''',motnames[i],''''); + write(stabfile,stabs[i]); + write(dwarffile,dwarfs[i]); + write(rnifile,regnumber_index[i]); + write(srifile,std_regname_index[i]); + write(grifile,gas_regname_index[i]); + write(mrifile,mot_regname_index[i]); + end; + write(norfile,regcount); + close(confile); + close(supfile); + closeinc(numfile); + closeinc(stdfile); + closeinc(gasfile); + closeinc(gssfile); + closeinc(motfile); + closeinc(stabfile); + closeinc(dwarffile); + closeinc(norfile); + closeinc(rnifile); + closeinc(srifile); + closeinc(grifile); + closeinc(mrifile); + writeln('Done!'); + writeln(regcount,' registers procesed'); +end; + + +begin + writeln('Register Table Converter Version ',Version); + line:=0; + regcount:=0; + read_ppcreg_file; + regcount_bsstart:=1; + while 2*regcount_bsstart<regcount do + regcount_bsstart:=regcount_bsstart*2; + build_regnum_index; + build_std_regname_index; + build_gas_regname_index; + build_mot_regname_index; + write_inc_files; +end. diff --git a/compiler/utils/mkspreg.pp b/compiler/utils/mkspreg.pp new file mode 100644 index 0000000000..5208064750 --- /dev/null +++ b/compiler/utils/mkspreg.pp @@ -0,0 +1,301 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman and Florian Klaempfl + + Convert spreg.dat to several .inc files for usage with + the Free pascal compiler + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} +program mkspreg; + +const Version = '1.00'; + max_regcount = 200; + +var s : string; + i : longint; + line : longint; + regcount:byte; + regcount_bsstart:byte; + supregs, + subregs, + names, + regtypes, + numbers, + stdnames, + stabs, + dwarfs : array[0..max_regcount-1] of string[63]; + regnumber_index, + std_regname_index : array[0..max_regcount-1] of byte; + +{$ifndef FPC} + procedure readln(var t:text;var s:string); + var + c : char; + i : longint; + begin + c:=#0; + i:=0; + while (not eof(t)) and (c<>#10) do + begin + read(t,c); + if c<>#10 then + begin + inc(i); + s[i]:=c; + end; + end; + if (i>0) and (s[i]=#13) then + dec(i); + s[0]:=chr(i); + end; +{$endif} + +function tostr(l : longint) : string; + +begin + str(l,tostr); +end; + +function readstr : string; + + var + result : string; + + begin + result:=''; + while (s[i]<>',') and (i<=length(s)) do + begin + result:=result+s[i]; + inc(i); + end; + readstr:=result; + end; + + +procedure readcomma; + begin + if s[i]<>',' then + begin + writeln('Missing "," at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + inc(i); + end; + + +procedure skipspace; + + begin + while (s[i] in [' ',#9]) do + inc(i); + end; + +procedure openinc(var f:text;const fn:string); +begin + writeln('creating ',fn); + assign(f,fn); + rewrite(f); + writeln(f,'{ don''t edit, this file is generated from spreg.dat }'); +end; + + +procedure closeinc(var f:text); +begin + writeln(f); + close(f); +end; + +procedure build_regnum_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + regnumber_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if numbers[regnumber_index[j]]>=numbers[regnumber_index[i]] then + break; + t:=regnumber_index[i]; + regnumber_index[i]:=regnumber_index[j]; + regnumber_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + +procedure build_std_regname_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + std_regname_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if stdnames[std_regname_index[j]]>=stdnames[std_regname_index[i]] then + break; + t:=std_regname_index[i]; + std_regname_index[i]:=std_regname_index[j]; + std_regname_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + + +procedure read_spreg_file; +var + infile:text; +begin + { open dat file } + assign(infile,'spreg.dat'); + reset(infile); + while not(eof(infile)) do + begin + { handle comment } + readln(infile,s); + inc(line); + while (s[1]=' ') do + delete(s,1,1); + if (s='') or (s[1]=';') then + continue; + + i:=1; + names[regcount]:=readstr; + readcomma; + regtypes[regcount]:=readstr; + readcomma; + subregs[regcount]:=readstr; + readcomma; + supregs[regcount]:=readstr; + readcomma; + stdnames[regcount]:=readstr; + readcomma; + stabs[regcount]:=readstr; + readcomma; + dwarfs[regcount]:=readstr; + { Create register number } + if supregs[regcount][1]<>'$' then + begin + writeln('Missing $ before number, at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + numbers[regcount]:=regtypes[regcount]+copy(subregs[regcount],2,255)+'00'+copy(supregs[regcount],2,255); + if i<length(s) then + begin + writeln('Extra chars at end of line, at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + inc(regcount); + if regcount>max_regcount then + begin + writeln('Error: Too much registers, please increase maxregcount in source'); + halt(2); + end; + end; + close(infile); +end; + +procedure write_inc_files; + +var + norfile,stdfile,supfile, + numfile,stabfile,dwarffile,confile, + rnifile,srifile:text; + first:boolean; + +begin + { create inc files } + openinc(confile,'rspcon.inc'); + openinc(supfile,'rspsup.inc'); + openinc(numfile,'rspnum.inc'); + openinc(stdfile,'rspstd.inc'); + openinc(stabfile,'rspstab.inc'); + openinc(dwarffile,'rspdwrf.inc'); + openinc(norfile,'rspnor.inc'); + openinc(rnifile,'rsprni.inc'); + openinc(srifile,'rspsri.inc'); + first:=true; + for i:=0 to regcount-1 do + begin + if not first then + begin + writeln(numfile,','); + writeln(stdfile,','); + writeln(stabfile,','); + writeln(dwarffile,','); + writeln(rnifile,','); + writeln(srifile,','); + end + else + first:=false; + writeln(confile,'NR_',names[i],' = tregister(',numbers[i],');'); + writeln(supfile,'RS_',names[i],' = ',supregs[i],';'); + write(numfile,'NR_',names[i]); + write(stdfile,'''',stdnames[i],''''); + write(stabfile,stabs[i]); + write(dwarffile,dwarfs[i]); + write(rnifile,regnumber_index[i]); + write(srifile,std_regname_index[i]); + end; + write(norfile,regcount); + close(confile); + close(supfile); + closeinc(numfile); + closeinc(stdfile); + closeinc(stabfile); + closeinc(dwarffile); + closeinc(norfile); + closeinc(rnifile); + closeinc(srifile); + writeln('Done!'); + writeln(regcount,' registers procesed'); +end; + + +begin + writeln('Register Table Converter Version ',Version); + line:=0; + regcount:=0; + read_spreg_file; + regcount_bsstart:=1; + while 2*regcount_bsstart<regcount do + regcount_bsstart:=regcount_bsstart*2; + build_regnum_index; + build_std_regname_index; + write_inc_files; +end. diff --git a/compiler/utils/mkx86ins.pp b/compiler/utils/mkx86ins.pp new file mode 100644 index 0000000000..2601eae9d2 --- /dev/null +++ b/compiler/utils/mkx86ins.pp @@ -0,0 +1,454 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman and Florian Klaempfl + + Convert i386ins.dat from Nasm to a .inc file for usage with + the Free pascal compiler + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} +program mkx86ins; + +const + Version = '1.5.0'; + +var + s : string; + i : longint; + x86_64 : boolean; + +{$ifndef FPC} + procedure readln(var t:text;var s:string); + var + c : char; + i : longint; + begin + c:=#0; + i:=0; + while (not eof(t)) and (c<>#10) do + begin + read(t,c); + if c<>#10 then + begin + inc(i); + s[i]:=c; + end; + end; + if (i>0) and (s[i]=#13) then + dec(i); + s[0]:=chr(i); + end; +{$endif} + + function lower(const s : string) : string; + { + return lowercased string of s + } + var + i : longint; + begin + for i:=1 to length(s) do + if s[i] in ['A'..'Z'] then + lower[i]:=char(byte(s[i])+32) + else + lower[i]:=s[i]; + lower[0]:=s[0]; + end; + + function Replace(var s:string;const s1,s2:string):boolean; + var + i : longint; + begin + i:=pos(s1,s); + if i>0 then + begin + Delete(s,i,length(s1)); + Insert(s2,s,i); + Replace:=true; + end + else + Replace:=false; + end; + + +function formatop(s:string):string; + const + replaces=19; + replacetab : array[1..replaces,1..2] of string[32]=( + (':',' or ot_colon'), + ('mem8','mem or ot_bits8'), + ('mem16','mem or ot_bits16'), + ('mem32','mem or ot_bits32'), + ('mem64','mem or ot_bits64'), + ('mem80','mem or ot_bits80'), + ('mem','memory'), + ('memory_offs','mem_offs'), + ('imm8','imm or ot_bits8'), + ('imm16','imm or ot_bits16'), + ('imm32','imm or ot_bits32'), + ('imm64','imm or ot_bits64'), + ('imm80','imm or ot_bits80'), + ('imm','immediate'), + ('rm8','regmem or ot_bits8'), + ('rm16','regmem or ot_bits16'), + ('rm32','regmem or ot_bits32'), + ('rm64','regmem or ot_bits64'), + ('rm80','regmem or ot_bits80') + ); + var + i : longint; + begin + for i:=1to replaces do + replace(s,replacetab[i,1],replacetab[i,2]); + formatop:=s; + end; + + +function readnumber : longint; + + var + base : longint; + result : longint; + + begin + result:=0; + if s[i]='\' then + begin + base:=8; + inc(i); + if s[i]='x' then + begin + base:=16; + inc(i); + end; + end + else + base:=10; + s[i]:=upcase(s[i]); + while s[i] in ['0'..'9','A'..'F'] do + begin + case s[i] of + '0'..'9': + result:=result*base+ord(s[i])-ord('0'); + + 'A'..'F': + result:=result*base+ord(s[i])-ord('A')+10; + end; + inc(i); + end; + readnumber:=result; + end; + +function tostr(l : longint) : string; + + var + hs : string; + + begin + str(l,hs); + tostr:=hs; + end; + +function readstr : string; + + var + result : string; + + begin + result:=''; + while (s[i] in ['0'..'9','A'..'Z','a'..'z','_']) and (i<=length(s)) do + begin + result:=result+s[i]; + inc(i); + end; + readstr:=result; + end; + +procedure skipspace; + + begin + while (s[i] in [' ',#9]) do + inc(i); + end; + +procedure openinc(var f:text;const fn:string); +begin + writeln('creating ',fn); + assign(f,fn); + rewrite(f); + writeln(f,'{ don''t edit, this file is generated from x86ins.dat }'); + writeln(f,'('); +end; + + +procedure closeinc(var f:text); +begin + writeln(f); + writeln(f,');'); + close(f); +end; + + +var + attsuffix, + hs : string; + j : longint; + firstopcode, + first : boolean; + maxinfolen, + code : byte; + insns : longint; + attsuffile,propfile,opfile, + nopfile,attfile,intfile, + infile,insfile : text; + { instruction fields } + skip : boolean; + last, + ops : longint; + intopcode, + attopcode, + opcode, + codes, + flags : string; + optypes : array[1..3] of string; +begin + writeln('Nasm Instruction Table Converter Version ',Version); + x86_64:=paramstr(1)='x86_64'; + insns:=0; + maxinfolen:=0; + { open dat file } + assign(infile,'../x86/x86ins.dat'); + if x86_64 then + begin + { create inc files } + openinc(insfile,'x8664tab.inc'); + openinc(opfile,'x8664op.inc'); + assign(nopfile,'x8664nop.inc'); + openinc(attfile,'x8664att.inc'); + openinc(attsuffile,'x8664ats.inc'); + openinc(intfile,'x8664int.inc'); + openinc(propfile,'x8664pro.inc'); + end + else + begin + { create inc files } + openinc(insfile,'i386tab.inc'); + openinc(opfile,'i386op.inc'); + assign(nopfile,'i386nop.inc'); + openinc(attfile,'i386att.inc'); + openinc(attsuffile,'i386atts.inc'); + openinc(intfile,'i386int.inc'); + openinc(propfile,'i386prop.inc'); + end; + rewrite(nopfile); + writeln(nopfile,'{ don''t edit, this file is generated from x86ins.dat }'); + reset(infile); + first:=true; + opcode:=''; + firstopcode:=true; + while not(eof(infile)) do + begin + { handle comment } + readln(infile,s); + while (s[1]=' ') do + delete(s,1,1); + if (s='') or (s[1]=';') then + continue; + if (s[1]='[') then + begin + i:=pos(',',s); + j:=pos(']',s); + if i=0 then + begin + opcode:='A_'+Copy(s,2,j-2); + intopcode:=Copy(s,2,j-2); + { Conditional } + if (intopcode[length(intopcode)]='c') and + (intopcode[length(intopcode)-1]='c') then + dec(byte(intopcode[0]),2); + attopcode:=intopcode; + attsuffix:='attsufNONE'; + end + else + begin + opcode:='A_'+Copy(s,2,i-2); + intopcode:=Copy(s,2,i-2); + { intel conditional } + if (intopcode[length(intopcode)]='c') and + (intopcode[length(intopcode)-1]='c') then + dec(byte(intopcode[0]),2); + attopcode:=Copy(s,i+1,j-i-1); + { att Suffix } + case attopcode[length(attopcode)] of + 'X' : + begin + dec(attopcode[0]); + attsuffix:='attsufINT'; + end; + 'F' : + begin + dec(attopcode[0]); + attsuffix:='attsufFPU'; + end; + 'R' : + begin + dec(attopcode[0]); + attsuffix:='attsufFPUint'; + end; + else + attsuffix:='attsufNONE'; + end; + { att Conditional } + if (attopcode[length(attopcode)]='C') and + (attopcode[length(attopcode)-1]='C') then + dec(byte(attopcode[0]),2); + end; + intopcode:=Lower(intopcode); + attopcode:=Lower(attopcode); + if firstopcode then + firstopcode:=false + else + begin + writeln(opfile,','); + writeln(attfile,','); + writeln(attsuffile,','); + writeln(intfile,','); + writeln(propfile,','); + end; + write(opfile,opcode); + write(intfile,'''',intopcode,''''); + write(attfile,'''',attopcode,''''); + write(attsuffile,attsuffix); + { read the next line which contains the Change options } + repeat + readln(infile,s); + until eof(infile) or ((s<>'') and (s[1]<>';')); + write(propfile,'(Ch: ',s,')'); + continue; + end; + { we must have an opcode } + if opcode='' then + runerror(234); + { clear } + ops:=0; + optypes[1]:=''; + optypes[2]:=''; + optypes[3]:=''; + codes:=''; + flags:=''; + skip:=false; + { ops and optypes } + i:=1; + repeat + hs:=readstr; + if (hs='void') or (hs='ignore') then + break; + inc(ops); + optypes[ops]:=optypes[ops]+'ot_'+formatop(hs); +{ if s[i]=':' then + begin + inc(i); + optypes[ops]:=optypes[ops]+' or ot_'+formatop(readstr); + end;} + while s[i]='|' do + begin + inc(i); + optypes[ops]:=optypes[ops]+' or ot_'+formatop(readstr); + end; + if s[i] in [',',':'] then + inc(i) + else + break; + until false; + for j:=1 to 3-ops do + optypes[3-j+1]:='ot_none'; + { codes } + skipspace; + j:=0; + last:=0; + if s[i] in ['\','0'..'9'] then + begin + while not(s[i] in [' ',#9]) do + begin + code:=readnumber; + { for some codes we want also to change the optypes, but not + if the last byte was a 1 then this byte belongs to a direct + copy } + if last<>1 then + begin + case code of + 12,13,14 : + optypes[code-11]:=optypes[code-11]+' or ot_signed'; + end; + end; + codes:=codes+'#'+tostr(code); + last:=code; + inc(j); + end; + end + else + begin + readstr; + codes:='#0'; + end; + if j>maxinfolen then + maxinfolen:=j; + { flags } + skipspace; + while not(s[i] in [' ',#9,#13,#10]) and (i<=length(s)) do + begin + hs:=readstr; + if x86_64 then + begin + if (upcase(hs)='NOX86_64') then + skip:=true; + end + else + begin + if (upcase(hs)='X86_64') then + skip:=true; + end; + if hs<>'ND' then + begin + if flags<>'' then + flags:=flags+' or '; + flags:=flags+'if_'+lower(hs); + end; + if (s[i]=',') and (i<=length(s)) then + inc(i) + else + break; + end; + { write instruction } + if not skip then + begin + if not(first) then + writeln(insfile,',') + else + first:=false; + writeln(insfile,' ('); + writeln(insfile,' opcode : ',opcode,';'); + writeln(insfile,' ops : ',ops,';'); + writeln(insfile,' optypes : (',optypes[1],',',optypes[2],',',optypes[3],');'); + writeln(insfile,' code : ',codes,';'); + writeln(insfile,' flags : ',flags); + write(insfile,' )'); + inc(insns); + end; + end; + close(infile); + closeinc(insfile); + closeinc(intfile); + closeinc(attfile); + closeinc(attsuffile); + closeinc(opfile); + writeln(nopfile,insns,';'); + close(nopfile); + closeinc(propfile); + writeln(insns,' nodes procesed (maxinfolen=',maxinfolen,')'); +end. diff --git a/compiler/utils/mkx86reg.pp b/compiler/utils/mkx86reg.pp new file mode 100644 index 0000000000..4b0cf7ef6d --- /dev/null +++ b/compiler/utils/mkx86reg.pp @@ -0,0 +1,467 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman and Florian Klaempfl + + Convert i386reg.dat to several .inc files for usage with + the Free pascal compiler + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} +{$mode objfpc} +{$i+} +program mkx86reg; + +const Version = '1.00'; + max_regcount = 128; + +var s : string; + i : longint; + line : longint; + regcount:byte; + regcount_bsstart:byte; + names,numbers,stdnames,intnames,nasmnames,attnames,stabs,dwarf32,dwarf64,ots,ops: + array[0..max_regcount-1] of string[63]; + regnumber_index,std_regname_index,int_regname_index,att_regname_index, + nasm_regname_index:array[0..max_regcount-1] of byte; + x86_64 : boolean; + fileprefix : string; + +{$ifndef FPC} + procedure readln(var t:text;var s:string); + var + c : char; + i : longint; + begin + c:=#0; + i:=0; + while (not eof(t)) and (c<>#10) do + begin + read(t,c); + if c<>#10 then + begin + inc(i); + s[i]:=c; + end; + end; + if (i>0) and (s[i]=#13) then + dec(i); + s[0]:=chr(i); + end; +{$endif} + +function tostr(l : longint) : string; + +begin + str(l,tostr); +end; + +function readstr : string; + begin + result:=''; + while (s[i]<>',') and (i<=length(s)) do + begin + result:=result+s[i]; + inc(i); + end; + readstr:=result; + end; + + +procedure readcomma; + begin + if s[i]<>',' then + begin + writeln('Missing "," at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + inc(i); + end; + + +procedure skipspace; + + begin + while (s[i] in [' ',#9]) do + inc(i); + end; + +procedure openinc(var f:text;const fn:string); +begin + writeln('creating ',fn); + assign(f,fn); + rewrite(f); + writeln(f,'{ don''t edit, this file is generated from x86reg.dat }'); +end; + + +procedure closeinc(var f:text); +begin + writeln(f); + close(f); +end; + +procedure build_regnum_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + regnumber_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if numbers[regnumber_index[j]]>=numbers[regnumber_index[i]] then + break; + t:=regnumber_index[i]; + regnumber_index[i]:=regnumber_index[j]; + regnumber_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + +procedure build_std_regname_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + std_regname_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if stdnames[std_regname_index[j]]>=stdnames[std_regname_index[i]] then + break; + t:=std_regname_index[i]; + std_regname_index[i]:=std_regname_index[j]; + std_regname_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + +procedure build_int_regname_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + int_regname_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if intnames[int_regname_index[j]]>=intnames[int_regname_index[i]] then + break; + t:=int_regname_index[i]; + int_regname_index[i]:=int_regname_index[j]; + int_regname_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + +procedure build_att_regname_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + att_regname_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if attnames[att_regname_index[j]]>=attnames[att_regname_index[i]] then + break; + t:=att_regname_index[i]; + att_regname_index[i]:=att_regname_index[j]; + att_regname_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + +procedure build_nasm_regname_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + nasm_regname_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if nasmnames[nasm_regname_index[j]]>=nasmnames[nasm_regname_index[i]] then + break; + t:=nasm_regname_index[i]; + nasm_regname_index[i]:=nasm_regname_index[j]; + nasm_regname_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + +procedure read_x86reg_file; + +var infile:text; + cpustr:string; + +begin + { open dat file } + assign(infile,'x86reg.dat'); + reset(infile); + while not(eof(infile)) do + begin + { handle comment } + readln(infile,s); + inc(line); + while (s[1]=' ') do + delete(s,1,1); + if (s='') or (s[1]=';') then + continue; + + i:=1; + names[regcount]:=readstr; + readcomma; + numbers[regcount]:=readstr; + readcomma; + stdnames[regcount]:=readstr; + readcomma; + attnames[regcount]:=readstr; + readcomma; + intnames[regcount]:=readstr; + readcomma; + nasmnames[regcount]:=readstr; + readcomma; + stabs[regcount]:=readstr; + readcomma; + dwarf32[regcount]:=readstr; + readcomma; + dwarf64[regcount]:=readstr; + readcomma; + ots[regcount]:=readstr; + readcomma; + ops[regcount]:=readstr; + if s[i]=',' then + begin + readcomma; + cpustr:=readstr; + end + else + cpustr:=''; + if i<length(s) then + begin + writeln('Extra chars at end of line, at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + if (cpustr<>'64') or x86_64 then + begin + inc(regcount); + if regcount>max_regcount then + begin + writeln('Error: Too much registers, please increase maxregcount in source'); + halt(2); + end; + end; + end; + close(infile); +end; + +procedure write_inc_files; + +var attfile,intfile,otfile,opfile, + norfile,nasmfile,stdfile, + numfile,stabfile,dwrffile,confile, + rnifile,irifile,srifile, + arifile,nrifile:text; + first:boolean; + +begin + { create inc files } + openinc(confile,fileprefix+'con.inc'); + openinc(numfile,fileprefix+'num.inc'); + openinc(stdfile,fileprefix+'std.inc'); + openinc(attfile,fileprefix+'att.inc'); + openinc(intfile,fileprefix+'int.inc'); + if not(x86_64) then + begin + openinc(nasmfile,fileprefix+'nasm.inc'); + end; + openinc(stabfile,fileprefix+'stab.inc'); + openinc(dwrffile,fileprefix+'dwrf.inc'); + openinc(otfile,fileprefix+'ot.inc'); + openinc(opfile,fileprefix+'op.inc'); + openinc(norfile,fileprefix+'nor.inc'); + openinc(rnifile,fileprefix+'rni.inc'); + openinc(srifile,fileprefix+'sri.inc'); + openinc(arifile,fileprefix+'ari.inc'); + openinc(irifile,fileprefix+'iri.inc'); + if not(x86_64) then + begin + openinc(nrifile,fileprefix+'nri.inc'); + end; + first:=true; + for i:=0 to regcount-1 do + begin + if not first then + begin + writeln(numfile,','); + writeln(stdfile,','); + writeln(attfile,','); + writeln(intfile,','); + if not(x86_64) then + begin + writeln(nasmfile,','); + end; + writeln(stabfile,','); + writeln(dwrffile,','); + writeln(otfile,','); + writeln(opfile,','); + writeln(rnifile,','); + writeln(srifile,','); + writeln(arifile,','); + writeln(irifile,','); + if not(x86_64) then + begin + writeln(nrifile,','); + end; + end + else + first:=false; + writeln(confile,names[i],' = ','tregister(',numbers[i],')',';'); + write(numfile,'tregister(',numbers[i],')'); + write(stdfile,'''',stdnames[i],''''); + write(attfile,'''',attnames[i],''''); + write(intfile,'''',intnames[i],''''); + if not(x86_64) then + begin + write(nasmfile,'''',nasmnames[i],''''); + end; + write(stabfile,stabs[i]); + if x86_64 then + write(dwrffile,dwarf64[i]) + else + write(dwrffile,dwarf32[i]); + write(otfile,ots[i]); + write(opfile,ops[i]); + write(rnifile,regnumber_index[i]); + write(srifile,std_regname_index[i]); + write(arifile,att_regname_index[i]); + write(irifile,int_regname_index[i]); + if not(x86_64) then + begin + write(nrifile,nasm_regname_index[i]); + end; + end; + write(norfile,regcount); + close(confile); + closeinc(numfile); + closeinc(attfile); + closeinc(stdfile); + closeinc(intfile); + if not(x86_64) then + begin + closeinc(nasmfile); + end; + closeinc(stabfile); + closeinc(dwrffile); + closeinc(otfile); + closeinc(opfile); + closeinc(norfile); + closeinc(rnifile); + closeinc(srifile); + closeinc(arifile); + closeinc(irifile); + if not(x86_64) then + begin + closeinc(nrifile); + end; + writeln('Done!'); + writeln(regcount,' registers procesed'); +end; + + +begin + writeln('Register Table Converter Version ',Version); + x86_64:=paramstr(1)='x86_64'; + if x86_64 then + fileprefix:='r8664' + else + fileprefix:='r386'; + line:=0; + regcount:=0; + read_x86reg_file; + regcount_bsstart:=1; + while 2*regcount_bsstart<regcount do + regcount_bsstart:=regcount_bsstart*2; + build_regnum_index; + if not(x86_64) then + begin + build_int_regname_index; + build_nasm_regname_index; + end; + build_std_regname_index; + build_att_regname_index; + write_inc_files; +end. diff --git a/compiler/utils/msg2inc.pp b/compiler/utils/msg2inc.pp new file mode 100644 index 0000000000..905d530952 --- /dev/null +++ b/compiler/utils/msg2inc.pp @@ -0,0 +1,815 @@ +{ + This program is part of the Free Pascal run time library. + Copyright (c) 1998-2002 by Peter Vreman + + Convert a .msg file to an .inc file with a const array of char + And for the lazy docwriters it can also generate some TeX output + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} +program msg2inc; +uses + strings; + +{$ifdef unix} + {$define EOL_ONE_CHAR} +{$endif unix} +{$ifdef amiga} + {$define EOL_ONE_CHAR} +{$endif amiga} +{$ifdef morphos} + {$define EOL_ONE_CHAR} +{$endif} +{$ifdef macos} + {$define EOL_ONE_CHAR} +{$endif} + +const + version='1.00'; +{$ifdef EOL_ONE_CHAR} + eollen=1; +{$else} + eollen=2; +{$endif} + msgparts = 20; + +type + TMode=(M_Char,M_Tex,M_Intel,M_String,M_Renumber); +var + InFile, + OutFile, + OutName : string; + Mode : TMode; + TexHeader : boolean; + + MsgTxt : pchar; + EnumTxt : pchar; + enumsize, + msgsize : longint; + + msgidxmax : array[1..msgparts] of longint; + msgs : array[0..msgparts,0..999] of boolean; + +procedure LoadMsgFile(const fn:string); +var + f : text; + error, + multiline : boolean; + code : word; + numpart,numidx, + line,i,j,num : longint; + ptxt, + penum : pchar; + number, + s,s1 : string; + + procedure err(const msgstr:string); + begin + writeln('error in line ',line,': ',msgstr); + error:=true; + end; + +begin + Writeln('Loading messagefile ',fn); +{Read the message file} + assign(f,fn); + {$I-} + reset(f); + {$I+} + if ioresult<>0 then + begin + WriteLn('fatal error: '+fn+' not found'); + halt(1); + end; +{ First parse the file and count bytes needed } + fillchar(msgidxmax,sizeof(msgidxmax),0); + fillchar(msgs,sizeof(msgs),0); + error:=false; + line:=0; + multiline:=false; + msgsize:=0; + while not eof(f) do + begin + readln(f,s); + inc(line); + if multiline then + begin + if s=']' then + multiline:=false + else + inc(msgsize,length(s)+1); { +1 for linebreak } + end + else + begin + if (s<>'') and not(s[1] in ['#',';','%']) then + begin + i:=pos('=',s); + if i>0 then + begin + j:=i+1; + if not(s[j] in ['0'..'9']) then + err('no number found') + else + begin + while (s[j] in ['0'..'9']) do + inc(j); + end; + if j-i-1<>5 then + err('number length is not 5'); + number:=Copy(s,i+1,j-i-1); + { update the max index } + val(number,num,code); + numpart:=num div 1000; + if numpart=0 then + err('number should be > 1000'); + numidx:=num mod 1000; + { duplicate ? } + if msgs[numpart,numidx] then + err('duplicate number found'); + msgs[numpart,numidx]:=true; + { check range } + if numpart > msgparts then + err('number is to large') + else + if numidx > msgidxmax[numpart] then + msgidxmax[numpart]:=numidx; + if s[j+1]='[' then + begin + inc(msgsize,j-i); + multiline:=true + end + else + inc(msgsize,length(s)-i+1); + inc(enumsize,j); + end + else + err('no = found'); + end; + end; + end; + if multiline then + err('still in multiline mode'); + if error then + begin + close(f); + writeln('aborting'); + halt(1); + end; +{ alloc memory } + getmem(msgtxt,msgsize); + ptxt:=msgtxt; + getmem(enumtxt,enumsize); + penum:=enumtxt; +{ now read the buffer in mem } + reset(f); + while not eof(f) do + begin + readln(f,s); + if multiline then + begin + if s=']' then + begin + multiline:=false; + { overwrite last eol } + dec(ptxt); + ptxt^:=#0; + inc(ptxt); + end + else + begin + move(s[1],ptxt^,length(s)); + inc(ptxt,length(s)); + ptxt^:=#10; + inc(ptxt); + end; + end + else + begin + if (s<>'') and not(s[1] in ['#',';','%']) then + begin + i:=pos('=',s); + if i>0 then + begin + j:=i+1; + while (s[j] in ['0'..'9']) do + inc(j); + {enum} + move(s[1],penum^,i-1); + inc(penum,i-1); + penum^:='='; + inc(penum); + number:=Copy(s,i+1,j-i-1); + move(number[1],penum^,length(number)); + inc(penum,length(number)); + penum^:=#0; + inc(penum); + { multiline start then no txt } + if s[j+1]='[' then + begin + s1:=Copy(s,i+1,j-i); + move(s1[1],ptxt^,length(s1)); + inc(ptxt,length(s1)); + multiline:=true; + end + else + begin + { txt including number } + s1:=Copy(s,i+1,255); + move(s1[1],ptxt^,length(s1)); + inc(ptxt,length(s1)); + ptxt^:=#0; + inc(ptxt); + end; + end; + end; + end; + end; + close(f); +end; + + +{***************************************************************************** + WriteEnumFile +*****************************************************************************} + +procedure WriteEnumFile(const fn,typename:string); +var + t : text; + i : longint; + p : pchar; + start : boolean; +begin + writeln('Writing enumfile '+fn); +{Open textfile} + assign(t,fn); + rewrite(t); + writeln(t,'const'); +{Parse buffer in msgbuf and create indexs} + p:=enumtxt; + start:=true; + for i:=1 to enumsize do + begin + if start then + begin + write(t,' '); + start:=false; + end; + if p^=#0 then + begin + writeln(t,';'); + start:=true; + end + else + begin + write(t,p^); + end; + inc(p); + end; + writeln(t,''); + { msgtxt size } + writeln(t,' MsgTxtSize = ',msgsize,';'); + writeln(t,''); + { max msg idx table } + writeln(t,' MsgIdxMax : array[1..20] of longint=('); + write(t,' '); + for i:=1 to 20 do + begin + write(t,msgidxmax[i]+1); + if i<20 then + write(t,','); + if i=10 then + begin + writeln(t,''); + write(t,' '); + end; + end; + writeln(t,''); + writeln(t,' );'); + close(t); +end; + + +{***************************************************************************** + WriteStringFile +*****************************************************************************} + +procedure WriteStringFile(const fn,constname:string); +const + maxslen=240; { to overcome aligning problems } + + function l0(l:longint):string; + var + s : string[16]; + begin + str(l,s); + while (length(s)<5) do + s:='0'+s; + l0:=s; + end; + +var + t : text; + f : file; + slen, + len,i : longint; + p : pchar; + s : string; + start, + quote : boolean; +begin + writeln('Writing stringfile ',fn); +{Open textfile} + assign(t,fn); + rewrite(t); + writeln(t,'{$ifdef Delphi}'); + writeln(t,'const '+constname+' : array[0..000000] of string[',maxslen,']=('); + writeln(t,'{$else Delphi}'); + writeln(t,'const '+constname+' : array[0..000000,1..',maxslen,'] of char=('); + write(t,'{$endif Delphi}'); +{Parse buffer in msgbuf and create indexs} + p:=msgtxt; + slen:=0; + len:=0; + quote:=false; + start:=true; + for i:=1 to msgsize do + begin + if slen>=maxslen then + begin + if quote then + begin + write(t,''''); + quote:=false; + end; + write(t,','); + slen:=0; + inc(len); + end; + if (len>70) or (start) then + begin + if quote then + begin + write(t,''''); + quote:=false; + end; + if slen>0 then + writeln(t,'+') + else + writeln(t); + len:=0; + start:=false; + end; + if (len=0) then + write(t,' '); + if (ord(p^)>=32) and (p^<>#39) then + begin + if not quote then + begin + write(t,''''); + quote:=true; + inc(len); + end; + write(t,p^); + inc(len); + end + else + begin + if quote then + begin + write(t,''''); + inc(len); + quote:=false; + end; + write(t,'#'+chr(ord(p^) div 100+48)+chr((ord(p^) mod 100) div 10+48)+chr(ord(p^) mod 10+48)); + inc(len,3); + end; + if p^ in [#0,#10] then + start:=true; + inc(slen); + inc(p); + end; + if quote then + write(t,''''); + writeln(t,''); + writeln(t,');'); + close(t); +{update arraysize} + s:=l0(msgsize div maxslen); { we start with 0 } + assign(f,fn); + reset(f,1); + seek(f,34+eollen+length(constname)); + blockwrite(f,s[1],5); + seek(f,90+3*eollen+2*length(constname)); + blockwrite(f,s[1],5); + close(f); +end; + + +{***************************************************************************** + WriteCharFile +*****************************************************************************} + +procedure WriteCharFile(const fn,constname:string); + + function l0(l:longint):string; + var + s : string[16]; + begin + str(l,s); + while (length(s)<5) do + s:='0'+s; + l0:=s; + end; + + function createconst(b:byte):string; + begin + if (b in [32..127]) and (b<>39) then + createconst:=''''+chr(b)+'''' + else + createconst:='#'+chr(b div 100+48)+chr((b mod 100) div 10+48)+chr(b mod 10+48) + end; + +var + t : text; + f : file; + cidx,i : longint; + p : pchar; + s : string; +begin + writeln('Writing charfile '+fn); +{Open textfile} + assign(t,fn); + rewrite(t); + writeln(t,'const ',constname,' : array[1..00000] of char=('); +{Parse buffer in msgbuf and create indexs} + p:=msgtxt; + cidx:=0; + for i:=1to msgsize do + begin + if cidx=15 then + begin + if cidx>0 then + writeln(t,',') + else + writeln(t,''); + write(t,' '); + cidx:=0; + end + else + if cidx>0 then + write(t,',') + else + write(t,' '); + write(t,createconst(ord(p^))); + inc(cidx); + inc(p); + end; + writeln(t,');'); + close(t); +{update arraysize} + s:=l0(msgsize); + assign(f,fn); + reset(f,1); + seek(f,18+length(constname)); + blockwrite(f,s[1],5); + close(f); +end; + + +{***************************************************************************** + WriteIntelFile +*****************************************************************************} + +procedure WriteIntelFile(const fn,constname:string); +var + t : text; + len,i : longint; + p : pchar; + start, + quote : boolean; +begin + writeln('Writing Intelfile ',fn); +{Open textfile} + assign(t,fn); + rewrite(t); + writeln(t,'procedure '+constname+';assembler;'); + writeln(t,'asm'); +{Parse buffer in msgbuf and create indexs} + p:=msgtxt; + len:=0; + start:=true; + quote:=false; + for i:=1to msgsize do + begin + if len>70 then + begin + if quote then + begin + write(t,''''); + quote:=false; + end; + writeln(t,''); + start:=true; + end; + if start then + begin + write(t,' db '''); + len:=0; + quote:=true; + end; + if (ord(p^)>=32) and (p^<>#39) then + begin + if not quote then + begin + write(t,','''); + quote:=true; + inc(len); + end; + write(t,p^); + inc(len); + end + else + begin + if quote then + begin + write(t,''''); + inc(len); + quote:=false; + end; + write(t,','+chr(ord(p^) div 100+48)+chr((ord(p^) mod 100) div 10+48)+chr(ord(p^) mod 10+48)); + inc(len,4); + end; + inc(p); + end; + if quote then + write(t,''''); + writeln(t,''); + writeln(t,'end;'); + close(t); +end; + + +{***************************************************************************** + RenumberFile +*****************************************************************************} + +procedure RenumberFile(const fn,name:string); +var + f,t : text; + i : longint; + s,s1 : string; +begin + Writeln('Renumbering ',fn); +{Read the message file} + assign(f,fn); + {$I-} + reset(f); + {$I+} + if ioresult<>0 then + begin + WriteLn('*** message file '+fn+' not found ***'); + exit; + end; + assign(t,'msg2inc.$$$'); + rewrite(t); + i:=0; + while not eof(f) do + begin + readln(f,s); + if (copy(s,1,length(Name))=Name) and (s[3] in ['0'..'9']) then + begin + inc(i); + str(i,s1); + while length(s1)<3 do + s1:='0'+s1; + writeln(t,Name+s1+Copy(s,6,255)); + end + else + writeln(t,s); + end; + close(t); + close(f); +{ rename new file } + erase(f); + rename(t,fn); +end; + + +{***************************************************************************** + WriteTexFile +*****************************************************************************} + +Function EscapeString (Const S : String) : String; +Var + I : longint; + hs : string; +begin + hs:=''; + for i:=1 to length(s) do + if (S[i]='$') then + begin + if (s[i+1] in ['0'..'9']) then + hs:=hs+'arg' + else + hs:=hs+'\$'; + end + else + hs:=hs+s[i]; + EscapeString:=hs; +end; + +procedure WriteTexFile(const infn,outfn:string); +var + t,f : text; + line, + i,k : longint; + s,s1 : string; + texoutput : boolean; +begin + Writeln('Loading messagefile ',infn); + writeln('Writing TeXfile ',outfn); +{ Open infile } + assign(f,infn); + {$I-} + reset(f); + {$I+} + if ioresult<>0 then + begin + WriteLn('*** message file '+infn+' not found ***'); + exit; + end; +{ Open outfile } + assign(t,outfn); + rewrite(t); + If texheader then + begin + writeln (t,'\documentclass{article}'); + writeln (t,'\usepackage{html}'); + writeln (t,'\usepackage{fpc}'); + writeln (t,'\begin{document}'); + end; +{ Parse } + line:=0; + TexOutput:=False; + while not eof(f) do + begin + readln(f,s); + inc(line); + If Pos ('# BeginOfTeX',S)=1 then + TexOutPut:=True + else if pos ('# EndOfTeX',S)=1 then + TexOutPut:=False; + if (s<>'') and not(s[1] in ['#',';']) and TeXOutPut then + begin + if s[1]='%' then + begin + Delete(s,1,1); + writeln(t,s); + end + else + begin + i:=pos('=',s); + if i>0 then + begin + inc(i); + while s[i] in ['0'..'9'] do + inc(i); + inc(i); + s1:=''; + k:=0; + while (k<5) and (s[i+k]<>'_') do + begin + case s[i+k] of + 'W' : s1:='Warning: '; + 'E' : s1:='Error: '; + 'F' : s1:='Fatal: '; + 'N' : s1:='Note: '; + 'I' : s1:='Info: '; + 'H' : s1:='Hint: '; + end; + inc(k); + end; + if s[i+k]='_' then + inc(i,k+1); + writeln(t,'\item ['+s1+escapestring(Copy(s,i,255))+']'); + end + else + writeln('error in line: ',line,' skipping'); + end; + end; + end; + If TexHeader then + writeln (t,'\end{document}'); + close(t); + close(f); +end; + + +{***************************************************************************** + Main Program +*****************************************************************************} + +procedure getpara; +var + ch : char; + para : string; + files,i : word; + + procedure helpscreen; + begin + writeln('usage : msg2inc [Options] <msgfile> <incfile> <constname>'); + writeln('<Options> can be : -T Create .doc TeX file'); + writeln(' -TS Create .doc TeX file (stand-alone)'); + writeln(' -I Intel style asm output'); + writeln(' -S array of string'); + writeln(' -C array of char'); + writeln(' -R renumber section <incfile>'); + writeln(' -V Show version'); + writeln(' -? or -H This HelpScreen'); + halt(1); + end; + +begin + Mode:=M_String; + FIles:=0; + for i:=1to paramcount do + begin + para:=paramstr(i); + if (para[1]='-') then + begin + ch:=upcase(para[2]); + delete(para,1,2); + case ch of + 'T' : begin + case upcase(para[1]) of + 'S' : TexHeader:=True; + end; + Mode:=M_Tex; + end; + 'I' : Mode:=M_Intel; + 'S' : Mode:=M_String; + 'C' : Mode:=M_Char; + 'R' : Mode:=M_Renumber; + 'V' : begin + Writeln('Msg2Inc ',version,' for Free Pascal (C) 1998-2002 Peter Vreman'); + Writeln; + Halt; + end; + '?','H' : helpscreen; + end; + end + else + begin + inc(Files); + if Files>3 then + HelpScreen; + case Files of + 1 : InFile:=Para; + 2 : OutFile:=Para; + 3 : OutName:=Para; + end; + end; + end; + case Mode of + M_Renumber, + M_Tex : if Files<2 then + Helpscreen; + else + if FIles<3 then + HelpScreen; + end; +end; + + +begin + GetPara; + case Mode of + M_Renumber : begin + Renumberfile(Infile,OutFile); + end; + M_Tex : begin + WriteTexFile(InFile,Outfile); + end; + M_Intel : begin + Loadmsgfile(InFile); + WriteEnumFile(OutFile+'idx.inc',OutName+'const'); + WriteIntelFile(OutFile+'txt.inc',OutName+'txt'); + end; + M_String : begin + Loadmsgfile(InFile); + WriteEnumFile(OutFile+'idx.inc',OutName+'const'); + WriteStringFile(OutFile+'txt.inc',OutName+'txt'); + end; + M_Char : begin + Loadmsgfile(InFile); + WriteEnumFile(OutFile+'idx.inc',OutName+'const'); + WriteCharFile(OutFile+'txt.inc',OutName+'txt'); + end; + end; +end. diff --git a/compiler/utils/msgdif.pp b/compiler/utils/msgdif.pp new file mode 100644 index 0000000000..1052f30bc8 --- /dev/null +++ b/compiler/utils/msgdif.pp @@ -0,0 +1,529 @@ +{ + This program is part of the Free Pascal run time library. + Copyright (c) 1998-2002 by Peter Vreman + + Show the differences between two .msg files + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + +{ May be we need to compare a prefixes of option_help_pages too? + Currently this is not performed } + +Program messagedif; + +{$h+} {Huge strings} + +Uses + Strings; + +Type + TEnum = String; + TText = String; + + PMsg = ^TMsg; + TMsg = Record + Line, ctxt, cnb : Longint; + enum : TEnum; + text : TText; + comment : pchar; + Next,Prev : PMsg; + FileNext, + Equivalent : PMsg; + end; +Var + OrgFileName,DiffFileName : String; + OrgRoot,DiffRoot : PMsg; + OrgFirst,DiffFirst : PMsg; + Last : PMsg; + +const + NewFileName = 'new.msg'; + Is_interactive : boolean = false; + Auto_verbosity : boolean = false; + + +Procedure GetTranslation( p : PMsg); +var + s : string; + i,j,k : longint; +begin + i:=pos('_',p^.text); + if i>0 then + for j:=i+1 to Length(p^.text) do + if p^.text[j]='_' then + begin + i:=j; + break; + end; + if (i>0) and (i<=15) then + Writeln(P^.Enum,' type "',copy(p^.text,1,i-1),'" "',copy(p^.text,i+1,255),'"') + else + Writeln(P^.enum,' "',p^.text,'"'); + Writeln('Type translated error message in,'); + Writeln('Press return to keep it unchanged, or "q" to finish interactive mode'); + Readln(s); + if s='' then + exit; + if s='q' then + begin + Is_interactive:=false; + exit; + end; + j:=pos('_',s); + if j>0 then + for k:=j+1 to Length(s) do + if s[j]='_' then + begin + j:=k; + break; + end; + if (j>0) then + begin + if copy(p^.text,1,i)<>copy(s,1,j) then + Writeln('Warning : different verbosity !!'); + p^.text:=s; + end + else + p^.text:=copy(p^.text,1,i)+s; +end; + +Function NewMsg (Var RM : PMsg; L : Longint; Const E : TEnum;Const T : TText;C : pchar;NbLn,TxtLn : longint) : PMsg; + +Var + P,R : PMsg; + +begin + New(P); + with P^ do + begin + Line:=L; + Text:=T; + enum:=E; + comment:=c; + cnb:=NbLn; + ctxt:=TxtLn; + next:=Nil; + prev:=Nil; + filenext:=nil; + equivalent:=nil; + if assigned(last) then + last^.FileNext:=P; + last:=P; + end; + R:=RM; + While (R<>Nil) and (UpCase(R^.enum)>UpCase(P^.Enum)) do + begin + P^.Prev:=R; + R:=R^.next; + end; + if assigned(R) and (UpCase(R^.Enum)=UpCase(P^.Enum)) then + Writeln('Error ',R^.Enum,' duplicate'); + P^.Next:=R; + If R<>Nil then + R^.Prev:=P; + If P^.Prev<>Nil then + P^.Prev^.Next:=P + else + RM:=P; + NewMsg:=P; +end; + +Procedure PrintList(const name : string;R : PMsg); +var + P : PMsg; + f : text; +begin + P:=R; + Assign(f,name); + Rewrite(f); + while assigned(P) do + begin + Writeln(f,UpCase(P^.Enum)); + P:=P^.Next; + end; + Close(f); +end; + +Procedure Usage; + +begin + Writeln('Usage : msgdif [options] <org-file> <dif-file>'); + Writeln('Options:'); + Writeln(' -i allow to enter translated messages interactively'); + Writeln(' -y1 use <org-file> verbosity (do not query acknowledge)'); + Writeln(''); + Writeln('Generates "',NewFileName,'" that contain the messages from <dif-file>'); + Writeln('with a new messages from <org-file>'); + Writeln(''); + Writeln('Example:'); + Writeln(' msgdif errore.msg errorr.msg'); + halt(1) +end; + +Procedure ProcessOptions; +var + i,count : longint; +begin + Is_interactive:=false; + Auto_verbosity:=false; + + count:=paramcount; i:=1; + while (count>0) and (Paramstr(i)[1]='-') do + case UpCase(Paramstr(i)[2]) of + 'I': begin + Is_interactive:=true; + dec(count); Inc(i); + end; + 'Y': case Paramstr(i)[3] of + '1': begin + Auto_verbosity:=true; + dec(count); Inc(i); + end; + else + Writeln ('Error: unknown option ', Paramstr(i)); + Usage; + end; + else + Writeln ('Error: unknown option ', Paramstr(i)); + Usage; + end; + If Count<>2 then begin + Writeln ('Error: there must be exactly two message files'); + Usage; + end; + + OrgfileName:=Paramstr(i); + DiffFileName:=Paramstr(i+1); + if (OrgFileName=NewFileName) or (DiffFileName=NewFileName) then + begin + Writeln('The file names must be different from ',NewFileName); + Halt(1); + end; +end; + +Procedure ProcessFile (FileName : String; Var Root,First : PMsg); + +Const + ArrayLength = 65500; +Var F : Text; + S,prevS : String; + J,LineNo,Count,NbLn,TxtLn : Longint; + chararray : array[0..ArrayLength] of char; + currentindex : longint; + c : pchar; + multiline : boolean; +begin + Assign(F,FileName); + Reset(F); + Write ('Processing: ',Filename,'...'); + LineNo:=0; + NbLn:=0; + TxtLn:=0; + Count:=0; + currentindex:=0; + Root:=Nil; + First:=nil; + Last:=nil; + PrevS:=''; + multiline:=false; + While not eof(f) do + begin + Readln(F,S); + Inc(LineNo); + If multiline then + begin + PrevS:=PrevS+#10+S; Inc(TxtLn); + if (Length(S)<>0) and (S[1]=']') then + multiline:=false; + end + else + if (length(S)>0) and Not (S[1] in ['%','#']) Then + begin + J:=Pos('=',S); + If j<1 then + writeln (Filename,'(',LineNo,') : Invalid entry') + else + begin + chararray[currentindex]:=#0; + c:=strnew(@chararray); + if PrevS<>'' then + NewMsg(Root,LineNo,Copy(PrevS,1,Pos('=',PrevS)-1), + Copy(PrevS,Pos('=',PrevS)+1,Length(PrevS)),c,NbLn,TxtLn) + else + StrDispose(c); + currentindex:=0; + NbLn:=0; TxtLn:=0; + PrevS:=S; Inc(TxtLn); + if S[j+7]='[' then multiline:=true; + if First=nil then + First:=Root; + Inc(Count); + end; + end + else + begin + if currentindex+length(s)+1>ArrayLength then + Writeln('Comment too long : over ',ArrayLength,' chars') + else + begin + strpcopy(@chararray[currentindex],s+#10); + inc(currentindex,length(s)+1); + inc(NbLn); + end; + end; + end; + chararray[currentindex]:=#0; + c:=strnew(@chararray); + if PrevS<>'' then + NewMsg(Root,LineNo,Copy(PrevS,1,Pos('=',PrevS)-1), + Copy(PrevS,Pos('=',PrevS)+1,Length(PrevS)),c,NbLn,TxtLn); + Writeln (' Done. Read ',LineNo,' lines, got ',Count,' constants.'); + Close(f); +end; + +Procedure ShowDiff (POrg,PDiff : PMsg); + +Var + count,orgcount,diffcount : longint; + +Procedure NotFound (Org : Boolean; P : PMsg); + +begin + With P^ do + If Org Then + Writeln ('Not found in ',DiffFileName,' : ',Enum,' ',OrgFileName,'(',Line,')') + else + Writeln ('Extra in ',DiffFileName,'(',line,') : ',enum); + if org then + inc(orgcount) + else + inc(diffcount); +end; + +begin + orgcount:=0; + diffcount:=0; + count:=0; + While (Porg<>Nil) and (PDiff<>Nil) do + begin +// Writeln (POrg^.enum,'<=>',PDiff^.Enum); + If UpCase(Porg^.Enum)>UpCase(PDiff^.Enum) then + begin + NotFound (True,Porg); + POrg:=POrg^.Next + end + else If UpCase(POrg^.enum)=UpCase(PDiff^.Enum) then + begin + inc(count); + POrg^.Equivalent:=PDiff; + PDiff^.Equivalent:=POrg; + POrg:=POrg^.Next; + PDiff:=PDiff^.Next; + end + else + begin + NotFound (False,PDiff); + PDiff:=PDiff^.Next + end; + end; + While POrg<>Nil do + begin + NotFound(True,Porg); + POrg:=pOrg^.Next; + end; + While PDiff<>Nil do + begin + NotFound(False,PDiff); + PDiff:=PDiff^.Next; + end; + Writeln(count,' messages found in common to both files'); + Writeln(orgcount,' messages only in ',OrgFileName); + Writeln(diffcount,' messages only in ',DiffFileName); +end; + +type TArgSet = set of 0..31; + +function MsgToSet(const Msg, FileName: string; var R: TArgSet): Boolean; + var + i, j, num : integer; + code : word; + begin + R:=[]; + MsgToSet:=false; + for i:=1 to Length(Msg) do + if Msg[i]='$' then + begin + j:=i+1; + while Msg[j] in ['0'..'9'] do Inc(j); + if j > i+1 then + begin + val(copy(Msg,i+1,j-i-1),num,code); + if num > high(TArgSet) then begin + WriteLn('Error in ', FileName,': ', Msg); + WriteLn(' number at position ', i); + WriteLn(' must be LE ', high(TArgSet)); + Exit; + end; + R:=R+[num]; + end; + end; + MsgToSet:=true; + end; + + +procedure CheckParm(const s1, s2: string); + var + R1, R2: TArgSet; + begin + if MsgToSet(s1,OrgFileName, R1) <> true then Exit; + if MsgToSet(s2,DiffFileName,R2) <> true then Exit; + if R1<>R2 then begin + WriteLn('Error: set of arguments is different'); + WriteLn(' ',s1); + WriteLn(' ',s2); + end; + end; + +procedure WriteReorderedFile(FileName : string;orgnext,diffnext : PMsg); + var t,t2,t3 : text; + i,ntcount : longint; + j : integer; + s,s2,s3 : string; + is_msg : boolean; + nextdiffkept : pmsg; + begin + ntcount:=0; + Assign(t,FileName); + Rewrite(t); + Writeln(t,'%%% Reordering of ',DiffFileName,' respective to ',OrgFileName); + Writeln(t,'%%% Contains all comments from ',DiffFileName); + Assign(t2,DiffFileName); + Reset(t2); + Assign(t3,OrgFileName); + Reset(t3); + i:=2; + s:='';s3:=''; + nextdiffkept:=diffnext; + while assigned(nextdiffkept) and (nextdiffkept^.equivalent=nil) do + nextdiffkept:=nextdiffkept^.filenext; + { First write the header of diff } + repeat + Readln(t2,s); + is_msg:=(pos('=',s)>1) and (s[1]<>'%') and (s[1]<>'#'); + if not is_msg then + begin + Writeln(t,s); + inc(i); + end; + until is_msg; + { Write all messages in Org order } + while assigned(orgnext) do + begin + if not assigned(orgnext^.equivalent) then + begin + { Insert a new error msg with the english comments } + Writeln('New error ',orgnext^.enum,' added'); + If Is_interactive then + GetTranslation(orgnext); + Writeln(t,orgnext^.enum,'=',orgnext^.text); + inc(i,orgnext^.ctxt); + Write(t,orgnext^.comment); + inc(i,orgnext^.cnb); + end + else + begin + inc(i); + if orgnext^.text=orgnext^.equivalent^.text then + begin + Writeln(FileName,'(',i,') ',orgnext^.enum,' not translated'); + If Is_interactive then + GetTranslation(orgnext^.equivalent); + if orgnext^.text=orgnext^.equivalent^.text then + inc(ntcount); + end; + s2:=orgnext^.text; + j:=pos('_',copy(s2,7,20)) + 6; + s2:=upcase(copy(s2,1,j)); + s3:=orgnext^.equivalent^.text; + j:=pos('_',copy(s3,7,20)) + 6; + s3:=upcase(copy(s3,1,j)); + { that are the conditions in verbose unit } + if (length(s3)<12) and (s2<>s3) then + begin + Writeln('Warning: different options for ',orgnext^.enum); + Writeln(' ',orgnext^.text); + Writeln(' ',orgnext^.equivalent^.text); + s:='N'; + if Auto_verbosity then + s:='Y' + else + If Is_interactive then + begin + Write('Use ',s2,' verbosity ? [y/n] '); + Readln(s); + end; + if UpCase(s[1])='Y' then + begin + orgnext^.equivalent^.text:=s2+copy(orgnext^.equivalent^.text, + length(s3)+1,Length(orgnext^.equivalent^.text)); + WriteLn(' Using ', s2); + end; + end; + + CheckParm(orgnext^.text, orgnext^.equivalent^.text); + + Writeln(t,orgnext^.enum,'=',orgnext^.equivalent^.text); + Dec(i); Inc(i,orgnext^.equivalent^.ctxt); + if assigned(orgnext^.equivalent^.comment) and + (strlen(orgnext^.equivalent^.comment)>0) then + begin + Write(t,orgnext^.equivalent^.comment); + inc(i,orgnext^.equivalent^.cnb); + end + else if assigned(orgnext^.comment) and + (strlen(orgnext^.comment)>0) then + begin + Writeln('Comment from ',OrgFileName,' for enum ',orgnext^.enum,' added'); + Write(t,orgnext^.comment); + inc(i,orgnext^.cnb); + end; + end; + orgnext:=orgnext^.filenext; + end; + + while assigned(diffnext) do + begin + if not assigned(diffnext^.Equivalent) then + begin + { Skip removed enum in errore.msg} + { maybe a renaming of an enum !} + Writeln(diffnext^.enum,' commented out'); + Writeln(t,'%%% ',diffnext^.enum,'=',diffnext^.text); + inc(i,diffnext^.ctxt); + Write(t,diffnext^.comment); + inc(i,diffnext^.cnb); + end; + diffnext:=diffnext^.filenext; + end; + Close(t); + Close(t2); + Close(t3); + Writeln(ntcount,' not translated items found'); + end; + +begin + ProcessOptions; + ProcessFile(OrgFileName,orgroot,orgfirst); + ProcessFile(DiffFileName,diffRoot,difffirst); + PrintList('org.lst',OrgRoot); + PrintList('diff.lst',DiffRoot); + ShowDiff (OrgRoot,DiffRoot); + WriteReorderedFile(NewFileName,orgfirst,difffirst); +end. diff --git a/compiler/utils/msgused.pl b/compiler/utils/msgused.pl new file mode 100644 index 0000000000..6ac46d655b --- /dev/null +++ b/compiler/utils/msgused.pl @@ -0,0 +1,42 @@ +#!/usr/bin/perl +# +# find not used messages + +unlink("./msgidx.inc"); +unlink("./msgtxt.inc"); +@compiler_src = (glob("./*.inc"), + glob("./*.pas")); + +open(MESSAGE_FILE, "< ./msg/errore.msg") or + die "Couldn't open <./msg/errore.msg> for reading: $!\n"; + +open(FOUND, "> MSG-OK.TXT") or + die "Couldn't open <MSG-OK.TXT> for writing: $!\n"; + +select FOUND; $| = 1; + +open(NOT_FOUND, "> MSG_BAD.TXT") or + die "Couldn't open <MSG_BAD.TXT> for writing: $!\n"; + +select NOT_FOUND; $| = 1; + +while (<MESSAGE_FILE>) +{ + if (/^(\w\w\w*?_\w\w*?_\w\w*?)=/) + { + $msg = $1; + $found = `grep -il $msg @compiler_src`; + if ($found) { + print stderr "$msg\n"; + print FOUND $msg . "\n"; + } + else { + print stderr "NOT FOUND \t $msg\n"; + print NOT_FOUND $msg . "\n"; + } + } +} + +close(IN); +close(FOUND); +close(NOT_FOUND); diff --git a/compiler/utils/ppudump.pp b/compiler/utils/ppudump.pp new file mode 100644 index 0000000000..1d73b79276 --- /dev/null +++ b/compiler/utils/ppudump.pp @@ -0,0 +1,2191 @@ +{ + Copyright (c) 1998-2002 by the FPC Development Team + + Dumps the contents of a FPC unit file (PPU File) + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + ****************************************************************************} +{$ifdef TP} + {$N+,E+} +{$endif} +program pppdump; +uses + dos, + ppu; + +const + Version = 'Version 2.0.0'; + Title = 'PPU-Analyser'; + Copyright = 'Copyright (c) 1998-2005 by the Free Pascal Development Team'; + +{ verbosity } + v_none = $0; + v_header = $1; + v_defs = $2; + v_syms = $4; + v_interface = $8; + v_implementation = $10; + v_browser = $20; + v_all = $ff; + +type + tprocinfoflag=( + {# procedure uses asm } + pi_uses_asm, + {# procedure does a call } + pi_do_call, + {# procedure has a try statement = no register optimization } + pi_uses_exceptions, + {# procedure is declared as @var(assembler), don't optimize} + pi_is_assembler, + {# procedure contains data which needs to be finalized } + pi_needs_implicit_finally + ); + tprocinfoflags=set of tprocinfoflag; + + { Copied from systems.pas } + tsystemcpu= + ( + cpu_no, { 0 } + cpu_i386, { 1 } + cpu_m68k, { 2 } + cpu_alpha, { 3 } + cpu_powerpc, { 4 } + cpu_sparc, { 5 } + cpu_vm, { 6 } + cpu_iA64, { 7 } + cpu_x86_64, { 8 } + cpu_mips, { 9 } + cpu_arm { 10 } + ); + +var + ppufile : tppufile; + space : string; + unitindex : longint; + verbose : longint; + derefdata : pbyte; + derefdatalen : longint; + +{**************************************************************************** + Helper Routines +****************************************************************************} + +const has_errors : boolean = false; +Procedure Error(const S : string); +Begin + Writeln(S); + has_errors:=true; +End; + + +function ToStr(w:longint):String; +begin + Str(w,ToStr); +end; + +Function Target2Str(w:longint):string; +type + { taken from systems.pas } + ttarget = + ( + target_none, { 0 } + target_i386_GO32V1, { 1 } + target_i386_GO32V2, { 2 } + target_i386_linux, { 3 } + target_i386_OS2, { 4 } + target_i386_Win32, { 5 } + target_i386_freebsd, { 6 } + target_m68k_Amiga, { 7 } + target_m68k_Atari, { 8 } + target_m68k_Mac, { 9 } + target_m68k_linux, { 10 } + target_m68k_PalmOS, { 11 } + target_alpha_linux, { 12 } + target_powerpc_linux, { 13 } + target_powerpc_macos, { 14 } + target_i386_sunos, { 15 } + target_i386_beos, { 16 } + target_i386_netbsd, { 17 } + target_m68k_netbsd, { 18 } + target_i386_Netware, { 19 } + target_i386_qnx, { 20 } + target_i386_wdosx, { 21 } + target_sparc_sunos, { 22 } + target_sparc_linux, { 23 } + target_i386_openbsd, { 24 } + target_m68k_openbsd, { 25 } + system_x86_64_linux, { 26 } + system_powerpc_macosx, { 27 } + target_i386_emx, { 28 } + target_powerpc_netbsd, { 29 } + target_powerpc_openbsd, { 30 } + target_arm_linux, { 31 } + target_i386_watcom, { 32 } + target_powerpc_MorphOS, { 33 } + target_x86_64_freebsd, { 34 } + target_i386_netwlibc, { 35 } + system_powerpc_Amiga, { 36 } + system_x86_64_win64, { 37 } + system_arm_wince, { 38 } + system_ia64_win64, { 39 } + system_i386_wince, { 40 } + system_x86_6432_linux, { 41 } + system_arm_gba { 42 } + ); +const + Targets : array[ttarget] of string[17]=( + { 0 } 'none', + { 1 } 'GO32V1', + { 2 } 'GO32V2', + { 3 } 'Linux-i386', + { 4 } 'OS/2', + { 5 } 'Win32', + { 6 } 'FreeBSD-i386', + { 7 } 'Amiga', + { 8 } 'Atari', + { 9 } 'MacOS-m68k', + { 10 } 'Linux-m68k', + { 11 } 'PalmOS-m68k', + { 12 } 'Linux-alpha', + { 13 } 'Linux-ppc', + { 14 } 'MacOS-ppc', + { 15 } 'Solaris-i386', + { 16 } 'BeOS-i386', + { 17 } 'NetBSD-i386', + { 18 } 'NetBSD-m68k', + { 19 } 'Netware-i386-clib', + { 20 } 'Qnx-i386', + { 21 } 'WDOSX-i386', + { 22 } 'Solaris-sparc', + { 23 } 'Linux-sparc', + { 24 } 'OpenBSD-i386', + { 25 } 'OpenBSD-m68k', + { 26 } 'Linux-x86-64', + { 27 } 'MacOSX-ppc', + { 28 } 'OS/2 via EMX', + { 29 } 'NetBSD-powerpc', + { 30 } 'OpenBSD-powerpc', + { 31 } 'Linux-arm', + { 32 } 'Watcom-i386', + { 33 } 'MorphOS-powerpc', + { 34 } 'FreeBSD-x86-64', + { 35 } 'Netware-i386-libc', + { 36 } 'Amiga-PowerPC', + { 37 } 'Win64-x64', + { 38 } 'WinCE-ARM', + { 39 } 'Win64-iA64', + { 40 } 'WinCE-i386', + { 41 } 'Linux-x64', + { 42 } 'GBA-ARM' + ); +begin + if w<=ord(high(ttarget)) then + Target2Str:=Targets[ttarget(w)] + else + Target2Str:='<!! Unknown target value '+tostr(w)+'>'; +end; + + +Function Cpu2Str(w:longint):string; +const + CpuTxt : array[tsystemcpu] of string[8]= + ('none','i386','m68k','alpha','powerpc','sparc','vis','ia64','x86_64','mips','arm'); +begin + if w<=ord(high(tsystemcpu)) then + Cpu2Str:=CpuTxt[tsystemcpu(w)] + else + Cpu2Str:='<!! Unknown cpu value '+tostr(w)+'>'; +end; + + +Function Varspez2Str(w:longint):string; +const + varspezstr : array[0..4] of string[6]=('Value','Const','Var','Out','Hidden'); +begin + if w<=ord(high(varspezstr)) then + Varspez2Str:=varspezstr[w] + else + Varspez2Str:='<!! Unknown varspez value '+tostr(w)+'>'; +end; + +Function VarRegable2Str(w:longint):string; +const + varregableStr : array[0..3] of string[6]=('None','IntReg','FPUReg','MMReg'); +begin + if w<=ord(high(varregablestr)) then + Varregable2Str:=varregablestr[w] + else + Varregable2Str:='<!! Unknown regable value '+tostr(w)+'>'; +end; + + +function PPUFlags2Str(flags:longint):string; +type + tflagopt=record + mask : longint; + str : string[30]; + end; +const + flagopts=19; + flagopt : array[1..flagopts] of tflagopt=( + (mask: $1 ;str:'init'), + (mask: $2 ;str:'final'), + (mask: $4 ;str:'big_endian'), + (mask: $8 ;str:'dbx'), + (mask: $10 ;str:'browser'), + (mask: $20 ;str:'in_library'), + (mask: $40 ;str:'smart_linked'), + (mask: $80 ;str:'static_linked'), + (mask: $100 ;str:'shared_linked'), + (mask: $200 ;str:'local_browser'), + (mask: $400 ;str:'no_link'), + (mask: $800 ;str:'has_resources'), + (mask: $1000 ;str:'little_endian'), + (mask: $2000 ;str:'release'), + (mask: $4000 ;str:'local_threadvars'), + (mask: $8000 ;str:'fpu_emulation_on'), + (mask: $10000 ;str:'has_debug_info'), + (mask: $20000 ;str:'local_symtable'), + (mask: $40000 ;str:'uses_variants') + ); +var + i : longint; + first : boolean; + s : string; +begin + s:=''; + if flags<>0 then + begin + first:=true; + for i:=1to flagopts do + if (flags and flagopt[i].mask)<>0 then + begin + if first then + first:=false + else + s:=s+', '; + s:=s+flagopt[i].str; + end; + end + else + s:='none'; + PPUFlags2Str:=s; +end; + + +const + HexTbl : array[0..15] of char='0123456789ABCDEF'; +function HexB(b:byte):string; +begin + HexB[0]:=#2; + HexB[1]:=HexTbl[b shr 4]; + HexB[2]:=HexTbl[b and $f]; +end; + + +function hexstr(val : cardinal;cnt : byte) : string; +const + HexTbl : array[0..15] of char='0123456789ABCDEF'; +var + i : longint; +begin + hexstr[0]:=char(cnt); + for i:=cnt downto 1 do + begin + hexstr[i]:=hextbl[val and $f]; + val:=val shr 4; + end; +end; + + + Function L0(l:longint):string; + { + return the string of value l, if l<10 then insert a zero, so + the string is always at least 2 chars '01','02',etc + } + var + s : string; + begin + Str(l,s); + if l<10 then + s:='0'+s; + L0:=s; + end; + + + function filetimestring( t : longint) : string; + { + convert dos datetime t to a string YY/MM/DD HH:MM:SS + } + var + DT : DateTime; + begin + if t=-1 then + begin + FileTimeString:='Not Found'; + exit; + end; + unpacktime(t,DT); + filetimestring:=L0(dt.Year)+'/'+L0(dt.Month)+'/'+L0(dt.Day)+' '+L0(dt.Hour)+':'+L0(dt.min)+':'+L0(dt.sec); + end; + + +{**************************************************************************** + Read Routines +****************************************************************************} + +Procedure ReadLinkContainer(const prefix:string); +{ + Read a serie of strings and write to the screen starting every line + with prefix +} + function maskstr(m:longint):string; + const + { link options } + link_none = $0; + link_allways = $1; + link_static = $2; + link_smart = $4; + link_shared = $8; + var + s : string; + begin + s:=''; + if (m and link_allways)<>0 then + s:=s+'always '; + if (m and link_static)<>0 then + s:=s+'static '; + if (m and link_smart)<>0 then + s:=s+'smart '; + if (m and link_shared)<>0 then + s:=s+'shared '; + maskstr:=s; + end; + +var + s : string; + m : longint; +begin + while not ppufile.endofentry do + begin + s:=ppufile.getstring; + m:=ppufile.getlongint; + WriteLn(prefix,s,' (',maskstr(m),')'); + end; +end; + + +Procedure ReadContainer(const prefix:string); +{ + Read a serie of strings and write to the screen starting every line + with prefix +} +begin + while not ppufile.endofentry do + WriteLn(prefix,ppufile.getstring); +end; + + +procedure ReadLoadUnit; +var + ucrc,uintfcrc : cardinal; +begin + while not ppufile.EndOfEntry do + begin + write('Uses unit: ',ppufile.getstring); + ucrc:=cardinal(ppufile.getlongint); + uintfcrc:=cardinal(ppufile.getlongint); + writeln(' (Crc: ',hexstr(ucrc,8),', IntfcCrc: ',hexstr(uintfcrc,8),')'); + end; +end; + + +Procedure ReadDerefmap; +var + i,mapsize : longint; +begin + mapsize:=ppufile.getword; + writeln('DerefMapsize: ',mapsize); + for i:=0 to mapsize-1 do + writeln('DerefMap[',i,'] = ',ppufile.getstring); +end; + + +Procedure ReadDerefdata; +begin + derefdatalen:=ppufile.entrysize; + if derefdatalen=0 then + begin + writeln('!! Error: derefdatalen=0'); + exit; + end; + Writeln('Derefdata length: ',derefdatalen); + derefdata:=allocmem(derefdatalen); + ppufile.getdata(derefdata^,derefdatalen); +end; + + +Procedure ReadRef; +begin + if (verbose and v_browser)=0 then + exit; + while (not ppufile.endofentry) and (not ppufile.error) do + Writeln(space,' - Refered : ',ppufile.getword,', (',ppufile.getlongint,',',ppufile.getword,')'); +end; + + +Procedure ReadAsmSymbols; +type + { Copied from aasmbase.pas } + TAsmsymbind=(AB_NONE,AB_EXTERNAL,AB_COMMON,AB_LOCAL,AB_GLOBAL); + TAsmsymtype=(AT_NONE,AT_FUNCTION,AT_DATA,AT_SECTION,AT_LABEL); +var + s, + bindstr, + typestr : string; + i : longint; +begin + writeln(space,'Number of AsmSymbols: ',ppufile.getlongint); + i:=0; + while (not ppufile.endofentry) and (not ppufile.error) do + begin + s:=ppufile.getstring; + case tasmsymbind(ppufile.getbyte) of + AB_EXTERNAL : + bindstr:='External'; + AB_COMMON : + bindstr:='Common'; + AB_LOCAL : + bindstr:='Local'; + AB_GLOBAL : + bindstr:='Global'; + else + bindstr:='<Error !!>' + end; + case tasmsymtype(ppufile.getbyte) of + AT_FUNCTION : + typestr:='Function'; + AT_DATA : + typestr:='Data'; + AT_SECTION : + typestr:='Section'; + AT_LABEL : + typestr:='Label'; + else + typestr:='<Error !!>' + end; + Writeln(space,' ',i,' : ',s,' [',bindstr,',',typestr,']'); + inc(i); + end; +end; + + +Procedure ReadPosInfo; +var + info : byte; + fileindex,line,column : longint; +begin + with ppufile do + begin + { + info byte layout in bits: + 0-1 - amount of bytes for fileindex + 2-3 - amount of bytes for line + 4-5 - amount of bytes for column + } + info:=getbyte; + case (info and $03) of + 0 : fileindex:=getbyte; + 1 : fileindex:=getword; + 2 : fileindex:=(getbyte shl 16) or getword; + 3 : fileindex:=getlongint; + end; + case ((info shr 2) and $03) of + 0 : line:=getbyte; + 1 : line:=getword; + 2 : line:=(getbyte shl 16) or getword; + 3 : line:=getlongint; + end; + case ((info shr 4) and $03) of + 0 : column:=getbyte; + 1 : column:=getword; + 2 : column:=(getbyte shl 16) or getword; + 3 : column:=getlongint; + end; + Writeln(fileindex,' (',line,',',column,')'); + end; +end; + + +procedure readderef; +type + tdereftype = (deref_nil, + deref_sym, + deref_def, + deref_aktrecord, + deref_aktstatic, + deref_aktglobal, + deref_aktlocal, + deref_aktpara, + deref_unit, + deref_record, + deref_local, + deref_para, + deref_parent_object + ); +var + b : tdereftype; + first : boolean; + idx : longint; + i,n : byte; + pdata : pbyte; +begin + if not assigned(derefdata) then + exit; + first:=true; + idx:=ppufile.getlongint; + if (idx>derefdatalen) then + begin + writeln('!! Error: Deref idx ',idx,' > ',derefdatalen); + exit; + end; + write('(',idx,') '); + pdata:=@derefdata[idx]; + i:=0; + n:=pdata[i]; + inc(i); + if n<1 then + begin + writeln('!! Error: Deref len < 1'); + exit; + end; + while (i<n) do + begin + if not first then + write(', ') + else + first:=false; + b:=tdereftype(pdata[i]); + inc(i); + case b of + deref_nil : + write('Nil'); + deref_def : + begin + idx:=pdata[i] shl 8; + idx:=idx or pdata[i+1]; + inc(i,2); + write('Definition ',idx); + end; + deref_sym : + begin + idx:=pdata[i] shl 8; + idx:=idx or pdata[i+1]; + inc(i,2); + write('Symbol ',idx); + end; + deref_aktrecord : + write('AktRecord'); + deref_aktstatic : + write('AktStatic'); + deref_aktglobal : + write('AktGlobal'); + deref_aktlocal : + write('AktLocal'); + deref_aktpara : + write('AktPara'); + deref_unit : + begin + idx:=pdata[i] shl 8; + idx:=idx or pdata[i+1]; + inc(i,2); + write('Unit ',idx); + end; + deref_record : + write('RecordDef'); + deref_para : + write('Parameter of procdef'); + deref_local : + write('Local of procdef'); + deref_parent_object : + write('Parent object'); + else + begin + writeln('!! unsupported dereftyp: ',ord(b)); + break; + end; + end; + end; + writeln; +end; + + +procedure readtype; +begin + readderef; +end; + + +procedure readsymlist(const s:string); +type + tsltype = (sl_none, + sl_load, + sl_call, + sl_subscript, + sl_vec + ); +const + slstr : array[tsltype] of string[9] = ('', + 'load', + 'call', + 'subscript', + 'vec' + ); +var + sl : tsltype; +begin + readderef; + repeat + sl:=tsltype(ppufile.getbyte); + if sl=sl_none then + break; + write(s,'(',slstr[sl],') '); + case sl of + sl_call, + sl_load, + sl_subscript : + readderef; + sl_vec : + writeln(ppufile.getlongint); + end; + until false; +end; + + +procedure readsymoptions; +type + tsymoption=(sp_none, + sp_public, + sp_private, + sp_published, + sp_protected, + sp_static, + sp_hint_deprecated, + sp_hint_platform, + sp_hint_library, + sp_hint_unimplemented, + sp_has_overloaded, + sp_internal { internal symbol, not reported as unused } + ); + tsymoptions=set of tsymoption; + tsymopt=record + mask : tsymoption; + str : string[30]; + end; +const + symopts=11; + symopt : array[1..symopts] of tsymopt=( + (mask:sp_public; str:'Public'), + (mask:sp_private; str:'Private'), + (mask:sp_published; str:'Published'), + (mask:sp_protected; str:'Protected'), + (mask:sp_static; str:'Static'), + (mask:sp_hint_deprecated;str:'Hint Deprecated'), + (mask:sp_hint_deprecated;str:'Hint Platform'), + (mask:sp_hint_deprecated;str:'Hint Library'), + (mask:sp_hint_deprecated;str:'Hint Unimplemented'), + (mask:sp_has_overloaded; str:'Has overloaded'), + (mask:sp_internal; str:'Internal') + ); +var + symoptions : tsymoptions; + i : longint; + first : boolean; +begin + ppufile.getsmallset(symoptions); + if symoptions<>[] then + begin + first:=true; + for i:=1to symopts do + if (symopt[i].mask in symoptions) then + begin + if first then + first:=false + else + write(', '); + write(symopt[i].str); + end; + end; + writeln; +end; + + +procedure readcommonsym(const s:string); +begin + writeln(space,'** Symbol Nr. ',ppufile.getword,' **'); + writeln(space,s,ppufile.getstring); + write(space,' File Pos : '); + readposinfo; + write(space,' SymOptions : '); + readsymoptions; +end; + + +procedure readcommondef(const s:string); +type + tdefoption=(df_none, + df_has_inittable, { init data has been generated } + df_has_rttitable, { rtti data has been generated } + df_unique + ); + tdefoptions=set of tdefoption; +var + defopts : tdefoptions; +begin + writeln(space,'** Definition Nr. ',ppufile.getword,' **'); + writeln(space,s); + write (space,' Type symbol : '); + readderef; + ppufile.getsmallset(defopts); + + if df_unique in defopts then + writeln (space,' Unique type symbol'); + + if df_has_rttitable in defopts then + begin + write (space,' RTTI symbol : '); + readderef; + end; + if df_has_inittable in defopts then + begin + write (space,' Init symbol : '); + readderef; + end; +end; + + +{ Read abstract procdef and return if inline procdef } +type + tproccalloption=(pocall_none, + { procedure uses C styled calling } + pocall_cdecl, + { C++ calling conventions } + pocall_cppdecl, + { Far16 for OS/2 } + pocall_far16, + { Old style FPC default calling } + pocall_oldfpccall, + { Procedure has compiler magic} + pocall_internproc, + { procedure is a system call, applies e.g. to MorphOS and PalmOS } + pocall_syscall, + { pascal standard left to right } + pocall_pascal, + { procedure uses register (fastcall) calling } + pocall_register, + { safe call calling conventions } + pocall_safecall, + { procedure uses stdcall call } + pocall_stdcall, + { Special calling convention for cpus without a floating point + unit. Floating point numbers are passed in integer registers + instead of floating point registers. Depending on the other + available calling conventions available for the cpu + this replaces either pocall_fastcall or pocall_stdcall. + } + pocall_softfloat, + { Metrowerks Pascal. Special case on Mac OS (X): passes all } + { constant records by reference. } + pocall_mwpascal + ); + tproccalloptions=set of tproccalloption; + tproctypeoption=(potype_none, + potype_proginit, { Program initialization } + potype_unitinit, { unit initialization } + potype_unitfinalize, { unit finalization } + potype_constructor, { Procedure is a constructor } + potype_destructor, { Procedure is a destructor } + potype_operator, { Procedure defines an operator } + potype_procedure, + potype_function + ); + tproctypeoptions=set of tproctypeoption; + 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_interrupt, { Procedure is an interrupt handler } + po_iocheck, { IO checking should be done after a call to the procedure } + po_assembler, { Procedure is written in assembler } + po_msgstr, { method for string message handling } + po_msgint, { method for int message handling } + po_exports, { Procedure has export directive (needed for OS/2) } + po_external, { Procedure is external (in other object or lib)} + po_overload, { procedure is declared with overload directive } + po_varargs, { printf like arguments } + po_internconst, { procedure has constant evaluator intern } + { flag that only the address of a method is returned and not a full methodpointer } + po_addressonly, + { procedure is exported } + po_public, + { calling convention is specified explicitly } + po_hascallingconvention, + { reintroduce flag } + po_reintroduce, + { location of parameters is given explicitly as it is necessary for some syscall + conventions like that one of MorphOS } + po_explicitparaloc, + { no stackframe will be generated, used by lowlevel assembler like get_frame } + po_nostackframe, + po_has_mangledname, + po_has_public_name, + po_forward, + po_global, + po_has_inlininginfo, + { The different kind of syscalls on MorphOS } + po_syscall_legacy, + po_syscall_sysv, + po_syscall_basesysv, + po_syscall_sysvbase, + po_syscall_r12base, + po_local, + { Procedure can be inlined } + po_inline, + { Procedure is used for internal compiler calls } + po_compilerproc + ); + tprocoptions=set of tprocoption; +procedure read_abstract_proc_def(var proccalloption:tproccalloption;var procoptions:tprocoptions); +type + tproccallopt=record + mask : tproccalloption; + str : string[30]; + end; + tproctypeopt=record + mask : tproctypeoption; + str : string[30]; + end; + tprocopt=record + mask : tprocoption; + str : string[30]; + end; +const + proccalloptionStr : array[tproccalloption] of string[14]=('', + 'CDecl', + 'CPPDecl', + 'Far16', + 'OldFPCCall', + 'InternProc', + 'SysCall', + 'Pascal', + 'Register', + 'SafeCall', + 'StdCall', + 'SoftFloat', + 'MWPascal' + ); + proctypeopts=8; + proctypeopt : array[1..proctypeopts] of tproctypeopt=( + (mask:potype_proginit; str:'ProgInit'), + (mask:potype_unitinit; str:'UnitInit'), + (mask:potype_unitfinalize;str:'UnitFinalize'), + (mask:potype_constructor; str:'Constructor'), + (mask:potype_destructor; str:'Destructor'), + (mask:potype_operator; str:'Operator'), + (mask:potype_function; str:'Function'), + (mask:potype_procedure; str:'Procedure') + ); + procopts=35; + procopt : array[1..procopts] of tprocopt=( + (mask:po_classmethod; str:'ClassMethod'), + (mask:po_virtualmethod; str:'VirtualMethod'), + (mask:po_abstractmethod; str:'AbstractMethod'), + (mask:po_staticmethod; str:'StaticMethod'), + (mask:po_overridingmethod;str:'OverridingMethod'), + (mask:po_methodpointer; str:'MethodPointer'), + (mask:po_interrupt; str:'Interrupt'), + (mask:po_iocheck; str:'IOCheck'), + (mask:po_assembler; str:'Assembler'), + (mask:po_msgstr; str:'MsgStr'), + (mask:po_msgint; str:'MsgInt'), + (mask:po_exports; str:'Exports'), + (mask:po_external; str:'External'), + (mask:po_overload; str:'Overload'), + (mask:po_varargs; str:'VarArgs'), + (mask:po_internconst; str:'InternConst'), + (mask:po_addressonly; str:'AddressOnly'), + (mask:po_public; str:'Public'), + (mask:po_hascallingconvention;str:'HasCallingConvention'), + (mask:po_reintroduce; str:'ReIntroduce'), + (mask:po_explicitparaloc; str:'ExplicitParaloc'), + (mask:po_nostackframe; str:'NoStackFrame'), + (mask:po_has_mangledname; str:'HasMangledName'), + (mask:po_has_public_name; str:'HasPublicName'), + (mask:po_forward; str:'Forward'), + (mask:po_global; str:'Global'), + (mask:po_has_inlininginfo;str:'HasInliningInfo'), + (mask:po_syscall_legacy; str:'SyscallLegacy'), + (mask:po_syscall_sysv; str:'SyscallSysV'), + (mask:po_syscall_basesysv;str:'SyscallBaseSysV'), + (mask:po_syscall_sysvbase;str:'SyscallSysVBase'), + (mask:po_syscall_r12base; str:'SyscallR12Base'), + (mask:po_local; str:'Local'), + (mask:po_inline; str:'Inline'), + (mask:po_compilerproc; str:'CompilerProc') + ); +var + proctypeoption : tproctypeoption; + i : longint; + first : boolean; + tempbuf : array[0..255] of byte; +begin + write(space,' Return type : '); + readtype; + writeln(space,' Fpu used : ',ppufile.getbyte); + proctypeoption:=tproctypeoption(ppufile.getbyte); + write(space,' TypeOption : '); + first:=true; + for i:=1 to proctypeopts do + if (proctypeopt[i].mask=proctypeoption) then + begin + if first then + first:=false + else + write(', '); + write(proctypeopt[i].str); + end; + writeln; + proccalloption:=tproccalloption(ppufile.getbyte); + writeln(space,' CallOption : ',proccalloptionStr[proccalloption]); + ppufile.getnormalset(procoptions); + if procoptions<>[] then + begin + write(space,' Options : '); + first:=true; + for i:=1to procopts do + if (procopt[i].mask in procoptions) then + begin + if first then + first:=false + else + write(', '); + write(procopt[i].str); + end; + writeln; + end; + if (po_explicitparaloc in procoptions) then + begin + i:=ppufile.getbyte; + ppufile.getdata(tempbuf,i); + end; +end; + + +type + { options for variables } + tvaroption=(vo_none, + vo_is_C_var, + vo_is_external, + vo_is_dll_var, + vo_is_thread_var, + vo_has_local_copy, + vo_is_const, { variable is declared as const (parameter) and can't be written to } + vo_is_exported, + vo_is_high_para, + vo_is_funcret, + vo_is_self, + vo_is_vmt, + vo_is_result, { special result variable } + vo_is_parentfp, + vo_is_loop_counter, { used to detect assignments to loop counter } + vo_is_hidden_para, + vo_has_explicit_paraloc, + vo_is_syscall_lib, + vo_has_mangledname + ); + tvaroptions=set of tvaroption; + { register variable } + tvarregable=(vr_none, + vr_intreg, + vr_fpureg, + vr_mmreg + ); +procedure readabstractvarsym(const s:string;var varoptions:tvaroptions); +type + tvaropt=record + mask : tvaroption; + str : string[30]; + end; +const + varopts=18; + varopt : array[1..varopts] of tvaropt=( + (mask:vo_is_C_var; str:'CVar'), + (mask:vo_is_external; str:'External'), + (mask:vo_is_dll_var; str:'DLLVar'), + (mask:vo_is_thread_var; str:'ThreadVar'), + (mask:vo_has_local_copy; str:'HasLocalCopy'), + (mask:vo_is_const; str:'Constant'), + (mask:vo_is_exported; str:'Exported'), + (mask:vo_is_high_para; str:'HighValue'), + (mask:vo_is_funcret; str:'Funcret'), + (mask:vo_is_self; str:'Self'), + (mask:vo_is_vmt; str:'VMT'), + (mask:vo_is_result; str:'Result'), + (mask:vo_is_parentfp; str:'ParentFP'), + (mask:vo_is_loop_counter; str:'LoopCounter'), + (mask:vo_is_hidden_para; str:'Hidden'), + (mask:vo_has_explicit_paraloc;str:'ExplicitParaloc'), + (mask:vo_is_syscall_lib; str:'SysCallLib'), + (mask:vo_has_mangledname; str:'HasMangledName') + ); +var + i : longint; + first : boolean; +begin + readcommonsym(s); + writeln(space,' Spez : ',Varspez2Str(ppufile.getbyte)); + writeln(space,' Regable : ',Varregable2Str(ppufile.getbyte)); + write (space,' Var Type : '); + readtype; + ppufile.getsmallset(varoptions); + if varoptions<>[] then + begin + write(space,' Options : '); + first:=true; + for i:=1to varopts do + if (varopt[i].mask in varoptions) then + begin + if first then + first:=false + else + write(', '); + write(varopt[i].str); + end; + writeln; + end; +end; + + +procedure readnodetree; +var + l : longint; + p : pointer; +begin + with ppufile do + begin + if space<>'' then + Writeln(space,'------ nodetree ------'); + if readentry=ibnodetree then + begin + l:=entrysize; + Writeln(space,'Tree size : ',l); + { Read data to prevent error that entry is not completly read } + getmem(p,l); + getdata(p^,l); + freemem(p); + end + else + begin + Writeln('!! ibnodetree not found'); + end; + end; +end; + + +{**************************************************************************** + Read Symbols Part +****************************************************************************} + +procedure readsymbols(const s:string); +type + pguid = ^tguid; + tguid = packed record + D1: LongWord; + D2: Word; + D3: Word; + D4: array[0..7] of Byte; + end; + + absolutetyp = (tovar,toasm,toaddr); + tconsttyp = (constnone, + constord,conststring,constreal, + constset,constpointer,constnil, + constresourcestring,constwstring,constguid + ); +var + b : byte; + pc : pchar; + totalsyms, + symcnt, + i,j,len : longint; + guid : tguid; + tempbuf : array[0..127] of char; + varoptions : tvaroptions; +begin + symcnt:=1; + with ppufile do + begin + if space<>'' then + Writeln(space,'------ ',s,' ------'); + if readentry=ibstartsyms then + begin + totalsyms:=getlongint; + Writeln(space,'Number of symbols : ',totalsyms); + Writeln(space,'Symtable datasize : ',getlongint); + Writeln(space,'Symtable alignment: ',getlongint); + end + else + begin + totalsyms:=-1; + Writeln('!! ibstartsym not found'); + end; + repeat + b:=readentry; + if not (b in [iberror,ibendsyms]) then + inc(symcnt); + case b of + + ibunitsym : + readcommonsym('Unit symbol '); + + iblabelsym : + readcommonsym('Label symbol '); + + ibtypesym : + begin + readcommonsym('Type symbol '); + write(space,' Result Type : '); + readtype; + end; + + ibprocsym : + begin + readcommonsym('Procedure symbol '); + len:=ppufile.getword; + for i:=1 to len do + begin + write(space,' Definition : '); + readderef; + end; + end; + + ibconstsym : + begin + readcommonsym('Constant symbol '); + b:=getbyte; + case tconsttyp(b) of + constord : + begin + write (space,' OrdinalType : '); + readtype; + writeln(space,' Value : ',getint64); + end; + constpointer : + begin + write (space,' PointerType : '); + readtype; + writeln(space,' Value : ',getlongint) + end; + conststring, + constresourcestring : + begin + len:=getlongint; + getmem(pc,len+1); + getdata(pc^,len); + (pc+len)^:= #0; + writeln(space,' Length : ',len); + writeln(space,' Value : "',pc,'"'); + freemem(pc,len+1); + if tconsttyp(b)=constresourcestring then + writeln(space,' Index : ',getlongint); + end; + constreal : + writeln(space,' Value : ',getreal); + constset : + begin + write (space,' Set Type : '); + readtype; + for i:=1to 4 do + begin + write (space,' Value : '); + for j:=1to 8 do + begin + if j>1 then + write(','); + write(hexb(getbyte)); + end; + writeln; + end; + end; + constwstring: + begin + end; + constguid: + begin + getdata(guid,sizeof(guid)); + write (space,' IID String: {',hexstr(guid.d1,8),'-',hexstr(guid.d2,4),'-',hexstr(guid.d3,4),'-'); + for i:=0 to 7 do + begin + write(hexstr(guid.d4[i],2)); + if i=1 then write('-'); + end; + writeln('}'); + end + else + Writeln ('!! Invalid unit format : Invalid const type encountered: ',b); + end; + end; + + ibabsolutevarsym : + begin + readabstractvarsym('Absolute variable symbol ',varoptions); + Write (space,' Relocated to '); + b:=getbyte; + case absolutetyp(b) of + tovar : + readsymlist(space+' Sym : '); + toasm : + Writeln('Assembler name : ',getstring); + toaddr : + begin + Write('Address : ',getlongint); + if tsystemcpu(ppufile.header.cpu)=cpu_i386 then + WriteLn(' (Far: ',getbyte<>0,')'); + end; + else + Writeln ('!! Invalid unit format : Invalid absolute type encountered: ',b); + end; + end; + + ibfieldvarsym : + begin + readabstractvarsym('Field Variable symbol ',varoptions); + writeln(space,' Address : ',getlongint); + end; + + ibglobalvarsym : + begin + readabstractvarsym('Global Variable symbol ',varoptions); + write (space,' DefaultConst : '); + readderef; + if (vo_has_mangledname in varoptions) then + writeln(space,' Mangledname : ',getstring); + end; + + iblocalvarsym : + begin + readabstractvarsym('Local Variable symbol ',varoptions); + write (space,' DefaultConst : '); + readderef; + end; + + ibparavarsym : + begin + readabstractvarsym('Parameter Variable symbol ',varoptions); + write (space,' DefaultConst : '); + readderef; + writeln(space,' ParaNr : ',getword); + if (vo_has_explicit_paraloc in varoptions) then + begin + i:=getbyte; + getdata(tempbuf,i); + end; + end; + + ibenumsym : + begin + readcommonsym('Enumeration symbol '); + write (space,' Definition : '); + readderef; + writeln(space,' Value : ',getlongint); + end; + + ibsyssym : + begin + readcommonsym('Internal system symbol '); + writeln(space,' Internal Nr : ',getlongint); + end; + + ibrttisym : + begin + readcommonsym('RTTI symbol '); + writeln(space,' RTTI Type : ',getbyte); + end; + + ibmacrosym : + begin + readcommonsym('Macro symbol '); + writeln(space,' Name: ',getstring); + writeln(space,' Defined: ',getbyte); + writeln(space,' Compiler var: ',getbyte); + len:=getlongint; + writeln(space,' Value length: ',len); + if len > 0 then + begin + getmem(pc,len+1); + getdata(pc^,len); + (pc+len)^:= #0; + writeln(space,' Value: "',pc,'"'); + freemem(pc,len+1); + end; + end; + + ibtypedconstsym : + begin + readcommonsym('Typed constant '); + write (space,' Constant Type : '); + readtype; + writeln(space,' ReallyConst : ',(getbyte<>0)); + end; + + ibpropertysym : + begin + readcommonsym('Property '); + i:=getlongint; + writeln(space,' PropOptions : ',i); + if (i and 32)>0 then + begin + write (space,' OverrideProp : '); + readderef; + end + else + begin + write (space,' Prop Type : '); + readtype; + writeln(space,' Index : ',getlongint); + writeln(space,' Default : ',getlongint); + write (space,' Index Type : '); + readtype; + write (space,' Readaccess : '); + readsymlist(space+' Sym: '); + write (space,' Writeaccess : '); + readsymlist(space+' Sym: '); + write (space,' Storedaccess : '); + readsymlist(space+' Sym: '); + end; + end; + + iberror : + begin + Writeln('!! Error in PPU'); + exit; + end; + + ibendsyms : + break; + + else + WriteLn('!! Skipping unsupported PPU Entry in Symbols: ',b); + end; + if not EndOfEntry then + Writeln('!! Entry has more information stored'); + until false; + if (totalsyms<>-1) and (symcnt-1<>totalsyms) then + Writeln('!! Only read ',symcnt-1,' of ',totalsyms,' symbols'); + end; +end; + + +{**************************************************************************** + Read defintions Part +****************************************************************************} + +procedure readdefinitions(const s:string;start_read : boolean); +type + tsettype = (normset,smallset,varset); + tbasetype = ( + uvoid, + u8bit,u16bit,u32bit,u64bit, + s8bit,s16bit,s32bit,s64bit, + bool8bit,bool16bit,bool32bit, + uchar,uwidechar,scurrency + ); + tobjectdeftype = (odt_none, + odt_class, + odt_object, + odt_interfacecom, + odt_interfacecorba, + odt_cppclass + ); + tvarianttype = ( + vt_normalvariant,vt_olevariant + ); +var + b : byte; + totaldefs,l,j, + defcnt : longint; + calloption : tproccalloption; + procoptions : tprocoptions; + procinfooptions : tprocinfoflag; + +begin + defcnt:=0; + with ppufile do + begin + if space<>'' then + Writeln(space,'------ ',s,' ------'); + if not start_read then + if readentry=ibstartdefs then + begin + totaldefs:=getlongint; + Writeln(space,'Number of definitions: ',totaldefs); + end + else + begin + totaldefs:=-1; + Writeln('!! ibstartdef not found'); + end; + repeat + b:=readentry; + if not (b in [iberror,ibenddefs]) then + inc(defcnt); + case b of + + ibpointerdef : + begin + readcommondef('Pointer definition'); + write (space,' Pointed Type : '); + readtype; + writeln(space,' Is Far : ',(getbyte<>0)); + end; + + iborddef : + begin + readcommondef('Ordinal definition'); + write (space,' Base type : '); + b:=getbyte; + case tbasetype(b) of + uvoid : writeln('uvoid'); + u8bit : writeln('u8bit'); + u16bit : writeln('u16bit'); + u32bit : writeln('s32bit'); + u64bit : writeln('u64bit'); + s8bit : writeln('s8bit'); + s16bit : writeln('s16bit'); + s32bit : writeln('s32bit'); + s64bit : writeln('s64bit'); + bool8bit : writeln('bool8bit'); + bool16bit : writeln('bool16bit'); + bool32bit : writeln('bool32bit'); + uchar : writeln('uchar'); + uwidechar : writeln('uwidechar'); + scurrency : writeln('ucurrency'); + else writeln('!! Warning: Invalid base type ',b); + end; + writeln(space,' Range : ',getint64,' to ',getint64); + end; + + ibfloatdef : + begin + readcommondef('Float definition'); + writeln(space,' Float type : ',getbyte); + end; + + ibarraydef : + begin + readcommondef('Array definition'); + write (space,' Element type : '); + readtype; + write (space,' Range Type : '); + readtype; + writeln(space,' Range : ',getlongint,' to ',getlongint); + writeln(space,' Is Constructor : ',(getbyte<>0)); + writeln(space,' Is Dynamic : ',(getbyte<>0)); + end; + + ibprocdef : + begin + readcommondef('Procedure definition'); + read_abstract_proc_def(calloption,procoptions); + if (po_has_mangledname in procoptions) then + writeln(space,' Mangled name : ',getstring); + writeln(space,' Number : ',getword); + writeln(space,' Level : ',getbyte); + write (space,' Class : '); + readderef; + write (space,' Procsym : '); + readderef; + write (space,' File Pos : '); + readposinfo; + write (space,' SymOptions : '); + readsymoptions; + if tsystemcpu(ppufile.header.cpu)=cpu_powerpc then + begin + { library symbol for AmigaOS/MorphOS } + write (space,' Library symbol : '); + readderef; + end; + if (po_inline in procoptions) then + begin + write (space,' FuncretSym : '); + readderef; + ppufile.getsmallset(procinfooptions); + writeln(space,' ProcInfoOptions : ',dword(procinfooptions)); + b := ppufile.getbyte; + writeln(space,' Inline node tree : ',b); + end; + if not EndOfEntry then + Writeln('!! Entry has more information stored'); + space:=' '+space; + { parast } + readdefinitions('parast',false); + readsymbols('parast'); + { localst } + if (po_has_inlininginfo in procoptions) or + ((ppufile.header.flags and uf_local_browser)<>0) then + begin + readdefinitions('localst',false); + readsymbols('localst'); + end; + if (po_has_inlininginfo in procoptions) then + readnodetree; + delete(space,1,4); + end; + + ibprocvardef : + begin + readcommondef('Procedural type (ProcVar) definition'); + read_abstract_proc_def(calloption,procoptions); + if not EndOfEntry then + Writeln('!! Entry has more information stored'); + space:=' '+space; + { parast } + readdefinitions('parast',false); + readsymbols('parast'); + delete(space,1,4); + end; + + ibshortstringdef : + begin + readcommondef('ShortString definition'); + writeln(space,' Length : ',getbyte); + end; + + ibwidestringdef : + begin + readcommondef('WideString definition'); + writeln(space,' Length : ',getlongint); + end; + + ibansistringdef : + begin + readcommondef('AnsiString definition'); + writeln(space,' Length : ',getlongint); + end; + + iblongstringdef : + begin + readcommondef('Longstring definition'); + writeln(space,' Length : ',getlongint); + end; + + ibrecorddef : + begin + readcommondef('Record definition'); + writeln(space,' DataSize : ',getlongint); + writeln(space,' FieldAlign : ',getbyte); + writeln(space,' RecordAlign : ',getbyte); + writeln(space,' PadAlign : ',getbyte); + if not EndOfEntry then + Writeln('!! Entry has more information stored'); + {read the record definitions and symbols} + space:=' '+space; + readdefinitions('fields',false); + readsymbols('fields'); + Delete(space,1,4); + end; + + ibobjectdef : + begin + readcommondef('Object/Class definition'); + b:=getbyte; + write (space,' Type : '); + case tobjectdeftype(b) of + odt_class : writeln('class'); + odt_object : writeln('object'); + odt_interfacecom : writeln('interfacecom'); + odt_interfacecorba : writeln('interfacecorba'); + odt_cppclass : writeln('cppclass'); + else writeln('!! Warning: Invalid object type ',b); + end; + writeln(space,' Name of Class : ',getstring); + writeln(space,' DataSize : ',getlongint); + writeln(space,' FieldAlign : ',getbyte); + writeln(space,' RecordAlign : ',getbyte); + writeln(space,' Vmt offset : ',getlongint); + write(space, ' Ancestor Class : '); + readderef; + writeln(space,' Options : ',getlongint); + + if tobjectdeftype(b) in [odt_interfacecom,odt_interfacecorba] then + begin + { IIDGUID } + for j:=1to 16 do + getbyte; + writeln(space,' IID String : ',getstring); + writeln(space,' Last VTable idx : ',getlongint); + end; + + if tobjectdeftype(b) in [odt_class,odt_interfacecorba] then + begin + l:=getlongint; + writeln(space,' Impl Intf Count : ',l); + for j:=1 to l do + begin + write (space,' - Definition : '); + readderef; + writeln(space,' IOffset : ',getlongint); + end; + end; + + if not EndOfEntry then + Writeln('!! Entry has more information stored'); + {read the record definitions and symbols} + space:=' '+space; + readdefinitions('fields',false); + readsymbols('fields'); + Delete(space,1,4); + end; + + ibfiledef : + begin + ReadCommonDef('File definition'); + write (space,' Type : '); + case getbyte of + 0 : writeln('Text'); + 1 : begin + writeln('Typed'); + write (space,' File of Type : '); + Readtype; + end; + 2 : writeln('Untyped'); + end; + end; + + ibformaldef : + readcommondef('Generic Definition (void-typ)'); + + ibenumdef : + begin + readcommondef('Enumeration type definition'); + write(space,'Base enumeration type : '); + readderef; + writeln(space,' Smallest element : ',getlongint); + writeln(space,' Largest element : ',getlongint); + writeln(space,' Size : ',getlongint); + end; + + ibclassrefdef : + begin + readcommondef('Class reference definition'); + write (space,' Pointed Type : '); + readtype; + end; + + ibsetdef : + begin + readcommondef('Set definition'); + write (space,' Element type : '); + readtype; + b:=getbyte; + case tsettype(b) of + smallset : writeln(space,' Set with 32 Elements'); + normset : writeln(space,' Set with 256 Elements'); + varset : writeln(space,' Set with ',getlongint,' Elements'); + else writeln('!! Warning: Invalid set type ',b); + end; + end; + + ibvariantdef : + begin + readcommondef('Variant definition'); + write (space,' Varianttype : '); + b:=getbyte; + case tvarianttype(b) of + vt_normalvariant : + writeln('Normal'); + vt_olevariant : + writeln('OLE'); + else + writeln('!! Warning: Invalid varianttype ',b); + end; + + end; + + iberror : + begin + Writeln('!! Error in PPU'); + exit; + end; + + ibenddefs : + break; + + else + WriteLn('!! Skipping unsupported PPU Entry in definitions: ',b); + end; + if not EndOfEntry then + Writeln('!! Entry has more information stored'); + until false; + if (totaldefs<>-1) and (defcnt<>totaldefs) then + Writeln('!! Only read ',defcnt,' of ',totaldefs,' definitions'); + end; +end; + + +{**************************************************************************** + Read General Part +****************************************************************************} + +procedure readinterface; +var + b : byte; + sourcenumber : longint; +begin + with ppufile do + begin + repeat + b:=readentry; + case b of + + ibmodulename : + Writeln('Module Name: ',getstring); + + ibsourcefiles : + begin + sourcenumber:=1; + while not EndOfEntry do + begin + Writeln('Source file ',sourcenumber,' : ',getstring,' ',filetimestring(getlongint)); + inc(sourcenumber); + end; + end; +{$IFDEF MACRO_DIFF_HINT} + ibusedmacros : + begin + while not EndOfEntry do + begin + Write('Conditional ',getstring); + b:=getbyte; + if boolean(b)=true then + write(' defined at startup') + else + write(' not defined at startup'); + b:=getbyte; + if boolean(b)=true then + writeln(' was used') + else + writeln; + end; + end; +{$ENDIF} + ibloadunit : + ReadLoadUnit; + + iblinkunitofiles : + ReadLinkContainer('Link unit object file: '); + + iblinkunitstaticlibs : + ReadLinkContainer('Link unit static lib: '); + + iblinkunitsharedlibs : + ReadLinkContainer('Link unit shared lib: '); + + iblinkotherofiles : + ReadLinkContainer('Link other object file: '); + + iblinkotherstaticlibs : + ReadLinkContainer('Link other static lib: '); + + iblinkothersharedlibs : + ReadLinkContainer('Link other shared lib: '); + + ibderefdata : + ReadDerefData; + + ibderefmap : + ReadDerefMap; + + iberror : + begin + Writeln('Error in PPU'); + exit; + end; + + ibendinterface : + break; + + else + WriteLn('!! Skipping unsupported PPU Entry in General Part: ',b); + end; + until false; + end; +end; + + + +{**************************************************************************** + Read Implementation Part +****************************************************************************} + +procedure readimplementation; +var + b : byte; +begin + with ppufile do + begin + repeat + b:=readentry; + case b of + ibasmsymbols : + ReadAsmSymbols; + + ibloadunit : + ReadLoadUnit; + + iberror : + begin + Writeln('Error in PPU'); + exit; + end; + ibendimplementation : + break; + else + WriteLn('!! Skipping unsupported PPU Entry in Implementation: ',b); + end; + until false; + end; +end; + + +{**************************************************************************** + Read Browser Part +****************************************************************************} + +procedure readbrowser; +var + b : byte; +const indent : string = ''; +begin + Writeln(indent,'Start of symtable browser'); + indent:=indent+'**'; + with ppufile do + begin + repeat + b:=readentry; + case b of + ibbeginsymtablebrowser : + begin + { here we must read object and record symtables !! } + indent:=indent+' '; + Writeln(indent,'Record/Object symtable'); + readbrowser; + Indent:=Copy(Indent,1,Length(Indent)-2); + end; + ibsymref : + begin + readderef; + readref; + end; + ibdefref : + begin + readderef; + readref; + if ((ppufile.header.flags and uf_local_browser)<>0) and + (UnitIndex=0) then + begin + { parast and localst } + indent:=indent+' '; + b:=ppufile.readentry; + if b=ibbeginsymtablebrowser then + readbrowser; + b:=ppufile.readentry; + if b=ibbeginsymtablebrowser then + readbrowser; + Indent:=Copy(Indent,1,Length(Indent)-2); + end; + end; + iberror : + begin + Writeln('Error in PPU'); + exit; + end; + ibendsymtablebrowser : + break; + else + begin + WriteLn('!! Skipping unsupported PPU Entry in Browser: ',b); + Halt; + end; + end; + until false; + end; + Indent:=Copy(Indent,1,Length(Indent)-2); + Writeln(Indent,'End of symtable browser'); +end; + + + + +procedure dofile (filename : string); +var + b : byte; +begin +{ reset } + space:=''; +{ fix filename } + if pos('.',filename)=0 then + filename:=filename+'.ppu'; + ppufile:=tppufile.create(filename); + if not ppufile.openfile then + begin + writeln ('IO-Error when opening : ',filename,', Skipping'); + exit; + end; +{ PPU File is open, check for PPU Id } + if not ppufile.CheckPPUID then + begin + writeln(Filename,' : Not a valid PPU file, Skipping'); + exit; + end; +{ Check PPU Version } + Writeln('Analyzing ',filename,' (v',ppufile.GetPPUVersion,')'); + if ppufile.GetPPUVersion<16 then + begin + writeln(Filename,' : Old PPU Formats (<v16) are not supported, Skipping'); + exit; + end; +{ Write PPU Header Information } + if (verbose and v_header)<>0 then + begin + Writeln; + Writeln('Header'); + Writeln('-------'); + with ppufile.header do + begin + Writeln('Compiler version : ',ppufile.header.compiler shr 14,'.', + (ppufile.header.compiler shr 7) and $7f,'.', + ppufile.header.compiler and $7f); + WriteLn('Target processor : ',Cpu2Str(cpu)); + WriteLn('Target operating system : ',Target2Str(target)); + Writeln('Unit flags : ',PPUFlags2Str(flags)); + Writeln('FileSize (w/o header) : ',size); + Writeln('Checksum : ',hexstr(checksum,8)); + Writeln('Interface Checksum : ',hexstr(interface_checksum,8)); + end; + end; +{read the general stuff} + if (verbose and v_interface)<>0 then + begin + Writeln; + Writeln('Interface section'); + Writeln('------------------'); + readinterface; + end + else + ppufile.skipuntilentry(ibendinterface); +{read the definitions} + if (verbose and v_defs)<>0 then + begin + Writeln; + Writeln('Interface definitions'); + Writeln('----------------------'); + readdefinitions('interface',false); + end + else + ppufile.skipuntilentry(ibenddefs); +{read the symbols} + if (verbose and v_syms)<>0 then + begin + Writeln; + Writeln('Interface Symbols'); + Writeln('------------------'); + readsymbols('interface'); + end + else + ppufile.skipuntilentry(ibendsyms); + +{read the macro symbols} + if (verbose and v_syms)<>0 then + begin + Writeln; + Writeln('Interface Macro Symbols'); + Writeln('-----------------------'); + end; + if ppufile.readentry<>ibexportedmacros then + begin + Writeln('!! Error in PPU'); + exit; + end; + if boolean(ppufile.getbyte) then + begin + {skip the definition section for macros (since they are never used) } + ppufile.skipuntilentry(ibenddefs); + {read the macro symbols} + if (verbose and v_syms)<>0 then + readsymbols('interface macro') + else + ppufile.skipuntilentry(ibendsyms); + end + else + Writeln('(no exported macros)'); + +{read the implementation stuff} + if (verbose and v_implementation)<>0 then + begin + Writeln; + Writeln('Implementation section'); + Writeln('-----------------------'); + readimplementation; + end + else + ppufile.skipuntilentry(ibendimplementation); +{read the static browser units stuff} + if (ppufile.header.flags and uf_local_symtable)<>0 then + begin + if (verbose and v_defs)<>0 then + begin + Writeln; + Writeln('Static definitions'); + Writeln('----------------------'); + readdefinitions('implementation',false); + end + else + ppufile.skipuntilentry(ibenddefs); + {read the symbols} + if (verbose and v_syms)<>0 then + begin + Writeln; + Writeln('Static Symbols'); + Writeln('------------------'); + readsymbols('implementation'); + end + else + ppufile.skipuntilentry(ibendsyms); + end; +{read the browser units stuff} + if (ppufile.header.flags and uf_has_browser)<>0 then + begin + if (verbose and v_browser)<>0 then + begin + Writeln; + Writeln('Browser section'); + Writeln('---------------'); + UnitIndex:=0; + repeat + b:=ppufile.readentry; + if b = ibendbrowser then break; + if b=ibbeginsymtablebrowser then + begin + Writeln('Unit ',UnitIndex); + readbrowser; + Inc(UnitIndex); + end + else + Writeln('Wrong end browser entry ',b,' should be ',ibendbrowser); + until false; + end; + end; +{read the static browser units stuff} + if (ppufile.header.flags and uf_local_browser)<>0 then + begin + if (verbose and v_browser)<>0 then + begin + Writeln; + Writeln('Static browser section'); + Writeln('---------------'); + UnitIndex:=0; + b:=ppufile.readentry; + if b=ibbeginsymtablebrowser then + readbrowser + else + Writeln('Wrong end browser entry ',b,' should be ',ibendbrowser); + end; + end; +{shutdown ppufile} + ppufile.closefile; + ppufile.free; + Writeln; +end; + + + +procedure help; +begin + writeln('usage: ppudump [options] <filename1> <filename2>...'); + writeln; + writeln('[options] can be:'); + writeln(' -V<verbose> Set verbosity to <verbose>'); + writeln(' H - Show header info'); + writeln(' I - Show interface'); + writeln(' M - Show implementation'); + writeln(' S - Show interface symbols'); + writeln(' D - Show interface definitions'); + writeln(' B - Show browser info'); + writeln(' A - Show all'); + writeln(' -h, -? This helpscreen'); + halt; +end; + +var + startpara, + nrfile,i : longint; + para : string; +begin + writeln(Title+' '+Version); + writeln(Copyright); + writeln; + if paramcount<1 then + begin + writeln('usage: dumpppu [options] <filename1> <filename2>...'); + halt(1); + end; +{ turn verbose on by default } + verbose:=v_all; +{ read options } + startpara:=1; + while copy(paramstr(startpara),1,1)='-' do + begin + para:=paramstr(startpara); + case upcase(para[2]) of + 'V' : begin + verbose:=0; + for i:=3 to length(para) do + case upcase(para[i]) of + 'H' : verbose:=verbose or v_header; + 'I' : verbose:=verbose or v_interface; + 'M' : verbose:=verbose or v_implementation; + 'D' : verbose:=verbose or v_defs; + 'S' : verbose:=verbose or v_syms; + 'B' : verbose:=verbose or v_browser; + 'A' : verbose:=verbose or v_all; + end; + end; + 'H' : help; + '?' : help; + end; + inc(startpara); + end; +{ process files } + for nrfile:=startpara to paramcount do + dofile (paramstr(nrfile)); + if has_errors then + Halt(1); +end. diff --git a/compiler/utils/ppufiles.pp b/compiler/utils/ppufiles.pp new file mode 100644 index 0000000000..66ff08736f --- /dev/null +++ b/compiler/utils/ppufiles.pp @@ -0,0 +1,252 @@ +{ + Copyright (c) 1999-2002 by Peter Vreman + + List files needed by PPU + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + ****************************************************************************} +Program ppufiles; + +uses + dos, + ppu; + +const + Version = 'Version 1.00'; + Title = 'PPU-Files'; + Copyright = 'Copyright (c) 1999-2002 by the Free Pascal Development Team'; + + PPUExt = 'ppu'; + +type + poutfile = ^toutfile; + toutfile = record + name : string; + next : poutfile; + end; + +var + skipdup, + showstatic, + showshared, + showobjects : boolean; + + OutFiles : poutfile; + + +{***************************************************************************** + Helpers +*****************************************************************************} + +Procedure Error(const s:string;stop:boolean); +{ + Write an error message to stderr +} +begin +{$ifdef FPC} + writeln(stderr,s); +{$else} + writeln(s); +{$endif} + if stop then + halt(1); +end; + + +Function AddExtension(Const HStr,ext:String):String; +{ + Return a filename which will have extension ext added if no + extension is found +} +var + j : longint; +begin + j:=length(Hstr); + while (j>0) and (Hstr[j]<>'.') do + dec(j); + if j=0 then + AddExtension:=Hstr+'.'+Ext + else + AddExtension:=HStr; +end; + + +Function SplitPath(Const HStr:String):String; +var + i : longint; +begin + i:=Length(Hstr); + while (i>0) and not(Hstr[i] in ['\','/']) do + dec(i); + SplitPath:=Copy(Hstr,1,i); +end; + + +Procedure AddFile(const s:string); +var + p : poutfile; +begin + p:=nil; + if skipdup then + begin + p:=outfiles; + while assigned(p) do + begin + if s=p^.name then + break; + p:=p^.next; + end; + end; + if not assigned(p) then + begin + new(p); + p^.name:=s; + p^.next:=outfiles; + outfiles:=p; + end; +end; + + +Function DoPPU(const PPUFn:String):Boolean; +{ + Convert one file (in Filename) to library format. + Return true if successful, false otherwise. +} +Var + inppu : tppufile; + b : byte; + + procedure showfiles; + begin + while not inppu.endofentry do + begin + AddFile(inppu.getstring); + inppu.getlongint; + end; + end; + +begin + DoPPU:=false; + inppu:=tppufile.create(PPUFn); + if not inppu.openfile then + begin + inppu.free; + Error('Error: Could not open : '+PPUFn,false); + Exit; + end; +{ Check the ppufile } + if not inppu.CheckPPUId then + begin + inppu.free; + Error('Error: Not a PPU File : '+PPUFn,false); + Exit; + end; + if inppu.GetPPUVersion<CurrentPPUVersion then + begin + inppu.free; + Error('Error: Wrong PPU Version : '+PPUFn,false); + Exit; + end; +{ read until the object files are found } + repeat + b:=inppu.readentry; + case b of + ibendinterface, + ibend : + break; + iblinkunitstaticlibs : + if showstatic then + showfiles; + iblinkunitsharedlibs : + if showshared then + showfiles; + iblinkunitofiles : + if showobjects then + showfiles; + end; + until false; + inppu.free; + DoPPU:=True; +end; + + + +var + i,parafile : longint; + dir : SearchRec; + s,InFile : String; + p : poutfile; +begin +{ defaults } + skipdup:=true; +{ options } + i:=1; + while (i<=paramcount) do + begin + s:=paramstr(i); + if s[1]<>'-' then + break; + case upcase(s[2]) of + 'L' : showshared:=true; + 'S' : showstatic:=true; + 'O' : showobjects:=true; + 'A' : skipdup:=false; + '?','H' : + begin + writeln('usage: ppufiles [options] <files>'); + writeln('options:'); + writeln(' -A Show all files (don''t remove duplicates)'); + writeln(' -L Show only shared libraries'); + writeln(' -S Show only static libraries'); + writeln(' -O Show only object files'); + writeln(' -H This helpscreen'); + end; + end; + inc(i); + end; + { default shows everything } + if i=1 then + begin + showshared:=true; + showstatic:=true; + showobjects:=true; + end; +{ files } + parafile:=i; + for i:=parafile to ParamCount do + begin + InFile:=AddExtension(ParamStr(i),PPUExt); + FindFirst(InFile,$20,Dir); + while (DosError=0) do + begin + DoPPU(SplitPath(InFile)+Dir.Name); + FindNext(Dir); + end; +{$ifdef fpc} + FindClose(Dir); +{$endif} + end; +{ Display the files } + while assigned(outfiles) do + begin + p:=outfiles; + write(outfiles^.name); + outfiles:=outfiles^.next; + dispose(p); + if assigned(outfiles) then + write(' '); + end; +end. diff --git a/compiler/utils/ppumove.pp b/compiler/utils/ppumove.pp new file mode 100644 index 0000000000..8250004622 --- /dev/null +++ b/compiler/utils/ppumove.pp @@ -0,0 +1,613 @@ +{ + Copyright (c) 1999-2002 by the FPC Development Team + + Add multiple FPC units into a static/shared library + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + ****************************************************************************} +{$ifndef TP} + {$H+} +{$endif} +Program ppumove; +uses +{$ifdef unix} + {$ifdef ver1_0} + linux, + {$else} + Baseunix,Unix, UnixUtil, + {$endif} +{$else unix} + dos, +{$endif unix} + ppu, + getopts; + +const + Version = 'Version 1.00'; + Title = 'PPU-Mover'; + Copyright = 'Copyright (c) 1998-2002 by the Free Pascal Development Team'; + + ShortOpts = 'o:e:d:qhsvbw'; + BufSize = 4096; + PPUExt = 'ppu'; + ObjExt = 'o'; + StaticLibExt ='a'; +{$ifdef unix} + SharedLibExt ='so'; + BatchExt ='.sh'; +{$else} + SharedLibExt ='dll'; + BatchExt ='.bat'; +{$endif unix} + + { link options } + link_none = $0; + link_allways = $1; + link_static = $2; + link_smart = $4; + link_shared = $8; + +Type + PLinkOEnt = ^TLinkOEnt; + TLinkOEnt = record + Name : string; + Next : PLinkOEnt; + end; + +Var + ArBin,LDBin,StripBin, + OutputFile, + OutputFileForLink, { the name of the output file needed when linking } + DestPath, + PPLExt, + LibExt : string; + Batch, + Quiet, + MakeStatic : boolean; + Buffer : Pointer; + ObjFiles : PLinkOEnt; + BatchFile : Text; + +{***************************************************************************** + Helpers +*****************************************************************************} + +Procedure Error(const s:string;stop:boolean); +{ + Write an error message to stderr +} +begin +{$ifdef FPC} + writeln(stderr,s); +{$else} + writeln(s); +{$endif} + if stop then + halt(1); +end; + + +function Shell(const s:string):longint; +{ + Run a shell commnad and return the exitcode +} +begin + if Batch then + begin + Writeln(BatchFile,s); + Shell:=0; + exit; + end; +{$ifdef unix} + Shell:={$ifdef ver1_0}linux{$else}unix{$endif}.shell(s); +{$else} + exec(getenv('COMSPEC'),'/C '+s); + Shell:=DosExitCode; +{$endif} +end; + + +Function FileExists (Const F : String) : Boolean; +{ + Returns True if the file exists, False if not. +} +Var +{$ifdef unix} + info : Stat; +{$else} + info : searchrec; +{$endif} +begin +{$ifdef unix} + FileExists:={$ifdef VER1_0}FStat{$ELSE}FpStat{$endif} (F,Info){$ifndef VER1_0}=0{$endif}; +{$else} + FindFirst (F,anyfile,Info); + FileExists:=DosError=0; +{$endif} +end; + + +Function AddExtension(Const HStr,ext:String):String; +{ + Return a filename which will have extension ext added if no + extension is found +} +var + j : longint; +begin + j:=length(Hstr); + while (j>0) and (Hstr[j]<>'.') do + dec(j); + if j=0 then + AddExtension:=Hstr+'.'+Ext + else + AddExtension:=HStr; +end; + + +Function ForceExtension(Const HStr,ext:String):String; +{ + Return a filename which certainly has the extension ext +} +var + j : longint; +begin + j:=length(Hstr); + while (j>0) and (Hstr[j]<>'.') do + dec(j); + if j=0 then + j:=255; + ForceExtension:=Copy(Hstr,1,j-1)+'.'+Ext; +end; + + +Procedure AddToLinkFiles(const S : String); +{ + Adds a filename to a list of object files to link to. + No duplicates allowed. +} +Var + P : PLinKOEnt; +begin + P:=ObjFiles; + { Don't add files twice } + While (P<>nil) and (p^.name<>s) do + p:=p^.next; + if p=nil then + begin + new(p); + p^.next:=ObjFiles; + p^.name:=s; + ObjFiles:=P; + end; +end; + + +Function ExtractLib(const libfn:string):string; +{ + Extract a static library libfn and return the files with a + wildcard +} +var + n : namestr; + d : dirstr; + e : extstr; +begin +{ create the temp dir first } + fsplit(libfn,d,n,e); + {$I-} + mkdir(n+'.sl'); + {$I+} + if ioresult<>0 then; +{ Extract } + if Shell(arbin+' x '+libfn)<>0 then + Error('Fatal: Error running '+arbin,true); +{ Remove the lib file, it's extracted so it can be created with ease } + if PPLExt=PPUExt then + Shell('rm '+libfn); +{$ifdef unix} + ExtractLib:=n+'.sl/*'; +{$else} + ExtractLib:=n+'.sl\*'; +{$endif} +end; + + +Function DoPPU(const PPUFn,PPLFn:String):Boolean; +{ + Convert one file (in Filename) to library format. + Return true if successful, false otherwise. +} +Var + inppu, + outppu : tppufile; + b, + untilb : byte; + l,m : longint; + f : file; + s : string; +begin + DoPPU:=false; + If Not Quiet then + Write ('Processing ',PPUFn,'...'); + inppu:=tppufile.create(PPUFn); + if not inppu.openfile then + begin + inppu.free; + Error('Error: Could not open : '+PPUFn,false); + Exit; + end; +{ Check the ppufile } + if not inppu.CheckPPUId then + begin + inppu.free; + Error('Error: Not a PPU File : '+PPUFn,false); + Exit; + end; + if inppu.GetPPUVersion<CurrentPPUVersion then + begin + inppu.free; + Error('Error: Wrong PPU Version : '+PPUFn,false); + Exit; + end; +{ No .o file generated for this ppu, just skip } + if (inppu.header.flags and uf_no_link)<>0 then + begin + inppu.free; + If Not Quiet then + Writeln (' No files.'); + DoPPU:=true; + Exit; + end; +{ Already a lib? } + if (inppu.header.flags and uf_in_library)<>0 then + begin + inppu.free; + Error('Error: PPU is already in a library : '+PPUFn,false); + Exit; + end; +{ We need a static linked unit } + if (inppu.header.flags and uf_static_linked)=0 then + begin + inppu.free; + Error('Error: PPU is not static linked : '+PPUFn,false); + Exit; + end; +{ Create the new ppu } + if PPUFn=PPLFn then + outppu:=tppufile.create('ppumove.$$$') + else + outppu:=tppufile.create(PPLFn); + outppu.createfile; +{ Create new header, with the new flags } + outppu.header:=inppu.header; + outppu.header.flags:=outppu.header.flags or uf_in_library; + if MakeStatic then + outppu.header.flags:=outppu.header.flags or uf_static_linked + else + outppu.header.flags:=outppu.header.flags or uf_shared_linked; +{ read until the object files are found } + untilb:=iblinkunitofiles; + repeat + b:=inppu.readentry; + if b in [ibendinterface,ibend] then + begin + inppu.free; + outppu.free; + Error('Error: No files to be linked found : '+PPUFn,false); + Exit; + end; + if b<>untilb then + begin + repeat + inppu.getdatabuf(buffer^,bufsize,l); + outppu.putdata(buffer^,l); + until l<bufsize; + outppu.writeentry(b); + end; + until (b=untilb); +{ we have now reached the section for the files which need to be added, + now add them to the list } + case b of + iblinkunitofiles : + begin + { add all o files, and save the entry when not creating a static + library to keep staticlinking possible } + while not inppu.endofentry do + begin + s:=inppu.getstring; + m:=inppu.getlongint; + if not MakeStatic then + begin + outppu.putstring(s); + outppu.putlongint(m); + end; + AddToLinkFiles(s); + end; + if not MakeStatic then + outppu.writeentry(b); + end; +{ iblinkunitstaticlibs : + begin + AddToLinkFiles(ExtractLib(inppu.getstring)); + if not inppu.endofentry then + begin + repeat + inppu.getdatabuf(buffer^,bufsize,l); + outppu.putdata(buffer^,l); + until l<bufsize; + outppu.writeentry(b); + end; + end; } + end; +{ just add a new entry with the new lib } + if MakeStatic then + begin + outppu.putstring(outputfileforlink); + outppu.putlongint(link_static); + outppu.writeentry(iblinkunitstaticlibs) + end + else + begin + outppu.putstring(outputfileforlink); + outppu.putlongint(link_shared); + outppu.writeentry(iblinkunitsharedlibs); + end; +{ read all entries until the end and write them also to the new ppu } + repeat + b:=inppu.readentry; + { don't write ibend, that's written automaticly } + if b<>ibend then + begin + repeat + inppu.getdatabuf(buffer^,bufsize,l); + outppu.putdata(buffer^,l); + until l<bufsize; + outppu.writeentry(b); + end; + until b=ibend; +{ write the last stuff and close } + outppu.flush; + outppu.writeheader; + outppu.free; + inppu.free; +{ rename } + if PPUFn=PPLFn then + begin + {$I-} + assign(f,PPUFn); + erase(f); + assign(f,'ppumove.$$$'); + rename(f,PPUFn); + {$I+} + if ioresult<>0 then; + end; +{ the end } + If Not Quiet then + Writeln (' Done.'); + DoPPU:=True; +end; + + +Function DoFile(const FileName:String):Boolean; +{ + Process a file, mainly here for wildcard support under Dos +} +{$ifndef unix} +var + dir : searchrec; +{$endif} +begin +{$ifdef unix} + DoFile:=DoPPU(FileName,ForceExtension(FileName,PPLExt)); +{$else} + DoFile:=false; + findfirst(filename,$20,dir); + while doserror=0 do + begin + if not DoPPU(Dir.Name,ForceExtension(Dir.Name,PPLExt)) then + exit; + findnext(dir); + end; + findclose(dir); + DoFile:=true; +{$endif} +end; + + +Procedure DoLink; +{ + Link the object files together to form a (shared) library, the only + problem here is the 255 char limit of Names +} +Var + Names : String; + f : file; + Err : boolean; + P : PLinkOEnt; +begin + if not Quiet then + Write ('Linking '); + P:=ObjFiles; + names:=''; + While p<>nil do + begin + if Names<>'' then + Names:=Names+' '+P^.name + else + Names:=p^.Name; + p:=p^.next; + end; + if Names='' then + begin + If not Quiet then + Writeln('Error: no files found to be linked'); + exit; + end; + If not Quiet then + WriteLn(names); +{ Run ar or ld to create the lib } + If MakeStatic then + Err:=Shell(arbin+' rs '+outputfile+' '+names)<>0 + else + begin + Err:=Shell(ldbin+' -shared -o '+OutputFile+' '+names)<>0; + if not Err then + Shell(stripbin+' --strip-unneeded '+OutputFile); + end; + If Err then + Error('Fatal: Library building stage failed.',true); +{ fix permission to 644, so it's not 755 } +{$ifdef unix} + {$ifdef VER1_0}ChMod{$ELSE}FPChmod{$endif}(OutputFile,420); +{$endif} +{ Rename to the destpath } + if DestPath<>'' then + begin + Assign(F, OutputFile); + Rename(F,DestPath+'/'+OutputFile); + end; +end; + + +Procedure usage; +{ + Print usage and exit. +} +begin + Writeln(paramstr(0),': [-qhwvbs] [-e ext] [-o name] [-d path] file [file ...]'); + Halt(0); +end; + + + +Procedure processopts; +{ + Process command line opions, and checks if command line options OK. +} +var + C : char; +begin + if paramcount=0 then + usage; +{ Reset } + ObjFiles:=Nil; + Quiet:=False; + Batch:=False; + OutputFile:=''; + PPLExt:='ppu'; + ArBin:='ar'; + LdBin:='ld'; + StripBin:='strip'; + repeat + c:=Getopt (ShortOpts); + Case C of + EndOfOptions : break; + 's' : MakeStatic:=True; + 'o' : OutputFile:=OptArg; + 'd' : DestPath:=OptArg; + 'e' : PPLext:=OptArg; + 'q' : Quiet:=True; + 'w' : begin + ArBin:='arw'; + LdBin:='ldw'; + end; + 'b' : Batch:=true; + '?' : Usage; + 'h' : Usage; + end; + until false; +{ Test filenames on the commandline } + if (OptInd>Paramcount) then + Error('Error: no input files',true); + if (OptInd<ParamCount) and (OutputFile='') then + Error('Error: when moving multiple units, specify an output name.',true); +{ alloc a buffer } + GetMem (Buffer,Bufsize); + If Buffer=Nil then + Error('Error: could not allocate memory for buffer.',true); +end; + + +var + i : longint; +begin + ProcessOpts; +{ Write Header } + if not Quiet then + begin + Writeln(Title+' '+Version); + Writeln(Copyright); + Writeln; + end; +{ Check if shared is allowed } +{$ifndef unix} + if arbin<>'arw' then + begin + Writeln('Warning: shared library not supported for Go32, switching to static library'); + MakeStatic:=true; + end; +{$endif} +{ fix the libext and outputfilename } + if Makestatic then + LibExt:=StaticLibExt + else + LibExt:=SharedLibExt; + if OutputFile='' then + OutPutFile:=Paramstr(OptInd); +{ fix filename } +{$ifdef unix} + if Copy(OutputFile,1,3)<>'lib' then + OutputFile:='lib'+OutputFile; + { For unix skip replacing the extension if a full .so.X.X if specified } + i:=pos('.so.',Outputfile); + if i<>0 then + OutputFileForLink:=Copy(Outputfile,4,i-4) + else + begin + OutputFile:=ForceExtension(OutputFile,LibExt); + OutputFileForLink:=Copy(Outputfile,4,length(Outputfile)-length(LibExt)-4); + end; +{$else} + OutputFile:=ForceExtension(OutputFile,LibExt); + OutputFileForLink:=OutputFile; +{$endif} +{ Open BatchFile } + if Batch then + begin + Assign(BatchFile,'pmove'+BatchExt); + Rewrite(BatchFile); + end; +{ Process Files } + i:=OptInd; + While (i<=ParamCount) and Dofile(AddExtension(Paramstr(i),PPUExt)) do + Inc(i); +{ Do Linking stage } + DoLink; +{ Close BatchFile } + if Batch then + begin + if Not Quiet then + Writeln('Writing pmove'+BatchExt); + Close(BatchFile); +{$ifdef unix} + {$ifdef VER1_0}ChMod{$ELSE}FPChmod{$endif}('pmove'+BatchExt,493); +{$endif} + end; +{ The End } + if Not Quiet then + Writeln('Done.'); +end. diff --git a/compiler/utils/samplecfg b/compiler/utils/samplecfg new file mode 100644 index 0000000000..bad2d8f569 --- /dev/null +++ b/compiler/utils/samplecfg @@ -0,0 +1,267 @@ +#!/bin/sh +# +# $Id: samplecfg,v 1.13 2005/02/19 18:50:20 florian Exp $ +# +# Generate Sample Free Pascal configuration file +# + +HOSTOS=`uname -s | tr A-Z a-z` +echo Running on $HOSTOS + +if [ $# = 0 ]; then + echo 'Usage :' + echo 'samplecfg fpcdir confdir' + echo 'fpcdir = Path where FPC is installed' + echo 'confdir = Path to /etc' + exit 1 +fi +if [ $2 ]; then + sysdir=$2 + [ -d $sysdir ] || mkdir $sysdir +else + sysdir=/etc +fi + +# Detect if we have write permission in root. +if [ -w $sysdir ] ; then + echo Write permission in $sysdir. + thefile=$sysdir/fpc.cfg +else + echo No write premission in $sysdir. + thefile=$HOME/.fpc.cfg +fi +# +if [ -f $thefile ] ; then + mv $thefile $thefile.orig >/dev/null 2>&1 + if [ $? = 0 ]; then + echo Saved old config to $thefile.orig + else + echo Could not save old config. Bailing out... + exit + fi +fi + +# Find path to libgcc.a +GCCSPEC=`(gcc -v 2>&1)| head -n 1| awk '{ print $4 } '` +if [ -z "$GCCSPEC" ] ; then + GCCSPEC=`gcc -print-libgcc-file-name` +fi +GCCDIR=`dirname $GCCSPEC` +echo $GCCDIR +if [ -f $GCCDIR ]; then +# include ports tree dir for FreeBSDers. +case $HOSTOS in + freebsd) + GCCDIR=-Fl/usr/local/lib + ;; + openbsd) + GCCDIR=-Fl/usr/local/lib + ;; + netbsd) + GCCDIR=-Fl/usr/pkg/lib + ;; +esac +else + echo Found libgcc.a in $GCCDIR + GCCDIR=-Fl$GCCDIR +fi +# Write the file +echo Writing sample configuration file to $thefile +cat <<EOFCFG > $thefile +# +# Example fpc.cfg for Free Pascal Compiler +# + +# ---------------------- +# Defines (preprocessor) +# ---------------------- + +# +# nested #IFNDEF, #IFDEF, #ENDIF, #ELSE, #DEFINE, #UNDEF are allowed +# +# -d is the same as #DEFINE +# -u is the same as #UNDEF +# + +# +# Some examples (for switches see below, and the -? helppages) +# +# Try compiling with the -dRELEASE or -dDEBUG on the commandline +# + +# For a release compile with optimizes and strip debuginfo +#IFDEF RELEASE + -OG2p3 + -Xs + #WRITE Compiling Release Version +#ENDIF + +# For a debug version compile with debuginfo and all codegeneration checks on +#IFDEF DEBUG + -g + -Crtoi + #WRITE Compiling Debug Version +#ENDIF + +# set binutils prefix +#IFDEF FPC_CROSSCOMPILING + -XP$fpctarget- +#ENDIF + +# ---------------- +# Parsing switches +# ---------------- + +# Pascal language mode +# -Mfpc free pascal dialect (default) +# -Mobjfpc switch some Delphi 2 extensions on +# -Mdelphi tries to be Delphi compatible +# -Mtp tries to be TP/BP 7.0 compatible +# -Mgpc tries to be gpc compatible +# -Mmacpas tries to be compatible to the macintosh pascal dialects +# +# Turn on Object Pascal extensions by default +#-Mobjfpc + +# Assembler reader mode +# -Rdefault use default assembler +# -Ratt read AT&T style assembler +# -Rintel read Intel style assembler +# +# All assembler blocks are AT&T styled by default +#-Ratt + +# Semantic checking +# -S2 same as -Mobjfpc +# -Sc supports operators like C (*=,+=,/= and -=) +# -Sa include assertion code. +# -Sd same as -Mdelphi +# -Se<x> compiler stops after the <x> errors (default is 1) +# -Sg allow LABEL and GOTO +# -Sh Use ansistrings +# -Si support C++ styled INLINE +# -SI<x> set interface style to <x> +# -SIcomCOM compatible interface (default) +# -SIcorbaCORBA compatible interface +# -Sm support macros like C (global) +# -So same as -Mtp +# -Sp same as -Mgpc +# -Ss constructor name must be init (destructor must be done) +# -St allow static keyword in objects +# +# Allow goto, inline, C-operators, C-vars +-Sgic + +# --------------- +# Code generation +# --------------- + +# Uncomment the next line if you always want static/dynamic units by default +# (can be overruled with -CD, -CS at the commandline) +#-CS +#-CD + +# Set the default heapsize to 8Mb +#-Ch8000000 + +# Set default codegeneration checks (iocheck, overflow, range, stack) +#-Ci +#-Co +#-Cr +#-Ct + +# Optimizer switches for i386 compiler +# -Og generate smaller code +# -OG generate faster code (default) +# -Or keep certain variables in registers (still BUGGY!!!) +# -Ou enable uncertain optimizations (see docs) +# -O1 level 1 optimizations (quick optimizations) +# -O2 level 2 optimizations (-O1 + slower optimizations) +# -O3 level 3 optimizations (same as -O2u) +# -Op target processor +# -Op1 set target processor to 386/486 +# -Op2 set target processor to Pentium/PentiumMMX (tm) +# -Op3 set target processor to PPro/PII/c6x86/K6 (tm) + +# Optimize always for Size and PII +#-OG2p3 + + +# ----------------------- +# Set Filenames and Paths +# ----------------------- + +# Slashes are also allowed under dos + +# path to the messagefile, not necessary anymore but can be used to override +# the default language +#-Fr$1/msg/errore.msg +#-Fr$1/msg/errorn.msg + +# searchpath for includefiles +#-Fi/pp/inc;/pp/rtl/inc + +# searchpath for units and other system dependent things +-Fu$1/units/\$fpctarget +-Fu$1/units/\$fpctarget/* +-Fu$1/units/\$fpctarget/rtl +#-Fu~/fpc/packages/base/*/units/$fpctarget;~/fpc/fcl/units/$fpctarget;~/fpc/rtl/units/$fpctarget + +# searchpath for libraries +$GCCDIR +#-Fl/pp/lib +#-Fl/lib;/usr/lib + + +# ------------- +# Linking +# ------------- + +# generate always debugging information for GDB (slows down the compiling +# process) +# -gc generate checks for pointers +# -gd use dbx +# -gg use gsym +# -gh use heap trace unit (for memory leak debugging) +# -gl use line info unit to show more info for backtraces +# -gv generates programs tracable with valgrind +# -gw generate dwarf debugging info +# +# Enable debuginfo and use the line info unit by default +#-gl + +# always pass an option to the linker +#-k-s + +# Always strip debuginfo from the executable +-Xs + + +# ------------- +# Miscellaneous +# ------------- + +# Write always a nice FPC logo ;) +-l + +# Verbosity +# e : Show errors (default) d : Show debug info +# w : Show warnings u : Show unit info +# n : Show notes t : Show tried/used files +# h : Show hints m : Show defined macros +# i : Show general info p : Show compiled procedures +# l : Show linenumbers c : Show conditionals +# a : Show everything 0 : Show nothing (except errors) +# b : Show all procedure r : Rhide/GCC compatibility mode +# declarations if an error x : Executable info (Win32 only) +# occurs +# +# Display Info, Warnings, Notes and Hints +-viwn +# If you don't want so much verbosity use +#-vw + +# +# That's all folks +# +EOFCFG diff --git a/compiler/utils/usubst.pp b/compiler/utils/usubst.pp new file mode 100644 index 0000000000..56c0ed38f7 --- /dev/null +++ b/compiler/utils/usubst.pp @@ -0,0 +1,109 @@ +{$mode objfpc} +{$H+} +{ + This file is part of Free Pascal build tools + Copyright (c) 2005 by Michael Van Canneyt + + Implements string substitutions + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} +unit usubst; + +interface + +uses SysUtils,Classes; + +// Add N=V pair to list. +Procedure AddToList(List : TStrings; Const N,V : String); +// Split NV to N/V and call AddToList +Function AddPair(List : TStrings; Const NV : String) : Boolean; +// Perform substitutions in S, from List. +Function DoSubStitutions(List : TStrings; Var S : String) : Integer; + +implementation + +Procedure AddToList(List : TStrings; Const N,V : String); + +var + I : Integer; + +begin + I:=List.IndexOfName(N); + If (V='') then + begin + If (I<>-1) then + List.Delete(I) + end + else + begin + If (I=-1) then + List.Add(N+'='+V) + else + List[I]:=N+'='+V; + end; +end; + +Function AddPair(List : TStrings; Const NV : String) : Boolean; + +Var + P,I : Integer; + N,V : string; + +begin + P:=Pos('=',NV); + Result:=(P<>0); + If Result then + begin + V:=NV; + N:=Copy(V,1,P-1); + Delete(V,1,P); + AddToList(List,N,V); + end; +end; + +Function DoSubstitutions(List : TStrings; Var S : String) : Integer; + +Var + N,T : String; + P : Integer; + +begin + Result:=0; + T:=S; + S:=''; + P:=Pos('%',T); + While (P>0) do + begin + S:=S+Copy(T,1,P-1); + Delete(T,1,P); + If (Length(T)>0) then + if (T[1]='%') then + begin + S:=S+'%'; + Delete(T,1,1); + end + else + begin + P:=Pos('%',T); + If (P=0) then + S:=S+'%' + else + begin + N:=Copy(T,1,P-1); + Delete(T,1,P); + S:=S+List.Values[N]; + end; + end; + P:=Pos('%',T); + end; + S:=S+T; +end; + +end. |