diff --git a/.gitattributes b/.gitattributes index fa89dd80ef..430332bbac 100644 --- a/.gitattributes +++ b/.gitattributes @@ -14441,6 +14441,13 @@ utils/pas2fpm/Makefile svneol=native#text/plain utils/pas2fpm/Makefile.fpc svneol=native#text/plain utils/pas2fpm/pas2fpm.lpi svneol=native#text/plain utils/pas2fpm/pas2fpm.pp svneol=native#text/plain +utils/pas2jni/Makefile svneol=native#text/plain +utils/pas2jni/Makefile.fpc svneol=native#text/plain +utils/pas2jni/def.pas svneol=native#text/plain +utils/pas2jni/pas2jni.pas svneol=native#text/plain +utils/pas2jni/ppuparser.pas svneol=native#text/plain +utils/pas2jni/readme.txt svneol=native#text/plain +utils/pas2jni/writer.pas svneol=native#text/plain utils/pas2ut/Makefile svneol=native#text/plain utils/pas2ut/Makefile.fpc svneol=native#text/plain utils/pas2ut/pas2ut.lpi svneol=native#text/plain diff --git a/utils/pas2jni/Makefile b/utils/pas2jni/Makefile new file mode 100644 index 0000000000..667f6848b9 --- /dev/null +++ b/utils/pas2jni/Makefile @@ -0,0 +1,2156 @@ +# +# Don't edit, this file is generated by FPCMake Version 2.0.0 [2013-03-25 rev 23995] +# +default: all +MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux jvm-java jvm-android +BSDs = freebsd netbsd openbsd darwin +UNIXs = linux $(BSDs) solaris qnx haiku aix +LIMIT83fs = go32v2 os2 emx watcom +OSNeedsComspecToRunBatch = go32v2 watcom +FORCE: +.PHONY: FORCE +override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH))) +ifneq ($(findstring darwin,$(OSTYPE)),) +inUnix=1 #darwin +SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH))) +else +ifeq ($(findstring ;,$(PATH)),) +inUnix=1 +SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH))) +else +SEARCHPATH:=$(subst ;, ,$(PATH)) +endif +endif +SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE)))) +PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH)))) +ifeq ($(PWD),) +PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH)))) +ifeq ($(PWD),) +$(error You need the GNU utils package to use this Makefile) +else +PWD:=$(firstword $(PWD)) +SRCEXEEXT= +endif +else +PWD:=$(firstword $(PWD)) +SRCEXEEXT=.exe +endif +ifndef inUnix +ifeq ($(OS),Windows_NT) +inWinNT=1 +else +ifdef OS2_SHELL +inOS2=1 +endif +endif +else +ifneq ($(findstring cygdrive,$(PATH)),) +inCygWin=1 +endif +endif +ifdef inUnix +SRCBATCHEXT=.sh +else +ifdef inOS2 +SRCBATCHEXT=.cmd +else +SRCBATCHEXT=.bat +endif +endif +ifdef COMSPEC +ifneq ($(findstring $(OS_SOURCE),$(OSNeedsComspecToRunBatch)),) +ifndef RUNBATCH +RUNBATCH=$(COMSPEC) /C +endif +endif +endif +ifdef inUnix +PATHSEP=/ +else +PATHSEP:=$(subst /,\,/) +ifdef inCygWin +PATHSEP=/ +endif +endif +ifdef PWD +BASEDIR:=$(subst \,/,$(shell $(PWD))) +ifdef inCygWin +ifneq ($(findstring /cygdrive/,$(BASEDIR)),) +BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR)) +BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR))) +BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR)) +endif +endif +else +BASEDIR=. +endif +ifdef inOS2 +ifndef ECHO +ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(ECHO),) +ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(ECHO),) +ECHO=echo +else +ECHO:=$(firstword $(ECHO)) +endif +else +ECHO:=$(firstword $(ECHO)) +endif +endif +export ECHO +endif +override DEFAULT_FPCDIR=../.. +ifndef FPC +ifdef PP +FPC=$(PP) +endif +endif +ifndef FPC +FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH)))) +ifneq ($(FPCPROG),) +FPCPROG:=$(firstword $(FPCPROG)) +ifneq ($(CPU_TARGET),) +FPC:=$(shell $(FPCPROG) -P$(CPU_TARGET) -PB) +else +FPC:=$(shell $(FPCPROG) -PB) +endif +ifneq ($(findstring Error,$(FPC)),) +override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH))))) +else +ifeq ($(strip $(wildcard $(FPC))),) +FPC:=$(firstword $(FPCPROG)) +endif +endif +else +override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH))))) +endif +endif +override FPC:=$(subst $(SRCEXEEXT),,$(FPC)) +override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT) +FOUNDFPC:=$(strip $(wildcard $(FPC))) +ifeq ($(FOUNDFPC),) +FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH)))) +ifeq ($(FOUNDFPC),) +$(error Compiler $(FPC) not found) +endif +endif +ifndef FPC_COMPILERINFO +FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO) +endif +ifndef FPC_VERSION +FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO)) +endif +export FPC FPC_VERSION FPC_COMPILERINFO +unexport CHECKDEPEND ALLDEPENDENCIES +ifndef CPU_TARGET +ifdef CPU_TARGET_DEFAULT +CPU_TARGET=$(CPU_TARGET_DEFAULT) +endif +endif +ifndef OS_TARGET +ifdef OS_TARGET_DEFAULT +OS_TARGET=$(OS_TARGET_DEFAULT) +endif +endif +ifndef CPU_SOURCE +CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO)) +endif +ifndef CPU_TARGET +CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO)) +endif +ifndef OS_SOURCE +OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO)) +endif +ifndef OS_TARGET +OS_TARGET:=$(word 5,$(FPC_COMPILERINFO)) +endif +FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET) +FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE) +ifeq ($(CPU_TARGET),armeb) +ARCH=arm +override FPCOPT+=-Cb +else +ifeq ($(CPU_TARGET),armel) +ARCH=arm +override FPCOPT+=-CaEABI +else +ARCH=$(CPU_TARGET) +endif +endif +ifeq ($(FULL_TARGET),arm-embedded) +ifeq ($(SUBARCH),) +$(error When compiling for arm-embedded, a sub-architecture (e.g. SUBARCH=armv4t or SUBARCH=armv7m) must be defined) +endif +override FPCOPT+=-Cp$(SUBARCH) +endif +ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),) +TARGETSUFFIX=$(OS_TARGET) +SOURCESUFFIX=$(OS_SOURCE) +else +ifneq ($(findstring $(OS_TARGET),$(LIMIT83fs)),) +TARGETSUFFIX=$(OS_TARGET) +else +TARGETSUFFIX=$(FULL_TARGET) +endif +SOURCESUFFIX=$(FULL_SOURCE) +endif +ifneq ($(FULL_TARGET),$(FULL_SOURCE)) +CROSSCOMPILE=1 +endif +ifeq ($(findstring makefile,$(MAKECMDGOALS)),) +ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),) +$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first) +endif +endif +ifneq ($(findstring $(OS_TARGET),$(BSDs)),) +BSDhier=1 +endif +ifeq ($(OS_TARGET),linux) +linuxHier=1 +endif +ifndef CROSSCOMPILE +BUILDFULLNATIVE=1 +export BUILDFULLNATIVE +endif +ifdef BUILDFULLNATIVE +BUILDNATIVE=1 +export BUILDNATIVE +endif +export OS_TARGET OS_SOURCE ARCH CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE +ifdef FPCDIR +override FPCDIR:=$(subst \,/,$(FPCDIR)) +ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) +override FPCDIR=wrong +endif +else +override FPCDIR=wrong +endif +ifdef DEFAULT_FPCDIR +ifeq ($(FPCDIR),wrong) +override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR)) +ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) +override FPCDIR=wrong +endif +endif +endif +ifeq ($(FPCDIR),wrong) +ifdef inUnix +override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION) +ifeq ($(wildcard $(FPCDIR)/units),) +override FPCDIR=/usr/lib/fpc/$(FPC_VERSION) +endif +else +override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH)))))) +override FPCDIR:=$(FPCDIR)/.. +ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) +override FPCDIR:=$(FPCDIR)/.. +ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) +override FPCDIR:=$(BASEDIR) +ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) +override FPCDIR=c:/pp +endif +endif +endif +endif +endif +ifndef CROSSBINDIR +CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX)) +endif +ifneq ($(findstring $(OS_TARGET),darwin iphonesim),) +ifeq ($(OS_SOURCE),darwin) +DARWIN2DARWIN=1 +endif +endif +ifndef BINUTILSPREFIX +ifndef CROSSBINDIR +ifdef CROSSCOMPILE +ifndef DARWIN2DARWIN +ifneq ($(CPU_TARGET),jvm) +BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)- +ifeq ($(OS_TARGET),android) +ifeq ($(CPU_TARGET),arm) +BINUTILSPREFIX=arm-linux-androideabi- +else +ifeq ($(CPU_TARGET),i386) +BINUTILSPREFIX=i686-linux-android- +else +ifeq ($(CPU_TARGET),mips) +BINUTILSPREFIX=mipsel-linux-android- +endif +endif +endif +endif +endif +endif +endif +endif +endif +UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX)) +ifeq ($(UNITSDIR),) +UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET)) +endif +PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages $(FPCDIR)/packages/base $(FPCDIR)/packages/extra) +ifndef FPCFPMAKE +ifdef CROSSCOMPILE +ifeq ($(strip $(wildcard $(addsuffix /compiler/ppc$(SRCEXEEXT),$(FPCDIR)))),) +FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH)))) +ifneq ($(FPCPROG),) +FPCPROG:=$(firstword $(FPCPROG)) +FPCFPMAKE:=$(shell $(FPCPROG) -PB) +ifeq ($(strip $(wildcard $(FPCFPMAKE))),) +FPCFPMAKE:=$(firstword $(FPCPROG)) +endif +else +override FPCFPMAKE=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH))))) +endif +else +FPCFPMAKE=$(strip $(wildcard $(addsuffix /compiler/ppc$(SRCEXEEXT),$(FPCDIR)))) +FPMAKE_SKIP_CONFIG=-n +export FPCFPMAKE +export FPMAKE_SKIP_CONFIG +endif +else +FPMAKE_SKIP_CONFIG=-n +FPCFPMAKE=$(FPC) +endif +endif +ifeq ($(FULL_TARGET),i386-linux) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),i386-go32v2) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),i386-win32) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),i386-os2) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),i386-freebsd) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),i386-beos) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),i386-haiku) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),i386-netbsd) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),i386-solaris) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),i386-qnx) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),i386-netware) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),i386-openbsd) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),i386-wdosx) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),i386-darwin) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),i386-emx) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),i386-watcom) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),i386-netwlibc) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),i386-wince) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),i386-embedded) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),i386-symbian) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),i386-nativent) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),i386-iphonesim) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),i386-android) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),m68k-linux) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),m68k-freebsd) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),m68k-netbsd) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),m68k-amiga) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),m68k-atari) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),m68k-openbsd) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),m68k-palmos) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),m68k-embedded) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),powerpc-linux) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),powerpc-netbsd) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),powerpc-amiga) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),powerpc-macos) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),powerpc-darwin) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),powerpc-morphos) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),powerpc-embedded) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),powerpc-wii) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),powerpc-aix) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),sparc-linux) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),sparc-netbsd) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),sparc-solaris) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),sparc-embedded) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),x86_64-linux) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),x86_64-freebsd) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),x86_64-netbsd) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),x86_64-solaris) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),x86_64-openbsd) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),x86_64-darwin) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),x86_64-win64) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),x86_64-embedded) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),arm-linux) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),arm-palmos) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),arm-darwin) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),arm-wince) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),arm-gba) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),arm-nds) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),arm-embedded) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),arm-symbian) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),arm-android) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),powerpc64-darwin) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),powerpc64-embedded) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),powerpc64-aix) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),avr-embedded) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),armeb-linux) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),armeb-embedded) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),mips-linux) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),mipsel-linux) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),jvm-java) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),jvm-android) +override TARGET_PROGRAMS+=pas2jni +endif +ifeq ($(FULL_TARGET),i386-linux) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),i386-go32v2) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),i386-win32) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),i386-os2) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),i386-freebsd) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),i386-beos) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),i386-haiku) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),i386-netbsd) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),i386-solaris) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),i386-qnx) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),i386-netware) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),i386-openbsd) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),i386-wdosx) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),i386-darwin) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),i386-emx) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),i386-watcom) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),i386-netwlibc) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),i386-wince) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),i386-embedded) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),i386-symbian) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),i386-nativent) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),i386-iphonesim) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),i386-android) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),m68k-linux) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),m68k-freebsd) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),m68k-netbsd) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),m68k-amiga) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),m68k-atari) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),m68k-openbsd) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),m68k-palmos) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),m68k-embedded) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),powerpc-linux) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),powerpc-netbsd) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),powerpc-amiga) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),powerpc-macos) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),powerpc-darwin) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),powerpc-morphos) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),powerpc-embedded) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),powerpc-wii) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),powerpc-aix) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),sparc-linux) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),sparc-netbsd) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),sparc-solaris) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),sparc-embedded) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),x86_64-linux) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),x86_64-freebsd) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),x86_64-netbsd) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),x86_64-solaris) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),x86_64-openbsd) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),x86_64-darwin) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),x86_64-win64) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),x86_64-embedded) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),arm-linux) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),arm-palmos) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),arm-darwin) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),arm-wince) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),arm-gba) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),arm-nds) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),arm-embedded) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),arm-symbian) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),arm-android) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),powerpc64-darwin) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),powerpc64-embedded) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),powerpc64-aix) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),avr-embedded) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),armeb-linux) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),armeb-embedded) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),mips-linux) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),mipsel-linux) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),jvm-java) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +ifeq ($(FULL_TARGET),jvm-android) +override CLEAN_UNITS+=pas2jni def ppuparser writer +endif +override INSTALL_FPCPACKAGE=y +ifdef REQUIRE_UNITSDIR +override UNITSDIR+=$(REQUIRE_UNITSDIR) +endif +ifdef REQUIRE_PACKAGESDIR +override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR) +endif +ifdef ZIPINSTALL +ifneq ($(findstring $(OS_TARGET),$(UNIXs)),) +UNIXHier=1 +endif +else +ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),) +UNIXHier=1 +endif +endif +ifndef INSTALL_PREFIX +ifdef PREFIX +INSTALL_PREFIX=$(PREFIX) +endif +endif +ifndef INSTALL_PREFIX +ifdef UNIXHier +INSTALL_PREFIX=/usr/local +else +ifdef INSTALL_FPCPACKAGE +INSTALL_BASEDIR:=/pp +else +INSTALL_BASEDIR:=/$(PACKAGE_NAME) +endif +endif +endif +export INSTALL_PREFIX +ifdef INSTALL_FPCSUBDIR +export INSTALL_FPCSUBDIR +endif +ifndef DIST_DESTDIR +DIST_DESTDIR:=$(BASEDIR) +endif +export DIST_DESTDIR +ifndef COMPILER_UNITTARGETDIR +ifdef PACKAGEDIR_MAIN +COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX) +else +COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX) +endif +endif +ifndef COMPILER_TARGETDIR +COMPILER_TARGETDIR=. +endif +ifndef INSTALL_BASEDIR +ifdef UNIXHier +ifdef INSTALL_FPCPACKAGE +INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION) +else +INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME) +endif +else +INSTALL_BASEDIR:=$(INSTALL_PREFIX) +endif +endif +ifndef INSTALL_BINDIR +ifdef UNIXHier +INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin +else +INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin +ifdef INSTALL_FPCPACKAGE +ifdef CROSSCOMPILE +ifdef CROSSINSTALL +INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX) +else +INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX) +endif +else +INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX) +endif +endif +endif +endif +ifndef INSTALL_UNITDIR +INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX) +ifdef INSTALL_FPCPACKAGE +ifdef PACKAGE_NAME +INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME) +endif +endif +endif +ifndef INSTALL_LIBDIR +ifdef UNIXHier +INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib +else +INSTALL_LIBDIR:=$(INSTALL_UNITDIR) +endif +endif +ifndef INSTALL_SOURCEDIR +ifdef UNIXHier +ifdef BSDhier +SRCPREFIXDIR=share/src +else +ifdef linuxHier +SRCPREFIXDIR=share/src +else +SRCPREFIXDIR=src +endif +endif +ifdef INSTALL_FPCPACKAGE +ifdef INSTALL_FPCSUBDIR +INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME) +else +INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME) +endif +else +INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION) +endif +else +ifdef INSTALL_FPCPACKAGE +ifdef INSTALL_FPCSUBDIR +INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME) +else +INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME) +endif +else +INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source +endif +endif +endif +ifndef INSTALL_DOCDIR +ifdef UNIXHier +ifdef BSDhier +DOCPREFIXDIR=share/doc +else +ifdef linuxHier +DOCPREFIXDIR=share/doc +else +DOCPREFIXDIR=doc +endif +endif +ifdef INSTALL_FPCPACKAGE +INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME) +else +INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION) +endif +else +ifdef INSTALL_FPCPACKAGE +INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME) +else +INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc +endif +endif +endif +ifndef INSTALL_EXAMPLEDIR +ifdef UNIXHier +ifdef INSTALL_FPCPACKAGE +ifdef BSDhier +INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME) +else +ifdef linuxHier +INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples +else +INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME) +endif +endif +else +ifdef BSDhier +INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION) +else +ifdef linuxHier +INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION) +else +INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION) +endif +endif +endif +else +ifdef INSTALL_FPCPACKAGE +INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME) +else +INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples +endif +endif +endif +ifndef INSTALL_DATADIR +INSTALL_DATADIR=$(INSTALL_BASEDIR) +endif +ifndef INSTALL_SHAREDDIR +INSTALL_SHAREDDIR=$(INSTALL_PREFIX)/lib +endif +ifdef CROSSCOMPILE +ifndef CROSSBINDIR +CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX)) +ifeq ($(CROSSBINDIR),) +CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE)) +endif +endif +else +CROSSBINDIR= +endif +BATCHEXT=.bat +LOADEREXT=.as +EXEEXT=.exe +PPLEXT=.ppl +PPUEXT=.ppu +OEXT=.o +ASMEXT=.s +SMARTEXT=.sl +STATICLIBEXT=.a +SHAREDLIBEXT=.so +SHAREDLIBPREFIX=libfp +STATICLIBPREFIX=libp +IMPORTLIBPREFIX=libimp +RSTEXT=.rst +EXEDBGEXT=.dbg +ifeq ($(OS_TARGET),go32v1) +STATICLIBPREFIX= +SHORTSUFFIX=v1 +endif +ifeq ($(OS_TARGET),go32v2) +STATICLIBPREFIX= +SHORTSUFFIX=dos +IMPORTLIBPREFIX= +endif +ifeq ($(OS_TARGET),watcom) +STATICLIBPREFIX= +OEXT=.obj +ASMEXT=.asm +SHAREDLIBEXT=.dll +SHORTSUFFIX=wat +IMPORTLIBPREFIX= +endif +ifneq ($(CPU_TARGET),jvm) +ifeq ($(OS_TARGET),android) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=lnx +endif +endif +ifeq ($(OS_TARGET),linux) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=lnx +endif +ifeq ($(OS_TARGET),freebsd) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=fbs +endif +ifeq ($(OS_TARGET),netbsd) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=nbs +endif +ifeq ($(OS_TARGET),openbsd) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=obs +endif +ifeq ($(OS_TARGET),win32) +SHAREDLIBEXT=.dll +SHORTSUFFIX=w32 +endif +ifeq ($(OS_TARGET),os2) +BATCHEXT=.cmd +AOUTEXT=.out +STATICLIBPREFIX= +SHAREDLIBEXT=.dll +SHORTSUFFIX=os2 +ECHO=echo +IMPORTLIBPREFIX= +endif +ifeq ($(OS_TARGET),emx) +BATCHEXT=.cmd +AOUTEXT=.out +STATICLIBPREFIX= +SHAREDLIBEXT=.dll +SHORTSUFFIX=emx +ECHO=echo +IMPORTLIBPREFIX= +endif +ifeq ($(OS_TARGET),amiga) +EXEEXT= +SHAREDLIBEXT=.library +SHORTSUFFIX=amg +endif +ifeq ($(OS_TARGET),morphos) +EXEEXT= +SHAREDLIBEXT=.library +SHORTSUFFIX=mos +endif +ifeq ($(OS_TARGET),atari) +EXEEXT=.ttp +SHORTSUFFIX=ata +endif +ifeq ($(OS_TARGET),beos) +BATCHEXT=.sh +EXEEXT= +SHORTSUFFIX=be +endif +ifeq ($(OS_TARGET),haiku) +BATCHEXT=.sh +EXEEXT= +SHORTSUFFIX=hai +endif +ifeq ($(OS_TARGET),solaris) +BATCHEXT=.sh +EXEEXT= +SHORTSUFFIX=sun +endif +ifeq ($(OS_TARGET),qnx) +BATCHEXT=.sh +EXEEXT= +SHORTSUFFIX=qnx +endif +ifeq ($(OS_TARGET),netware) +EXEEXT=.nlm +STATICLIBPREFIX= +SHORTSUFFIX=nw +IMPORTLIBPREFIX=imp +endif +ifeq ($(OS_TARGET),netwlibc) +EXEEXT=.nlm +STATICLIBPREFIX= +SHORTSUFFIX=nwl +IMPORTLIBPREFIX=imp +endif +ifeq ($(OS_TARGET),macos) +BATCHEXT= +EXEEXT= +DEBUGSYMEXT=.xcoff +SHORTSUFFIX=mac +IMPORTLIBPREFIX=imp +endif +ifneq ($(findstring $(OS_TARGET),darwin iphonesim),) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=dwn +EXEDBGEXT=.dSYM +endif +ifeq ($(OS_TARGET),gba) +EXEEXT=.gba +SHAREDLIBEXT=.so +SHORTSUFFIX=gba +endif +ifeq ($(OS_TARGET),symbian) +SHAREDLIBEXT=.dll +SHORTSUFFIX=symbian +endif +ifeq ($(OS_TARGET),NativeNT) +SHAREDLIBEXT=.dll +SHORTSUFFIX=nativent +endif +ifeq ($(OS_TARGET),wii) +EXEEXT=.dol +SHAREDLIBEXT=.so +SHORTSUFFIX=wii +endif +ifeq ($(OS_TARGET),aix) +BATCHEXT=.sh +EXEEXT= +SHORTSUFFIX=aix +endif +ifeq ($(OS_TARGET),java) +OEXT=.class +ASMEXT=.j +SHAREDLIBEXT=.jar +SHORTSUFFIX=java +endif +ifeq ($(CPU_TARGET),jvm) +ifeq ($(OS_TARGET),android) +OEXT=.class +ASMEXT=.j +SHAREDLIBEXT=.jar +SHORTSUFFIX=android +endif +endif +ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),) +FPCMADE=fpcmade.$(SHORTSUFFIX) +ZIPSUFFIX=$(SHORTSUFFIX) +ZIPCROSSPREFIX= +ZIPSOURCESUFFIX=src +ZIPEXAMPLESUFFIX=exm +else +FPCMADE=fpcmade.$(TARGETSUFFIX) +ZIPSOURCESUFFIX=.source +ZIPEXAMPLESUFFIX=.examples +ifdef CROSSCOMPILE +ZIPSUFFIX=.$(SOURCESUFFIX) +ZIPCROSSPREFIX=$(TARGETSUFFIX)- +else +ZIPSUFFIX=.$(TARGETSUFFIX) +ZIPCROSSPREFIX= +endif +endif +ifndef ECHO +ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(ECHO),) +ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(ECHO),) +ECHO= __missing_command_ECHO +else +ECHO:=$(firstword $(ECHO)) +endif +else +ECHO:=$(firstword $(ECHO)) +endif +endif +export ECHO +ifndef DATE +DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(DATE),) +DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(DATE),) +DATE= __missing_command_DATE +else +DATE:=$(firstword $(DATE)) +endif +else +DATE:=$(firstword $(DATE)) +endif +endif +export DATE +ifndef GINSTALL +GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(GINSTALL),) +GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(GINSTALL),) +GINSTALL= __missing_command_GINSTALL +else +GINSTALL:=$(firstword $(GINSTALL)) +endif +else +GINSTALL:=$(firstword $(GINSTALL)) +endif +endif +export GINSTALL +ifndef CPPROG +CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(CPPROG),) +CPPROG= __missing_command_CPPROG +else +CPPROG:=$(firstword $(CPPROG)) +endif +endif +export CPPROG +ifndef RMPROG +RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(RMPROG),) +RMPROG= __missing_command_RMPROG +else +RMPROG:=$(firstword $(RMPROG)) +endif +endif +export RMPROG +ifndef MVPROG +MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(MVPROG),) +MVPROG= __missing_command_MVPROG +else +MVPROG:=$(firstword $(MVPROG)) +endif +endif +export MVPROG +ifndef MKDIRPROG +MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(MKDIRPROG),) +MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(MKDIRPROG),) +MKDIRPROG= __missing_command_MKDIRPROG +else +MKDIRPROG:=$(firstword $(MKDIRPROG)) +endif +else +MKDIRPROG:=$(firstword $(MKDIRPROG)) +endif +endif +export MKDIRPROG +ifndef ECHOREDIR +ifndef inUnix +ECHOREDIR=echo +else +ECHOREDIR=$(ECHO) +endif +endif +ifndef COPY +COPY:=$(CPPROG) -fp +endif +ifndef COPYTREE +COPYTREE:=$(CPPROG) -Rfp +endif +ifndef MKDIRTREE +MKDIRTREE:=$(MKDIRPROG) -p +endif +ifndef MOVE +MOVE:=$(MVPROG) -f +endif +ifndef DEL +DEL:=$(RMPROG) -f +endif +ifndef DELTREE +DELTREE:=$(RMPROG) -rf +endif +ifndef INSTALL +ifdef inUnix +INSTALL:=$(GINSTALL) -c -m 644 +else +INSTALL:=$(COPY) +endif +endif +ifndef INSTALLEXE +ifdef inUnix +INSTALLEXE:=$(GINSTALL) -c -m 755 +else +INSTALLEXE:=$(COPY) +endif +endif +ifndef MKDIR +MKDIR:=$(GINSTALL) -m 755 -d +endif +export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR +ifndef PPUMOVE +PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(PPUMOVE),) +PPUMOVE= __missing_command_PPUMOVE +else +PPUMOVE:=$(firstword $(PPUMOVE)) +endif +endif +export PPUMOVE +ifndef FPCMAKE +FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(FPCMAKE),) +FPCMAKE= __missing_command_FPCMAKE +else +FPCMAKE:=$(firstword $(FPCMAKE)) +endif +endif +export FPCMAKE +ifndef ZIPPROG +ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(ZIPPROG),) +ZIPPROG= __missing_command_ZIPPROG +else +ZIPPROG:=$(firstword $(ZIPPROG)) +endif +endif +export ZIPPROG +ifndef TARPROG +TARPROG:=$(strip $(wildcard $(addsuffix /gtar$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(TARPROG),) +TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(TARPROG),) +TARPROG= __missing_command_TARPROG +else +TARPROG:=$(firstword $(TARPROG)) +endif +else +TARPROG:=$(firstword $(TARPROG)) +endif +endif +export TARPROG +ASNAME=$(BINUTILSPREFIX)as +LDNAME=$(BINUTILSPREFIX)ld +ARNAME=$(BINUTILSPREFIX)ar +RCNAME=$(BINUTILSPREFIX)rc +ifndef ASPROG +ifdef CROSSBINDIR +ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT) +else +ASPROG=$(ASNAME) +endif +endif +ifndef LDPROG +ifdef CROSSBINDIR +LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT) +else +LDPROG=$(LDNAME) +endif +endif +ifndef RCPROG +ifdef CROSSBINDIR +RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT) +else +RCPROG=$(RCNAME) +endif +endif +ifndef ARPROG +ifdef CROSSBINDIR +ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT) +else +ARPROG=$(ARNAME) +endif +endif +AS=$(ASPROG) +LD=$(LDPROG) +RC=$(RCPROG) +AR=$(ARPROG) +ifdef inUnix +PPAS=./ppas$(SRCBATCHEXT) +else +PPAS=ppas$(SRCBATCHEXT) +endif +ifdef inUnix +LDCONFIG=ldconfig +else +LDCONFIG= +endif +ifdef DATE +DATESTR:=$(shell $(DATE) +%Y%m%d) +else +DATESTR= +endif +ZIPOPT=-9 +ZIPEXT=.zip +ifeq ($(USETAR),bz2) +TAROPT=vj +TAREXT=.tar.bz2 +else +TAROPT=vz +TAREXT=.tar.gz +endif +override REQUIRE_PACKAGES=rtl +ifeq ($(FULL_TARGET),i386-linux) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-go32v2) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-win32) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-os2) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-freebsd) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-beos) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-haiku) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-netbsd) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-solaris) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-qnx) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-netware) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-openbsd) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-wdosx) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-darwin) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-emx) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-watcom) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-netwlibc) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-wince) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-embedded) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-symbian) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-nativent) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-iphonesim) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-android) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),m68k-linux) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),m68k-freebsd) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),m68k-netbsd) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),m68k-amiga) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),m68k-atari) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),m68k-openbsd) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),m68k-palmos) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),m68k-embedded) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),powerpc-linux) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),powerpc-netbsd) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),powerpc-amiga) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),powerpc-macos) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),powerpc-darwin) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),powerpc-morphos) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),powerpc-embedded) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),powerpc-wii) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),powerpc-aix) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),sparc-linux) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),sparc-netbsd) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),sparc-solaris) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),sparc-embedded) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),x86_64-linux) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),x86_64-freebsd) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),x86_64-netbsd) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),x86_64-solaris) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),x86_64-openbsd) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),x86_64-darwin) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),x86_64-win64) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),x86_64-embedded) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),arm-linux) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),arm-palmos) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),arm-darwin) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),arm-wince) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),arm-gba) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),arm-nds) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),arm-embedded) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),arm-symbian) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),arm-android) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),powerpc64-darwin) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),powerpc64-embedded) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),powerpc64-aix) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),avr-embedded) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),armeb-linux) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),armeb-embedded) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),mips-linux) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),mipsel-linux) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),jvm-java) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),jvm-android) +REQUIRE_PACKAGES_RTL=1 +endif +ifdef REQUIRE_PACKAGES_RTL +PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR)))))) +ifneq ($(PACKAGEDIR_RTL),) +ifneq ($(wildcard $(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX)),) +UNITDIR_RTL=$(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX) +else +UNITDIR_RTL=$(PACKAGEDIR_RTL) +endif +ifneq ($(wildcard $(PACKAGEDIR_RTL)/units/$(SOURCESUFFIX)),) +UNITDIR_FPMAKE_RTL=$(PACKAGEDIR_RTL)/units/$(SOURCESUFFIX) +else +ifneq ($(wildcard $(PACKAGEDIR_RTL)/units_bs/$(SOURCESUFFIX)),) +UNITDIR_FPMAKE_RTL=$(PACKAGEDIR_RTL)/units_bs/$(SOURCESUFFIX) +else +UNITDIR_FPMAKE_RTL=$(PACKAGEDIR_RTL) +endif +endif +ifdef CHECKDEPEND +$(PACKAGEDIR_RTL)/$(OS_TARGET)/$(FPCMADE): + $(MAKE) -C $(PACKAGEDIR_RTL)/$(OS_TARGET) $(FPCMADE) +override ALLDEPENDENCIES+=$(PACKAGEDIR_RTL)/$(OS_TARGET)/$(FPCMADE) +endif +else +PACKAGEDIR_RTL= +UNITDIR_RTL:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /rtl/Package.fpc,$(UNITSDIR))))) +ifneq ($(UNITDIR_RTL),) +UNITDIR_RTL:=$(firstword $(UNITDIR_RTL)) +else +UNITDIR_RTL= +endif +endif +ifdef UNITDIR_RTL +override COMPILER_UNITDIR+=$(UNITDIR_RTL) +endif +ifdef UNITDIR_FPMAKE_RTL +override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_RTL) +endif +endif +ifndef NOCPUDEF +override FPCOPTDEF=$(ARCH) +endif +ifneq ($(OS_TARGET),$(OS_SOURCE)) +override FPCOPT+=-T$(OS_TARGET) +endif +ifneq ($(CPU_TARGET),$(CPU_SOURCE)) +override FPCOPT+=-P$(ARCH) +endif +ifeq ($(OS_SOURCE),openbsd) +override FPCOPT+=-FD$(NEW_BINUTILS_PATH) +override FPCMAKEOPT+=-FD$(NEW_BINUTILS_PATH) +endif +ifndef CROSSBOOTSTRAP +ifneq ($(BINUTILSPREFIX),) +override FPCOPT+=-XP$(BINUTILSPREFIX) +endif +ifneq ($(BINUTILSPREFIX),) +override FPCOPT+=-Xr$(RLINKPATH) +endif +endif +ifndef CROSSCOMPILE +ifneq ($(BINUTILSPREFIX),) +override FPCMAKEOPT+=-XP$(BINUTILSPREFIX) +endif +endif +ifdef UNITDIR +override FPCOPT+=$(addprefix -Fu,$(UNITDIR)) +endif +ifdef LIBDIR +override FPCOPT+=$(addprefix -Fl,$(LIBDIR)) +endif +ifdef OBJDIR +override FPCOPT+=$(addprefix -Fo,$(OBJDIR)) +endif +ifdef INCDIR +override FPCOPT+=$(addprefix -Fi,$(INCDIR)) +endif +ifdef LINKSMART +override FPCOPT+=-XX +endif +ifdef CREATESMART +override FPCOPT+=-CX +endif +ifdef DEBUG +override FPCOPT+=-gl +override FPCOPTDEF+=DEBUG +endif +ifdef RELEASE +ifneq ($(findstring 2.0.,$(FPC_VERSION)),) +ifeq ($(CPU_TARGET),i386) +FPCCPUOPT:=-OG2p3 +endif +ifeq ($(CPU_TARGET),powerpc) +FPCCPUOPT:=-O1r +endif +else +FPCCPUOPT:=-O2 +endif +override FPCOPT+=-Ur -Xs $(FPCCPUOPT) -n +override FPCOPTDEF+=RELEASE +endif +ifdef STRIP +override FPCOPT+=-Xs +endif +ifdef OPTIMIZE +override FPCOPT+=-O2 +endif +ifdef VERBOSE +override FPCOPT+=-vwni +endif +ifdef COMPILER_OPTIONS +override FPCOPT+=$(COMPILER_OPTIONS) +endif +ifdef COMPILER_UNITDIR +override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR)) +endif +ifdef COMPILER_LIBRARYDIR +override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR)) +endif +ifdef COMPILER_OBJECTDIR +override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR)) +endif +ifdef COMPILER_INCLUDEDIR +override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR)) +endif +ifdef CROSSBINDIR +override FPCOPT+=-FD$(CROSSBINDIR) +endif +ifdef COMPILER_TARGETDIR +override FPCOPT+=-FE$(COMPILER_TARGETDIR) +ifeq ($(COMPILER_TARGETDIR),.) +override TARGETDIRPREFIX= +else +override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/ +endif +endif +ifdef COMPILER_UNITTARGETDIR +override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR) +ifeq ($(COMPILER_UNITTARGETDIR),.) +override UNITTARGETDIRPREFIX= +else +override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/ +endif +else +ifdef COMPILER_TARGETDIR +override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR) +override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX) +endif +endif +ifdef CREATESHARED +override FPCOPT+=-Cg +endif +ifneq ($(findstring $(OS_TARGET),freebsd openbsd netbsd linux solaris),) +ifeq ($(CPU_TARGET),x86_64) +override FPCOPT+=-Cg +endif +endif +ifdef LINKSHARED +endif +ifdef OPT +override FPCOPT+=$(OPT) +endif +ifdef FPCOPTDEF +override FPCOPT+=$(addprefix -d,$(FPCOPTDEF)) +endif +ifdef CFGFILE +override FPCOPT+=@$(CFGFILE) +endif +ifdef USEENV +override FPCEXTCMD:=$(FPCOPT) +override FPCOPT:=!FPCEXTCMD +export FPCEXTCMD +endif +override AFULL_TARGET=$(CPU_TARGET)-$(OS_TARGET) +override AFULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE) +ifneq ($(AFULL_TARGET),$(AFULL_SOURCE)) +override ACROSSCOMPILE=1 +endif +ifdef ACROSSCOMPILE +override FPCOPT+=$(CROSSOPT) +endif +override COMPILER:=$(FPC) $(FPCOPT) +ifeq (,$(findstring -s ,$(COMPILER))) +EXECPPAS= +else +ifeq ($(FULL_SOURCE),$(FULL_TARGET)) +ifdef RUNBATCH +EXECPPAS:=@$(RUNBATCH) $(PPAS) +else +EXECPPAS:=@$(PPAS) +endif +endif +endif +.PHONY: fpc_exes +ifndef CROSSINSTALL +ifneq ($(TARGET_PROGRAMS),) +override EXEFILES=$(addsuffix $(EXEEXT),$(TARGET_PROGRAMS)) +override EXEOFILES:=$(addsuffix $(OEXT),$(TARGET_PROGRAMS)) $(addprefix $(STATICLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_PROGRAMS))) $(addprefix $(IMPORTLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_PROGRAMS))) +override EXEDBGFILES:=$(addsuffix $(EXEDBGEXT),$(TARGET_PROGRAMS)) +override ALLTARGET+=fpc_exes +override INSTALLEXEFILES+=$(EXEFILES) +override CLEANEXEFILES+=$(EXEFILES) $(EXEOFILES) +override CLEANEXEDBGFILES+=$(EXEDBGFILES) +ifeq ($(OS_TARGET),os2) +override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_PROGRAMS)) +endif +ifeq ($(OS_TARGET),emx) +override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_PROGRAMS)) +endif +endif +endif +fpc_exes: $(COMPILER_TARGETDIR) $(COMPILER_UNITTARGETDIR) $(EXEFILES) +ifdef TARGET_RSTS +override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS)) +override CLEANRSTFILES+=$(RSTFILES) +endif +.PHONY: fpc_all fpc_smart fpc_debug fpc_release fpc_shared +$(FPCMADE): $(ALLDEPENDENCIES) $(ALLTARGET) + @$(ECHOREDIR) Compiled > $(FPCMADE) +fpc_all: $(FPCMADE) +fpc_smart: + $(MAKE) all LINKSMART=1 CREATESMART=1 +fpc_debug: + $(MAKE) all DEBUG=1 +fpc_release: + $(MAKE) all RELEASE=1 +.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lpr .dpr .pp .rc .res +$(COMPILER_UNITTARGETDIR): + $(MKDIRTREE) $(COMPILER_UNITTARGETDIR) +$(COMPILER_TARGETDIR): + $(MKDIRTREE) $(COMPILER_TARGETDIR) +%$(PPUEXT): %.pp + $(COMPILER) $< + $(EXECPPAS) +%$(PPUEXT): %.pas + $(COMPILER) $< + $(EXECPPAS) +%$(EXEEXT): %.pp + $(COMPILER) $< + $(EXECPPAS) +%$(EXEEXT): %.pas + $(COMPILER) $< + $(EXECPPAS) +%$(EXEEXT): %.lpr + $(COMPILER) $< + $(EXECPPAS) +%$(EXEEXT): %.dpr + $(COMPILER) $< + $(EXECPPAS) +%.res: %.rc + windres -i $< -o $@ +vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR) +vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR) +vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR) +vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR) +vpath %.inc $(COMPILER_INCLUDEDIR) +vpath %$(OEXT) $(COMPILER_UNITTARGETDIR) +vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR) +.PHONY: fpc_shared +override INSTALLTARGET+=fpc_shared_install +ifndef SHARED_LIBVERSION +SHARED_LIBVERSION=$(FPC_VERSION) +endif +ifndef SHARED_LIBNAME +SHARED_LIBNAME=$(PACKAGE_NAME) +endif +ifndef SHARED_FULLNAME +SHARED_FULLNAME=$(SHAREDLIBPREFIX)$(SHARED_LIBNAME)-$(SHARED_LIBVERSION)$(SHAREDLIBEXT) +endif +ifndef SHARED_LIBUNITS +SHARED_LIBUNITS:=$(TARGET_UNITS) $(TARGET_IMPLICITUNITS) +override SHARED_LIBUNITS:=$(filter-out $(INSTALL_BUILDUNIT),$(SHARED_LIBUNITS)) +endif +fpc_shared: +ifdef HASSHAREDLIB + $(MAKE) all CREATESHARED=1 LINKSHARED=1 CREATESMART=1 +ifneq ($(SHARED_BUILD),n) + $(PPUMOVE) -q $(SHARED_LIBUNITS) -i$(COMPILER_UNITTARGETDIR) -o$(SHARED_FULLNAME) -d$(COMPILER_UNITTARGETDIR) +endif +else + @$(ECHO) Shared Libraries not supported +endif +fpc_shared_install: +ifneq ($(SHARED_BUILD),n) +ifneq ($(SHARED_LIBUNITS),) +ifneq ($(wildcard $(COMPILER_UNITTARGETDIR)/$(SHARED_FULLNAME)),) + $(INSTALL) $(COMPILER_UNITTARGETDIR)/$(SHARED_FULLNAME) $(INSTALL_SHAREDDIR) +endif +endif +endif +.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall +ifdef INSTALL_UNITS +override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS)) +endif +ifdef INSTALL_BUILDUNIT +override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES)) +endif +ifdef INSTALLPPUFILES +override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))) +ifneq ($(UNITTARGETDIRPREFIX),) +override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES))) +override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES)))) +endif +override INSTALL_CREATEPACKAGEFPC=1 +endif +ifdef INSTALLEXEFILES +ifneq ($(TARGETDIRPREFIX),) +override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES))) +endif +endif +fpc_install: all $(INSTALLTARGET) +ifdef INSTALLEXEFILES + $(MKDIR) $(INSTALL_BINDIR) + $(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR) +endif +ifdef INSTALL_CREATEPACKAGEFPC +ifdef FPCMAKE +ifdef PACKAGE_VERSION +ifneq ($(wildcard Makefile.fpc),) + $(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc + $(MKDIR) $(INSTALL_UNITDIR) + $(INSTALL) Package.fpc $(INSTALL_UNITDIR) +endif +endif +endif +endif +ifdef INSTALLPPUFILES + $(MKDIR) $(INSTALL_UNITDIR) + $(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR) +ifneq ($(INSTALLPPULINKFILES),) + $(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR) +endif +ifneq ($(wildcard $(LIB_FULLNAME)),) + $(MKDIR) $(INSTALL_LIBDIR) + $(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR) +ifdef inUnix + ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME) +endif +endif +endif +ifdef INSTALL_FILES + $(MKDIR) $(INSTALL_DATADIR) + $(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR) +endif +fpc_sourceinstall: distclean + $(MKDIR) $(INSTALL_SOURCEDIR) + $(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR) +fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS)) +ifdef HASEXAMPLES + $(MKDIR) $(INSTALL_EXAMPLEDIR) +endif +ifdef EXAMPLESOURCEFILES + $(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR) +endif +ifdef TARGET_EXAMPLEDIRS + $(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR) +endif +.PHONY: fpc_clean fpc_cleanall fpc_distclean +ifdef EXEFILES +override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES)) +override CLEANEXEDBGFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEDBGFILES)) +endif +ifdef CLEAN_PROGRAMS +override CLEANEXEFILES+=$(addprefix $(TARGETDIRPREFIX),$(addsuffix $(EXEEXT), $(CLEAN_PROGRAMS))) +override CLEANEXEDBGFILES+=$(addprefix $(TARGETDIRPREFIX),$(addsuffix $(EXEDBGEXT), $(CLEAN_PROGRAMS))) +endif +ifdef CLEAN_UNITS +override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS)) +endif +ifdef CLEANPPUFILES +override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))) +ifdef DEBUGSYMEXT +override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES)) +endif +override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES)) +override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES))) +endif +fpc_clean: $(CLEANTARGET) +ifdef CLEANEXEFILES + -$(DEL) $(CLEANEXEFILES) +endif +ifdef CLEANEXEDBGFILES + -$(DELTREE) $(CLEANEXEDBGFILES) +endif +ifdef CLEANPPUFILES + -$(DEL) $(CLEANPPUFILES) +endif +ifneq ($(CLEANPPULINKFILES),) + -$(DEL) $(CLEANPPULINKFILES) +endif +ifdef CLEANRSTFILES + -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES)) +endif +ifdef CLEAN_FILES + -$(DEL) $(CLEAN_FILES) +endif +ifdef LIB_NAME + -$(DEL) $(LIB_NAME) $(LIB_FULLNAME) +endif + -$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE) + -$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT) +fpc_cleanall: $(CLEANTARGET) +ifdef CLEANEXEFILES + -$(DEL) $(CLEANEXEFILES) +endif +ifdef COMPILER_UNITTARGETDIR +ifdef CLEANPPUFILES + -$(DEL) $(CLEANPPUFILES) +endif +ifneq ($(CLEANPPULINKFILES),) + -$(DEL) $(CLEANPPULINKFILES) +endif +ifdef CLEANRSTFILES + -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES)) +endif +endif +ifdef CLEAN_FILES + -$(DEL) $(CLEAN_FILES) +endif + -$(DELTREE) units + -$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT) +ifneq ($(PPUEXT),.ppu) + -$(DEL) *.o *.ppu *.a +endif + -$(DELTREE) *$(SMARTEXT) + -$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE) + -$(DEL) *_ppas$(BATCHEXT) +ifdef AOUTEXT + -$(DEL) *$(AOUTEXT) +endif +ifdef DEBUGSYMEXT + -$(DEL) *$(DEBUGSYMEXT) +endif +fpc_distclean: cleanall +.PHONY: fpc_baseinfo +override INFORULES+=fpc_baseinfo +fpc_baseinfo: + @$(ECHO) + @$(ECHO) == Package info == + @$(ECHO) Package Name..... $(PACKAGE_NAME) + @$(ECHO) Package Version.. $(PACKAGE_VERSION) + @$(ECHO) + @$(ECHO) == Configuration info == + @$(ECHO) + @$(ECHO) FPC.......... $(FPC) + @$(ECHO) FPC Version.. $(FPC_VERSION) + @$(ECHO) Source CPU... $(CPU_SOURCE) + @$(ECHO) Target CPU... $(CPU_TARGET) + @$(ECHO) Source OS.... $(OS_SOURCE) + @$(ECHO) Target OS.... $(OS_TARGET) + @$(ECHO) Full Source.. $(FULL_SOURCE) + @$(ECHO) Full Target.. $(FULL_TARGET) + @$(ECHO) SourceSuffix. $(SOURCESUFFIX) + @$(ECHO) TargetSuffix. $(TARGETSUFFIX) + @$(ECHO) FPC fpmake... $(FPCFPMAKE) + @$(ECHO) + @$(ECHO) == Directory info == + @$(ECHO) + @$(ECHO) Required pkgs... $(REQUIRE_PACKAGES) + @$(ECHO) + @$(ECHO) Basedir......... $(BASEDIR) + @$(ECHO) FPCDir.......... $(FPCDIR) + @$(ECHO) CrossBinDir..... $(CROSSBINDIR) + @$(ECHO) UnitsDir........ $(UNITSDIR) + @$(ECHO) PackagesDir..... $(PACKAGESDIR) + @$(ECHO) + @$(ECHO) GCC library..... $(GCCLIBDIR) + @$(ECHO) Other library... $(OTHERLIBDIR) + @$(ECHO) + @$(ECHO) == Tools info == + @$(ECHO) + @$(ECHO) As........ $(AS) + @$(ECHO) Ld........ $(LD) + @$(ECHO) Ar........ $(AR) + @$(ECHO) Rc........ $(RC) + @$(ECHO) + @$(ECHO) Mv........ $(MVPROG) + @$(ECHO) Cp........ $(CPPROG) + @$(ECHO) Rm........ $(RMPROG) + @$(ECHO) GInstall.. $(GINSTALL) + @$(ECHO) Echo...... $(ECHO) + @$(ECHO) Shell..... $(SHELL) + @$(ECHO) Date...... $(DATE) + @$(ECHO) FPCMake... $(FPCMAKE) + @$(ECHO) PPUMove... $(PPUMOVE) + @$(ECHO) Zip....... $(ZIPPROG) + @$(ECHO) + @$(ECHO) == Object info == + @$(ECHO) + @$(ECHO) Target Loaders........ $(TARGET_LOADERS) + @$(ECHO) Target Units.......... $(TARGET_UNITS) + @$(ECHO) Target Implicit Units. $(TARGET_IMPLICITUNITS) + @$(ECHO) Target Programs....... $(TARGET_PROGRAMS) + @$(ECHO) Target Dirs........... $(TARGET_DIRS) + @$(ECHO) Target Examples....... $(TARGET_EXAMPLES) + @$(ECHO) Target ExampleDirs.... $(TARGET_EXAMPLEDIRS) + @$(ECHO) + @$(ECHO) Clean Units......... $(CLEAN_UNITS) + @$(ECHO) Clean Files......... $(CLEAN_FILES) + @$(ECHO) + @$(ECHO) Install Units....... $(INSTALL_UNITS) + @$(ECHO) Install Files....... $(INSTALL_FILES) + @$(ECHO) + @$(ECHO) == Install info == + @$(ECHO) + @$(ECHO) DateStr.............. $(DATESTR) + @$(ECHO) ZipName.............. $(ZIPNAME) + @$(ECHO) ZipPrefix............ $(ZIPPREFIX) + @$(ECHO) ZipCrossPrefix....... $(ZIPCROSSPREFIX) + @$(ECHO) ZipSuffix............ $(ZIPSUFFIX) + @$(ECHO) FullZipName.......... $(FULLZIPNAME) + @$(ECHO) Install FPC Package.. $(INSTALL_FPCPACKAGE) + @$(ECHO) + @$(ECHO) Install base dir..... $(INSTALL_BASEDIR) + @$(ECHO) Install binary dir... $(INSTALL_BINDIR) + @$(ECHO) Install library dir.. $(INSTALL_LIBDIR) + @$(ECHO) Install units dir.... $(INSTALL_UNITDIR) + @$(ECHO) Install source dir... $(INSTALL_SOURCEDIR) + @$(ECHO) Install doc dir...... $(INSTALL_DOCDIR) + @$(ECHO) Install example dir.. $(INSTALL_EXAMPLEDIR) + @$(ECHO) Install data dir..... $(INSTALL_DATADIR) + @$(ECHO) + @$(ECHO) Dist destination dir. $(DIST_DESTDIR) + @$(ECHO) Dist zip name........ $(DIST_ZIPNAME) + @$(ECHO) +.PHONY: fpc_info +fpc_info: $(INFORULES) +.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \ + fpc_makefile_dirs +fpc_makefile: + $(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc +fpc_makefile_sub1: +ifdef TARGET_DIRS + $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS)) +endif +ifdef TARGET_EXAMPLEDIRS + $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS)) +endif +fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS)) +fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2 +fpc_makefiles: fpc_makefile fpc_makefile_dirs +all: fpc_all +debug: fpc_debug +smart: fpc_smart +release: fpc_release +units: fpc_units +examples: +shared: fpc_shared +install: fpc_install +sourceinstall: fpc_sourceinstall +exampleinstall: fpc_exampleinstall +distinstall: +zipinstall: +zipsourceinstall: +zipexampleinstall: +zipdistinstall: +clean: fpc_clean +distclean: fpc_distclean +cleanall: fpc_cleanall +info: fpc_info +makefiles: fpc_makefiles +.PHONY: all debug smart release units examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info makefiles +ifneq ($(wildcard fpcmake.loc),) +include fpcmake.loc +endif +pas2jni$(EXEEXT): pas2jni.pas diff --git a/utils/pas2jni/Makefile.fpc b/utils/pas2jni/Makefile.fpc new file mode 100644 index 0000000000..10687b637d --- /dev/null +++ b/utils/pas2jni/Makefile.fpc @@ -0,0 +1,18 @@ +# +# Makefile.fpc for pas2jni +# + +[target] +programs=pas2jni + +[clean] +units=pas2jni def ppuparser writer + +[install] +fpcpackage=y + +[default] +fpcdir=../.. + +[rules] +pas2jni$(EXEEXT): pas2jni.pas diff --git a/utils/pas2jni/def.pas b/utils/pas2jni/def.pas new file mode 100644 index 0000000000..bf1997cca0 --- /dev/null +++ b/utils/pas2jni/def.pas @@ -0,0 +1,578 @@ +{ + pas2jni - JNI bridge generator for Pascal. + + Copyright (c) 2013 by Yury Sidorov. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + ****************************************************************************} + +unit def; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, contnrs; + +type + TDefType = (dtNone, dtUnit, dtClass, dtRecord, dtProc, dtField, dtProp, dtParam, dtVar, + dtType, dtConst, dtProcType, dtEnum, dtSet); + + TDefClass = class of TDef; + { TDef } + + TDef = class + private + FAliasName: string; + FRefCnt: integer; + FItems: TObjectList; + FInSetUsed: boolean; + procedure CheckItems; + function GetAliasName: string; + function GetCount: integer; + function GetIsUsed: boolean; + function GetItem(Index: Integer): TDef; + procedure SetItem(Index: Integer; const AValue: TDef); + protected + procedure SetIsUsed(const AValue: boolean); virtual; + function ResolveDef(d: TDef; ExpectedClass: TDefClass = nil): TDef; + procedure AddRef; + procedure DecRef; + procedure SetExtUsed(ExtDef: TDef; AUsed: boolean; var HasRef: boolean); + public + DefType: TDefType; + DefId: integer; + SymId: integer; + Name: string; + Parent: TDef; + Tag: integer; + IsPrivate: boolean; + + constructor Create; virtual; overload; + constructor Create(AParent: TDef; AType: TDefType); virtual; overload; + destructor Destroy; override; + function Add(ADef: TDef): integer; + function Insert(Index: integer; ADef: TDef): integer; + function FindDef(ADefId: integer; Recursive: boolean = True): TDef; + procedure ResolveDefs; virtual; + procedure SetNotUsed; + property Items[Index: Integer]: TDef read GetItem write SetItem; default; + property Count: integer read GetCount; + property IsUsed: boolean read GetIsUsed write SetIsUsed; + property RefCnt: integer read FRefCnt; + property AliasName: string read GetAliasName write FAliasName; + end; + + { TClassDef } + + TClassDef = class(TDef) + private + FHasClassRef: boolean; + protected + procedure SetIsUsed(const AValue: boolean); override; + public + AncestorClass: TClassDef; + HasAbstractMethods: boolean; + HasReplacedItems: boolean; + ImplementsReplacedItems: boolean; + procedure ResolveDefs; override; + end; + + TRecordDef = class(TDef) + public + Size: integer; + end; + + TBasicType = (btVoid, btByte, btShortInt, btWord, btSmallInt, btLongWord, btLongInt, btInt64, + btSingle, btDouble, btString, btWideString, btBoolean, btChar, btWideChar, btEnum, btPointer, + btGuid); + + { TTypeDef } + + TTypeDef = class(TDef) + protected + procedure SetIsUsed(const AValue: boolean); override; + public + BasicType: TBasicType; + end; + + { TReplDef } + + TReplDef = class(TDef) + protected + procedure SetIsUsed(const AValue: boolean); override; + public + IsReplaced: boolean; + IsReplImpl: boolean; + ReplacedItem: TReplDef; + + function CanReplaced: boolean; virtual; + function IsReplacedBy(d: TReplDef): boolean; virtual; + procedure CheckReplaced; + end; + + TVarOption = (voRead, voWrite, voConst, voVar, voOut); + TVarOptions = set of TVarOption; + + { TVarDef } + + TVarDef = class(TReplDef) + private + FHasTypeRef: boolean; + protected + procedure SetIsUsed(const AValue: boolean); override; + public + VarOpt: TVarOptions; + VarType: TDef; + IndexType: TDef; + constructor Create; override; + procedure ResolveDefs; override; + function IsReplacedBy(d: TReplDef): boolean; override; + function CanReplaced: boolean; override; + end; + + TProcType = (ptProcedure, ptFunction, ptConstructor, ptDestructor); + TProcOption = (poOverride, poOverload, poMethodPtr, poPrivate, poProtected); + TProcOptions = set of TProcOption; + + { TProcDef } + + TProcDef = class(TReplDef) + private + FHasRetTypeRef: boolean; + protected + procedure SetIsUsed(const AValue: boolean); override; + public + ProcType: TProcType; + ReturnType: TDef; + ProcOpt: TProcOptions; + procedure ResolveDefs; override; + function IsReplacedBy(d: TReplDef): boolean; override; + function CanReplaced: boolean; override; + end; + + TUnitDef = class(TDef) + public + OS: string; + CPU: string; + IntfCRC: string; + PPUVer: integer; + UsedUnits: array of TUnitDef; + Processed: boolean; + end; + + TConstDef = class(TVarDef) + public + Value: string; + end; + + { TSetDef } + + TSetDef = class(TDef) + private + FHasElTypeRef: boolean; + protected + procedure SetIsUsed(const AValue: boolean); override; + public + Size: integer; + Base: integer; + ElMax: integer; + ElType: TTypeDef; + end; + +const + ReplDefs = [dtField, dtProp, dtProc]; + +implementation + +{ TReplDef } + +procedure TReplDef.SetIsUsed(const AValue: boolean); +var + i: integer; +begin + i:=RefCnt; + inherited SetIsUsed(AValue); + if (i = 0) and (RefCnt > 0) then + CheckReplaced; +end; + +function TReplDef.CanReplaced: boolean; +begin + Result:=not (IsPrivate or (Parent = nil) or (Parent.DefType <> dtClass)); +end; + +function TReplDef.IsReplacedBy(d: TReplDef): boolean; +begin + Result:=d.CanReplaced and (CompareText(Name, d.Name) = 0); +end; + +procedure TReplDef.CheckReplaced; + + function _Scan(cls: TClassDef): boolean; + var + i: integer; + d: TReplDef; + c: TClassDef; + begin + Result:=False; + c:=cls.AncestorClass; + if c = nil then + exit; + for i:=0 to c.Count - 1 do begin + d:=TReplDef(c[i]); + if (d.DefType in ReplDefs) and IsReplacedBy(d) then begin + d.IsReplaced:=True; + ReplacedItem:=d; + Result:=True; + break; + end; + end; + if not Result then + Result:=_Scan(c); + if Result then begin + cls.ImplementsReplacedItems:=True; + c.HasReplacedItems:=True; + end; + end; + +begin + if not CanReplaced then + exit; + if _Scan(TClassDef(Parent)) then + IsReplImpl:=True; +end; + +{ TSetDef } + +procedure TSetDef.SetIsUsed(const AValue: boolean); +begin + inherited SetIsUsed(AValue); + SetExtUsed(ElType, AValue, FHasElTypeRef); +end; + +{ TTypeDef } + +procedure TTypeDef.SetIsUsed(const AValue: boolean); +begin + if BasicType in [btEnum] then + inherited SetIsUsed(AValue) + else + if AValue then + AddRef + else + DecRef; +end; + +{ TProcDef } + +procedure TProcDef.SetIsUsed(const AValue: boolean); +var + i: integer; +begin + if IsPrivate then + exit; + if AValue and (RefCnt = 0) then begin + for i:=0 to Count - 1 do + if TVarDef(Items[i]).VarType = nil then + exit; // If procedure has unsupported parameters, don't use it + end; + inherited SetIsUsed(AValue); + if ReturnType <> Parent then + SetExtUsed(ReturnType, AValue, FHasRetTypeRef); +end; + +procedure TProcDef.ResolveDefs; +begin + inherited ResolveDefs; + ReturnType:=ResolveDef(ReturnType); +end; + +function TProcDef.IsReplacedBy(d: TReplDef): boolean; +var + i: integer; + p: TProcDef; +begin + Result:=False; + if d.DefType <> dtProc then + exit; + p:=TProcDef(d); + if (ReturnType <> p.ReturnType) and (Count = p.Count) and inherited IsReplacedBy(p) then begin + // Check parameter types + for i:=0 to Count - 1 do + if TVarDef(Items[i]).VarType <> TVarDef(p.Items[i]).VarType then + exit; + Result:=True; + end; +end; + +function TProcDef.CanReplaced: boolean; +begin + Result:=inherited CanReplaced and (ProcType = ptFunction); +end; + +{ TClassDef } + +procedure TClassDef.SetIsUsed(const AValue: boolean); +begin + inherited SetIsUsed(AValue); + SetExtUsed(AncestorClass, AValue, FHasClassRef); +end; + +procedure TClassDef.ResolveDefs; +begin + inherited ResolveDefs; + AncestorClass:=TClassDef(ResolveDef(AncestorClass, TClassDef)); +end; + +{ TVarDef } + +procedure TVarDef.SetIsUsed(const AValue: boolean); +begin + if IsPrivate then + exit; + inherited SetIsUsed(AValue); + SetExtUsed(VarType, AValue, FHasTypeRef); +end; + +procedure TVarDef.ResolveDefs; +begin + inherited ResolveDefs; + VarType:=ResolveDef(VarType); +end; + +function TVarDef.IsReplacedBy(d: TReplDef): boolean; +begin + Result:=(d.DefType in [dtProp, dtField]) and (VarType <> TVarDef(d).VarType) and inherited IsReplacedBy(d); +end; + +function TVarDef.CanReplaced: boolean; +begin + Result:=(voRead in VarOpt) and inherited CanReplaced; +end; + +constructor TVarDef.Create; +begin + inherited Create; + VarOpt:=[voRead, voWrite]; +end; + +{ TDef } + +procedure TDef.CheckItems; +begin + if FItems = nil then + FItems:=TObjectList.Create(True); +end; + +function TDef.GetAliasName: string; +begin + if FAliasName <> '' then + Result:=FAliasName + else + Result:=Name; +end; + +function TDef.GetCount: integer; +begin + if FItems = nil then + Result:=0 + else begin + CheckItems; + Result:=FItems.Count; + end; +end; + +function TDef.GetIsUsed: boolean; +begin + Result:=FRefCnt > 0; +end; + +function TDef.GetItem(Index: Integer): TDef; +begin + CheckItems; + Result:=TDef(FItems[Index]); +end; + +procedure TDef.SetIsUsed(const AValue: boolean); +var + i: integer; + f: boolean; +begin + if FInSetUsed or (DefType = dtNone) or IsPrivate then + exit; + if AValue then begin + AddRef; + f:=FRefCnt = 1; + end + else begin + if FRefCnt = 0 then + exit; + DecRef; + f:=FRefCnt = 0; + end; + if f then begin + // Update userd mark of children only once + FInSetUsed:=True; + try + for i:=0 to Count - 1 do + Items[i].IsUsed:=AValue; + finally + FInSetUsed:=False; + end; + // Update parent's used mark + if (Parent <> nil) and (Parent.DefType = dtUnit) then + if AValue then + Parent.AddRef + else + Parent.DecRef; + end; +end; + +function TDef.ResolveDef(d: TDef; ExpectedClass: TDefClass): TDef; +begin + if (d = nil) or (d.DefType <> dtNone) then begin + Result:=d; + exit; + end; + Result:=d.Parent.FindDef(d.DefId); + if (ExpectedClass <> nil) and (Result <> nil) then + if not (Result is ExpectedClass) then + raise Exception.CreateFmt('Unexpected class. Expected: %s, got: %s', [ExpectedClass.ClassName, Result.ClassName]); +end; + +procedure TDef.AddRef; +begin + Inc(FRefCnt); +end; + +procedure TDef.DecRef; +begin + if FRefCnt > 0 then + Dec(FRefCnt); +end; + +procedure TDef.SetExtUsed(ExtDef: TDef; AUsed: boolean; var HasRef: boolean); +var + OldRefCnt: integer; +begin + if ExtDef = nil then + exit; + if AUsed then begin + if HasRef then + exit; + OldRefCnt:=ExtDef.RefCnt; + ExtDef.IsUsed:=True; + HasRef:=OldRefCnt <> ExtDef.RefCnt; + end + else + if HasRef and not IsUsed then begin + ExtDef.IsUsed:=False; + HasRef:=False; + end; +end; + +procedure TDef.SetItem(Index: Integer; const AValue: TDef); +begin + CheckItems; + FItems[Index]:=AValue; +end; + +constructor TDef.Create; +begin + DefId:=-1; + DefType:=dtNone; +end; + +constructor TDef.Create(AParent: TDef; AType: TDefType); +begin + Create; + if AParent <> nil then + AParent.Add(Self); + DefType:=AType; +end; + +destructor TDef.Destroy; +begin + FreeAndNil(FItems); + if (Parent <> nil) and (Parent.FItems <> nil) then begin + Parent.FItems.OwnsObjects:=False; + try + Parent.FItems.Remove(Self); + finally + Parent.FItems.OwnsObjects:=True; + end; + end; + inherited Destroy; +end; + +function TDef.Add(ADef: TDef): integer; +begin + Result:=Insert(Count, ADef); +end; + +function TDef.Insert(Index: integer; ADef: TDef): integer; +begin + CheckItems; + Result:=Index; + FItems.Insert(Result, ADef); + ADef.Parent:=Self; +end; + +function TDef.FindDef(ADefId: integer; Recursive: boolean): TDef; + + function _Find(d: TDef): TDef; + var + i: integer; + begin + Result:=nil; + for i:=0 to d.Count - 1 do + with d[i] do begin + if (DefType <> dtNone) and (DefId = ADefId) then begin + Result:=d[i]; + break; + end; + if Recursive and (Count > 0) then begin + Result:=_Find(d[i]); + if Result <> nil then + break; + end; + end; + end; + +begin + Result:=_Find(Self); +end; + +procedure TDef.ResolveDefs; +var + i: integer; +begin + for i:=0 to Count - 1 do + Items[i].ResolveDefs; +end; + +procedure TDef.SetNotUsed; +begin + if FRefCnt = 0 then + exit; + FRefCnt:=1; + IsUsed:=False; +end; + +end. + diff --git a/utils/pas2jni/pas2jni.pas b/utils/pas2jni/pas2jni.pas new file mode 100644 index 0000000000..eaabb9f179 --- /dev/null +++ b/utils/pas2jni/pas2jni.pas @@ -0,0 +1,190 @@ +{ + pas2jni - JNI bridge generator for Pascal. + + Copyright (c) 2013 by Yury Sidorov. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + ****************************************************************************} + +{$mode objfpc}{$H+} +{$apptype console} +program pas2jni; + +uses SysUtils, Classes, writer, ppuparser; + +var + w: TWriter; + +procedure ShowUsage; +begin + writeln('Usage: ', ChangeFileExt(ExtractFileName(ParamStr(0)), ''), ' [options] [ ...]'); + writeln; + writeln('Options:'); + writeln(' -U - Unit search path, semicolon delimited. Wildcards are allowed.'); + writeln(' -L - Set output library name.'); + writeln(' -P - Set Java package name.'); + writeln(' -O - Set output path for Pascal files.'); + writeln(' -J - Set output path for Java files.'); + writeln(' -D - Set full path to the "ppudump" program.'); + writeln(' -I - Include the list of specified objects in the output. The list is'); + writeln(' semicolon delimited. To read the list from a file use -I@'); + writeln(' -E - Exclude the list of specified objects from the output. The list is'); + writeln(' semicolon delimited. To read the list from a file use -E@'); + writeln(' -? - Show this help information.'); +end; + +function GetListParam(const p: string): TStringList; +var + fs: TFileStream; + r: string; +begin + if Copy(p, 1, 1) = '@' then begin + fs:=TFileStream.Create(Copy(p, 2, MaxInt), fmOpenRead or fmShareDenyWrite); + try + SetLength(r, fs.Size); + if r <> '' then + fs.ReadBuffer(PChar(r)^, fs.Size); + finally + fs.Free; + end; + end + else + r:=p; + r:=StringReplace(r, ';', LineEnding, [rfReplaceAll]); + Result:=TStringList.Create; + Result.Text:=r; +end; + +procedure ParseCmdLine; +var + i: integer; + s, ss: string; + sl: TStringList; +begin + if ParamCount = 0 then begin + ShowUsage; + Halt(1); + end; + for i:=1 to Paramcount do begin + s:=ParamStr(i); + if Copy(s, 1, 1) = '-' then begin + Delete(s, 1, 1); + if s = '' then + continue; + case s[1] of + 'U': + begin + Delete(s, 1, 1); + if s = '' then + continue; + if w.SearchPath <> '' then + w.SearchPath:=w.SearchPath + ';'; + w.SearchPath:=w.SearchPath + s; + end; + 'L': + begin + Delete(s, 1, 1); + if s = '' then + continue; + w.LibName:=s; + end; + 'P': + begin + Delete(s, 1, 1); + if s = '' then + continue; + w.JavaPackage:=s; + end; + 'O': + begin + Delete(s, 1, 1); + if s = '' then + continue; + w.OutPath:=s; + if w.JavaOutPath = '' then + w.JavaOutPath:=s; + end; + 'J': + begin + Delete(s, 1, 1); + if s = '' then + continue; + w.JavaOutPath:=s; + end; + 'D': + begin + Delete(s, 1, 1); + if s = '' then + continue; + ppudumpprog:=s; + end; + 'I': + begin + Delete(s, 1, 1); + if s = '' then + continue; + sl:=GetListParam(s); + w.IncludeList.AddStrings(sl); + sl.Free; + end; + 'E': + begin + Delete(s, 1, 1); + if s = '' then + continue; + sl:=GetListParam(s); + w.ExcludeList.AddStrings(sl); + sl.Free; + end; + '?', 'H': + begin + ShowUsage; + Halt(0); + end; + else + begin + writeln('Illegal parameter: -', s); + Halt(1); + end; + end; + end + else begin + ss:=ExtractFilePath(s); + if ss <> '' then begin + if w.SearchPath <> '' then + w.SearchPath:=w.SearchPath + ';'; + w.SearchPath:=w.SearchPath + ss; + end; + w.Units.Add(ExtractFileName(s)); + end; + end; +end; + +begin + try + w:=TWriter.Create; + try + ParseCmdLine; + w.ProcessUnits; + finally + w.Free; + end; + except + writeln(Exception(ExceptObject).Message); + Halt(2); + end; +end. + diff --git a/utils/pas2jni/ppuparser.pas b/utils/pas2jni/ppuparser.pas new file mode 100644 index 0000000000..fb5ad3cbaa --- /dev/null +++ b/utils/pas2jni/ppuparser.pas @@ -0,0 +1,851 @@ +{ + pas2jni - JNI bridge generator for Pascal. + + Copyright (c) 2013 by Yury Sidorov. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + ****************************************************************************} + +unit ppuparser; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, def; + +type + TCheckItemResult = (crDefault, crInclude, crExclude); + TOnCheckItem = function (const ItemName: string): TCheckItemResult of object; + + { TPPUParser } + TPPUParser = class + private + FOnCheckItem: TOnCheckItem; + function FindUnit(const AName: string): string; + procedure ReadUnit(const AName: string; Lines: TStrings); + function InternalParse(const AUnitName: string): TUnitDef; + public + SearchPath: TStringList; + Units: TDef; + + constructor Create(const ASearchPath: string); + destructor Destroy; override; + procedure Parse(const AUnitName: string); + property OnCheckItem: TOnCheckItem read FOnCheckItem write FOnCheckItem; + end; + +var + ppudumpprog: string = 'ppudump'; + +implementation + +uses process, pipes; + +type + TCharSet = set of char; + +function WordPosition(const N: Integer; const S: string; + const WordDelims: TCharSet): Integer; +var + Count, I: Integer; +begin + Count := 0; + I := 1; + Result := 0; + while (I <= Length(S)) and (Count <> N) do + begin + { skip over delimiters } + while (I <= Length(S)) and (S[I] in WordDelims) do + Inc(I); + { if we're not beyond end of S, we're at the start of a word } + if I <= Length(S) then + Inc(Count); + { if not finished, find the end of the current word } + if Count <> N then + while (I <= Length(S)) and not (S[I] in WordDelims) do + Inc(I) + else + Result := I; + end; +end; + +function ExtractWord(N: Integer; const S: string; + const WordDelims: TCharSet): string; +var + I: Integer; + Len: Integer; +begin + Len := 0; + I := WordPosition(N, S, WordDelims); + if I <> 0 then + { find the end of the current word } + while (I <= Length(S)) and not (S[I] in WordDelims) do + begin + { add the I'th character to result } + Inc(Len); + SetLength(Result, Len); + Result[Len] := S[I]; + Inc(I); + end; + SetLength(Result, Len); +end; + +{ TPPUParser } + +constructor TPPUParser.Create(const ASearchPath: string); +var + i, j: integer; + s, d: string; + sr: TSearchRec; +begin + SearchPath:=TStringList.Create; + SearchPath.Delimiter:=';'; + SearchPath.DelimitedText:=ASearchPath; + i:=0; + while i < SearchPath.Count do begin + s:=SearchPath[i]; + if (Pos('*', s) > 0) or (Pos('?', s) > 0) then begin + d:=ExtractFilePath(s); + j:=FindFirst(s, faDirectory, sr); + while j = 0 do begin + if (sr.Name <> '.') and (sr.Name <> '..') then + SearchPath.Add(d + sr.Name); + j:=FindNext(sr); + end; + FindClose(sr); + SearchPath.Delete(i); + end + else + Inc(i); + end; + Units:=TDef.Create(nil, dtNone); +end; + +destructor TPPUParser.Destroy; +begin + Units.Free; + SearchPath.Free; + inherited Destroy; +end; + +procedure TPPUParser.Parse(const AUnitName: string); +begin + InternalParse(AUnitName); +end; + +function TPPUParser.FindUnit(const AName: string): string; +var + i: integer; + fn: string; +begin + fn:=ChangeFileExt(LowerCase(AName), '.ppu'); + if FileExists(fn) then begin + Result:=fn; + exit; + end; + for i:=0 to SearchPath.Count - 1 do begin + Result:=IncludeTrailingPathDelimiter(SearchPath[i]) + fn; + if FileExists(Result) then + exit; + end; + raise Exception.CreateFmt('Unable to find PPU file for unit "%s".', [AName]); +end; + +procedure TPPUParser.ReadUnit(const AName: string; Lines: TStrings); +var + p: TProcess; + s, un: ansistring; + i, j: integer; +begin + un:=FindUnit(AName); + p:=TProcess.Create(nil); + try + p.Executable:=ppudumpprog; + p.Parameters.Add(un); + p.Options:=[poUsePipes, poNoConsole, poStderrToOutPut]; + p.ShowWindow:=swoHIDE; + p.StartupOptions:=[suoUseShowWindow]; + try + p.Execute; + except + raise Exception.CreateFmt('Unable to run "%s".'+LineEnding+'%s', [p.Executable, Exception(ExceptObject).Message]); + end; + s:=''; + repeat + with p.Output do + while NumBytesAvailable > 0 do begin + i:=NumBytesAvailable; + j:=Length(s); + SetLength(s, j + i); + ReadBuffer(s[j + 1], i); + end; + until not p.Running; + if p.ExitStatus <> 0 then begin + if Length(s) > 300 then + s:=''; + raise Exception.CreateFmt('Error reading contents of unit "%s" using "%s".'+LineEnding+'Error code: %d'+LineEnding+'%s', [un, ppudumpprog, p.ExitStatus, s]); + end; + finally + p.Free; + end; + Lines.Text:=s; +{$ifopt D+} +// Lines.SaveToFile(AName + '-dump.txt'); +{$endif} +end; + +const + LInc = 4; + SDefId = '** Definition Id '; + SSymId = '** Symbol Id '; + +function TPPUParser.InternalParse(const AUnitName: string): TUnitDef; +var + FLines: TStringList; + deref: array of TUnitDef; + CurUnit: TUnitDef; + CurDef: TDef; + level, skiplevel: integer; + IsSystemUnit: boolean; + AMainUnit: boolean; + + function _ThisLevel(const s: string): boolean; + var + i: integer; + begin + Result:=True; + if (level = 1) or (Length(s) < level - LInc) then + exit; + if s[1] = '-' then begin + Result:=False; + exit; + end; + i:=level; + repeat + Dec(i, LInc); + if Copy(s, i, 3) = '** ' then begin + Result:=False; + exit; + end; + until i = 1; + end; + + function _GetDef(const Path: string; ExpectedClass: TDefClass = nil): TDef; + var + s, ss: string; + i, j: integer; + u: TUnitDef; + begin + Result:=nil; + u:=CurUnit; + s:=Trim(Path); + if Copy(s, 1, 1) = '(' then begin + i:=Pos(') ', s); + if i > 0 then + Delete(s, 1, i + 1); + end; + i:=1; + while True do begin + ss:=Trim(ExtractWord(i, s, [','])); + if ss = '' then + break; + if Pos('Unit', ss) = 1 then begin + j:=StrToInt(Copy(ss, 6, MaxInt)); + u:=deref[j]; + if u.DefType = dtNone then begin + // Reading unit + u:=InternalParse(LowerCase(u.Name)); + if u = nil then + exit; + if u.CPU <> CurUnit.CPU then + raise Exception.CreateFmt('Invalid target CPU of unit "%s": %s', [u.Name, u.CPU]); + if u.OS <> CurUnit.OS then + raise Exception.CreateFmt('Invalid target OS of unit "%s": %s', [u.Name, u.OS]); + if u.PPUVer <> CurUnit.PPUVer then + raise Exception.CreateFmt('Invalid PPU version of unit "%s": %s', [u.Name, u.PPUVer]); + deref[j].Free; + deref[j]:=u; + end; + end + else + if Pos('DefId', ss) = 1 then begin + j:=StrToInt(Copy(ss, 7, MaxInt)); + Result:=u.FindDef(j); + if Result = nil then begin + if ExpectedClass <> nil then + Result:=ExpectedClass.Create(u, dtNone) + else + Result:=TDef.Create(u, dtNone); + Result.DefId:=j; + end; + break; + end; + Inc(i); + end; + if (ExpectedClass <> nil) and (Result <> nil) then + if (Result.DefType <> dtNone) and not (Result is ExpectedClass) then + raise Exception.CreateFmt('Unexpected class. Expected: %s, got: %s', [ExpectedClass.ClassName, Result.ClassName]); + end; + + function _ReadSym(var idx: integer; ParentDef: TDef): TDef; + var + s, ss, name: string; + id: integer; + i, j: integer; + d: TDef; + begin + Result:=nil; + // symvol id + s:=Trim(FLines[idx]); + id:=StrToInt(ExtractWord(4, s, [' '])); + Inc(idx); + s:=Trim(FLines[idx]); + if Pos('Property', s) = 1 then begin + name:=Trim(Copy(s, 10, MaxInt)); + Result:=TVarDef.Create(nil, dtProp); + TVarDef(Result).VarOpt:=[]; + end + else begin + i:=Pos('symbol', s); + if i = 0 then + exit; + name:=Trim(Copy(s, i + 7, MaxInt)); + if Copy(name, 1, 1) = '$' then + exit; + + s:=LowerCase(Trim(Copy(s, 1, i - 1))); + if s = 'field variable' then + Result:=TVarDef.Create(nil, dtField) + else + if s = 'global variable' then + Result:=TVarDef.Create(nil, dtVar) + else + if s = 'parameter variable' then begin + Result:=TVarDef.Create(nil, dtParam); + TVarDef(Result).VarOpt:=[voRead]; + end + else + if s = 'enumeration' then begin + if ParentDef = CurUnit then + exit; + Result:=TConstDef.Create(nil, dtConst); + TConstDef(Result).VarType:=ParentDef; + end + else + if s = 'constant' then begin + Result:=TConstDef.Create(nil, dtConst); + end + + else + if (s = 'procedure') or (s = 'type') then + Result:=nil + else + exit; + end; + + if Result <> nil then begin + Result.Name:=name; + Result.SymId:=id; + end; + + Inc(level, LInc); + skiplevel:=level; + Inc(idx); + while idx < FLines.Count do begin + s:=FLines[idx]; + if not _ThisLevel(s) or (Copy(Trim(s), 1, 3) = '---') then begin + Dec(idx); + break; + end; + + if Pos('Visibility :', s) > 0 then begin + s:=LowerCase(Trim(ExtractWord(2, s, [':']))); + if (s <> 'public') and (s <> 'published') then begin + FreeAndNil(Result); + exit; + end; + end + else + if (Pos('Definition :', s) > 0) or (Pos('Result Type :', s) > 0) then begin + if (Result = nil) or (Result.DefType <> dtConst) then begin + s:=Trim(ExtractWord(2, s, [':'])); + d:=_GetDef(s); + if (d <> nil) and (d.Name = '') then begin + if (d.DefType = dtProc) and (TProcDef(d).ProcType = ptConstructor) and (CompareText(name, 'create') = 0) then + name:='Create'; // fix char case for standard constructors + d.Name:=name; + d.SymId:=id; + end; + end + end + else + if Pos('Options :', s) > 0 then begin + s:=LowerCase(Trim(ExtractWord(2, s, [':']))); + if Pos('hidden', s) > 0 then begin + FreeAndNil(Result); + exit; + end; + end + else + if Result <> nil then + case Result.DefType of + dtVar, dtField, dtProp, dtParam: + if (Pos('Var Type :', s) > 0) or (Pos('Prop Type :', s) > 0) then begin + s:=Trim(ExtractWord(2, s, [':'])); + TVarDef(Result).VarType:=_GetDef(s); + end + else + if Pos('access :', s) > 0 then begin + if Pos('Sym:', Trim(FLines[idx+1])) = 1 then begin + d:=nil; + ss:=Trim(ExtractWord(2, s, [':'])); + if Pos('Nil', ss) = 0 then + d:=_GetDef(ss, TProcDef); + with TVarDef(Result) do + if Pos('Readaccess :', s) > 0 then begin + VarOpt:=VarOpt + [voRead]; + if (d <> nil) and (d.Count = 1) then + IndexType:=TVarDef(d[0]).VarType; + end + else + if Pos('Writeaccess :', s) > 0 then begin + VarOpt:=VarOpt + [voWrite]; + if (d <> nil) and (d.Count = 2) then + IndexType:=TVarDef(d[0]).VarType; + end; + end; + end + else + if Pos('Spez :', s) > 0 then begin + with TVarDef(Result) do begin + s:=LowerCase(Trim(ExtractWord(2, s, [':']))); + if s = 'out' then + VarOpt:=[voWrite, voOut] + else + if s = 'var' then + VarOpt:=[voRead, voWrite, voVar] + else + if s = 'const' then + VarOpt:=[voRead, voConst]; + end; + end; + + dtConst: + begin + j:=Pos('Value :', s); + if j > 0 then begin + Inc(j, 6); + ss:=Trim(Copy(s, j + 1, MaxInt)); + if Copy(ss, 1, 1) = '"' then begin + Delete(ss, 1, 1); + i:=level - LInc; + while True do begin + Inc(idx); + if idx >= FLines.Count then + break; + s:=FLines[idx]; + if (Copy(s, i, 3) = '** ') or (Copy(s, j, 1) = ':') then + break; + ss:=ss + #10 + s; + end; + Dec(idx); + Delete(ss, Length(ss), 1); + ss:=StringReplace(ss, '\', '\\', [rfReplaceAll]); + ss:=StringReplace(ss, '"', '\"', [rfReplaceAll]); + ss:=StringReplace(ss, #10, '\n', [rfReplaceAll]); + ss:='"' + ss + '"'; + end; + TConstDef(Result).Value:=ss; + end + else + if Pos('OrdinalType :', s) > 0 then begin + s:=Trim(ExtractWord(2, s, [':'])); + TConstDef(Result).VarType:=_GetDef(s); + end + else + if Pos('Set Type :', s) > 0 then begin +// s:=Trim(ExtractWord(2, s, [':'])); +// TConstDef(Result).VarType:=_GetDef(s); + FreeAndNil(Result); + exit; + end; + end; + end; + + Inc(idx); + end; + + if Result <> nil then + ParentDef.Add(Result); + end; + + procedure _RemoveCurDef; + var + d: TDef; + begin + d:=CurDef; + CurDef:=CurDef.Parent; + d.Free; + skiplevel:=level; + end; + +var + s: ansistring; + i, j: integer; + dd: TDef; + HdrRead: boolean; +begin + Result:=nil; + for i:=0 to Units.Count - 1 do + if CompareText(Units[i].Name, AUnitName) = 0 then begin + Result:=TUnitDef(Units[i]); + exit; + end; + + AMainUnit:=FOnCheckItem(AUnitName) = crInclude; + + if not AMainUnit and ( (CompareText(AUnitName, 'windows') = 0) or (CompareText(AUnitName, 'unix') = 0) ) then begin + Result:=nil; + exit; + end; + + FLines:=TStringList.Create; + try + ReadUnit(AUnitName, FLines); + + IsSystemUnit:=CompareText(AUnitName, 'system') = 0; + + Result:=TUnitDef.Create(nil, dtUnit); + Units.Add(Result); + CurUnit:=Result; + SetLength(deref, 0); + CurDef:=Result; + level:=1; + skiplevel:=0; + i:=-1; + HdrRead:=False; + while True do begin + Inc(i); + if i >= FLines.Count then + break; + s:=FLines[i]; + + if s = 'Implementation symtable' then + break; + + if not HdrRead then begin + if Trim(s) = 'Interface symtable' then begin + HdrRead:=True; + continue; + end; + + if Pos('Analyzing', s) = 1 then begin + j:=Pos('(v', s); + if j > 0 then + Result.PPUVer:=StrToInt(Copy(s, j + 2, Length(s) - j - 2)); + end + else + if Pos('Target processor', s) = 1 then + Result.CPU:=Trim(ExtractWord(2, s, [':'])) + else + if Pos('Target operating system', s) = 1 then + Result.OS:=Trim(ExtractWord(2, s, [':'])) + else + if Pos('Interface Checksum', s) = 1 then + Result.IntfCRC:=Trim(ExtractWord(2, s, [':'])) + else + if (Pos('Module Name:', s) = 1) and (Result.Name = '') then begin + Result.Name:=Trim(ExtractWord(2, s, [':'])); + continue; + end + else + if Pos('DerefMap[', s) = 1 then begin + s:=Trim(ExtractWord(2, s, ['='])); + j:=Length(deref); + SetLength(deref, j + 1); + deref[j]:=TUnitDef.Create(nil, dtNone); + deref[j].Name:=s; + continue; + end; + end; + + while not _ThisLevel(s) do begin + if skiplevel = 0 then + CurDef:=CurDef.Parent; + Dec(level, LInc); + skiplevel:=0; + end; + + if level = skiplevel then + continue; // Skipping not supported entries + + // Definition + j:=Pos(SDefId, s); + if j > 0 then begin + Inc(level, LInc); + // def id + j:=StrToInt(Copy(s, j + Length(SDefId), Length(s) - (j + Length(SDefId)) - 2)); + Inc(i); + s:=FLines[i]; + if Pos('definition', s) = 0 then begin + skiplevel:=level; + continue; + end; + s:=LowerCase(Trim(ExtractWord(1, s, [' ']))); + dd:=nil; + if s = 'object/class' then + dd:=TClassDef.Create(CurDef, dtClass) + else + if s = 'record' then + dd:=TRecordDef.Create(CurDef, dtRecord) + else + if s = 'procedure' then + dd:=TProcDef.Create(CurDef, dtProc) + else + if s = 'ordinal' then begin + dd:=TTypeDef.Create(CurDef, dtType); + TTypeDef(dd).BasicType:=btLongInt; + end + else + if Pos('string', s) > 0 then begin + dd:=TTypeDef.Create(CurDef, dtType); + dd.Name:=s; + if (s = 'widestring') or (s = 'unicodestring') then + TTypeDef(dd).BasicType:=btWideString + else + TTypeDef(dd).BasicType:=btString; + end + else + if s = 'float' then begin + dd:=TTypeDef.Create(CurDef, dtType); + TTypeDef(dd).BasicType:=btDouble; + end + else + if s = 'enumeration' then begin + dd:=TTypeDef.Create(CurDef, dtEnum); + TTypeDef(dd).BasicType:=btEnum; + end + else + if s = 'pointer' then begin + dd:=TTypeDef.Create(CurDef, dtType); + TTypeDef(dd).BasicType:=btPointer; + end + else + if s = 'procedural' then begin + dd:=TProcDef.Create(CurDef, dtProcType); + TProcDef(dd).ProcType:=ptProcedure; + end + else + if s = 'set' then begin + dd:=TSetDef.Create(CurDef, dtSet); + end + else + skiplevel:=level; + if dd <> nil then begin + CurDef:=dd; + CurDef.DefId:=j; + end; + continue; + end; + + // Symbol + if Pos(SSymId, s) > 0 then begin + dd:=_ReadSym(i, CurDef); + continue; + end; + + if CurDef <> nil then + case CurDef.DefType of + dtClass: + begin + if Pos('Type :', Trim(s)) = 1 then begin + s:=LowerCase(Trim(ExtractWord(2, s, [':']))); + if CurDef.DefId = 0 then + s:=s; + if s <> 'class' then + _RemoveCurDef; + end + else + if Pos('Ancestor Class :', s) > 0 then begin + s:=Trim(ExtractWord(2, s, [':'])); + TClassDef(CurDef).AncestorClass:=TClassDef(_GetDef(s, TClassDef)); + end + end; + dtRecord: + begin + if IsSystemUnit and (Pos('Name of Record :', s) > 0) then begin + s:=Trim(ExtractWord(2, s, [':'])); + if CompareText(s, 'tguid') = 0 then begin + dd:=TTypeDef.Create(CurUnit, dtType); + TTypeDef(dd).BasicType:=btGuid; + dd.DefId:=CurDef.DefId; + CurDef.Free; + CurDef:=dd; + end; + end + else + if Pos('DataSize :', s) > 0 then begin + s:=Trim(ExtractWord(2, s, [':'])); + TRecordDef(CurDef).Size:=StrToInt(s); + end; + end; + dtProc, dtProcType: + begin + s:=Trim(s); + if Pos('TypeOption :', s) = 1 then begin + s:=LowerCase(Trim(ExtractWord(2, s, [':']))); + with TProcDef(CurDef) do + if s = 'procedure' then + ProcType:=ptProcedure + else + if s = 'function' then + ProcType:=ptFunction + else + if s = 'constructor' then + ProcType:=ptConstructor + else + if s = 'destructor' then + ProcType:=ptDestructor; + end + else + if Pos('Return type :', s) = 1 then begin + s:=Trim(ExtractWord(2, s, [':'])); + with TProcDef(CurDef) do begin + ReturnType:=_GetDef(s); + if (CurDef.DefType = dtProcType) and not ( (ReturnType is TTypeDef) and (TTypeDef(ReturnType).BasicType = btVoid) ) then + ProcType:=ptFunction; + end; + end + else + if Pos('Visibility :', s) = 1 then begin + s:=LowerCase(Trim(ExtractWord(2, s, [':']))); + if (s <> 'public') and (s <> 'published') then + CurDef.IsPrivate:=True; + end + else + if Pos('Options :', s) = 1 then begin + s:=LowerCase(Trim(ExtractWord(2, s, [':']))); + with TProcDef(CurDef) do begin + if Pos('overridingmethod', s) > 0 then begin + ProcOpt:=ProcOpt + [poOverride]; + if ProcType <> ptConstructor then + CurDef.IsPrivate:=True; + end; + if Pos('overload', s) > 0 then + ProcOpt:=ProcOpt + [poOverload]; + if Pos('methodpointer', s) > 0 then + ProcOpt:=ProcOpt + [poMethodPtr]; + + if (CurDef.Parent.DefType = dtClass) and (Pos('abstractmethod', s) > 0) then + TClassDef(CurDef.Parent).HasAbstractMethods:=True; + end; + end; + end; + dtType: + with TTypeDef(CurDef) do + if Pos('Base type :', s) > 0 then begin + s:=LowerCase(Trim(ExtractWord(2, s, [':']))); + if Pos('bool', s) = 1 then + BasicType:=btBoolean + else + if s = 'u8bit' then + BasicType:=btByte + else + if s = 's8bit' then + BasicType:=btShortInt + else + if s = 'u16bit' then + BasicType:=btWord + else + if s = 's16bit' then + BasicType:=btSmallInt + else + if s = 'u32bit' then + BasicType:=btLongWord + else + if s = 's32bit' then + BasicType:=btLongInt + else + if (s = 'u64bit') or (s = 's64bit') then + BasicType:=btInt64 + else + if s = 'uvoid' then + BasicType:=btVoid + else + if s = 'uchar' then + BasicType:=btChar + else + if s = 'uwidechar' then + BasicType:=btWideChar; + end + else + if Pos('Float type :', s) > 0 then begin + s:=Trim(ExtractWord(2, s, [':'])); + if s = '0' then + BasicType:=btSingle; + end + else + if Pos('Range :', s) > 0 then begin + s:=LowerCase(Trim(ExtractWord(2, s, [':']))); + if s = '0 to 1' then + BasicType:=btBoolean; + end; + dtSet: + with TSetDef(CurDef) do + if Pos('Size :', s) > 0 then + Size:=StrToInt(Trim(ExtractWord(2, s, [':']))) + else + if Pos('Set Base :', s) > 0 then + Base:=StrToInt(Trim(ExtractWord(2, s, [':']))) + else + if Pos('Set Max :', s) > 0 then + ElMax:=StrToInt(Trim(ExtractWord(2, s, [':']))) + else + if Pos('Element type :', s) > 0 then + ElType:=TTypeDef(_GetDef(Trim(ExtractWord(2, s, [':'])), TTypeDef)) + else + if Pos('Type symbol :', s) > 0 then begin + s:=LowerCase(Trim(ExtractWord(2, s, [':']))); + if Trim(ExtractWord(2, s, [' '])) = 'nil' then + _RemoveCurDef; + end; + end; + end; + + Result.ResolveDefs; + + if AMainUnit then + Result.IsUsed:=True; + + SetLength(Result.UsedUnits, Length(deref)); + j:=0; + for i:=0 to High(deref) do + if deref[i].DefType = dtNone then + deref[i].Free + else begin + Result.UsedUnits[j]:=deref[i]; + Inc(j); + end; + SetLength(Result.UsedUnits, j); + finally + FLines.Free; + end; +end; + +end. + diff --git a/utils/pas2jni/readme.txt b/utils/pas2jni/readme.txt new file mode 100644 index 0000000000..c12ca399ef --- /dev/null +++ b/utils/pas2jni/readme.txt @@ -0,0 +1,69 @@ +pas2jni - JNI bridge generator for Pascal. + +Copyright (c) 2013 by Yury Sidorov. + +The pas2jni utility generates a JNI (Java Native Interface) bridge for a Pascal code. Then the Pascal code (including classes and other advanced features) can be easily used in Java programs. + +For example you can do the following in Java: + +import pas.classes.*; + +... + +TStringList sl = TStringList.Create(); +sl.Add("Hello."); +String s = sl.getStrings(0); +sl.Free(); + +... + +The following Pascal features are supported by pas2jni: + +- function/procedure; +- var/out parameters; +- class; +- record; +- property; +- constant; +- enum; +- TGuid type; +- pointer type; +- string types; +- all numeric types; + +Shared libraries, generated by pas2jni were tested with Java on Windows and Android. It should work on other systems as well. + +HOW TO USE + +pas2jni uses the ppudump utility included with Free Pascal Compiler to read unit interfaces. Therefore your Pascal code must be first compiled with FPC. +When your units are compiled, you can run pas2jni. You need to specify a list of main units and units search path. +When you specify a main unit, all its interface declarations will be available in Java. For linked units only used declarations will be available. You can fine tune included/excluded declaration using -I and -E command line options. + +The basic invocation of pas2jni: + +pas2jni myunit -U/path/to/my/units;/path/to/FPC/units/* + +Here you specify myunit as the main unit and provide path to your compiled units and FPC compiled units. + +After successfull run of pas2jni you will get the following output files: +- file "myunitjni.pas" - a generated library unit to be compiled to a shared library. It will contain all your Pascal code to be used from Java. +- folder "pas" - generated Java package "pas" to be used in your Java program. Interface to each Pascal unit is placed to a separate Java public class. + +Note: You need to use ppudump of the same version as the FPC compiler. Use the -D switch to specify correct ppudump if it is not in PATH. + +COMMAND LINE OPTIONS + +Usage: pas2jni [options] [ ...] + +Options: + -U - Unit search path, semicolon delimited. Wildcards are allowed. + -L - Set output library name. + -P - Set Java package name. + -O - Set output path for Pascal files. + -J - Set output path for Java files. + -D - Set full path to the "ppudump" program. + -I - Include the list of specified objects in the output. The list is + semicolon delimited. To read the list from a file use -I@ + -E - Exclude the list of specified objects from the output. The list is + semicolon delimited. To read the list from a file use -E@ + -? - Show this help information. diff --git a/utils/pas2jni/writer.pas b/utils/pas2jni/writer.pas new file mode 100644 index 0000000000..984b15d3eb --- /dev/null +++ b/utils/pas2jni/writer.pas @@ -0,0 +1,2156 @@ +{ + pas2jni - JNI bridge generator for Pascal. + + Copyright (c) 2013 by Yury Sidorov. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + ****************************************************************************} + +unit writer; + +{$mode objfpc}{$H+} + +interface + +{$define DEBUG} + +{$ifdef DEBUG} +{$ASSERTIONS ON} +{$endif} + +uses + Classes, SysUtils, def, contnrs, PPUParser; + +const + MaxMethodPointers = 10000; + +type + { TTextOutStream } + + TTextOutStream = class(TFileStream) + private + FIndent: integer; + FIndStr: string; + procedure SetIndednt(const AValue: integer); + public + procedure Write(const s: ansistring); overload; + procedure WriteLn(const s: ansistring = ''; ExtraIndent: integer = 0); + procedure IncI; + procedure DecI; + property Indent: integer read FIndent write SetIndednt; + property SIndent: string read FIndStr; + end; + + { TWriter } + + TWriter = class + private + Fjs, Fps: TTextOutStream; + FClasses: TStringList; + FPkgDir: string; + FUniqueCnt: integer; + FThisUnit: TUnitDef; + + function DoCheckItem(const ItemName: string): TCheckItemResult; + + procedure ProcessRules(d: TDef; const Prefix: string = ''); + function GetUniqueNum: integer; + function DefToJniType(d: TDef; var err: boolean): string; + function DefToJniSig(d: TDef): string; + function DefToJavaType(d: TDef): string; + function GetJavaClassPath(d: TDef; const AClassName: string = ''): string; + function JniToPasType(d: TDef; const v: string; CheckNil: boolean): string; + function PasToJniType(d: TDef; const v: string): string; + function GetTypeInfoVar(ClassDef: TDef): string; + function GetClassPrefix(ClassDef: TDef; const AClassName: string = ''): string; + function IsJavaSimpleType(d: TDef): boolean; + function GetProcDeclaration(d: TProcDef; const ProcName: string = ''): string; + function GetJavaProcDeclaration(d: TProcDef; const ProcName: string = ''): string; + function GetJniFuncType(d: TDef): string; + function GetJavaClassName(cls: TDef; it: TDef): string; + procedure RegisterPseudoClass(d: TDef); + function GetPasIntType(Size: integer): string; +// procedure AddCustomProc(ParentDef: TDef; const JniName, Name: string; RetType: TBasicType; const Params: array of TBasicType); + function AddCustomProc(ParentDef: TDef; const JniName, Name: string; RetType: TBasicType; const Params: array of TBasicType): TProcDef; + procedure AddNativeMethod(ParentDef: TDef; const JniName, Name, Signature: string); + function GetProcSignature(d: TProcDef): string; + procedure EHandlerStart; + procedure EHandlerEnd(const EnvVarName: string; const ExtraCode: string = ''); + + procedure WriteClassInfoVar(d: TDef); + procedure WriteComment(d: TDef; const AType: string); + procedure WriteClass(d: TDef; PreInfo: boolean); + procedure WriteProc(d: TProcDef; Variable: TVarDef = nil; AParent: TDef = nil); + procedure WriteVar(d: TVarDef; AParent: TDef = nil); + procedure WriteConst(d: TConstDef); + procedure WriteEnum(d: TDef); + procedure WriteProcType(d: TProcDef; PreInfo: boolean); + procedure WriteSet(d: TSetDef); + procedure WriteUnit(u: TUnitDef); + procedure WriteOnLoad; + public + SearchPath: string; + LibName: string; + JavaPackage: string; + Units: TStringList; + OutPath: string; + JavaOutPath: string; + IncludeList: TStringList; + ExcludeList: TStringList; + + constructor Create; + destructor Destroy; override; + procedure ProcessUnits; + end; + +implementation + +const + JNIType: array[TBasicType] of string = + ('', 'jshort', 'jbyte', 'jint', 'jshort', 'jlong', 'jint', 'jlong', 'jfloat', 'jdouble', 'jstring', + 'jstring', 'jboolean', 'jchar', 'jchar', 'jint', 'jlong', 'jstring'); + JNITypeSig: array[TBasicType] of string = + ('V', 'S', 'B', 'I', 'S', 'J', 'I', 'J', 'F', 'D', 'Ljava/lang/String;', 'Ljava/lang/String;', + 'Z', 'C', 'C', 'I', 'J', 'Ljava/lang/String;'); + JavaType: array[TBasicType] of string = + ('void', 'short', 'byte', 'int', 'short', 'long', 'int', 'long', 'float', 'double', 'String', + 'String', 'boolean', 'char', 'char', 'int', 'long', 'String'); + + TextIndent = 2; + + ExcludeStd: array[1..43] of string = ( + 'classes.TStream.ReadComponent', 'classes.TStream.ReadComponentRes', 'classes.TStream.WriteComponent', 'classes.TStream.WriteComponentRes', + 'classes.TStream.WriteDescendent', 'classes.TStream.WriteDescendentRes', 'classes.TStream.WriteResourceHeader', 'classes.TStream.FixupResourceHeader', + 'classes.TStream.ReadResHeader', 'classes.TComponent.WriteState', 'classes.TComponent.ExecuteAction', 'classes.TComponent.UpdateAction', + 'classes.TComponent.GetEnumerator', 'classes.TComponent.VCLComObject', 'classes.TComponent.DesignInfo', 'classes.TComponent.Destroying', + 'classes.TComponent.FreeNotification', 'classes.TComponent.RemoveFreeNotification', 'classes.TComponent.FreeOnRelease', 'classes.TComponent.SetSubComponent', + 'system.TObject.newinstance', 'system.TObject.FreeInstance', 'system.TObject.SafeCallException', 'system.TObject.InitInstance', + 'system.TObject.CleanupInstance', 'system.TObject.ClassInfo', 'system.TObject.AfterConstruction', 'system.TObject.BeforeDestruction', + 'system.TObject.GetInterfaceEntry', 'system.TObject.GetInterfaceTable', 'system.TObject.MethodAddress', 'system.TObject.MethodName', + 'system.TObject.FieldAddress', 'classes.TComponent.ComponentState', 'classes.TComponent.ComponentStyle', 'classes.TList.GetEnumerator', + 'classes.TList.List', 'classes.TList.FPOAttachObserver', 'classes.TList.FPODetachObserver', 'classes.TList.FPONotifyObservers', + 'classes.TPersistent.FPOAttachObserver', 'classes.TPersistent.FPODetachObserver', 'classes.TPersistent.FPONotifyObservers' + ); + + ExcludeDelphi7: array[1..25] of string = ( + 'system.TObject.StringMessageTable', 'system.TObject.GetInterfaceEntryByStr', 'system.TObject.UnitName', 'system.TObject.Equals', + 'system.TObject.GetHashCode', 'system.TObject.ToString','classes.TStream.ReadByte', 'classes.TStream.ReadWord', + 'classes.TStream.ReadDWord', 'classes.TStream.ReadQWord', 'classes.TStream.ReadAnsiString', 'classes.TStream.WriteByte', + 'classes.TStream.WriteWord', 'classes.TStream.WriteDWord', 'classes.TStream.WriteQWord', 'classes.TStream.WriteAnsiString', + 'classes.TCollection.Exchange', 'classes.TStrings.Equals', 'classes.TStrings.GetNameValue', 'classes.TStrings.ExtractName', + 'classes.TStrings.TextLineBreakStyle', 'classes.TStrings.StrictDelimiter', 'classes.TStrings.GetEnumerator', 'classes.TStringList.OwnsObjects', + 'classes.TList.AddList' + ); + + SUnsupportedType = ''; + +function JniCaliing: string; +begin + Result:='{$ifdef windows} stdcall {$else} cdecl {$endif};'; +end; + +{ TTextOutStream } + +procedure TTextOutStream.SetIndednt(const AValue: integer); +begin + if FIndent = AValue then exit; + FIndent:=AValue; + SetLength(FIndStr, FIndent*TextIndent); + if FIndent > 0 then + FillChar(FIndStr[1], FIndent*TextIndent, ' '); +end; + +procedure TTextOutStream.Write(const s: ansistring); +begin + WriteBuffer(PChar(s)^, Length(s)); +end; + +procedure TTextOutStream.WriteLn(const s: ansistring; ExtraIndent: integer); +begin + if s = '' then + Write(LineEnding) + else begin + Indent:=Indent + ExtraIndent; + try + Write(FIndStr + s + LineEnding); + finally + Indent:=Indent - ExtraIndent; + end; + end; +end; + +procedure TTextOutStream.IncI; +begin + Indent:=Indent + 1; +end; + +procedure TTextOutStream.DecI; +begin + if Indent > 0 then + Indent:=Indent - 1; +end; + +type + { TClassInfo } + TClassInfo = class + public + Def: TDef; + Funcs: TObjectList; + IsCommonClass: boolean; + constructor Create; + destructor Destroy; override; + end; + + TProcInfo = class + public + Name: string; + JniName: string; + JniSignature: string; + end; + +{ TClassInfo } + +constructor TClassInfo.Create; +begin + Funcs:=TObjectList.Create(True); +end; + +destructor TClassInfo.Destroy; +begin + Funcs.Free; + inherited Destroy; +end; + +{ TWriter } + +function TWriter.DefToJniType(d: TDef; var err: boolean): string; +begin + if d = nil then begin + Result:=SUnsupportedType; + err:=True; + end + else begin + if not d.IsUsed then begin + Result:=' ' + d.Name; + err:=True; + end + else + case d.DefType of + dtType: + Result:=JNIType[TTypeDef(d).BasicType]; + dtClass, dtRecord, dtEnum: + Result:='jobject'; + dtProcType: + if poMethodPtr in TProcDef(d).ProcOpt then + Result:='jobject' + else begin + Result:=SUnsupportedType + ' ' + d.Name; + err:=True; + end; + dtSet: + if TSetDef(d).Size <= 4 then + Result:='jobject' + else begin + Result:=SUnsupportedType + ' ' + d.Name; + err:=True; + end; + else begin + Result:=SUnsupportedType + ' ' + d.Name; + err:=True; + d.SetNotUsed; + end; + end; + end; +end; + +function TWriter.DoCheckItem(const ItemName: string): TCheckItemResult; +begin + if IncludeList.IndexOf(ItemName) >= 0 then + Result:=crInclude + else + if ExcludeList.IndexOf(ItemName) >= 0 then + Result:=crExclude + else + Result:=crDefault; +end; + +procedure TWriter.ProcessRules(d: TDef; const Prefix: string); +var + i: integer; + s: string; +begin + s:=Prefix + d.Name; + i:=IncludeList.IndexOf(s); + if i >= 0 then begin + i:=ptruint(IncludeList.Objects[i]); + if (i = 0) or (d.Count = i - 1) then + d.IsUsed:=True; + end + else + if ExcludeList.IndexOf(s) >= 0 then begin + d.SetNotUsed; + end; + if not (d.DefType in [dtUnit, dtClass, dtRecord]) then + exit; + s:=s + '.'; + for i:=0 to d.Count - 1 do + ProcessRules(d[i], s); +end; + +function TWriter.GetUniqueNum: integer; +begin + Inc(FUniqueCnt); + Result:=FUniqueCnt; +end; + +function TWriter.DefToJniSig(d: TDef): string; +begin + if d = nil then + Result:=SUnsupportedType + else + case d.DefType of + dtType: + Result:=JNITypeSig[TTypeDef(d).BasicType]; + dtClass, dtRecord, dtProcType, dtSet, dtEnum: + Result:='L' + GetJavaClassPath(d) + ';'; + else + Result:=SUnsupportedType; + end; +end; + +function TWriter.DefToJavaType(d: TDef): string; +begin + if d = nil then + Result:=SUnsupportedType + else + case d.DefType of + dtType: + Result:=JavaType[TTypeDef(d).BasicType]; + dtClass, dtRecord, dtProcType, dtSet, dtEnum: + Result:=d.Name; + else + Result:=SUnsupportedType; + end; +end; + +function TWriter.GetJavaClassPath(d: TDef; const AClassName: string): string; +var + n: string; +begin + if AClassName = '' then + n:=d.AliasName + else + n:=AClassName; + Result:=StringReplace(JavaPackage, '.', '/', [rfReplaceAll]); + if Result <> '' then + Result:=Result + '/'; + if d.DefType = dtUnit then + Result:=Result + n + else + Result:=Result + d.Parent.AliasName + '$' + n; +end; + +procedure TWriter.WriteClass(d: TDef; PreInfo: boolean); +var + WrittenItems: TList; + + procedure _WriteConstructors(c: TClassDef; Written: TStringList); + var + i, j: integer; + p: TProcDef; + OldRet: TDef; + s: string; + begin + if c = nil then + exit; + for i:=0 to c.Count - 1 do + with c[i] do begin + if (DefType = dtProc) and not c.IsPrivate and (TProcDef(c[i]).ProcType = ptConstructor) then begin + p:=TProcDef(c[i]); + j:=Written.IndexOf(p.Name); + if (j < 0) or (Written.Objects[j] = c) then begin + s:=p.Name + ':'; + for j:=0 to p.Count - 1 do + s:=s + DefToJniSig(p[j]); + if Written.IndexOf(s) < 0 then begin + OldRet:=p.ReturnType; + p.ReturnType:=d; + p.Parent:=d; + try + WriteProc(p); + finally + p.ReturnType:=OldRet; + p.Parent:=c; + end; + Written.Add(s); + if not (poOverload in p.ProcOpt) then + Written.AddObject(p.Name, c); + end; + end; + end; + end; + + _WriteConstructors(c.AncestorClass, Written); + end; + + procedure WriteConstructors; + var + cc: TStringList; + begin + if not TClassDef(d).HasAbstractMethods then begin + // Writing all constructors including parent's + cc:=TStringList.Create; + try + cc.Sorted:=True; + _WriteConstructors(TClassDef(d), cc); + finally + cc.Free; + end; + end; + end; + + procedure _WriteReplacedItems(c: TClassDef); + var + i: integer; + p: TReplDef; + begin + c:=c.AncestorClass; + if c = nil then + exit; + if c.HasReplacedItems then begin + for i:=0 to c.Count - 1 do + with c[i] do begin + p:=TReplDef(c[i]); + if (DefType in ReplDefs) and ((p.IsReplaced) or p.IsReplImpl) then begin + if p.ReplacedItem <> nil then + WrittenItems.Add(p.ReplacedItem); + if WrittenItems.IndexOf(p) >= 0 then + continue; + case p.DefType of + dtProc: + WriteProc(TProcDef(p), nil, d); + dtProp, dtField: + WriteVar(TVarDef(p), d); + end; + end; + end; + end; + _WriteReplacedItems(c); + end; + + procedure WriteReplacedItems; + begin + _WriteReplacedItems(TClassDef(d)); + end; + + procedure WriteItems(Regular, Replaced, ReplImpl: boolean); + var + i: integer; + it: TReplDef; + begin + for i:=0 to d.Count - 1 do begin + it:=TReplDef(d[i]); + if not (it.DefType in ReplDefs) then + continue; + if not (it.IsReplImpl or it.IsReplaced) then begin + if not Regular then + continue; + end + else + if (not Replaced and it.IsReplaced) or (not ReplImpl and it.IsReplImpl) then + continue; + if it.ReplacedItem <> nil then + WrittenItems.Add(it.ReplacedItem); + case it.DefType of + dtProc: + if TProcDef(it).ProcType <> ptConstructor then + WriteProc(TProcDef(it)); + dtProp, dtField: + WriteVar(TVarDef(it)); + end; + end; + end; + +var + s, ss: string; + RegularClass: boolean; +begin + if PreInfo then begin + WriteClassInfoVar(d); + + if d.DefType = dtRecord then begin + s:=d.Parent.Name + '.' + d.Name; + Fps.WriteLn; + Fps.WriteLn(Format('function _%s_CreateObj(env: PJNIEnv; const r: %s): jobject;', [GetClassPrefix(d), s])); + Fps.WriteLn(Format('var pr: ^%s;', [s])); + Fps.WriteLn('begin'); + Fps.IncI; + Fps.WriteLn('New(pr); pr^:=r;'); + Fps.WriteLn(Format('Result:=_CreateJavaObj(env, pr, %s);', [GetTypeInfoVar(d)])); + Fps.DecI; + Fps.WriteLn('end;'); + + Fps.WriteLn; + ss:=Format('_%s_Free', [GetClassPrefix(d)]); + Fps.WriteLn(Format('procedure %s(env: PJNIEnv; _self: JObject; r: jlong);', [ss]) + JniCaliing); + Fps.WriteLn(Format('var pr: ^%s;', [s])); + Fps.WriteLn('begin'); + Fps.WriteLn('pr:=pointer(ptruint(r));', 1); + Fps.WriteLn('Dispose(pr);', 1); + Fps.WriteLn('end;'); + + AddNativeMethod(d, ss, 'Release', '(J)V'); + end; + exit; + end; + + // Java + case d.DefType of + dtClass: + s:='class'; + dtRecord: + s:='record'; + else + s:=''; + end; + WriteComment(d, s); + s:='public static class ' + GetJavaClassName(d, nil) + ' extends '; + if d.DefType = dtClass then + with TClassDef(d) do begin + if AncestorClass <> nil then begin + ss:=AncestorClass.Name; + if ImplementsReplacedItems then + ss:='__' + ss; + s:=s + ss; + end + else + s:=s + 'PascalObject'; + end + else + s:=s + Format('%s.system.Record', [JavaPackage]); + Fjs.WriteLn(s + ' {'); + Fjs.IncI; + if d.DefType = dtRecord then begin + Fjs.WriteLn('private native void Release(long pasobj);'); + Fjs.WriteLn(Format('public %s() { }', [d.Name])); + Fjs.WriteLn(Format('public void Free() { Release(_pasobj); super.Free(); }', [d.Name])); + Fjs.WriteLn(Format('public int Size() { return %d; }', [TRecordDef(d).Size])); + end; + + WrittenItems:=TList.Create; + try + RegularClass:=(d.DefType = dtClass) and not TClassDef(d).HasReplacedItems; + if RegularClass then + WriteConstructors; + // Write regular items + WriteItems(True, False, RegularClass); + if RegularClass and TClassDef(d).ImplementsReplacedItems then + // Write implementation wrappers for replaced mehods + WriteReplacedItems; + + Fjs.DecI; + Fjs.WriteLn('}'); + Fjs.WriteLn; + + if (d.DefType = dtClass) and (TClassDef(d).HasReplacedItems) then begin + // Write replaced items + Fjs.WriteLn(Format('public static class %s extends __%0:s {', [d.AliasName])); + Fjs.IncI; + + WriteConstructors; + WriteItems(False, True, True); + + if TClassDef(d).ImplementsReplacedItems then + // Write implementation wrappers for replaced mehods + WriteReplacedItems; + + Fjs.DecI; + Fjs.WriteLn('}'); + Fjs.WriteLn; + end; + finally + WrittenItems.Free; + end; +end; + +procedure TWriter.WriteProc(d: TProcDef; Variable: TVarDef; AParent: TDef); +var + i, j, ClassIdx: integer; + s, ss: string; + err, tf: boolean; + pi: TProcInfo; + ci: TClassInfo; + IsTObject: boolean; + tempvars: TStringList; + vd: TVarDef; + UseTempObjVar: boolean; + ItemDef: TDef; +begin + ASSERT(d.DefType = dtProc); + if d.IsPrivate or not d.IsUsed then + exit; + IsTObject:=(d.Parent.DefType = dtClass) and (TClassDef(d.Parent).AncestorClass = nil); + if (d.ProcType = ptDestructor) and not IsTObject then + exit; + if Variable <> nil then + ItemDef:=Variable + else + ItemDef:=d; + tempvars:=nil; + pi:=TProcInfo.Create; + with d do + try + pi.Name:=Name; + s:=GetClassPrefix(d.Parent) + pi.Name; + pi.JniName:=s; + pi.JniSignature:=GetProcSignature(d); + if AParent = nil then begin + // Checking duplicate name + ClassIdx:=FClasses.IndexOf(GetJavaClassName(d.Parent, ItemDef)); + if ClassIdx >= 0 then begin + ci:=TClassInfo(FClasses.Objects[ClassIdx]); + j:=1; + repeat + err:=False; + for i:=0 to ci.Funcs.Count - 1 do + with TProcInfo(ci.Funcs[i]) do + if CompareText(JniName, pi.JniName) = 0 then begin + Inc(j); + pi.JniName:=Format('%s_%d', [s, j]); + err:=True; + break; + end; + until not err; + end; + + err:=False; + if ProcType in [ptFunction, ptConstructor] then + s:='function' + else + s:='procedure'; + s:=s + ' ' + pi.JniName + '(_env: PJNIEnv; _jobj: jobject'; + + UseTempObjVar:=(ProcType = ptProcedure) and (Variable <> nil) and (Variable.VarType <> nil) and (Variable.VarType.DefType = dtProcType) and (Variable.Parent.DefType <> dtUnit); + + for j:=0 to Count - 1 do + with TVarDef(Items[j]) do begin + s:=s + '; ' + Name + ': '; + if VarOpt * [voVar, voOut] = [] then + s:=s + DefToJniType(VarType, err) + else begin + s:=s + 'jarray'; + if tempvars = nil then + tempvars:=TStringList.Create; + if VarType = nil then + err:=True + else + Tag:=tempvars.AddObject('__tmp_' + Name, d.Items[j]) + 1; + end; + end; + s:=s + ')'; + + if ProcType in [ptFunction, ptConstructor] then + s:=s + ': ' + DefToJniType(ReturnType, err); + s:=s + '; ' + JniCaliing; + if err then begin + d.SetNotUsed; + s:='// ' + s; + end; + Fps.WriteLn; + Fps.WriteLn(s); + if err then + exit; + if (tempvars <> nil) or UseTempObjVar then begin + s:=''; + Fps.WriteLn('var'); + Fps.IncI; + if tempvars <> nil then begin + for i:=0 to tempvars.Count - 1 do begin + vd:=TVarDef(tempvars.Objects[i]); + Fps.WriteLn(Format('%s: %s;', [tempvars[i], vd.VarType.Name])); + if IsJavaSimpleType(vd.VarType) then begin + Fps.WriteLn(Format('%s_arr: P%s;', [tempvars[i], DefToJniType(vd.VarType, err)])); + if s = '' then + s:='__iscopy: JBoolean;'; + end; + end; + if s <> '' then + Fps.WriteLn(s); + end; + if UseTempObjVar then + Fps.WriteLn('__objvar: ' + d.Parent.Name + ';'); + Fps.DecI; + end; + Fps.WriteLn('begin'); + Fps.IncI; + EHandlerStart; + + tf:=False; + // Assign var parameter values to local vars + if tempvars <> nil then begin + for i:=0 to tempvars.Count - 1 do begin + vd:=TVarDef(tempvars.Objects[i]); + Fps.WriteLn(Format('if _env^^.GetArrayLength(_env, %s) <> 1 then _RaiseVarParamException(''%s'');', [vd.Name, vd.Name])); + if IsJavaSimpleType(vd.VarType) then begin + Fps.WriteLn(Format('%s_arr:=_env^^.Get%sArrayElements(_env, %s, __iscopy);', [tempvars[i], GetJniFuncType(vd.VarType), vd.Name])); + Fps.WriteLn(Format('if %s_arr = nil then _RaiseVarParamException(''%s'');', [tempvars[i], vd.Name])); + s:=tempvars[i] + '_arr^'; + tf:=True; + end + else + s:=Format('_env^^.GetObjectArrayElement(_env, %s, 0)', [vd.Name]); + if voVar in vd.VarOpt then + Fps.WriteLn(tempvars[i] + ':=' + JniToPasType(vd.VarType, s, False) + ';'); + end; + end; + + if tf then begin + Fps.WriteLn('try'); + Fps.IncI; + end; + + s:=''; + if Parent.DefType = dtUnit then + s:=Parent.Name + '.' + else + if ProcType = ptConstructor then + s:=Parent.Parent.Name + '.' + Parent.Name + '.' + else + s:=JniToPasType(d.Parent, '_jobj', True) + '.'; + + if Variable = nil then begin + // Regular proc + s:=s + pi.Name; + if Count > 0 then begin + s:=s + '('; + for j:=0 to Count - 1 do begin + vd:=TVarDef(Items[j]); + if vd.Tag <> 0 then + ss:=tempvars[vd.Tag - 1] + else begin + ss:=Items[j].Name; + ss:=JniToPasType(vd.VarType, ss, False); + end; + if j <> 0 then + s:=s + ', '; + s:=s + ss; + end; + s:=s + ')'; + end; + end + else begin + // Var access + if UseTempObjVar then begin + System.Delete(s, Length(s), 1); + Fps.WriteLn('__objvar:=' + s + ';'); + s:='__objvar.'; + end; + s:=s + Variable.Name; + if Variable.IndexType <> nil then begin + ASSERT(Count >= 1); + i:=1; + s:=Format('%s[%s]', [s, JniToPasType(TVarDef(Items[0]).VarType, Items[0].Name, False)]); + end + else + i:=0; + if ProcType = ptProcedure then begin + ASSERT(Count = i + 1); + if Variable.VarType.DefType = dtProcType then begin + Fps.WriteLn(Format('_RefMethodPtr(_env, TMethod(%s), False);', [s])); + ss:=Format('_RefMethodPtr(_env, TMethod(%s), True);', [s]); + end; + s:=s + ':=' + JniToPasType(TVarDef(Items[i]).VarType, Items[i].Name, False); + end; + end; + + if ProcType in [ptFunction, ptConstructor] then + s:='Result:=' + PasToJniType(ReturnType, s); + s:=s + ';'; + Fps.WriteLn(s); + + if (Variable <> nil) and UseTempObjVar then + Fps.WriteLn(ss); + + // Return var/out parameters + if tempvars <> nil then begin + for i:=0 to tempvars.Count - 1 do begin + vd:=TVarDef(tempvars.Objects[i]); + if IsJavaSimpleType(vd.VarType) then + Fps.WriteLn(Format('%s_arr^:=%s;', [tempvars[i], PasToJniType(vd.VarType, tempvars[i])])) + else + Fps.WriteLn(Format('_env^^.SetObjectArrayElement(_env, %s, 0, %s);', [vd.Name, PasToJniType(vd.VarType, tempvars[i])])); + end; + end; + + if IsTObject and ( (ProcType = ptDestructor) or (CompareText(Name, 'Free') = 0) ) then + Fps.WriteLn(Format('_env^^.SetLongField(_env, _jobj, %s.ObjFieldId, 0);', [GetTypeInfoVar(d.Parent)])); + + if tf then begin + Fps.WriteLn('finally', -1); + + if tempvars <> nil then begin + for i:=0 to tempvars.Count - 1 do begin + vd:=TVarDef(tempvars.Objects[i]); + if IsJavaSimpleType(vd.VarType) then + Fps.WriteLn(Format('_env^^.Release%sArrayElements(_env, %s, %s_arr, 0);', [JavaType[TTypeDef(vd.VarType).BasicType], vd.Name, tempvars[i]])); + end; + end; + + Fps.DecI; + Fps.WriteLn('end;'); + end; + + s:=''; + if ProcType in [ptFunction, ptConstructor] then begin + s:='0'; + if (ReturnType.DefType = dtType) and (TTypeDef(ReturnType).BasicType <= btDouble) then + s:='0' + else + s:=Format('%s(0)', [DefToJniType(ReturnType, err)]); + s:='Result:=' + s + ';'; + end; + EHandlerEnd('_env', s); + + Fps.DecI; + Fps.WriteLn('end;'); + AParent:=d.Parent; + end + else + ClassIdx:=FClasses.IndexOf(GetJavaClassName(AParent, ItemDef)); + + if ClassIdx < 0 then begin + ci:=TClassInfo.Create; + ci.Def:=AParent; + s:=GetJavaClassName(AParent, ItemDef); + ci.IsCommonClass:=s <> AParent.Name; + ClassIdx:=FClasses.AddObject(s, ci); + end; + TClassInfo(FClasses.Objects[ClassIdx]).Funcs.Add(pi); + pi:=nil; + + // Java part + s:=GetJavaProcDeclaration(d) + ';'; + if (Parent.DefType = dtUnit) or (ProcType = ptConstructor) then + s:='static ' + s; + + if Variable = nil then + Fjs.WriteLn('// ' + GetProcDeclaration(d)); + if poPrivate in ProcOpt then + ss:='private' + else + if poProtected in ProcOpt then + ss:='protected' + else + ss:='public'; + Fjs.WriteLn(ss + ' native ' + s); + finally + pi.Free; + tempvars.Free; + end; +end; + +procedure TWriter.WriteVar(d: TVarDef; AParent: TDef); +var + pd: TProcDef; + t: TTypeDef; + s: string; +begin + if not d.IsUsed then + exit; + if d.VarType <> nil then begin + case d.DefType of + dtVar: + s:='var'; + dtProp: + s:='property'; + else + s:=''; + end; + s:=Trim(s + ' ' + d.Name); + if d.IndexType <> nil then + s:=s + '[]'; + Fjs.WriteLn(Format('// %s: %s', [s, d.VarType.Name])); + end; + + if voRead in d.VarOpt then begin + pd:=TProcDef.Create(nil, dtProc); + try + pd.IsUsed:=True; + pd.Parent:=d.Parent; + pd.ProcType:=ptFunction; + pd.Name:='get' + d.Name; + pd.ReturnType:=d.VarType; + if d.IndexType <> nil then + with TVarDef.Create(pd, dtParam) do begin + Name:='_Index'; + AliasName:='Index'; + VarType:=d.IndexType; + VarOpt:=[voRead]; + end; + WriteProc(pd, d, AParent); + finally + pd.Free; + end; + end; + + if voWrite in d.VarOpt then begin + pd:=TProcDef.Create(nil, dtProc); + try + pd.IsUsed:=True; + pd.Parent:=d.Parent; + pd.ProcType:=ptProcedure; + pd.Name:='set' + d.Name; + if d.IndexType <> nil then + with TVarDef.Create(pd, dtParam) do begin + Name:='_Index'; + AliasName:='Index'; + VarType:=d.IndexType; + VarOpt:=[voRead]; + end; + with TVarDef.Create(pd, dtParam) do begin + Name:='_Value'; + AliasName:='Value'; + VarType:=d.VarType; + VarOpt:=[voRead]; + end; + t:=TTypeDef.Create(nil, dtType); + try + t.BasicType:=btVoid; + pd.ReturnType:=t; + WriteProc(pd, d, AParent); + finally + t.Free; + end; + finally + pd.Free; + end; + end; +end; + +procedure TWriter.WriteConst(d: TConstDef); +var + s: string; +begin + if not d.IsUsed then + exit; + if d.VarType = nil then begin + if Copy(d.Value, 1, 1) = '"' then + s:='String' + else + s:='double'; + end + else + s:=DefToJavaType(d.VarType); + Fjs.WriteLn(Format('public static final %s %s = %s;', [s, d.Name, d.Value])); +end; + +procedure TWriter.WriteEnum(d: TDef); +var + i: integer; + s: string; +begin + if not d.IsUsed then + exit; + + RegisterPseudoClass(d); + + WriteComment(d, 'enum'); + Fjs.WriteLn(Format('public enum %s {', [d.Name])); + Fjs.IncI; + for i:=0 to d.Count - 1 do begin + s:=Format('%s (%s)', [d[i].Name, TConstDef(d[i]).Value]); + if i <> d.Count - 1 then + s:=s + ',' + else + s:=s + ';'; + Fjs.WriteLn(s); + end; + Fjs.WriteLn; + Fjs.WriteLn('private final int Value;'); + Fjs.WriteLn(Format('%s(int v) { Value=v; }', [d.Name])); + Fjs.WriteLn('public int Ord() { return Value; }'); + Fjs.DecI; + Fjs.WriteLn('}'); + Fjs.WriteLn; +end; + +procedure TWriter.WriteProcType(d: TProcDef; PreInfo: boolean); + + procedure _AccessSimpleArray(vd: TVarDef; VarIndex: integer; DoSet: boolean); + begin + with vd do begin + Fps.WriteLn(Format('_tmp_%s:=_env^^.Get%sArrayElements(_env, _args[%d].L, PJBoolean(nil)^);', [Name, GetJniFuncType(VarType), VarIndex])); + Fps.WriteLn(Format('if _tmp_%s <> nil then', [Name])); + if DoSet then + Fps.WriteLn(Format('_tmp_%s^:=%s;', [Name, PasToJniType(VarType, Name)]), 1) + else + Fps.WriteLn(Format('%s:=%s;', [Name, JniToPasType(VarType, '_tmp_' + Name + '^', False)]), 1); + Fps.WriteLn(Format('_env^^.Release%sArrayElements(_env, _args[%d].L, _tmp_%s, 0);', [GetJniFuncType(VarType), VarIndex, Name])); + end; + end; + +var + vd: TVarDef; + i: integer; + s, ss: string; + err: boolean; +begin + if not d.IsUsed or not (poMethodPtr in d.ProcOpt) then + exit; + + if PreInfo then begin + WriteClassInfoVar(d); + + // Handler proc + Fps.WriteLn; + vd:=TVarDef.Create(nil, dtParam); + try + vd.Name:='_data'; + vd.VarType:=TTypeDef.Create(nil, dtType); + with TTypeDef(vd.VarType) do begin + Name:='pointer'; + BasicType:=btPointer; + end; + d.Insert(0, vd); + Fps.WriteLn(GetProcDeclaration(d, Format('%sHandler', [GetClassPrefix(d)])) + ';'); + finally + vd.VarType.Free; + vd.Free; + end; + Fps.WriteLn('var'); + Fps.IncI; + Fps.WriteLn('_env: PJNIEnv;'); + Fps.WriteLn('_mpi: _TMethodPtrInfo;'); + if d.Count > 0 then begin + Fps.WriteLn(Format('_args: array[0..%d] of jvalue;', [d.Count - 1])); + for i:=0 to d.Count - 1 do + with TVarDef(d[i]) do + if (VarOpt * [voOut, voVar] <> []) and IsJavaSimpleType(VarType) then + Fps.WriteLn(Format('_tmp_%s: P%s;', [Name, DefToJniType(VarType, err)])); + end; + Fps.DecI; + Fps.WriteLn('begin'); + Fps.IncI; + Fps.WriteLn('CurJavaVM^^.GetEnv(CurJavaVM, @_env, JNI_VERSION_1_6);'); + Fps.WriteLn('_MethodPointersCS.Enter;'); + Fps.WriteLn('try'); + Fps.WriteLn('_mpi:=_TMethodPtrInfo(_MethodPointers[-integer(ptruint(_data)) - 1]);', 1); + Fps.WriteLn('finally'); + Fps.WriteLn('_MethodPointersCS.Leave;', 1); + Fps.WriteLn('end;'); + + for i:=0 to d.Count - 1 do + with TVarDef(d[i]) do begin + if VarOpt * [voOut, voVar] = [] then begin + s:='L'; + if VarType.DefType = dtType then + s:=Copy(JNITypeSig[TTypeDef(VarType).BasicType], 1, 1); + ss:=PasToJniType(VarType, Name); + end + else begin + s:='L'; + if IsJavaSimpleType(VarType) then + ss:=Format('_env^^.New%sArray(_env, 1)', [GetJniFuncType(VarType)]) + else begin + if voVar in VarOpt then + ss:=PasToJniType(VarType, Name) + else + ss:='nil'; + ss:=Format('_env^^.NewObjectArray(_env, 1, %s.ClassRef, %s)', [GetTypeInfoVar(VarType), ss]); + end; + end; + Fps.WriteLn(Format('_args[%d].%s:=%s;', [i, s, ss])); + if (voVar in VarOpt) and IsJavaSimpleType(VarType) then + _AccessSimpleArray(TVarDef(d[i]), i, True); + end; + + if d.Count > 0 then + s:='@_args' + else + s:='nil'; + // Calling Java handler + s:=Format('_env^^.Call%sMethodA(_env, _mpi.Obj, _mpi.MethodId, %s)', [GetJniFuncType(d.ReturnType), s]); + if d.ProcType = ptFunction then + s:=Format('Result:=%s', [JniToPasType(d.ReturnType, s, False)]); + Fps.WriteLn(s + ';'); + // Processing var/out parameters + for i:=0 to d.Count - 1 do + with TVarDef(d[i]) do + if VarOpt * [voOut, voVar] <> [] then + if IsJavaSimpleType(VarType) then + _AccessSimpleArray(TVarDef(d[i]), i, False) + else begin + s:=Format('_env^^.GetObjectArrayElement(_env, _args[%d].L, 0)', [i]); + Fps.WriteLn(Format('%s:=%s;', [Name, JniToPasType(VarType, s, False)])); + end; + + Fps.DecI; + Fps.WriteLn('end;'); + + // Get handler proc + Fps.WriteLn; + Fps.WriteLn(Format('function %sGetHandler(env: PJNIEnv; jobj: jobject; const ci: _TJavaClassInfo): %s.%s;', + [GetClassPrefix(d), d.Parent.Name, d.Name])); + Fps.WriteLn('var mpi: _TMethodPtrInfo;'); + Fps.WriteLn('begin'); + Fps.IncI; + Fps.WriteLn('Result:=nil;'); + Fps.WriteLn('mpi:=_TMethodPtrInfo(_GetPasObj(env, jobj, ci, False));'); + Fps.WriteLn('if mpi = nil then exit;'); + Fps.WriteLn('if mpi.Index = 0 then'); + Fps.WriteLn('TMethod(Result):=mpi.RealMethod', 1); + Fps.WriteLn('else'); + Fps.WriteLn('with TMethod(Result) do begin', 1); + Fps.WriteLn('Data:=pointer(ptruint(-integer(mpi.Index)));', 2); + Fps.WriteLn(Format('Code:=@%sHandler;', [GetClassPrefix(d)]), 2); + Fps.WriteLn('end;', 1); + Fps.DecI; + Fps.WriteLn('end;'); + + exit; + end; + + err:=False; + WriteComment(d, 'procedural type'); + + RegisterPseudoClass(d); + + Fjs.WriteLn(Format('/* Pascal prototype: %s */', [GetProcDeclaration(d, 'Execute')])); + Fjs.WriteLn(Format('/* Java prototype: %s */', [GetJavaProcDeclaration(d, 'Execute')])); + + Fjs.WriteLn(Format('public static class %s extends %s.system.MethodPtr {', [d.Name, JavaPackage])); + Fjs.IncI; + Fjs.WriteLn(Format('private String HandlerSig = "%s";', [GetProcSignature(d)])); + Fjs.WriteLn(Format('public %s(Object Obj, String MethodName) { Init(Obj, MethodName, HandlerSig); }', [d.Name])); + Fjs.WriteLn(Format('public %s() { Init(this, "Execute", HandlerSig); }', [d.Name])); + Fjs.WriteLn(Format('protected %s throws NoSuchMethodException { throw new NoSuchMethodException(); }', [GetJavaProcDeclaration(d, 'Execute')])); + Fjs.DecI; + Fjs.WriteLn('}'); + Fjs.WriteLn; +end; + +procedure TWriter.WriteSet(d: TSetDef); +begin + if not d.IsUsed then + exit; + if d.ElType = nil then + raise Exception.Create('No element type.'); + + WriteComment(d, ''); + Fjs.WriteLn(Format('/* set of %s */', [d.ElType.Name])); + if d.Size > 4 then begin + Fjs.WriteLn('/* Set size more than 32 bits is not supported */'); + exit; + end; + + RegisterPseudoClass(d); + + Fjs.WriteLn(Format('public static class %s extends %s.system.Set<%s,%s> {', [d.Name, JavaPackage, d.Name, d.ElType.Name])); + Fjs.IncI; + Fjs.WriteLn(Format('protected byte Size() { return %d; }', [d.Size])); + Fjs.WriteLn(Format('protected int Base() { return %d; }', [d.Base])); + Fjs.WriteLn(Format('protected int ElMax() { return %d; }', [d.ElMax])); + Fjs.WriteLn(Format('protected int Ord(%s Element) { return Element.Ord(); }', [d.ElType.Name])); + Fjs.WriteLn(Format('public %s() { }', [d.Name])); + Fjs.WriteLn(Format('public %s(%s... Elements) { super(Elements); }', [d.Name, d.ElType.Name])); + Fjs.WriteLn(Format('public %0:s(%0:s... Elements) { super(Elements); }', [d.Name])); + Fjs.WriteLn(Format('public static %0:s Exclude(%0:s s1, %0:s s2) { %0:s r = new %0:s(s1); r.Exclude(s2); return r; }', [d.Name])); + Fjs.WriteLn(Format('public static %0:s Intersect(%0:s s1, %0:s s2) { %0:s r = new %0:s(s1); r.Intersect(s2); return r; }', [d.Name])); + Fjs.DecI; + Fjs.WriteLn('}'); + Fjs.WriteLn; +end; + +procedure TWriter.WriteUnit(u: TUnitDef); +var + d: TDef; + i: integer; +begin + if u.Processed then + exit; + u.Processed:=True; + + if not u.IsUsed then + exit; + + for i:=0 to High(u.UsedUnits) do + WriteUnit(u.UsedUnits[i]); + + Fps.WriteLn; + Fps.WriteLn(Format('{ Unit %s }', [u.Name])); + + u.Name:=LowerCase(u.Name); + Fjs:=TTextOutStream.Create(IncludeTrailingPathDelimiter(FPkgDir) + u.Name + '.java', fmCreate); + try + Fjs.WriteLn(Format('package %s;', [JavaPackage])); + if Length(u.UsedUnits) > 0 then begin + Fjs.WriteLn; + for i:=0 to High(u.UsedUnits) do + if u.UsedUnits[i].IsUsed then + Fjs.WriteLn(Format('import %s.%s.*;', [JavaPackage, LowerCase(u.UsedUnits[i].Name)])); + end; + Fjs.WriteLn; + Fjs.WriteLn('public class ' + u.Name + ' {'); + Fjs.IncI; + if u.Name = 'system' then begin + Fjs.WriteLn('static private boolean _JniLibLoaded = false;'); + Fjs.WriteLn('public static void InitJni() {'); + Fjs.WriteLn('if (!_JniLibLoaded) {', 1); + Fjs.WriteLn('_JniLibLoaded=true;', 2); + Fjs.WriteLn(Format('System.loadLibrary("%s");', [LibName]), 2); + Fjs.WriteLn('}', 1); + Fjs.WriteLn('}'); + + // Support functions + Fjs.WriteLn('public native static long AllocMemory(int Size);'); + AddNativeMethod(u, '_AllocMemory', 'AllocMemory', '(I)J'); + + // Base object + Fjs.WriteLn; + Fjs.WriteLn('public static class PascalObject {'); + Fjs.IncI; + Fjs.WriteLn(Format('static { %s.system.InitJni(); }', [JavaPackage])); + Fjs.WriteLn('protected long _pasobj = 0;'); + Fjs.DecI; + Fjs.WriteLn('}'); + Fjs.WriteLn; + Fjs.WriteLn('public static long Pointer(PascalObject obj) { return obj._pasobj; }'); + + // Record + Fjs.WriteLn; + Fjs.WriteLn('public static class Record extends PascalObject {'); + Fjs.IncI; + Fjs.WriteLn('protected void finalize() { Free(); }'); + Fjs.WriteLn('public Record() { _pasobj = AllocMemory(Size()); }'); + Fjs.WriteLn('public void Free() { _pasobj = 0; }'); + Fjs.WriteLn('public int Size() { return 0; }'); + Fjs.DecI; + Fjs.WriteLn('}'); + + // Method pointer base class + d:=TClassDef.Create(FThisUnit, dtClass); + d.Name:='_TMethodPtrInfo'; + d.AliasName:='MethodPtr'; + WriteClassInfoVar(d); + + Fps.WriteLn; + Fps.WriteLn('procedure _TMethodPtrInfo_Init(env: PJNIEnv; _self, JavaObj: JObject; AMethodName, AMethodSig: jstring);' + JniCaliing); + Fps.WriteLn('var mpi: _TMethodPtrInfo;'); + Fps.WriteLn('begin'); + Fps.IncI; + EHandlerStart; + Fps.WriteLn('mpi:=_TMethodPtrInfo.Create(env, JavaObj, ansistring(_StringFromJString(env, AMethodName)), ansistring(_StringFromJString(env, AMethodSig)));'); + Fps.WriteLn(Format('env^^.SetLongField(env, _self, %s.ObjFieldId, Int64(ptruint(mpi)));', [GetTypeInfoVar(d)])); + EHandlerEnd('env'); + Fps.DecI; + Fps.WriteLn('end;'); + + AddNativeMethod(d, '_TMethodPtrInfo_Init', 'Init', Format('(Ljava/lang/Object;%s%s)V', [JNITypeSig[btString], JNITypeSig[btString]])); + + Fps.WriteLn; + Fps.WriteLn('procedure _TMethodPtrInfo_Release(env: PJNIEnv; _self: JObject);' + JniCaliing); + Fps.WriteLn('begin'); + Fps.IncI; + EHandlerStart; + Fps.WriteLn(Format('_TMethodPtrInfo(_GetPasObj(env, _self, %s, True)).Release(env);', [GetTypeInfoVar(d)])); + EHandlerEnd('env'); + Fps.DecI; + Fps.WriteLn('end;'); + + AddNativeMethod(d, '_TMethodPtrInfo_Release', 'Release', '()V'); + + Fjs.WriteLn; + Fjs.WriteLn('public static class MethodPtr extends PascalObject {'); + Fjs.IncI; + + Fjs.WriteLn('private native void Release();'); + Fjs.WriteLn('protected void finalize() { if (_pasobj != 0) Release(); }'); + Fjs.WriteLn('protected native void Init(Object Obj, String MethodName, String MethodSignature);'); + Fjs.DecI; + Fjs.WriteLn('}'); + Fjs.WriteLn; + + // Set base class + Fjs.WriteLn('public static class Set,TE> {'); + Fjs.IncI; + Fjs.WriteLn('protected int Value = 0;'); + Fjs.WriteLn('protected byte Size() { return 0; }'); + Fjs.WriteLn('protected int Base() { return 0; }'); + Fjs.WriteLn('protected int ElMax() { return 0; }'); + Fjs.WriteLn('protected int Ord(TE Element) { return 0; }'); + Fjs.WriteLn('protected int GetMask(TE Element) {'); + Fjs.IncI; + Fjs.WriteLn('return 1 << (Ord(Element) - Base());'); + Fjs.DecI; + Fjs.WriteLn('}'); + Fjs.WriteLn('public Set() { }'); + Fjs.WriteLn('public Set(TE... Elements) { Include(Elements); }'); + Fjs.WriteLn('public Set(TS... Elements) { for (TS e : Elements) Include(e); }'); + Fjs.WriteLn('public void Include(TE... Elements) { for (TE e: Elements) Value = Value | GetMask(e); }'); + Fjs.WriteLn('public void Include(TS s) { Value=Value | s.Value; }'); + Fjs.WriteLn('public void Exclude(TE... Elements) { for (TE e: Elements) Value = Value & ~GetMask(e); }'); + Fjs.WriteLn('public void Exclude(TS s) { Value=Value & ~s.Value; }'); + Fjs.WriteLn('public void Assign(TS s) { Value=s.Value; }'); + Fjs.WriteLn('public void Intersect(TS s) { Value=Value & s.Value; }'); + Fjs.WriteLn('public boolean Compare(TS s) { return Value == s.Value; }'); + Fjs.WriteLn('public boolean Has(TE Element) { return (Value & GetMask(Element)) != 0; }'); + Fjs.DecI; + Fjs.WriteLn('}'); + Fjs.WriteLn; + end; + Fjs.WriteLn(Format('static { %s.system.InitJni(); }', [JavaPackage])); + Fjs.WriteLn; + + // First pass + for i:=0 to u.Count - 1 do begin + d:=u[i]; + if not d.IsUsed then + continue; + case d.DefType of + dtSet, dtEnum: + WriteClassInfoVar(d); + dtClass, dtRecord: + WriteClass(d, True); + dtProcType: + WriteProcType(TProcDef(d), True); + end; + end; + + // Second pass + for i:=0 to u.Count - 1 do begin + d:=u[i]; + if not d.IsUsed then + continue; + case d.DefType of + dtClass, dtRecord: + WriteClass(d, False); + dtProc: + WriteProc(TProcDef(d)); + dtVar, dtProp: + WriteVar(TVarDef(d)); + dtEnum: + WriteEnum(d); + dtProcType: + WriteProcType(TProcDef(d), False); + dtSet: + WriteSet(TSetDef(d)); + dtConst: + WriteConst(TConstDef(d)); + end; + end; + + Fjs.DecI; + Fjs.WriteLn('}'); + finally + Fjs.Free; + end; +end; + +procedure TWriter.WriteOnLoad; +var + i, j: integer; + ci: TClassInfo; + s, ss, fn: string; + d: TTypeDef; +begin + if FClasses.Count = 0 then + exit; + Fps.WriteLn; + Fps.WriteLn('function JNI_OnLoad(vm: PJavaVM; reserved: pointer): jint;' + JniCaliing); + + Fps.WriteLn('const'); + for i:=0 to FClasses.Count - 1 do begin + ci:=TClassInfo(FClasses.Objects[i]); + if ci.Funcs.Count = 0 then + continue; + Fps.WriteLn(Format(' _%sNativeMethods: array[0..%d] of JNINativeMethod = (', [GetClassPrefix(ci.Def, FClasses[i]), ci.Funcs.Count - 1])); + for j:=0 to ci.Funcs.Count - 1 do begin + with TProcInfo(ci.Funcs[j]) do + Fps.Write(Format(' (name: ''%s''; signature: ''%s''; fnPtr: @%s)', [Name, JniSignature, JniName])); + if j < ci.Funcs.Count - 1 then + Fps.Write(','); + Fps.WriteLn; + end; + Fps.WriteLn(' );'); + end; + + Fps.WriteLn; + Fps.WriteLn('var'); + Fps.IncI; + Fps.WriteLn('env: PJNIEnv;'); + Fps.WriteLn; + Fps.WriteLn('function _Reg(ClassName: PAnsiChar; Methods: PJNINativeMethod; Count: integer; ci: _PJavaClassInfo; const FieldName: ansistring = ''_pasobj''; const FieldSig: ansistring = ''J''): boolean;'); + Fps.WriteLn('var'); + Fps.WriteLn('c: jclass;', 1); + Fps.WriteLn('begin'); + Fps.IncI; + Fps.WriteLn('Result:=False;'); + Fps.WriteLn('c:=env^^.FindClass(env, ClassName);'); + Fps.WriteLn('if c = nil then exit;'); + Fps.WriteLn('Result:=(Count = 0) or (env^^.RegisterNatives(env, c, Methods, Count) = 0);'); + Fps.WriteLn('if Result and (ci <> nil) then begin'); + Fps.IncI; + Fps.WriteLn('ci^.ClassRef:=env^^.NewGlobalRef(env, c);'); + Fps.WriteLn('Result:=ci^.ClassRef <> nil;'); + Fps.WriteLn('if Result and (FieldName <> '''') then begin'); + Fps.WriteLn('ci^.ObjFieldId:=env^^.GetFieldID(env, ci^.ClassRef, PAnsiChar(FieldName), PAnsiChar(FieldSig));', 1); + Fps.WriteLn('Result:=ci^.ObjFieldId <> nil;', 1); + Fps.WriteLn('end;'); + Fps.DecI; + Fps.WriteLn('end;'); + Fps.DecI; + Fps.WriteLn('end;'); + Fps.WriteLn; + Fps.WriteLn('begin', -1); + Fps.WriteLn('Result:=JNI_ERR;'); + Fps.WriteLn('if vm^^.GetEnv(vm, @env, JNI_VERSION_1_6) <> JNI_OK then exit;'); + Fps.WriteLn('CurJavaVM:=vm;'); + + d:=TTypeDef.Create(nil, dtType); + try + d.BasicType:=btString; + s:=JNITypeSig[d.BasicType]; + s:=Copy(s, 2, Length(s) - 2); + Fps.WriteLn(Format('if not _Reg(''%s'', nil, 0, @%s, '''', '''') then exit;', + [s, GetTypeInfoVar(d)])); + finally + d.Free; + end; + + for i:=0 to FClasses.Count - 1 do begin + ci:=TClassInfo(FClasses.Objects[i]); + s:=GetTypeInfoVar(ci.Def); + if (s = '') or (ci.IsCommonClass) then + s:='nil' + else + s:='@' + s; + if ci.Funcs.Count = 0 then + ss:='nil' + else + ss:=Format('@_%sNativeMethods', [GetClassPrefix(ci.Def, FClasses[i])]); + fn:=''; + if ci.Def <> nil then + if ci.Def.DefType in [dtSet, dtEnum] then + fn:=', ''Value'', ''I'''; + Fps.WriteLn(Format('if not _Reg(''%s'', %s, %d, %s%s) then exit;', + [GetJavaClassPath(ci.Def, FClasses[i]), ss, ci.Funcs.Count, s, fn])); + end; + + Fps.WriteLn('Result:=JNI_VERSION_1_6;'); + Fps.DecI; + Fps.WriteLn('end;'); + Fps.WriteLn; + Fps.WriteLn('exports JNI_OnLoad;'); +end; + +function TWriter.JniToPasType(d: TDef; const v: string; CheckNil: boolean): string; +var + n: string; +begin + Result:=v; + if d = nil then + exit; + case d.DefType of + dtType: + with TTypeDef(d) do + case BasicType of + btString, btWideString: + begin + Result:=Format('_StringFromJString(_env, %s)', [Result]); + if BasicType <> btWideString then + Result:=Format('%s(%s)', [d.Name, Result]); + end; + btBoolean: + Result:=Format('LongBool(%s)', [Result]); + btChar: + Result:=Format('char(widechar(%s))', [Result]); + btWideChar: + Result:=Format('widechar(%s)', [Result]); + btEnum: + Result:=Format('%s(%s)', [d.Name, Result]); + btPointer: + Result:=Format('pointer(ptruint(%s))', [Result]); + btGuid: + Result:=Format('StringToGUID(ansistring(_StringFromJString(_env, %s)))', [Result]); + end; + dtClass: + begin + if CheckNil then + n:='True' + else + n:='False'; + Result:=Format('%s.%s(_GetPasObj(_env, %s, %s, %s))', [d.Parent.Name, d.Name, Result, GetTypeInfoVar(d), n]); + end; + dtRecord: + Result:=Format('%s.%s(_GetPasObj(_env, %s, %s, True)^)', [d.Parent.Name, d.Name, Result, GetTypeInfoVar(d)]); + dtProcType: + Result:=Format('%sGetHandler(_env, %s, %s)', [GetClassPrefix(d), Result, GetTypeInfoVar(d)]); + dtEnum: + Result:=Format('%s.%s(_GetIntObjValue(_env, %s, %s))', [d.Parent.Name, d.Name, Result, GetTypeInfoVar(d)]); + dtSet: + Result:=Format('%s.%s(%s(_GetIntObjValue(_env, %s, %s)))', [d.Parent.Name, d.Name, GetPasIntType(TSetDef(d).Size), Result, GetTypeInfoVar(d)]); + end; +end; + +function TWriter.PasToJniType(d: TDef; const v: string): string; +begin + Result:=v; + if d = nil then + exit; + case d.DefType of + dtType: + with TTypeDef(d) do + case BasicType of + btString, btWideString: + Result:=Format('_StringToJString(_env, _JNIString(%s))', [Result]); + btBoolean: + Result:=Format('jboolean(LongBool(%s))', [Result]); + btChar: + Result:=Format('jchar(widechar(%s))', [Result]); + btWideChar: + Result:=Format('jchar(%s)', [Result]); + btEnum: + Result:=Format('jint(%s)', [Result]); + btPointer: + Result:=Format('ptruint(pointer(%s))', [Result]); + btGuid: + Result:=Format('_StringToJString(_env, _JNIString(GUIDToString(%s)))', [Result]); + end; + dtClass: + Result:=Format('_CreateJavaObj(_env, %s, %s)', [Result, GetTypeInfoVar(d)]); + dtRecord: + Result:=Format('_%s_CreateObj(_env, %s)', [GetClassPrefix(d), Result]); + dtProcType: + Result:=Format('_CreateMethodPtrObject(_env, TMethod(%s), %s)', [Result, GetTypeInfoVar(d)]); + dtEnum: + Result:=Format('_CreateIntObj(_env, longint(%s), %s)', [Result, GetTypeInfoVar(d)]); + dtSet: + Result:=Format('_CreateIntObj(_env, %s(%s), %s)', [GetPasIntType(TSetDef(d).Size), Result, GetTypeInfoVar(d)]); + end; +end; + +function TWriter.GetTypeInfoVar(ClassDef: TDef): string; +begin + if ClassDef.DefType = dtUnit then + Result:='' + else + if ClassDef.DefType = dtType then + Result:='_Java_' + JavaType[TTypeDef(ClassDef).BasicType] + '_Info' + else + Result:='_JNI_' + ClassDef.Parent.Name + '_' + ClassDef.Name + '_Info'; +end; + +function TWriter.GetClassPrefix(ClassDef: TDef; const AClassName: string): string; +begin + if AClassName = '' then + Result:=ClassDef.Name + else + Result:=AClassName; + Result:=Result + '_'; + if ClassDef.DefType <> dtUnit then + Result:=ClassDef.Parent.Name + '_' + Result; + Result:='JNI_' + Result; +end; + +function TWriter.IsJavaSimpleType(d: TDef): boolean; +begin + Result:=(d <> nil) and (d.DefType = dtType) and (Length(JNITypeSig[TTypeDef(d).BasicType]) = 1); +end; + +function TWriter.GetProcDeclaration(d: TProcDef; const ProcName: string): string; +var + s, ss: string; + j: integer; +begin + with d do begin + if Count > 0 then + s:='(' + else + s:=''; + for j:=0 to Count - 1 do + with TVarDef(Items[j]) do begin + if j > 0 then + s:=s + '; '; + if voVar in VarOpt then + s:=s + 'var ' + else + if voOut in VarOpt then + s:=s + 'out ' + else + if voConst in VarOpt then + s:=s + 'const '; + s:=s + Name + ': ' + VarType.Name; + end; + + if Count > 0 then + s:=s + ')'; + case ProcType of + ptConstructor: + ss:='constructor'; + ptDestructor: + ss:='destructor'; + ptProcedure: + ss:='procedure'; + ptFunction: + ss:='function'; + else + ss:=''; + end; + if ProcType in [ptConstructor, ptFunction] then + s:=s + ': ' + ReturnType.Name; + ss:=ss + ' '; + if ProcName <> '' then + ss:=ss + ProcName + else + ss:=ss + Name; + Result:=ss + s; + end; +end; + +function TWriter.GetJavaProcDeclaration(d: TProcDef; const ProcName: string): string; +var + s: string; + j: integer; +begin + with d do begin + if ProcName <> '' then + s:=ProcName + else + s:=AliasName; + s:=DefToJavaType(ReturnType) + ' ' + s + '('; + for j:=0 to Count - 1 do + with TVarDef(Items[j]) do begin + if j > 0 then + s:=s + ', '; + s:=s + DefToJavaType(VarType); + if VarOpt * [voVar, voOut] <> [] then + s:=s + '[]'; + s:=s + ' ' + AliasName; + end; + s:=s + ')'; + end; + Result:=s; +end; + +function TWriter.GetJniFuncType(d: TDef): string; +begin + if IsJavaSimpleType(d) then begin + Result:=JavaType[TTypeDef(d).BasicType]; + Result[1]:=UpCase(Result[1]); + end + else + Result:='Object'; +end; + +function TWriter.GetJavaClassName(cls: TDef; it: TDef): string; +begin + Result:=cls.AliasName; + if (cls.DefType <> dtClass) or ((it <> nil) and not (it.DefType in ReplDefs)) then + exit; + with TClassDef(cls) do begin + if not (HasReplacedItems or ImplementsReplacedItems) then + exit; + if ImplementsReplacedItems and not HasReplacedItems then + exit; + if it <> nil then + with TReplDef(it) do begin + if (it.DefType = dtProc) and (TProcDef(it).ProcType = ptConstructor) then + exit; + if IsReplaced or IsReplImpl then + exit; + end; + end; + Result:='__' + Result; +end; + +procedure TWriter.RegisterPseudoClass(d: TDef); +var + ci: TClassInfo; +begin + if FClasses.IndexOf(d.Name) < 0 then begin + ci:=TClassInfo.Create; + ci.Def:=d; + FClasses.AddObject(d.Name, ci); + end; +end; + +function TWriter.GetPasIntType(Size: integer): string; +begin + case Size of + 1: Result:='byte'; + 2: Result:='word'; + else + Result:='cardinal'; + end; +end; + +function TWriter.AddCustomProc(ParentDef: TDef; const JniName, Name: string; RetType: TBasicType; const Params: array of TBasicType): TProcDef; +var + i: integer; + vd: TVarDef; +begin + Result:=TProcDef.Create(ParentDef, dtProc); + Result.Name:=JniName; + Result.AliasName:=Name; + if RetType = btVoid then + Result.ProcType:=ptProcedure + else + Result.ProcType:=ptFunction; + for i:=0 to High(Params) do begin + vd:=TVarDef.Create(Result, dtParam); + vd.Name:=Format('p%d', [i + 1]); + vd.VarType:=TTypeDef.Create(vd, dtType); + TTypeDef(vd.VarType).BasicType:=Params[i]; + end; + Result.ReturnType:=TTypeDef.Create(ParentDef, dtType); + TTypeDef(Result.ReturnType).BasicType:=RetType; +end; + +procedure TWriter.AddNativeMethod(ParentDef: TDef; const JniName, Name, Signature: string); +var + i: integer; + ci: TClassInfo; + pi: TProcInfo; +begin + pi:=TProcInfo.Create; + pi.Name:=Name; + pi.JniName:=JniName; + pi.JniSignature:=Signature; + i:=FClasses.IndexOf(ParentDef.AliasName); + if i < 0 then begin + ci:=TClassInfo.Create; + ci.Def:=ParentDef; + i:=FClasses.AddObject(ParentDef.AliasName, ci); + end; + TClassInfo(FClasses.Objects[i]).Funcs.Add(pi); +end; + +function TWriter.GetProcSignature(d: TProcDef): string; +var + j: integer; +begin + Result:='('; + for j:=0 to d.Count - 1 do + with TVarDef(d[j]) do begin + if VarOpt * [voVar, voOut] <> [] then + Result:=Result + '['; + Result:=Result + DefToJniSig(VarType); + end; + Result:=Result + ')' + DefToJniSig(d.ReturnType); +end; + +procedure TWriter.EHandlerStart; +begin + Fps.WriteLn('try'); + Fps.IncI; +end; + +procedure TWriter.EHandlerEnd(const EnvVarName: string; const ExtraCode: string); +begin + Fps.WriteLn('except', -1); + Fps.WriteLn(Format('_HandleJNIException(%s);', [EnvVarName])); + if ExtraCode <> '' then + Fps.WriteLn(ExtraCode); + Fps.DecI; + Fps.WriteLn('end;'); +end; + +procedure TWriter.WriteClassInfoVar(d: TDef); +begin + Fps.WriteLn; + Fps.WriteLn(Format('var %s: _TJavaClassInfo;', [GetTypeInfoVar(d)])); +end; + +procedure TWriter.WriteComment(d: TDef; const AType: string); +begin + Fps.WriteLn; + Fps.WriteLn(Format('{ %s }', [d.Name])); + + Fjs.WriteLn(Format('/* %s %s */', [AType, d.Name])); +{$ifdef DEBUG} + Fjs.WriteLn(Format('/* Ref count: %d */', [d.RefCnt])); +{$endif} +end; + +{ +procedure TWriter.AddCustomProc(ParentDef: TDef; const JniName, Name: string; RetType: TBasicType; const Params: array of TBasicType); +var + i: integer; + ci: TClassInfo; + pi: TProcInfo; +begin + pi:=TProcInfo.Create; + pi.Name:=Name; + pi.JniName:=JniName; + pi.JniSignature:='('; + for i:=0 to High(Params) do + pi.JniSignature:=pi.JniSignature + JNITypeSig[Params[i]]; + pi.JniSignature:=pi.JniSignature + ')'; + pi.JniSignature:=pi.JniSignature + JNITypeSig[RetType]; + + i:=FClasses.IndexOf(ParentDef.Name); + if i < 0 then begin + ci:=TClassInfo.Create; + ci.Def:=ParentDef; + i:=FClasses.AddObject(ParentDef.Name, ci); + end; + TClassInfo(FClasses.Objects[i]).Funcs.Add(pi); +end; +} +constructor TWriter.Create; +var + i: integer; +begin + Units:=TStringList.Create; + FClasses:=TStringList.Create; + FClasses.Sorted:=True; + JavaPackage:='pas'; + IncludeList:=TStringList.Create; + IncludeList.Duplicates:=dupIgnore; + ExcludeList:=TStringList.Create; + ExcludeList.Duplicates:=dupIgnore; + + for i:=Low(ExcludeStd) to High(ExcludeStd) do + ExcludeList.Add(ExcludeStd[i]); + for i:=Low(ExcludeDelphi7) to High(ExcludeDelphi7) do + ExcludeList.Add(ExcludeDelphi7[i]); + + FThisUnit:=TUnitDef.Create(nil, dtUnit); +end; + +destructor TWriter.Destroy; +var + i: integer; +begin + for i:=0 to FClasses.Count - 1 do + FClasses.Objects[i].Free; + FClasses.Free; + Units.Free; + IncludeList.Free; + ExcludeList.Free; + FThisUnit.Free; + inherited Destroy; +end; + +procedure TWriter.ProcessUnits; +var + p: TPPUParser; + i: integer; + s, ss: string; + d: TDef; +begin + if Units.Count = 0 then + raise Exception.Create('No unit name specified.'); + if (OutPath <> '') and not DirectoryExists(OutPath) then + raise Exception.CreateFmt('Output path "%s" does not exist.', [OutPath]); + if (JavaOutPath <> '') and not DirectoryExists(JavaOutPath) then + raise Exception.CreateFmt('Output path "%s" does not exist.', [JavaOutPath]); + if LibName = '' then + LibName:=AnsiLowerCase(ChangeFileExt(Units[0], '')) + 'jni'; + + for i:=0 to IncludeList.Count - 1 do + IncludeList[i]:=Trim(IncludeList[i]); + IncludeList.Sorted:=True; + for i:=0 to ExcludeList.Count - 1 do + ExcludeList[i]:=Trim(ExcludeList[i]); + ExcludeList.Sorted:=True; + + FThisUnit.Name:=LibName; + FThisUnit.AliasName:='system'; + + p:=TPPUParser.Create(SearchPath); + try + p.OnCheckItem:=@DoCheckItem; + for i:=0 to Units.Count - 1 do + IncludeList.Add(ChangeFileExt(ExtractFileName(Units[i]), '')); + for i:=0 to Units.Count - 1 do + p.Parse(ChangeFileExt(ExtractFileName(Units[i]), '')); + + if OutPath <> '' then + OutPath:=IncludeTrailingPathDelimiter(OutPath); + if JavaOutPath <> '' then + JavaOutPath:=IncludeTrailingPathDelimiter(JavaOutPath); + + FPkgDir:=JavaOutPath + StringReplace(JavaPackage, '.', DirectorySeparator, [rfReplaceAll]); + ForceDirectories(FPkgDir); + Fps:=TTextOutStream.Create(OutPath + LibName + '.pas', fmCreate); + + Fps.WriteLn('library '+ LibName + ';'); + Fps.WriteLn('{$ifdef fpc} {$mode objfpc} {$H+} {$endif}'); + + Fps.WriteLn; + Fps.WriteLn('uses'); + Fps.WriteLn('{$ifndef FPC} Windows, {$endif} {$ifdef unix} cthreads, {$endif} SysUtils, SyncObjs,', 1); + s:=''; + for i:=0 to p.Units.Count - 1 do begin + ProcessRules(p.Units[i]); + ss:=LowerCase(p.Units[i].Name); + if (ss ='system') or (ss = 'objpas') or (ss = 'sysutils') or (ss = 'syncobjs') or (ss = 'jni') then + continue; + if s <> '' then + s:=s + ', '; + s:=s + p.Units[i].Name; + end; + Fps.WriteLn(s + ', jni;', 1); + + // Types + Fps.WriteLn; + Fps.WriteLn('type'); + Fps.IncI; + Fps.WriteLn('_JNIString = {$ifdef FPC} unicodestring {$else} widestring {$endif};'); + Fps.WriteLn('{$ifndef FPC} ptruint = cardinal; {$endif}'); + Fps.WriteLn; + Fps.WriteLn('_TJavaClassInfo = record'); + Fps.WriteLn('ClassRef: JClass;', 1); + Fps.WriteLn('ObjFieldId: JFieldId;', 1); + Fps.WriteLn('end;'); + Fps.WriteLn('_PJavaClassInfo = ^_TJavaClassInfo;'); + Fps.DecI; + + Fps.WriteLn; + d:=TtypeDef.Create(nil, dtType); + TtypeDef(d).BasicType:=btString; + Fps.WriteLn(Format('var %s: _TJavaClassInfo;', [GetTypeInfoVar(d)])); + d.Free; + + // Support functions + Fps.WriteLn; + Fps.WriteLn('function _StringFromJString(env: PJNIEnv; s: jstring): _JNIString;'); + Fps.WriteLn('var'); + Fps.WriteLn('p: PJChar;', 1); + Fps.WriteLn('c: JBoolean;', 1); + Fps.WriteLn('begin'); + Fps.WriteLn('if s = nil then begin', 1); + Fps.WriteLn('Result:='''';', 2); + Fps.WriteLn('exit;', 2); + Fps.WriteLn('end;', 1); + Fps.WriteLn('p:=env^^.GetStringChars(env, s, c);', 1); + Fps.WriteLn('SetString(Result, PWideChar(p), env^^.GetStringLength(env, s));', 1); + Fps.WriteLn('env^^.ReleaseStringChars(env, s, p);', 1); + Fps.WriteLn('end;'); + + Fps.WriteLn; + Fps.WriteLn('function _StringToJString(env: PJNIEnv; const s: _JNIString): jstring;'); + Fps.WriteLn('begin'); + Fps.WriteLn('Result:=env^^.NewString(env, PJChar(PWideChar(s)), Length(s));', 1); + Fps.WriteLn('end;'); + + Fps.WriteLn; + Fps.WriteLn('function _CreateJavaObj(env: PJNIEnv; PasObj: pointer; const ci: _TJavaClassInfo): jobject;'); + Fps.WriteLn('begin'); + Fps.IncI; + Fps.WriteLn('Result:=nil;'); + Fps.WriteLn('Result:=env^^.AllocObject(env, ci.ClassRef);'); + Fps.WriteLn('if Result = nil then exit;'); + Fps.WriteLn('env^^.SetLongField(env, Result, ci.ObjFieldId, Int64(ptruint(PasObj)));'); + Fps.DecI; + Fps.WriteLn('end;'); + + Fps.WriteLn; + Fps.WriteLn('function _GetPasObj(env: PJNIEnv; jobj: jobject; const ci: _TJavaClassInfo; CheckNil: boolean): pointer;'); + Fps.WriteLn('var pasobj: jlong;'); + Fps.WriteLn('begin'); + Fps.IncI; + Fps.WriteLn('if jobj <> nil then'); + Fps.WriteLn('pasobj:=env^^.GetLongField(env, jobj, ci.ObjFieldId)', 1); + Fps.WriteLn('else'); + Fps.WriteLn('pasobj:=0;', 1); + Fps.WriteLn('if CheckNil and (pasobj = 0) then'); + Fps.WriteLn('raise Exception.Create(''Attempt to access a released Pascal object.'');', 1); + Fps.WriteLn('Result:=pointer(ptruint(pasobj));'); + Fps.DecI; + Fps.WriteLn('end;'); + + Fps.WriteLn; + Fps.WriteLn('procedure _HandleJNIException(env: PJNIEnv);'); + Fps.WriteLn('begin'); + Fps.WriteLn('env^^.ThrowNew(env, env^^.FindClass(env, ''java/lang/Exception''), PAnsiChar(Utf8Encode(Exception(ExceptObject).Message)));', 1); + Fps.WriteLn('end;'); + + Fps.WriteLn; + Fps.WriteLn('procedure _RaiseVarParamException(const VarName: string);'); + Fps.WriteLn('begin'); + Fps.WriteLn('raise Exception.CreateFmt(''An array with only single element must be passed as parameter "%s".'', [VarName]);', 1); + Fps.WriteLn('end;'); + + Fps.WriteLn; + Fps.WriteLn('function _AllocMemory(env: PJNIEnv; jobj: jobject; size: jint): jlong;'); + Fps.WriteLn('var p: pointer;'); + Fps.WriteLn('begin'); + Fps.WriteLn('GetMem(p, size);', 1); + Fps.WriteLn('FillChar(p^, size, 0);', 1); + Fps.WriteLn('Result:=ptruint(p);', 1); + Fps.WriteLn('end;'); + + // Method pointer support + Fps.WriteLn; + Fps.WriteLn('type'); + Fps.IncI; + Fps.WriteLn('_TMethodPtrInfo = class'); + Fps.IncI; + Fps.WriteLn('Obj: JObject;'); + Fps.WriteLn('MethodId: JMethodID;'); + Fps.WriteLn('Index, RefCnt: integer;'); + Fps.WriteLn('RealMethod: TMethod;'); + Fps.WriteLn('constructor Create(env: PJNIEnv; JavaObj: JObject; const AMethodName, AMethodSig: ansistring);'); + Fps.WriteLn('procedure Release(env: PJNIEnv);'); + Fps.DecI; + Fps.WriteLn('end;'); + Fps.DecI; + Fps.WriteLn; + Fps.WriteLn('var _MethodPointers: array of _TMethodPtrInfo;'); + Fps.WriteLn('var _MethodPointersCS: TCriticalSection;'); + Fps.WriteLn; + + Fps.WriteLn('constructor _TMethodPtrInfo.Create(env: PJNIEnv; JavaObj: JObject; const AMethodName, AMethodSig: ansistring);'); + Fps.WriteLn('var c: JClass;'); + Fps.WriteLn('begin'); + Fps.IncI; + Fps.WriteLn('RefCnt:=1;'); + Fps.WriteLn('if (JavaObj = nil) or (AMethodName = '''') then exit;'); + Fps.WriteLn('c:=env^^.GetObjectClass(env, JavaObj);'); + Fps.WriteLn('if c = nil then exit;'); + Fps.WriteLn('MethodId:=env^^.GetMethodID(env, c, PAnsiChar(AMethodName), PAnsiChar(AMethodSig));'); + Fps.WriteLn('if MethodId = nil then raise Exception.CreateFmt(''Method "%s" does not exist or has wrong parameters.'', [AMethodName]);'); + Fps.WriteLn('Obj:=env^^.NewGlobalRef(env, JavaObj);'); + Fps.WriteLn('_MethodPointersCS.Enter;'); + Fps.WriteLn('try'); + Fps.IncI; + Fps.WriteLn('Index:=Length(_MethodPointers) + 1;'); + Fps.WriteLn(Format('if Index > %d then raise Exception.Create(''Too many method pointers.'');', [MaxMethodPointers])); + Fps.WriteLn('SetLength(_MethodPointers, Index);'); + Fps.WriteLn('_MethodPointers[Index - 1]:=Self;'); + Fps.WriteLn('finally', -1); + Fps.WriteLn('_MethodPointersCS.Leave;'); + Fps.DecI; + Fps.WriteLn('end;'); + Fps.DecI; + Fps.WriteLn('end;'); + + Fps.WriteLn; + Fps.WriteLn('procedure _TMethodPtrInfo.Release(env: PJNIEnv);'); + Fps.WriteLn('var i: integer;'); + Fps.WriteLn('begin'); + Fps.IncI; + Fps.WriteLn('i:=InterlockedDecrement(RefCnt);'); + Fps.WriteLn('if i <> 0 then exit;'); + Fps.WriteLn('if Index > 0 then begin'); + Fps.IncI; + Fps.WriteLn('_MethodPointersCS.Enter;'); + Fps.WriteLn('try'); + Fps.IncI; + Fps.WriteLn('Dec(Index);'); + Fps.WriteLn('_MethodPointers[Index]:=nil;'); + Fps.WriteLn('Index:=Length(_MethodPointers);'); + Fps.WriteLn('while (Index > 0) and (_MethodPointers[Index] = nil) do Dec(Index);'); + Fps.WriteLn('SetLength(_MethodPointers, Index + 1);'); + Fps.WriteLn('finally', -1); + Fps.WriteLn('_MethodPointersCS.Leave;'); + Fps.DecI; + Fps.WriteLn('end;'); + Fps.WriteLn('env^^.DeleteGlobalRef(env, Obj);'); + Fps.DecI; + Fps.WriteLn('end;'); + Fps.WriteLn('Self.Destroy;'); + Fps.DecI; + Fps.WriteLn('end;'); + + Fps.WriteLn; + Fps.WriteLn('procedure _RefMethodPtr(env: PJNIEnv; const m: TMethod; AddRef: boolean);'); + Fps.WriteLn('var i: integer;'); + Fps.WriteLn('begin'); + Fps.IncI; + Fps.WriteLn('i:=-integer(ptruint(m.Data));'); + Fps.WriteLn(Format('if (i < 1) or (i > %d) then exit;', [MaxMethodPointers])); + Fps.WriteLn('_MethodPointersCS.Enter;'); + Fps.WriteLn('try'); + Fps.IncI; + Fps.WriteLn('with _MethodPointers[i - 1] do'); + Fps.WriteLn('if AddRef then InterlockedIncrement(RefCnt) else Release(env);', 1); + Fps.WriteLn('finally', -1); + Fps.WriteLn('_MethodPointersCS.Leave;'); + Fps.DecI; + Fps.WriteLn('end;'); + Fps.DecI; + Fps.WriteLn('end;'); + + Fps.WriteLn; + Fps.WriteLn('function _CreateMethodPtrObject(env: PJNIEnv; const m: TMethod; const ci: _TJavaClassInfo): jobject;'); + Fps.WriteLn('var i: integer;'); + Fps.WriteLn('var mpi: _TMethodPtrInfo;'); + Fps.WriteLn('begin'); + Fps.IncI; + Fps.WriteLn('_MethodPointersCS.Enter;'); + Fps.WriteLn('try'); + Fps.IncI; + Fps.WriteLn('i:=-integer(ptruint(m.Data));'); + Fps.WriteLn(Format('if (i > 0) and (i <= %d) then begin', [MaxMethodPointers])); + Fps.WriteLn('mpi:=_MethodPointers[i - 1];', 1); + Fps.WriteLn('InterlockedIncrement(mpi.RefCnt);', 1); + Fps.WriteLn('end'); + Fps.WriteLn('else begin'); + Fps.WriteLn('mpi:=_TMethodPtrInfo.Create(env, nil, '''', '''');', 1); + Fps.WriteLn('mpi.RealMethod:=m;', 1); + Fps.WriteLn('end;'); + Fps.WriteLn('finally', -1); + Fps.WriteLn('_MethodPointersCS.Leave;'); + Fps.DecI; + Fps.WriteLn('end;'); + Fps.WriteLn('Result:=_CreateJavaObj(env, pointer(mpi), ci);'); + Fps.DecI; + Fps.WriteLn('end;'); + + // Set support + Fps.WriteLn; + Fps.WriteLn('function _GetIntObjValue(env: PJNIEnv; jobj: jobject; const ci: _TJavaClassInfo): longint;'); + Fps.WriteLn('begin'); + Fps.IncI; + Fps.WriteLn('if jobj = nil then raise Exception.Create(''Attempt to access a NULL set.'');'); + Fps.WriteLn('Result:=env^^.GetIntField(env, jobj, ci.ObjFieldId);'); + Fps.DecI; + Fps.WriteLn('end;'); + Fps.WriteLn; + Fps.WriteLn('function _CreateIntObj(env: PJNIEnv; Value: longint; const ci: _TJavaClassInfo): jobject;'); + Fps.WriteLn('begin'); + Fps.IncI; + Fps.WriteLn('Result:=nil;'); + Fps.WriteLn('Result:=env^^.AllocObject(env, ci.ClassRef);'); + Fps.WriteLn('if Result = nil then exit;'); + Fps.WriteLn('env^^.SetIntField(env, Result, ci.ObjFieldId, Value);'); + Fps.DecI; + Fps.WriteLn('end;'); + + // Write units + for i:=0 to p.Units.Count - 1 do + with TUnitDef(p.Units[i]) do begin + WriteUnit(TUnitDef(p.Units[i])); + end; + + WriteOnLoad; + + Fps.WriteLn; + Fps.WriteLn('begin'); + Fps.WriteLn('IsMultiThread:=True;', 1); + Fps.WriteLn('_MethodPointersCS:=TCriticalSection.Create;', 1); + Fps.WriteLn('end.'); + finally + Fps.Free; + p.Free; + end; +end; + +end. +