Pārlūkot izejas kodu

Initial implementation

michael 25 gadi atpakaļ
vecāks
revīzija
69fb6245ea

+ 973 - 0
utils/fprcp/Makefile

@@ -0,0 +1,973 @@
+#
+# Makefile generated by fpcmake v0.99.13 on 1999/12/15 14:54
+#
+
+defaultrule: all
+
+#####################################################################
+# Autodetect OS (Linux or Dos or Windows NT)
+# define inlinux when running under linux
+# define inWinNT when running under WinNT
+#####################################################################
+
+# We need only / in the path
+override PATH:=$(subst \,/,$(PATH))
+
+# Search for PWD and determine also if we are under linux
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(subst ;, ,$(PATH)))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(subst :, ,$(PATH)))))
+ifeq ($(PWD),)
+nopwd:
+	@echo You need the GNU utils package to use this Makefile!
+	@echo Get ftp://ftp.freepascal.org/pub/fpc/dist/go32v2/utilgo32.zip
+	@exit
+else
+inlinux=1
+endif
+else
+PWD:=$(firstword $(PWD))
+endif
+
+# Detect NT - NT sets OS to Windows_NT
+ifndef inlinux
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+endif
+endif
+
+# Detect OS/2 - OS/2 has OS2_SHELL defined
+ifndef inlinux
+ifndef inWinNT
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+endif
+
+# The extension of executables
+ifdef inlinux
+EXEEXT=
+else
+EXEEXT=.exe
+endif
+
+# The path which is search separated by spaces
+ifdef inlinux
+SEARCHPATH=$(subst :, ,$(PATH))
+else
+SEARCHPATH=$(subst ;, ,$(PATH))
+endif
+
+#####################################################################
+# FPC version/target Detection
+#####################################################################
+
+# What compiler to use ?
+ifndef FPC
+# Compatibility with old makefiles
+ifdef PP
+export FPC=$(PP)
+else
+ifdef inOS2
+export FPC=ppos2$(EXEEXT)
+else
+export FPC=ppc386$(EXEEXT)
+endif
+endif
+endif
+
+# Target OS
+ifndef OS_TARGET
+export OS_TARGET:=$(shell $(FPC) -iTO)
+endif
+
+# Source OS
+ifndef OS_SOURCE
+export OS_SOURCE:=$(shell $(FPC) -iSO)
+endif
+
+# Target CPU
+ifndef CPU_TARGET
+export CPU_TARGET:=$(shell $(FPC) -iTP)
+endif
+
+# Source CPU
+ifndef CPU_SOURCE
+export CPU_SOURCE:=$(shell $(FPC) -iSP)
+endif
+
+# FPC version
+ifndef FPC_VERSION
+export FPC_VERSION:=$(shell $(FPC) -iV)
+endif
+
+#####################################################################
+# Default Settings
+#####################################################################
+
+# Release ? Then force OPT and don't use extra opts via commandline
+ifndef REDIRFILE
+REDIRFILE=log
+endif
+
+ifdef RELEASE
+override OPT:=-Xs -OG2p3 -n
+endif
+
+# Verbose settings (warning,note,info)
+ifdef VERBOSE
+override OPT+=-vwni
+endif
+
+ifdef REDIR
+ifndef inlinux
+override FPC=redir -eo $(FPC)
+endif
+# set the verbosity to max
+override OPT+=-va
+override REDIR:= >> $(REDIRFILE)
+endif
+
+#####################################################################
+# User Settings
+#####################################################################
+
+
+# Targets
+
+override EXEOBJECTS+=fprcp
+
+# Clean
+
+override EXTRACLEANUNITS+=comments pexpr pasprep
+
+# Install
+
+ZIPTARGET=install
+
+# Defaults
+
+
+# Directories
+
+ifndef FPCDIR
+FPCDIR=../..
+endif
+ifndef PACKAGEDIR
+PACKAGEDIR=$(FPCDIR)/packages
+endif
+ifndef COMPONENTDIR
+COMPONENTDIR=$(FPCDIR)/components
+endif
+
+# Packages
+
+
+# Libraries
+
+
+# Info
+
+INFOTARGET=fpc_infocfg fpc_infoobjects fpc_infoinstall 
+
+#####################################################################
+# Default Directories
+#####################################################################
+
+# Base dir
+ifdef PWD
+BASEDIR:=$(shell $(PWD))
+else
+BASEDIR=.
+endif
+
+# this can be set to 'rtl' when the RTL units are installed
+ifndef UNITPREFIX
+UNITPREFIX=units
+endif
+
+# set the prefix directory where to install everything
+ifndef PREFIXINSTALLDIR
+ifdef inlinux
+export PREFIXINSTALLDIR=/usr
+else
+export PREFIXINSTALLDIR=/pp
+endif
+endif
+
+# create fcldir,rtldir,unitdir
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifneq ($(FPCDIR),.)
+override RTLDIR=$(FPCDIR)/rtl/$(OS_TARGET)
+override FCLDIR=$(FPCDIR)/fcl/$(OS_TARGET)
+override UNITSDIR=$(FPCDIR)/units/$(OS_TARGET)
+endif
+endif
+
+#####################################################################
+# Install Directories
+#####################################################################
+
+# set the base directory where to install everything
+ifndef BASEINSTALLDIR
+ifdef inlinux
+BASEINSTALLDIR=$(PREFIXINSTALLDIR)/lib/fpc/$(FPC_VERSION)
+else
+BASEINSTALLDIR=$(PREFIXINSTALLDIR)
+endif
+endif
+
+# set the directory where to install the binaries
+ifndef BININSTALLDIR
+ifdef inlinux
+BININSTALLDIR=$(PREFIXINSTALLDIR)/bin
+else
+BININSTALLDIR=$(BASEINSTALLDIR)/bin/$(OS_TARGET)
+endif
+endif
+
+# set the directory where to install the units.
+ifndef UNITINSTALLDIR
+UNITINSTALLDIR=$(BASEINSTALLDIR)/$(UNITPREFIX)/$(OS_TARGET)
+endif
+
+# Where to install shared libraries
+ifndef LIBINSTALLDIR
+ifdef inlinux
+LIBINSTALLDIR=$(PREFIXINSTALLDIR)/lib
+else
+LIBINSTALLDIR=$(UNITINSTALLDIR)
+endif
+endif
+
+# Where the source files will be stored
+ifndef SOURCEINSTALLDIR
+ifdef inlinux
+SOURCEINSTALLDIR=$(PREFIXINSTALLDIR)/src/fpc-$(FPC_VERSION)
+else
+SOURCEINSTALLDIR=$(BASEINSTALLDIR)/source
+endif
+endif
+
+# Where the doc files will be stored
+ifndef DOCINSTALLDIR
+ifdef inlinux
+DOCINSTALLDIR=$(PREFIXINSTALLDIR)/doc/fpc/$(FPC_VERSION)
+else
+DOCINSTALLDIR=$(BASEINSTALLDIR)/doc
+endif
+endif
+
+# Where the some extra (data)files will be stored
+ifndef EXTRAINSTALLDIR
+EXTRAINSTALLDIR=$(BASEINSTALLDIR)
+endif
+
+
+#####################################################################
+# Compiler Command Line
+#####################################################################
+
+# Load commandline OPTDEF and add FPC_CPU define
+override FPCOPTDEF:=-d$(CPU_TARGET)
+
+# Load commandline OPT and add target and unit dir to be sure
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+
+ifdef RTLDIR
+override FPCOPT+=-Fu$(RTLDIR)
+endif
+
+ifdef UNITSDIR
+override FPCOPT+=-Fu$(UNITSDIR)
+endif
+
+# Smartlinking
+ifdef SMARTLINK
+override FPCOPT+=-CX
+endif
+
+# Debug
+ifdef DEBUG
+override FPCOPT+=-g
+endif
+
+# Add commandline options
+ifdef OPT
+override FPCOPT+=$(OPT)
+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
+
+# Add defines from FPCOPTDEF to FPCOPT
+ifdef FPCOPTDEF
+override FPCOPT+=$(FPCOPTDEF)
+endif
+
+# Error file ?
+ifdef ERRORFILE
+override FPCOPT+=-Fr$(ERRORFILE)
+endif
+
+# Was a config file specified ?
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+
+# For win32 the options are passed using the environment variable FPCEXTCMD
+ifeq ($(OS_SOURCE),win32)
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+
+# Compiler commandline
+override COMPILER:=$(FPC) $(FPCOPT)
+
+#####################################################################
+# Shell tools
+#####################################################################
+
+# To copy pograms
+ifndef COPY
+export COPY:=cp -fp
+endif
+
+# Copy a whole tree
+ifndef COPYTREE
+export COPYTREE:=cp -rfp
+endif
+
+# To move pograms
+ifndef MOVE
+export MOVE:=mv -f
+endif
+
+# Check delete program
+ifndef DEL
+export DEL:=rm -f
+endif
+
+# Check deltree program
+ifndef DELTREE
+export DELTREE:=rm -rf
+endif
+
+# To install files
+ifndef INSTALL
+ifdef inlinux
+export INSTALL:=install -m 644
+else
+export INSTALL:=$(COPY)
+endif
+endif
+
+# To install programs
+ifndef INSTALLEXE
+ifdef inlinux
+export INSTALLEXE:=install -m 755
+else
+export INSTALLEXE:=$(COPY)
+endif
+endif
+
+# To make a directory.
+ifndef MKDIR
+ifdef inlinux
+export MKDIR:=install -m 755 -d
+else
+export MKDIR:=ginstall -m 755 -d
+endif
+endif
+
+#####################################################################
+# Default Tools
+#####################################################################
+
+# file used to check if a package is compiled
+ifndef FPCMAKED
+FPCMAKED=fpcmaked
+endif
+
+# assembler, redefine it if cross compiling
+ifndef AS
+AS=as
+endif
+
+# linker, but probably not used
+ifndef LD
+LD=ld
+endif
+
+# ppas.bat / ppas.sh
+ifdef inlinux
+PPAS=ppas.sh
+else
+ifdef inOS2
+PPAS=ppas.cmd
+else
+PPAS=ppas.bat
+endif
+endif
+
+# also call ppas if with command option -s
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+EXECPPAS:=@$(PPAS)
+endif
+
+# ldconfig to rebuild .so cache
+ifdef inlinux
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+
+# echo
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(EXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+export ECHO:=echo
+else
+export ECHO:=$(firstword $(ECHO))
+endif
+endif
+
+# ppdep
+ifndef PPDEP
+PPDEP:=$(strip $(wildcard $(addsuffix /ppdep$(EXEEXT),$(SEARCHPATH))))
+ifeq ($(PPDEP),)
+PPDEP=
+else
+export PPDEP:=$(firstword $(PPDEP))
+endif
+endif
+
+# ppumove
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(EXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE=
+else
+export PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+
+# ppufiles
+ifndef PPUFILES
+PPUFILES:=$(strip $(wildcard $(addsuffix /ppufiles$(EXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUFILES),)
+PPUFILES=
+else
+export PPUFILES:=$(firstword $(PPUFILES))
+endif
+endif
+
+# Look if UPX is found for go32v2 and win32. We can't use $UPX becuase
+# upx uses that one itself (PFV)
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(EXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+export UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+
+# gdate/date
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /date$(EXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(EXEEXT),$(SEACHPATH))))
+ifeq ($(DATE),)
+DATE=
+else
+export DATE:=$(firstword $(DATE))
+endif
+else
+export DATE:=$(firstword $(DATE))
+endif
+endif
+
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+
+# ZipProg, you can't use Zip as the var name (PFV)
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(EXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG=
+else
+export ZIPPROG:=$(firstword $(ZIPPROG)) -D9 -r
+endif
+endif
+
+ifndef ZIPEXT
+ZIPEXT=.zip
+endif
+
+#####################################################################
+# Default extensions
+#####################################################################
+
+# Default needed extensions (Go32v2,Linux)
+LOADEREXT=.as
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+PACKAGESUFFIX=
+
+# Go32v1
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+PACKAGESUFFIX=v1
+endif
+
+# Go32v2
+ifeq ($(OS_TARGET),go32v2)
+PACKAGESUFFIX=go32
+endif
+
+# Linux
+ifeq ($(OS_TARGET),linux)
+PACKAGESUFFIX=linux
+endif
+
+# Win32
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+PACKAGESUFFIX=win32
+endif
+
+# OS/2
+ifeq ($(OS_TARGET),os2)
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+SMARTEXT=.so
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+PACKAGESUFFIX=os2
+endif
+
+# library prefix
+LIBPREFIX=lib
+ifeq ($(OS_TARGET),go32v2)
+LIBPREFIX=
+endif
+ifeq ($(OS_TARGET),go32v1)
+LIBPREFIX=
+endif
+
+# determine which .pas extension is used
+ifndef PASEXT
+ifdef EXEOBJECTS
+override TESTPAS:=$(strip $(wildcard $(addsuffix .pas,$(firstword $(EXEOBJECTS)))))
+else
+override TESTPAS:=$(strip $(wildcard $(addsuffix .pas,$(firstword $(UNITOBJECTS)))))
+endif
+ifeq ($(TESTPAS),)
+PASEXT=.pp
+else
+PASEXT=.pas
+endif
+endif
+
+#####################################################################
+# Standard rules
+#####################################################################
+
+all: fpc_all
+
+debug: fpc_debug
+
+smart: fpc_smart
+
+shared: fpc_shared
+
+showinstall: fpc_showinstall
+
+install: fpc_install
+
+sourceinstall: fpc_sourceinstall
+
+zipinstall: fpc_zipinstall
+
+zipinstalladd: fpc_zipinstalladd
+
+clean: fpc_clean
+
+cleanall: fpc_cleanall
+
+info: fpc_info
+
+.PHONY:  all debug smart shared showinstall install sourceinstall zipinstall zipinstalladd clean cleanall info
+
+#####################################################################
+# Package depends
+#####################################################################
+
+ifneq ($(wildcard $(RTLDIR)),)
+ifeq ($(wildcard $(RTLDIR)/$(FPCMAKED)),)
+override COMPILEPACKAGES+=rtl
+rtl_package:
+	$(MAKE) -C $(RTLDIR) all
+endif
+endif
+
+.PHONY:  rtl_package
+
+#####################################################################
+# Exes
+#####################################################################
+
+.PHONY: fpc_exes
+
+override EXEFILES=$(addsuffix $(EXEEXT),$(EXEOBJECTS))
+override EXEOFILES=$(addsuffix $(OEXT),$(EXEOBJECTS))
+
+override ALLTARGET+=fpc_exes
+override INSTALLEXEFILES+=$(EXEFILES)
+override CLEANEXEFILES+=$(EXEFILES) $(EXEOFILES)
+
+fpc_exes: $(EXEFILES)
+
+#####################################################################
+# General compile rules
+#####################################################################
+
+.PHONY: fpc_all fpc_debug
+
+$(FPCMAKED):
+	@$(ECHO) Compiled > $(FPCMAKED)
+
+fpc_all: $(addsuffix _package,$(COMPILEPACKAGES)) \
+	 $(addsuffix _component,$(COMPILECOMPONENTS)) \
+	 $(ALLTARGET) $(FPCMAKED)
+
+fpc_debug:
+	$(MAKE) all DEBUG=1
+
+# General compile rules, available for both possible PASEXT
+
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .pp
+
+%$(PPUEXT): %.pp
+	$(COMPILER) $< $(REDIR)
+	$(EXECPASS)
+
+%$(PPUEXT): %.pas
+	$(COMPILER) $< $(REDIR)
+	$(EXECPASS)
+
+%$(EXEEXT): %.pp
+	$(COMPILER) $< $(REDIR)
+	$(EXECPASS)
+
+%$(EXEEXT): %.pas
+	$(COMPILER) $< $(REDIR)
+	$(EXECPASS)
+
+#####################################################################
+# Library
+#####################################################################
+
+.PHONY: fpc_smart fpc_shared
+
+# Default sharedlib units are all unit objects
+ifndef SHAREDLIBUNITOBJECTS
+SHAREDLIBUNITOBJECTS:=$(UNITOBJECTS)
+endif
+
+fpc_smart:
+	$(MAKE) all SMARTLINK=1
+
+fpc_shared: all
+ifdef inlinux
+ifndef LIBNAME
+	@$(ECHO) LIBNAME not set
+else
+	$(PPUMOVE) $(SHAREDLIBUNITOBJECTS) -o$(LIBNAME)
+endif
+else
+	@$(ECHO) Shared Libraries not supported
+endif
+
+#####################################################################
+# Install rules
+#####################################################################
+
+.PHONY: fpc_showinstall fpc_install
+
+ifdef EXTRAINSTALLUNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(EXTRAINSTALLUNITS))
+endif
+
+ifdef INSTALLPPUFILES
+ifdef PPUFILES
+ifdef inlinux
+INSTALLPPULINKFILES:=$(shell $(PPUFILES) -S -O $(INSTALLPPUFILES))
+INSTALLPPULIBFILES:=$(shell $(PPUFILES) -L $(INSTALLPPUFILES))
+else
+INSTALLPPULINKFILES:=$(shell $(PPUFILES) $(INSTALLPPUFILES))
+endif
+else
+INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES))
+endif
+endif
+
+fpc_showinstall: $(SHOWINSTALLTARGET)
+ifdef INSTALLEXEFILES
+	@$(ECHO) $(addprefix "\n"$(BININSTALLDIR)/,$(INSTALLEXEFILES))
+endif
+ifdef INSTALLPPUFILES
+	@$(ECHO) $(addprefix "\n"$(UNITINSTALLDIR)/,$(INSTALLPPUFILES))
+ifneq ($(INSTALLPPULINKFILES),)
+	@$(ECHO) $(addprefix "\n"$(UNITINSTALLDIR)/,$(INSTALLPPULINKFILES))
+endif
+ifneq ($(INSTALLPPULIBFILES),)
+	@$(ECHO) $(addprefix "\n"$(LIBINSTALLDIR)/,$(INSTALLPPULIBFILES))
+endif
+endif
+ifdef EXTRAINSTALLFILES
+	@$(ECHO) $(addprefix "\n"$(EXTRAINSTALLDIR)/,$(EXTRAINSTALLFILES))
+endif
+
+fpc_install: $(INSTALLTARGET)
+# Create UnitInstallFiles
+ifdef INSTALLEXEFILES
+	$(MKDIR) $(BININSTALLDIR)
+# Compress the exes if upx is defined
+ifdef UPXPROG
+	-$(UPXPROG) $(INSTALLEXEFILES)
+endif
+	$(INSTALLEXE) $(INSTALLEXEFILES) $(BININSTALLDIR)
+endif
+ifdef INSTALLPPUFILES
+	$(MKDIR) $(UNITINSTALLDIR)
+	$(INSTALL) $(INSTALLPPUFILES) $(UNITINSTALLDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+	$(INSTALL) $(INSTALLPPULINKFILES) $(UNITINSTALLDIR)
+endif
+ifneq ($(INSTALLPPULIBFILES),)
+	$(MKDIR) $(LIBINSTALLDIR)
+	$(INSTALL) $(INSTALLPPULIBFILES) $(LIBINSTALLDIR)
+endif
+endif
+ifdef EXTRAINSTALLFILES
+	$(MKDIR) $(EXTRAINSTALLDIR)
+	$(INSTALL) $(EXTRAINSTALLFILES) $(EXTRAINSTALLDIR)
+endif
+
+#####################################################################
+# Source install rules
+#####################################################################
+
+.PHONY: fpc_sourceinstall
+
+fpc_sourceinstall: clean
+	$(MKDIR) $(SOURCEINSTALLDIR)
+	$(COPYTREE) $(BASEDIR) $(SOURCEINSTALLDIR)
+
+#####################################################################
+# Zip
+#####################################################################
+
+.PHONY: fpc_zipinstall fpc_zipinstalladd
+
+# Temporary path to pack a file
+ifndef PACKDIR
+ifndef inlinux
+PACKDIR=pack_tmp
+else
+PACKDIR=/tmp/fpc-pack
+endif
+endif
+
+# Test dir if none specified
+ifndef DESTZIPDIR
+DESTZIPDIR:=$(BASEDIR)
+endif
+
+# Add .zip/.tar.gz extension
+ifdef ZIPNAME
+ifndef inlinux
+override ZIPNAME:=$(ZIPNAME)$(ZIPEXT)
+endif
+endif
+
+# Note: This will not remove the zipfile first
+fpc_zipinstalladd:
+ifndef ZIPNAME
+	@$(ECHO) Please specify ZIPNAME!
+	@exit
+else
+	$(MAKE) $(ZIPTARGET) PREFIXINSTALLDIR=$(PACKDIR)
+ifdef inlinux
+	gzip -d $(DESTZIPDIR)/$(ZIPNAME).tar.gz
+	cd $(PACKDIR) ; tar rv --file $(DESTZIPDIR)/$(ZIPNAME).tar * ; cd $(BASEDIR)
+	gzip $(DESTZIPDIR)/$(ZIPNAME).tar
+else
+	cd $(PACKDIR) ; $(ZIPPROG) $(DESTZIPDIR)/$(ZIPNAME) * ; cd $(BASEDIR)
+endif
+	$(DELTREE) $(PACKDIR)
+endif
+
+# First remove the zip and then install
+fpc_zipinstall:
+ifndef ZIPNAME
+	@$(ECHO) Please specify ZIPNAME!
+	@exit
+else
+	$(DEL) $(DESTZIPDIR)/$(ZIPNAME)
+	$(MAKE) $(ZIPTARGET) PREFIXINSTALLDIR=$(PACKDIR)
+ifdef inlinux
+	cd $(PACKDIR) ; tar cvz --file $(DESTZIPDIR)/$(ZIPNAME).tar.gz * ; cd $(BASEDIR)
+else
+	cd $(PACKDIR) ; $(ZIPPROG) $(DESTZIPDIR)/$(ZIPNAME) * ; cd $(BASEDIR)
+endif
+	$(DELTREE) $(PACKDIR)
+endif
+
+#####################################################################
+# Clean rules
+#####################################################################
+
+.PHONY: fpc_clean fpc_cleanall
+
+ifdef EXTRACLEANUNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(EXTRACLEANUNITS))
+endif
+
+ifdef CLEANPPUFILES
+ifdef PPUFILES
+CLEANPPULINKFILES:=$(shell $(PPUFILES) $(CLEANPPUFILES))
+else
+CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES))
+endif
+endif
+
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+	-$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+	-$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef EXTRACLEANFILES
+	-$(DEL) $(EXTRACLEANFILES)
+endif
+	-$(DEL) $(FPCMAKED) $(PPAS) link.res $(REDIRFILE)
+
+fpc_cleanall: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+	-$(DEL) *$(OEXT) *$(PPUEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+	-$(DELTREE) *$(SMARTEXT)
+	-$(DEL) $(FPCMAKED) $(PPAS) link.res $(REDIRFILE)
+
+#####################################################################
+# Info rules
+#####################################################################
+
+.PHONY: fpc_info fpc_cfginfo fpc_objectinfo fpc_toolsinfo fpc_installinfo \
+	fpc_dirinfo
+
+fpc_info: $(INFOTARGET)
+
+fpc_infocfg:
+	@$(ECHO)
+	@$(ECHO)  == Configuration info ==
+	@$(ECHO)
+	@$(ECHO)  FPC....... $(FPC)
+	@$(ECHO)  Version... $(FPC_VERSION)
+	@$(ECHO)  CPU....... $(CPU_TARGET)
+	@$(ECHO)  Source.... $(OS_SOURCE)
+	@$(ECHO)  Target.... $(OS_TARGET)
+	@$(ECHO)
+
+fpc_infoobjects:
+	@$(ECHO)
+	@$(ECHO)  == Object info ==
+	@$(ECHO)
+	@$(ECHO)  LoaderObjects..... $(LOADEROBJECTS)
+	@$(ECHO)  UnitObjects....... $(UNITOBJECTS)
+	@$(ECHO)  ExeObjects........ $(EXEOBJECTS)
+	@$(ECHO)
+	@$(ECHO)  ExtraCleanUnits... $(EXTRACLEANUNITS)
+	@$(ECHO)  ExtraCleanFiles... $(EXTRACLEANFILES)
+	@$(ECHO)
+	@$(ECHO)  ExtraInstallUnits. $(EXTRAINSTALLUNITS)
+	@$(ECHO)  ExtraInstallFiles. $(EXTRAINSTALLFILES)
+	@$(ECHO)
+
+fpc_infoinstall:
+	@$(ECHO)
+	@$(ECHO)  == Install info ==
+	@$(ECHO)
+ifdef DATE
+	@$(ECHO)  DateStr.............. $(DATESTR)
+endif
+	@$(ECHO)  PackageSuffix........ $(PACKAGESUFFIX)
+	@$(ECHO)
+	@$(ECHO)  BaseInstallDir....... $(BASEINSTALLDIR)
+	@$(ECHO)  BinInstallDir........ $(BININSTALLDIR)
+	@$(ECHO)  LibInstallDir........ $(LIBINSTALLDIR)
+	@$(ECHO)  UnitInstallDir....... $(UNITINSTALLDIR)
+	@$(ECHO)  SourceInstallDir..... $(SOURCEINSTALLDIR)
+	@$(ECHO)  DocInstallDir........ $(DOCINSTALLDIR)
+	@$(ECHO)  ExtraInstallDir...... $(EXTRAINSTALLDIR)
+	@$(ECHO)
+
+#####################################################################
+# Users rules
+#####################################################################
+
+
+fpcrp$(EXEEXT): h2pas$(PASEXT) comments$(PASEXT) pexpr$(PASEXPR) pasprep$(PASEXPR)

+ 19 - 0
utils/fprcp/Makefile.fpc

@@ -0,0 +1,19 @@
+#
+#   Makefile.fpc for h2pas
+#
+
+[targets]
+programs=fprcp
+
+[clean]
+units=comments pexpr pasprep
+
+[dirs]
+fpcdir=../..
+
+[defaults]
+
+
+[rules]
+
+fpcrp$(EXEEXT): fpcrp$(PASEXT) comments$(PASEXT) pexpr$(PASEXPR) pasprep$(PASEXPR)

+ 34 - 0
utils/fprcp/Readme.txt

@@ -0,0 +1,34 @@
+This binary with source code is released to public domain.
+The utility can be compiled by Turbo Pascal (but 16-bit version
+cannot handle files greather than 64K!), Delphi or Free Pascal.
+fprcp.exe extracts from C header and Pascal files included into
+resource scripts numerical constants and replaces these constants
+to its values in resource script. Modified resource script is writing
+to stdout.
+
+fprcp.exe can be used as preprocessor by windres GNU-win32 utility.
+It was tested with windres 2.9.4 successfully.
+syntax: 
+windres --preprocessor fprcp.exe [another switches].
+
+Notes:
+1) current fprcp does not support typecasting and operations with
+non-numeric constants;
+2) Old versions of windres cannot create .res files;
+3) in fprcp also source code written by Lars Fosdal 1987 and
+   released to the public domain 1993 was used
+
+files:
+readme.1th   - this file
+
+USE_DEMO.BAT |
+DEMO.RC      |
+DEMO.PAS      - demo files
+DEMO.H       |
+
+COMMENTS.PAS |
+PASPREP.PAS  |
+FPRCP.PP      - source code
+EXPR.PAS     |
+
+fprcp.exe     - executable

+ 123 - 0
utils/fprcp/comments.pp

@@ -0,0 +1,123 @@
+unit Comments;
+interface
+procedure ClearComments(nesting:longbool;__buf:pointer;size:longint);
+implementation
+procedure ClearComments(nesting:longbool;__buf:pointer;size:longint);
+ type                                                                       
+  tat=array[1..1]of char;                                                   
+  pat=^tat;                                                                 
+  pblock=^tblock;                                                           
+  tblock=record                                                             
+   next:pblock;                                                             
+   _begin,_end:longint;                                                     
+  end;                                                                      
+ type                                                                       
+  str255=string[255];                                                       
+ var                                                                        
+  CommLevel:longint;                                                        
+  buf:pat absolute __buf;                                                   
+  i,j:longint;                                                              
+  comm:pblock;                                                              
+ function TwoChars(const s):str255;                                         
+  var                                                                       
+   d:tat absolute s;                                                        
+   ii:longint;                                                              
+  begin                                                                     
+   TwoChars:='  ';                                                          
+   if succ(i)>=size then                                                    
+    TwoChars:=''                                                            
+   else                                                                     
+    begin                                                                   
+     ii:=2;                                                                 
+     TwoChars[1]:=d[1];                                                     
+     TwoChars[ii]:=d[ii];                                                   
+    end;                                                                    
+  end;                                                                      
+ function FindFrom(position:longint;const Origin:str255):longint;           
+  var                                                                       
+   j,k:longint;                                                             
+  begin                                                                     
+   FindFrom:=size;                                                          
+   for j:=position to Size-length(Origin)do                                 
+    begin                                                                   
+     for k:=1 to length(Origin)do                                           
+      begin                                                                 
+       if buf^[j+k-1]<>Origin[k]then                                        
+        break                                                               
+       else if k=length(Origin)then                                         
+        begin                                                               
+         FindFrom:=j;                                                       
+         exit;                                                              
+        end;                                                                
+      end;                                                                  
+    end;                                                                    
+  end;                                                                      
+ procedure BeginComment(i:longint);                                         
+  var                                                                       
+   c:pBlock;                                                                
+  begin                                                                     
+   new(c);                                                                  
+   c^.next:=comm;                                                           
+   c^._begin:=i;                                                            
+   c^._end:=size;                                                           
+   comm:=c;                                                                 
+   CommLevel:=1;                                                            
+  end;                                                                      
+ procedure EndComment(i:longint);                                           
+  begin                                                                     
+   if comm<>nil then                                                        
+    comm^._end:=i;                                                          
+   dec(CommLevel);                                                          
+  end;                                                                      
+ procedure DeleteComments;                                                  
+  var                                                                       
+   i:longint;                                                               
+   c,cc:pblock;                                                                
+  begin                                                                     
+   c:=comm;                                                                 
+   while c<>nil do                                                          
+    begin                                                                   
+     for i:=c^._begin to c^._end do                                         
+      buf^[i]:=#32;                                                         
+     cc:=c;
+     c:=c^.next;
+     dispose(cc);
+    end;                                                                    
+  end;                                                                      
+ begin                                                                      
+  commLevel:=0;                                                             
+  comm:=nil;                                                                
+  i:=1;                                                                     
+  while i<size do                                                           
+   begin                                                                    
+    if commlevel=0 then                                                     
+     begin                                                                  
+      if buf^[i]=''''then                                                   
+       i:=FindFrom(succ(i),'''');                                           
+      if TwoChars(buf^[i])='//'then                                         
+       begin                                                                
+        BeginComment(i);                                                    
+        j:=FindFrom(succ(i),#13);                                           
+        if j=size then                                                      
+         j:=FindFrom(succ(i),'#10');                                        
+        i:=j;                                                               
+        EndComment(i);                                                      
+       end;                                                                 
+      if(buf^[i]='{')or(TwoChars(buf^[i])='(*')then                         
+       BeginComment(i);                                                     
+     end                                                                    
+    else                                                                    
+     begin                                                                  
+      if(buf^[i]='{')or(TwoChars(buf^[i])='(*')then                         
+       begin                                                                
+        if nesting then                                                     
+         inc(CommLevel);                                                    
+       end;                                                                 
+      if(buf^[i]='}')or(TwoChars(buf^[i])='*)')then                         
+       EndComment(succ(i));                                                 
+     end;                                                                   
+    inc(i);                                                                 
+   end;                                                                     
+  DeleteComments;                                                           
+ end;
+end.

+ 2 - 0
utils/fprcp/demo.h

@@ -0,0 +1,2 @@
+#define ID_NEW 1112 +  /* */ 1
+#define Id_open 1

+ 36 - 0
utils/fprcp/demo.pp

@@ -0,0 +1,36 @@
+{test}
+
+//test
+
+const
+ x:string='asd            asdasd''asdasdas{{{{';
+{//begin}
+(*{ASASAS}*)
+ ID_NEW=10000;
+function ttt:longint;
+ function Level2(const x;const y:longint):longint;assembler;
+  asm
+   mov ax,1
+  end;
+ const
+  ID_OPEN=10001;
+var
+  xx:record
+  end;
+  x:byte;
+ begin
+  case x of
+  1:;
+  2:;
+  end;
+ end;
+const
+ ID_OPEN=3000;
+ ID_SAVE = ID_OPEN + 1;
+ ID_SAVEAS=$B +$001+ 3;
+ ID_CLOSE=abs(-1);
+ ID_Exit=pred(4);
+ TEST1=1.5;
+ test2='sdsadasd';
+begin
+end.

+ 26 - 0
utils/fprcp/demo.rc

@@ -0,0 +1,26 @@
+#include "demo.h"
+//#include "demo.pas"
+MENU1 MENU
+BEGIN
+    POPUP        "&File"
+    BEGIN
+        MENUITEM    "&New",              	ID_NEW
+        MENUITEM    "&Open...",          	2
+        MENUITEM    "&Save",             	3
+        MENUITEM    "Save &As...",       	4
+        MENUITEM    "&Print",            	5
+        MENUITEM    SEPARATOR
+        MENUITEM    "E&xit",             	6
+    END
+
+    POPUP        "&Edit"
+    BEGIN
+        MENUITEM    "&Undo\tAlt+Bksp",     7
+        MENUITEM    SEPARATOR
+        MENUITEM    "Cu&t\tShift+Del",     8
+        MENUITEM    "&Copy\tCtrl+Ins",     9
+        MENUITEM    "&Paste\tShift+Ins",   10
+        MENUITEM    "C&lear\tDel", 11
+    END
+END
+

BIN
utils/fprcp/expr.ow


+ 278 - 0
utils/fprcp/expr.pp

@@ -0,0 +1,278 @@
+{$ifdef win32}
+{$H-}
+{$endif}
+{$N+}
+Unit Expr;
+interface
+const
+ IntSize2:longbool=false;
+PROCEDURE Eval(Formula : String;    { Expression to be evaluated}
+               VAR Value   : double;      { Return value }
+               VAR ErrPos  : Integer);  { error position }
+
+{
+  Simple recursive expression parser based on the TCALC example of TP3.
+  Written by Lars Fosdal 1987
+  Released to the public domain 1993
+}
+implementation
+type
+ real=double;
+PROCEDURE Eval(Formula : String;    { Expression to be evaluated}
+               VAR Value   : double;      { Return value }
+               VAR ErrPos  : Integer);  { error position }
+  CONST
+    Digit: Set of Char = ['0'..'9'];
+  VAR
+    Posn  : Integer;   { Current position in Formula}
+    CurrChar   : Char;      { character at Posn in Formula }
+
+
+PROCEDURE ParseNext; { returnerer neste tegn i Formulaen  }
+BEGIN
+  REPEAT
+    Posn:=Posn+1;
+    IF Posn<=Length(Formula) THEN CurrChar:=Formula[Posn]
+     ELSE CurrChar:=^M;
+  UNTIL CurrChar<>' ';
+END  { ParseNext };
+
+
+FUNCTION add_subt: Real;
+  VAR
+    E   : Real;
+    Opr : Char;
+
+  FUNCTION mult_DIV: Real;
+    VAR
+      S   : Real;
+      Opr : Char;
+
+    FUNCTION Power: Real;
+      VAR
+        T : Real;
+
+      FUNCTION SignedOp: Real;
+
+        FUNCTION UnsignedOp: Real;
+          TYPE
+            StdFunc = (fabs,    fsqrt, fsqr, fsin, fcos,
+                       farctan, fln,   flog, fexp, ffact,
+                       fpred,fsucc,fround,ftrunc);
+            StdFuncList = ARRAY[StdFunc] of String[6];
+
+          CONST
+            StdFuncName: StdFuncList =
+            ('ABS','SQRT','SQR','SIN','COS',
+            'ARCTAN','LN','LOG','EXP','FACT',
+            'PRED','SUCC','ROUND','TRUNC');
+          VAR
+            E, L, Start    : Integer;
+            Funnet         : Boolean;
+            F              : Real;
+            Sf             : StdFunc;
+
+              FUNCTION Fact(I: Integer): Real;
+              BEGIN
+                IF I > 0 THEN BEGIN Fact:=I*Fact(I-1); END
+                ELSE Fact:=1;
+              END  { Fact };
+
+          BEGIN { FUNCTION UnsignedOp }
+            IF CurrChar in Digit THEN
+            BEGIN
+              Start:=Posn;
+              REPEAT ParseNext UNTIL not (CurrChar in Digit);
+              IF CurrChar='.' THEN REPEAT ParseNext UNTIL not (CurrChar in Digit);
+              IF CurrChar='E' THEN
+              BEGIN
+                ParseNext;
+                REPEAT ParseNext UNTIL not (CurrChar in Digit);
+              END;
+              Val(Copy(Formula,Start,Posn-Start),F,ErrPos);
+            END ELSE
+            IF CurrChar='(' THEN
+            BEGIN
+              ParseNext;
+              F:=add_subt;
+              IF CurrChar=')' THEN ParseNext ELSE ErrPos:=Posn;
+            END ELSE
+            BEGIN
+              Funnet:=False;
+              FOR sf:=fabs TO ftrunc DO
+              IF not Funnet THEN
+              BEGIN
+                l:=Length(StdFuncName[sf]);
+                IF Copy(Formula,Posn,l)=StdFuncName[sf] THEN
+                BEGIN
+                  Posn:=Posn+l-1; ParseNext;
+                  f:=UnsignedOp;
+                  CASE sf of
+                    fabs:     f:=abs(f);
+                    fsqrt:    f:=SqrT(f);
+                    fsqr:     f:=Sqr(f);
+                    fsin:     f:=Sin(f);
+                    fcos:     f:=Cos(f);
+                    farctan:  f:=ArcTan(f);
+                    fln :     f:=LN(f);
+                    flog:     f:=LN(f)/LN(10);
+                    fexp:     f:=EXP(f);
+                    ffact:    f:=fact(Trunc(f));
+                    fpred:f:=f-1;
+                    fsucc:f:=f+1;
+                    fround:f:=round(f)+0.0;
+                    ftrunc:f:=trunc(f)+0.0;
+                  END;
+                  Funnet:=True;
+                END;
+              END;
+              IF not Funnet THEN
+              BEGIN
+                ErrPos:=Posn;
+                f:=0;
+              END;
+            END;
+            UnsignedOp:=F;
+          END { UnsignedOp};
+
+        BEGIN { SignedOp }
+          IF CurrChar='-' THEN
+          BEGIN
+            ParseNext; SignedOp:=-UnsignedOp;
+          END
+          ELSE IF CurrChar='!' THEN
+           BEGIN
+            ParseNext; SignedOp:=not longint(round(UnsignedOp))+0.0;
+           END
+          ELSE SignedOp:=UnsignedOp;
+        END { SignedOp };
+
+      BEGIN { Power }
+        T:=SignedOp;
+        WHILE CurrChar='^' DO
+        BEGIN
+          ParseNext;
+          IF t<>0 THEN t:=EXP(LN(abs(t))*SignedOp) ELSE t:=0;
+        END;
+        Power:=t;
+      END { Power };
+
+
+    BEGIN { mult_DIV }
+      s:=Power;
+      WHILE CurrChar in ['*','/','&','¬','\','«','¯'] DO
+      BEGIN
+        Opr:=CurrChar; ParseNext;
+        CASE Opr of
+          '*': s:=s*Power;
+          '/': s:=s/Power;
+          '&': s:=longint(round(s)) and longint(round(power))+0.0;
+          '¬': s:=longint(round(s)) mod longint(round(power))+0.0;
+          '\': s:=trunc(s/Power);
+          '«': s:=longint(round(s)) shl longint(round(power))+0.0;
+          '¯': s:=longint(round(s)) shr longint(round(power))+0.0;
+        END;
+      END;
+      mult_DIV:=s;
+    END { mult_DIV };
+
+  BEGIN { add_subt }
+    E:=mult_DIV;
+    WHILE CurrChar in ['+','-','|','å'] DO
+    BEGIN
+      Opr:=CurrChar; ParseNext;
+      CASE Opr of
+        '+': e:=e+mult_DIV;
+        '-': e:=e-mult_DIV;
+        '|': e:=longint(round(e))or longint(round(mult_DIV))+0.0;
+        'å': e:=longint(round(e))xor longint(round(mult_DIV))+0.0;
+      END;
+    END;
+    add_subt:=E;
+  END { add_subt };
+procedure Replace(const _from,_to:string);
+ var
+  p:longint;
+ begin
+  repeat
+   p:=pos(_from,formula);
+   if p>0 then
+    begin
+     delete(formula,p,length(_from));
+     insert(_to,formula,p);
+    end;
+  until p=0;
+ end;
+function HexToDecS:longbool;
+ var
+  DecError:longbool;
+ procedure Decim(const pattern:string);
+  var
+   i,p,b,x:longint;
+   ss,st:string;
+  begin
+   repeat
+    p:=pos(pattern,formula);
+    if p>0 then
+     begin
+      b:=p+length(pattern);
+      ss:='';
+      if b<=length(formula)then
+       begin
+        while formula[b]in['0'..'9','a'..'f','A'..'F']do
+         begin
+          ss:=ss+formula[b];
+          inc(b);
+          if b>length(formula)then
+           break;
+         end;
+        val('$'+ss,x,posn);
+        DecError:=posn<>0;
+        str(x:0,st);
+        delete(formula,p,length(pattern)+length(ss));
+        insert(st,formula,p);
+       end;
+     end;
+   until p=0;
+  end;
+ begin
+  DecError:=false;
+  Decim('0x');
+  if not DecError then
+   Decim('$');
+  HexToDecS:=not DecError;
+ end;
+
+BEGIN {PROC Eval}
+  if not HexToDecS then
+   begin
+    value:=0;
+    ErrPos:=Posn;
+    exit;
+   end;
+  IF Formula[1]='.'
+  THEN Formula:='0'+Formula;
+  IF Formula[1]='+'
+  THEN Delete(Formula,1,1);
+  FOR Posn:=1 TO Length(Formula)
+  DO Formula[Posn] := Upcase(Formula[Posn]);
+  replace('<<','«');
+  replace('>>','¯');
+  replace('^','å');
+  replace('**','^');
+  replace('DIV','\');
+  replace('MOD','¬');
+  replace('AND','&');
+  replace('XOR','å');
+  replace('SHR','¯');
+  replace('SHL','«');
+  replace('NOT','!');
+  replace('OR','|');
+  Posn:=0;
+  ParseNext;
+  Value:=add_subt;
+  IF CurrChar=^M THEN ErrPos:=0 ELSE ErrPos:=Posn;
+END {PROC Eval};
+
+END.
+

BIN
utils/fprcp/expr.ppw


+ 572 - 0
utils/fprcp/fprcp.pp

@@ -0,0 +1,572 @@
+program FreePasResourcePreprocessor;
+{$ifdef win32}
+{$APPTYPE CONSOLE}
+{$endif}
+{$N+}
+uses
+ Comments,PasPrep,Expr
+{$ifndef win32}
+,DOS;
+type
+ str255=string[255];
+{$else}
+;
+type
+ str255=string[255];
+function SearchPath(path,name,ext:pchar;size:longint;buf:pchar;var x:pointer):longint;stdcall;
+ external 'kernel32.dll' name 'SearchPathA';
+function FSearch(s,path:str255):Str255;
+ var
+  l:longint;
+ procedure zeroterm(var s:str255);
+  begin
+   l:=length(s);
+   move(s[1],s[0],l);
+   s[l]:=#0;
+  end;
+ var
+  buf:str255;
+  aPtr:pointer;
+  i:longint;
+ begin
+  zeroterm(path);
+  zeroterm(s);
+  i:=SearchPath(pchar(@path),pchar(@s),nil,255,pchar(@buf[1]),aPtr);
+  if i<=255 then
+   byte(buf[0]):=i
+  else
+   buf[0]:=#0;
+  FSearch:=buf;
+ end;
+{$endif}
+
+type
+ pstring=^str255;
+ PReplaceRec=^TReplaceRec;
+ TReplaceRec=record
+  next:PReplaceRec;
+  CaseSentitive:longbool;
+  oldvalue,newvalue:pstring;
+ end;
+ chars=array[1..2]of char;
+ pchars=^chars;
+const
+ Chain:PReplaceRec=nil;
+ ChainHdr:PReplaceRec=nil;
+ Chainlen:longint=0;
+var
+ f:file;
+ s:str255;
+ size,nextpos:longint;
+ buf:pchars;
+ i:longint;
+function Entry(buf:pchars;Size,fromPos:longint;const sample:str255;casesent:longbool):longbool;
+ var
+  i:longint;
+  c:char;
+ begin
+  Entry:=false;
+  if(fromPos>1)and(buf^[pred(frompos)]>#32)then
+   exit;
+  if fromPos+length(sample)-1>=size then
+   exit;
+  if buf^[fromPos+length(sample)]>#32 then
+   exit;
+  Entry:=true;
+  for i:=1 to length(sample)do
+   begin
+    if pred(fromPos+i)>size then
+     begin
+      Entry:=false;
+      exit;
+     end;
+    c:=buf^[pred(fromPos+i)];
+    if not casesent then
+     c:=UpCase(c);
+    if c<>sample[i]then
+     begin
+      Entry:=false;
+      exit;
+     end;
+    end;
+ end;
+function GetWord(buf:pchars;Size,fromPos:longint;var EndPos:longint):str255;
+ var
+  s:str255;
+  i:longint;
+  word_begin:longbool;
+ begin
+  s:='';
+  i:=frompos;
+  word_begin:=false;
+  while i<size do
+   begin
+    if not word_begin then
+     word_begin:=(buf^[i]>#32)and(buf^[i]<>';')and(buf^[i]<>'=');
+    if word_begin then
+     begin
+      if not(buf^[i]in[#0..#32,';','='])then
+       s:=s+buf^[i]
+      else
+       begin
+        EndPos:=i;
+        break;
+       end;
+     end;
+    inc(i);
+   end;
+  GetWord:=s;
+ end;
+procedure excludeComments(buf:pchars;size:longint);
+ var
+  comment:longbool;
+  i:longint;
+ begin
+  comment:=false;
+  for i:=1 to pred(size)do
+   begin
+    if(buf^[i]='/')and(buf^[succ(i)]='*')then
+     comment:=true;
+    if comment then
+     begin
+      if(buf^[i]='*')and(buf^[succ(i)]='/')then
+       begin
+        comment:=false;
+        buf^[succ(i)]:=' ';
+       end;
+      buf^[i]:=' ';
+     end;
+   end;
+  comment:=false;
+  for i:=1 to pred(size)do
+   begin
+    if(buf^[i]='/')and(buf^[succ(i)]='/')then
+     comment:=true;
+    if comment then
+     begin
+      if buf^[i]in[#10,#13]then
+       comment:=false;
+      buf^[i]:=' ';
+     end;
+   end;
+ end;
+function IsSwitch(const switch:str255):longbool;
+ var
+  i:longint;
+ begin
+  IsSwitch:=false;
+  for i:=1 to ParamCount do
+   if paramstr(i)='-'+switch then
+    begin
+     IsSwitch:=true;
+     exit;
+    end;
+ end;
+function GetSwitch(const switch:str255):str255;
+ var
+  i:longint;
+ begin
+  GetSwitch:='';
+  for i:=1 to paramcount do
+   if paramstr(i)='-'+switch then
+    GetSwitch:=paramstr(succ(i));
+ end;
+procedure saveproc(const key,value:str255;CaseSent:longbool);far;
+ var
+  c:pReplaceRec;
+ begin
+  new(c);
+  c^.next:=nil;
+  c^.CaseSentitive:=CaseSent;
+  getmem(c^.oldvalue,succ(length(key)));
+  c^.oldvalue^:=key;
+  getmem(c^.newvalue,succ(length(value)));
+  c^.newvalue^:=value;
+  if chainhdr=nil then
+   begin
+    chain:=c;
+    chainhdr:=chain;
+    ChainLen:=1;
+   end
+  else
+   begin
+    chain^.next:=c;
+    chain:=c;
+    inc(ChainLen);
+   end;
+ end;
+type
+ Tlanguage=(L_C,L_Pascal);
+function Language(s:str255):tLanguage;
+ var
+  s1,Lstr:str255;
+  i,j:longint;
+  found:longbool;
+ type
+  TLD=record
+   x:string[3];
+   l:tLanguage;
+  end;
+ const
+  default:array[1..7]of TLD=(
+   (x:'PAS';l:L_PASCAL),
+   (x:'PP';l:L_PASCAL),
+   (x:'P';l:L_PASCAL),
+   (x:'DPR';l:L_PASCAL),
+   (x:'IN?';l:L_PASCAL),
+   (x:'C';l:L_C),
+   (x:'H';l:L_C));
+ begin
+  Lstr:=GetSwitch('l');
+  if lstr=''then
+   Lstr:=GetSwitch('-language');
+  for i:=1 to length(Lstr)do
+   Lstr[i]:=UpCase(Lstr[i]);
+  if Lstr='C'then
+   begin
+    Language:=L_C;
+    exit;
+   end
+  else if(Lstr='PASCAL')or(Lstr='DELPHI')then
+   begin
+    Language:=L_PASCAL;
+    exit;
+   end
+  else if (Lstr<>'')then
+   writeln('Warning: unknown language ',Lstr);
+  s1:='';
+  for i:=length(s)downto 1 do
+   begin
+    if s[i]='.'then
+     break;
+    s1:=upcase(s[i])+s1;
+   end;
+  for i:=1 to 7 do
+   begin
+    found:=true;
+    for j:=1 to length(s1)do
+     if s1[j]<>default[i].x[j]then
+      case default[i].x[j] of
+       '?':
+        ;
+       else
+        found:=false;
+      end;
+     if(found)and(s1<>'')then
+      begin
+       Language:=default[i].l;
+       exit;
+      end;
+    end;
+  Language:=L_PASCAL;
+ end;
+function Up(const s:str255):str255;
+ var
+  n:str255;
+  i:longint;
+ begin
+  n:=s;
+  for i:=1 to length(s)do
+   n[i]:=upcase(s[i]);
+  Up:=n;
+ end;
+procedure do_C(buf:pchars;size:longint;proc:pointer);
+ type
+  Tpushfunc=procedure(const key,value:str255;CaseSent:longBool);
+ var
+  position:longint;
+  charconst,stringconst:longbool;
+  s,s0:str255;
+  afunc:Tpushfunc absolute proc;
+ procedure read(var s:str255;toEOL:longbool);
+  var
+   i:longint absolute position;
+  function EndOfWord:longbool;
+   begin
+    if toEOL then
+     EndOfWord:=buf^[i]in[#10,#13]
+    else
+     EndOfWord:=buf^[i]<=#32;
+   end;
+  begin
+   s:='';
+   if i>size then
+    exit;
+   while buf^[i]<=#32 do
+    begin
+     if i>size then
+      exit;
+     inc(i);
+    end;
+   repeat
+    if i>size then
+     exit;
+    if not stringConst then
+     if buf^[i]=''''then
+      charconst:=not charconst;
+    if not charConst then
+     if buf^[i]='"'then
+      stringconst:=not stringconst;
+    if(not charconst)and(not stringconst)and EndOfWord then
+     exit;
+    if buf^[i]>#32 then
+     s:=s+buf^[i];
+    inc(i);
+   until false;
+  end;
+ begin
+  ExcludeComments(buf,size);
+  position:=1;
+  charconst:=false;
+  stringconst:=false;
+  repeat
+   read(s,false);
+   if Up(s)='#DEFINE' then
+    begin
+     read(s,false);
+     read(s0,true);
+     Tpushfunc(afunc)(s,s0,true);
+    end;
+  until position>=size;
+ end;
+procedure expandname(var s:str255;path:str255);
+ var
+  astr:str255;
+ begin
+  astr:=fsearch(s,path);
+  if astr<>''then
+   s:={$ifndef Win32}FExpand{$endif}(astr);
+ end;
+function do_include(name:str255):longbool;
+ var
+  buf:pchars;
+  f:file;
+  i,size,nextpos:longint;
+  s1,s2:str255;
+  done:longbool;
+ procedure trim;
+  begin
+   delete(name,1,1);
+   dec(name[0]);
+  end;
+ begin
+  if (name[1]='"')and(name[length(name)]='"')then
+   trim
+  else if (name[1]='<')and(name[length(name)]='>')then
+   begin
+    trim;
+    s1:=GetSwitch('p');
+    if s1=''then
+     s1:=GetSwitch('-path');
+    expandname(name,s1);
+   end;
+  assign(f,name);
+  reset(f,1);
+  size:=filesize(f);
+  GetMem(buf,size);
+  blockread(f,buf^,size);
+  close(f);
+  case Language(name)of
+   L_C:
+    do_C(buf,size,@saveProc);
+   L_PASCAL:
+    do_pascal(buf,size,@saveProc);
+  end;
+  FreeMem(buf,size);
+ end;
+function CheckRight(const s:str255;pos:longint):longbool;
+ begin
+  CheckRight:=true;
+  if pos>length(s)then
+   CheckRight:=false
+  else
+   CheckRight:=not(s[succ(pos)]in['a'..'z','A'..'Z','0'..'9','_']);
+ end;
+function CheckLeft(const s:str255;pos:longint):longbool;
+ begin
+  CheckLeft:=true;
+  if pos>1 then
+   begin
+    if pos>length(s)then
+     CheckLeft:=false
+    else
+     CheckLeft:=not(s[pred(pos)]in['a'..'z','A'..'Z','0'..'9','_']);
+   end;
+ end;
+function Evaluate(Equation:Str255):Str255;
+ var
+  x:double;
+  Err:integer;
+ begin
+  Eval(Equation,x,Err);
+  if(Err=0)and(frac(x)=0)then
+   str(x:1:0,Equation)
+  else
+   Equation:='';
+  Evaluate:=Equation;
+ end;
+type
+ taccel=array[1..100]of pReplaceRec;
+var
+ accel:^taccel;
+ c:pReplaceRec;
+ j,kk:longint;
+ sss,sst:str255;
+ MustBeReplaced,includeStatement,beginline:longbool;
+begin
+ if(paramcount=0)or isSwitch('h')or isSwitch('-help')or((paramcount>1)and(GetSwitch('i')=''))then
+  begin
+   writeln('FPC CONSTANTS EXTRACTOR for resource scripts preprocessing');
+   writeln('version 0.01');
+   writeln('Usage: fprcp <file_name>');
+   writeln('or:');
+   writeln('fprcp -i <file_name> [-n] [-C] [-l PASCAL|C] [-p <include_path>]');
+   writeln('      -C type C header instead preprocessed resource script');
+   writeln('      -l set programming language for include files');
+   writeln('      -p set path to include files');
+   writeln('      -n disable support of pascal comments nesting');
+   halt;
+  end;
+ if ParamCount=1 then
+  assign(f,paramstr(1))
+ else
+  assign(f,GetSwitch('i'));
+ reset(f,1);
+ size:=filesize(f);
+ getmem(buf,size);
+ blockread(f,buf^,size);
+ close(f);
+ if isSwitch('n')then
+  PasNesting:=false;
+ if isSwitch('-disable-nested-pascal-comments')then
+  PasNesting:=false;
+ excludeComments(buf,size);
+ for i:=1 to size do
+  begin
+   if entry(buf,size,i,'#include',true)then
+    do_include(GetWord(buf,size,i+length('#include'),nextpos));
+  end;
+
+ getmem(Accel,sizeof(pReplaceRec)*ChainLen);
+ c:=ChainHdr;
+ i:=0;
+ while c<>nil do
+  begin
+   inc(i);
+   Accel^[i]:=c;
+   c:=c^.next;
+  end;
+ for i:=1 to pred(Chainlen)do
+  for j:=succ(i)to Chainlen do
+   if length(Accel^[j]^.newvalue^)>=length(Accel^[i]^.oldvalue^)then
+    repeat
+     MustBeReplaced:=false;
+     for kk:=1 to length(Accel^[j]^.newvalue^)do
+      begin
+       sss:=copy(Accel^[j]^.newvalue^,kk,length(Accel^[i]^.oldvalue^));
+       if length(sss)<>length(Accel^[i]^.oldvalue^)then
+        break
+       else if sss=Accel^[i]^.oldvalue^ then
+        begin
+         MustBeReplaced:=(CheckLeft(Accel^[j]^.newvalue^,kk)and CheckRight(Accel^[j]^.newvalue^,kk-1+
+                             length(Accel^[i]^.oldvalue^)));
+         if MustBeReplaced then
+          break;
+        end;
+      end;
+     if MustBeReplaced then
+      begin
+       sss:=Accel^[j]^.newvalue^;
+       delete(sss,kk,length(Accel^[i]^.oldvalue^));
+       insert(Accel^[i]^.newvalue^,sss,kk);
+       freemem(Accel^[j]^.newvalue,length(Accel^[j]^.newvalue^));
+       getmem(Accel^[j]^.newvalue,length(sss));
+       Accel^[j]^.newvalue^:=sss;
+      end;
+    until not MustBeReplaced;
+ for j:=1 to Chainlen do
+  begin
+   sss:=Evaluate(Accel^[j]^.newvalue^);
+   freemem(Accel^[j]^.newvalue,length(Accel^[j]^.newvalue^));
+   getmem(Accel^[j]^.newvalue,length(sss));
+   Accel^[j]^.newvalue^:=sss;
+  end;
+ if isSwitch('C')or isSwitch('-Cheader')then
+  for i:=1 to Chainlen do
+   begin
+    if Accel^[i]^.newvalue^<>''then
+     writeln('#define ',Accel^[i]^.oldvalue^,' ',Accel^[i]^.newvalue^)
+   end
+ else
+  begin
+   sss:='';
+   includeStatement:=false;
+   beginline:=true;
+   i:=1;
+   sss:='';
+   while i<=size do
+    begin
+     if buf^[i]<>#10 then
+      sss:=sss+buf^[i]
+     else
+      begin
+       while(sss<>'')and(sss[1]<=#32)do
+        delete(sss,1,1);
+       sst:=sss;
+       for j:=1 to length(sst)do
+        sst[j]:=upcase(sst[j]);
+       if pos('#INCLUDE',sst)=0 then
+        begin
+         s:='';
+         for kk:=1 to length(sss)do
+          begin
+           if sss[kk]>#32 then
+            s:=s+sss[kk]
+           else if s<>'' then
+            begin
+             for j:=1 to ChainLen do
+              begin
+               if accel^[j]^.casesentitive then
+                begin
+                 if(accel^[j]^.oldvalue^=s)and(accel^[j]^.newvalue^<>'')then
+                  begin
+                   s:=accel^[j]^.newvalue^;
+                   break;
+                  end;
+                end
+               else
+                begin
+                 if(accel^[j]^.oldvalue^=Up(s))and(accel^[j]^.newvalue^<>'')then
+                  begin
+                   s:=accel^[j]^.newvalue^;
+                   break;
+                  end;
+                end;
+              end;
+             write(s,' ');
+             s:='';
+            end;
+          end;
+         writeln;
+         sss:='';
+        end
+       else
+        sss:='';
+      end;
+     inc(i);
+    end;
+  end;
+ freemem(Accel,sizeof(pReplaceRec)*ChainLen);
+ Chain:=ChainHdr;
+ while Chain<>nil do
+  begin
+   c:=Chain;
+   Chain:=Chain^.next;
+   if c^.oldvalue<>nil then
+    freemem(c^.oldvalue,succ(length(c^.oldvalue^)));
+   if c^.newvalue<>nil then
+    freemem(c^.newvalue,succ(length(c^.newvalue^)));
+   dispose(c);
+  end;
+ freemem(buf,size);
+end.

+ 167 - 0
utils/fprcp/pasprep.pp

@@ -0,0 +1,167 @@
+unit PasPrep;
+interface
+uses
+ Comments;
+const
+ PasNesting:longbool=true;
+procedure do_pascal(__buf:pointer;size:longint;proc:pointer);
+implementation
+type
+ at=array[1..1]of char;
+ pat=^at;
+ str255=string[255];
+procedure do_pascal(__buf:pointer;size:longint;proc:pointer);
+var
+ old,i:longint;
+ buf:pat absolute __buf;
+const
+ GetWord_Pos:longint=0;
+ LastWord:str255='';
+ StringBody:longbool=false;
+procedure GetWord;
+ begin
+  LastWord:='';
+  if GetWord_Pos>size then
+   exit;
+  while buf^[GetWord_Pos]<=#32 do
+   begin
+    if GetWord_Pos>size then
+     exit;
+    inc(GetWord_Pos);
+   end;
+  repeat
+   if buf^[GetWord_Pos]=''''then
+    StringBody:=not StringBody;
+   LastWord:=LastWord+upcase(buf^[GetWord_Pos]);
+   inc(GetWord_Pos);
+   if GetWord_Pos>size then
+    break;
+   if(buf^[GetWord_Pos]in[#0..#32,';'])and not StringBody then
+    break;
+  until false;
+  while(length(LastWord)>1)and(lastWord[1]=';')do
+   begin
+    inc(GetWord_Pos);
+    delete(LastWord,1,1);
+   end;
+ end;
+function IsTypeDef(pos:longint):longbool;
+ var
+  i:longint;
+ begin
+  IsTypeDef:=false;
+  for i:=pos downto 1 do
+   if buf^[i]>=#32 then
+    begin
+     IsTypeDef:=buf^[i]in['=',':'];
+     exit;
+    end;
+ end;
+procedure JumpToEnd;
+ var
+  mainBegin:str255;
+ procedure do_body;
+  var
+   level:longint;
+  begin
+   level:=1;
+   while level>0 do
+    begin
+     if GetWord_Pos>size then
+      exit;
+     GetWord;
+     if (LastWord='BEGIN')or(LastWord='ASM')or(LastWord='CASE')then
+      inc(level)
+     else if (LastWord='END')then
+      dec(level);
+    end;
+  end;
+ begin
+  mainBegin:='BEGIN';
+  repeat
+   if GetWord_Pos>size then
+    exit;
+   GetWord;
+   i:=GetWord_Pos;
+   if((LastWord='PROCEDURE')or(lastword='FUNCTION')or(lastword='OPERATOR'))and not isTypedef(old)then
+    JumpToEnd
+   else if(LastWord='EXTERNAL')or(LastWord='FORWARD')or(LastWord='INLINE')then
+    exit
+   else if (LastWord='ASSEMBLER')then
+    mainBegin:='ASM';
+  until LastWord=mainBegin;
+  do_body;
+ end;
+procedure do_consts(savefunc:pointer);
+ type
+  Tpushfunc=procedure(const key,value:str255;CaseSent:longbool);
+ var
+  old,k,kk:longint;
+  s:str255;
+  ss:array[1..2]of str255;
+  pushfunc:Tpushfunc absolute SaveFunc;
+ begin
+  repeat
+   if GetWord_Pos>size then
+    exit;
+   old:=GetWord_Pos;
+   GetWord;
+   if(((LastWord='PROCEDURE')or(lastword='FUNCTION')or(lastword='OPERATOR'))and not isTypedef(old))
+     or(lastword='TYPE')
+     or(lastword='CONST')
+     or(lastword='VAR')then
+    begin
+     GetWord_Pos:=old;
+     exit;
+    end
+   else
+    begin
+     s:=LastWord;
+     while LastWord<>';'do
+      begin
+       GetWord;
+       if GetWord_Pos>size then
+        exit;
+       s:=s+LastWord;
+      end;
+     if s[length(s)]=';'then
+      dec(s[0]);
+     if s<>''then
+      if pos(':',s)=0 then
+       if pos('=',s)>0 then
+        begin
+         ss[1]:='';
+         ss[2]:='';
+         kk:=1;
+         for k:=1 to length(s)do
+          begin
+           if s[k]>#32 then
+            begin
+             if(s[k]='=')and(kk=1)then
+              inc(kk)
+             else
+              ss[kk]:=ss[kk]+s[k];
+            end;
+          end;
+         TpushFunc(PushFunc)(ss[1],ss[2],false);
+        end;
+    end;
+  until false;
+ end;
+begin
+ ClearComments(PasNesting,buf,size);
+ i:=1;
+ while i<=size do
+  begin
+   old:=GetWord_Pos;
+   GetWord;
+   i:=GetWord_Pos;
+   if((LastWord='PROCEDURE')or(lastword='FUNCTION')or(lastword='OPERATOR'))and not isTypedef(old)then
+    JumpToEnd
+   else if LastWord='CONST'then
+    Do_Consts(proc)
+   else if LastWord='IMPLEMENTATION'then
+    exit;
+  end;
+end;
+end.

+ 1 - 0
utils/fprcp/use_demo.bat

@@ -0,0 +1 @@
+windres -I rc -i demo.rc -o demo.res -O res --preprocessor fprcp.exe