paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-24 02:39:11 +02:00
Code Issues Packages Projects Releases Wiki Activity

Initial implementation

Browse Source
This commit is contained in:
michael 2000-01-10 15:31:40 +00:00
parent cecaff56a3
commit 69fb6245ea
13 changed files with 2231 additions and 0 deletions

973
utils/fprcp/Makefile Normal file
View File

@ -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
utils/fprcp/Makefile.fpc Normal file
View File

@ -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
utils/fprcp/Readme.txt Normal file
View File

@ -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
utils/fprcp/comments.pp Normal file
View File

@ -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
utils/fprcp/demo.h Normal file
View File

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

36
utils/fprcp/demo.pp Normal file
View File

@ -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
utils/fprcp/demo.rc Normal file
View File

@ -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 Normal file
View File

Binary file not shown.

278
utils/fprcp/expr.pp Normal file
View File

@ -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 Normal file
View File

Binary file not shown.

572
utils/fprcp/fprcp.pp Normal file
View File

@ -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
utils/fprcp/pasprep.pp Normal file
View File

@ -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
utils/fprcp/use_demo.bat Normal file
View File

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