+ RTL for emx target

rtl/emx/Makefile

@@ -0,0 +1,1247 @@
+#
+# Don't edit, this file is generated by FPCMake Version 1.1 [2002/10/28]
+#
+default: all
+MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx emx
+override PATH:=$(subst \,/,$(PATH))
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+$(error You need the GNU utils package to use this Makefile)
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygwin,$(MACHTYPE)),)
+inCygWin=1
+endif
+endif
+ifeq ($(OS_TARGET),freebsd)
+BSDhier=1
+endif
+ifeq ($(OS_TARGET),netbsd)
+BSDhier=1
+endif
+ifeq ($(OS_TARGET),openbsd)
+BSDhier=1
+endif
+ifdef inUnix
+BATCHEXT=.sh
+else
+ifdef inOS2
+BATCHEXT=.cmd
+else
+BATCHEXT=.bat
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+ifneq ($(findstring sh.exe,$(SHELL)),)
+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 OS_TARGET_DEFAULT=emx
+override CPU_TARGET_DEFAULT=i386
+override DEFAULT_FPCDIR=../..
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+endif
+endif
+ifndef FPC
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+FPC:=$(shell $(FPCPROG) -PB)
+ifneq ($(findstring Error,$(FPC)),)
+override FPC=ppc386
+endif
+else
+override FPC=ppc386
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+ifndef FPC_VERSION
+FPC_VERSION:=$(shell $(FPC) -iV)
+endif
+export FPC FPC_VERSION
+unexport CHECKDEPEND ALLDEPENDENCIES
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+COMPILERINFO:=$(shell $(FPC) -iSP -iTP -iSO -iTO)
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(word 1,$(COMPILERINFO))
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(word 2,$(COMPILERINFO))
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(word 3,$(COMPILERINFO))
+endif
+ifndef OS_TARGET
+OS_TARGET:=$(word 4,$(COMPILERINFO))
+endif
+else
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(shell $(FPC) -iSP)
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(shell $(FPC) -iTP)
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(shell $(FPC) -iSO)
+endif
+ifndef OS_TARGET
+OS_TARGET:=$(shell $(FPC) -iTO)
+endif
+endif
+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
+FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifneq ($(FULL_TARGET),$(FULL_SOURCE))
+CROSSCOMPILE=1
+endif
+ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
+ifeq ($(findstring $(OS_TARGET),$(MAKEFILETARGETS)),)
+$(error The Makefile doesn't support target $(OS_TARGET), please run fpcmake first)
+endif
+endif
+export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE CROSSCOMPILE
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifdef DEFAULT_FPCDIR
+ifeq ($(FPCDIR),wrong)
+override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+ifndef CROSSDIR
+CROSSDIR:=$(FPCDIR)/cross/$(FULL_TARGET)
+endif
+ifndef CROSSTARGETDIR
+CROSSTARGETDIR=$(CROSSDIR)/$(FULL_TARGET)
+endif
+ifdef CROSSCOMPILE
+UNITSDIR:=$(wildcard $(CROSSTARGETDIR)/units)
+ifeq ($(UNITSDIR),)
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+endif
+else
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+endif
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
+override PACKAGE_NAME=rtl
+RTL=..
+INC=$(RTL)/inc
+PROCINC=$(RTL)/$(CPU_TARGET)
+UNITPREFIX=rtl
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+SYSTEMUNIT=system
+else
+SYSTEMUNIT=sysos2
+endif
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl dive dos crt objects printer sysutils math typinfo varutils charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types
+override TARGET_LOADERS+=prt0 prt1
+override TARGET_RSTS+=math varutils typinfo
+override INSTALL_FPCPACKAGE=y
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) ../os2
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) ../os2
+override COMPILER_TARGETDIR+=.
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifeq ($(OS_TARGET),linux)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_TARGET),freebsd)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_TARGET),netbsd)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_TARGET),openbsd)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_TARGET),sunos)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_TARGET),qnx)
+UNIXINSTALLDIR=1
+endif
+else
+ifeq ($(OS_SOURCE),linux)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_SOURCE),freebsd)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_SOURCE),netbsd)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_SOURCE),openbsd)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_TARGET),sunos)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_TARGET),qnx)
+UNIXINSTALLDIR=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef PREFIX
+INSTALL_PREFIX=$(PREFIX)
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXINSTALLDIR
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifdef INSTALL_FPCSUBDIR
+export INSTALL_FPCSUBDIR
+endif
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef INSTALL_BASEDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXINSTALLDIR
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(OS_TARGET)
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+ifdef CROSSCOMPILE
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/cross/$(FULL_TARGET)/units
+else
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(OS_TARGET)
+endif
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXINSTALLDIR
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXINSTALLDIR
+ifdef BSDhier
+SRCPREFIXDIR=share/src
+else
+SRCPREFIXDIR=src
+endif
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXINSTALLDIR
+ifdef BSDhier
+DOCPREFIXDIR=share/doc
+else
+DOCPREFIXDIR=doc
+endif
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+endif
+else
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifdef CROSSCOMPILE
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(FULL_SOURCE))
+ifeq ($(CROSSBINDIR),)
+CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(FULL_TARGET)/bin/$(FULL_SOURCE))
+endif
+endif
+else
+CROSSBINDIR=
+endif
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+STATICLIBPREFIX=libp
+RSTEXT=.rst
+FPCMADE=fpcmade
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+STATICLIBPREFIX=
+FPCMADE=fpcmade.v1
+PACKAGESUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+FPCMADE=fpcmade.dos
+ZIPSUFFIX=go32
+endif
+ifeq ($(OS_TARGET),linux)
+EXEEXT=
+HASSHAREDLIB=1
+FPCMADE=fpcmade.lnx
+ZIPSUFFIX=linux
+endif
+ifeq ($(OS_TARGET),freebsd)
+EXEEXT=
+HASSHAREDLIB=1
+FPCMADE=fpcmade.freebsd
+ZIPSUFFIX=freebsd
+endif
+ifeq ($(OS_TARGET),netbsd)
+EXEEXT=
+HASSHAREDLIB=1
+FPCMADE=fpcmade.netbsd
+ZIPSUFFIX=netbsd
+endif
+ifeq ($(OS_TARGET),openbsd)
+EXEEXT=
+HASSHAREDLIB=1
+FPCMADE=fpcmade.openbsd
+ZIPSUFFIX=openbsd
+endif
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+FPCMADE=fpcmade.w32
+ZIPSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+AOUTEXT=.out
+SMARTEXT=.sl2
+STATICLIBPREFIX=
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+FPCMADE=fpcmade.os2
+ZIPSUFFIX=emx
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+PPUEXT=.ppu
+ASMEXT=.asm
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.library
+FPCMADE=fpcmade.amg
+endif
+ifeq ($(OS_TARGET),atari)
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=.ttp
+FPCMADE=fpcmade.ata
+endif
+ifeq ($(OS_TARGET),beos)
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+FPCMADE=fpcmade.be
+ZIPSUFFIX=be
+endif
+ifeq ($(OS_TARGET),sunos)
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+FPCMADE=fpcmade.sun
+ZIPSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+FPCMADE=fpcmade.qnx
+ZIPSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+STATICLIBPREFIX=
+PPUEXT=.ppn
+OEXT=.on
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+FPCMADE=fpcmade.nw
+ZIPSUFFIX=nw
+EXEEXT=.nlm
+endif
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE=
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL=
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG=
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG=
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG=
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef ECHOREDIR
+ECHOREDIR:=$(subst /,$(PATHSEP),$(ECHO))
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -rfp
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE=
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE=
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG=
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG=
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ASNAME=as
+LDNAME=ld
+ARNAME=ar
+RCNAME=rc
+ifeq ($(OS_TARGET),win32)
+ASNAME=asw
+LDNAME=ldw
+ARNAME=arw
+endif
+ifndef ASPROG
+ifdef CROSSBINDIR
+ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
+else
+ASPROG=$(ASNAME)
+endif
+endif
+ifndef LDPROG
+ifdef CROSSBINDIR
+LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT)
+else
+LDPROG=$(LDNAME)
+endif
+endif
+ifndef RCPROG
+ifdef CROSSBINDIR
+RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT)
+else
+RCPROG=$(RCNAME)
+endif
+endif
+ifndef ARPROG
+ifdef CROSSBINDIR
+ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT)
+else
+ARPROG=$(ARNAME)
+endif
+endif
+AS=$(ASPROG)
+LD=$(LDPROG)
+RC=$(RCPROG)
+AR=$(ARPROG)
+PPAS=ppas$(BATCHEXT)
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+export UPXPROG
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vI
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+ifndef NOCPUDEF
+override FPCOPTDEF=$(CPU_TARGET)
+endif
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifeq ($(OS_SOURCE),openbsd)
+override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+ifeq ($(CPU_TARGET),i386)
+FPCCPUOPT:=-OG2p3
+else
+FPCCPUOPT:=
+endif
+override FPCOPT+=-Xs $(FPCCPUOPT) -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+ifeq ($(CPU_TARGET),i386)
+override FPCOPT+=-OG2p3
+endif
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef CROSSBINDIR
+override FPCOPT+=-FD$(CROSSBINDIR)
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override COMPILER:=$(FPC) $(FPCOPT)
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+ifeq ($(OS_SOURCE),$(OS_TARGET))
+EXECPPAS:=@$(PPAS)
+endif
+endif
+.PHONY: fpc_loaders
+ifdef TARGET_LOADERS
+override ALLTARGET+=fpc_loaders
+override CLEANTARGET+=fpc_loaders_clean
+override INSTALLTARGET+=fpc_loaders_install
+override LOADEROFILES:=$(addsuffix $(OEXT),$(TARGET_LOADERS))
+endif
+%$(OEXT): %$(LOADEREXT)
+	$(AS) -o $*$(OEXT) $<
+fpc_loaders: $(LOADEROFILES)
+fpc_loaders_clean:
+	-$(DEL) $(LOADEROFILES)
+fpc_loaders_install:
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) $(LOADEROFILES) $(INSTALL_UNITDIR)
+.PHONY: fpc_units
+ifdef TARGET_UNITS
+override ALLTARGET+=fpc_units
+override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS))
+override IMPLICITUNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_IMPLICITUNITS))
+override INSTALLPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+override CLEANPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+endif
+fpc_units: $(UNITPPUFILES)
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_all fpc_smart fpc_debug fpc_release
+$(FPCMADE): $(ALLDEPENDENCIES) $(ALLTARGET)
+	@$(ECHOREDIR) Compiled > $(FPCMADE)
+fpc_all: $(FPCMADE)
+fpc_smart:
+	$(MAKE) all LINKSMART=1 CREATESMART=1
+fpc_debug:
+	$(MAKE) all DEBUG=1
+fpc_release:
+	$(MAKE) all RELEASE=1
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .pp .rc .res
+%$(PPUEXT): %.pp
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(PPUEXT): %.pas
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(EXEEXT): %.pp
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(EXEEXT): %.pas
+	$(COMPILER) $<
+	$(EXECPPAS)
+%.res: %.rc
+	windres -i $< -o $@
+vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALL_BUILDUNIT
+override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
+endif
+ifdef INSTALLPPUFILES
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPUFILES))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPULINKFILES)))
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(INSTALLEXEFILES))
+endif
+fpc_install: all $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+	$(MKDIR) $(INSTALL_BINDIR)
+ifdef UPXPROG
+	-$(UPXPROG) $(INSTALLEXEFILES)
+endif
+	$(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+	$(FPCMAKE) -p -T$(OS_TARGET) Makefile.fpc
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+	$(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+	$(MKDIR) $(INSTALL_LIBDIR)
+	$(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+	ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+	$(MKDIR) $(INSTALL_DATADIR)
+	$(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+	$(MKDIR) $(INSTALL_SOURCEDIR)
+	$(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+	$(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+	$(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+	$(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+	-$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+	-$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+	-$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+	-$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+	-$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+	-$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+fpc_distclean: clean
+ifdef COMPILER_UNITTARGETDIR
+TARGETDIRCLEAN=fpc_clean
+endif
+fpc_cleanall: $(CLEANTARGET) $(TARGETDIRCLEAN)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+	-$(DELTREE) *$(SMARTEXT)
+	-$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ifdef AOUTEXT
+	-$(DEL) *$(AOUTEXT)
+endif
+.PHONY: fpc_baseinfo
+override INFORULES+=fpc_baseinfo
+fpc_baseinfo:
+	@$(ECHO)
+	@$(ECHO)  == Package info ==
+	@$(ECHO)  Package Name..... $(PACKAGE_NAME)
+	@$(ECHO)  Package Version.. $(PACKAGE_VERSION)
+	@$(ECHO)
+	@$(ECHO)  == Configuration info ==
+	@$(ECHO)
+	@$(ECHO)  FPC.......... $(FPC)
+	@$(ECHO)  FPC Version.. $(FPC_VERSION)
+	@$(ECHO)  Source CPU... $(CPU_SOURCE)
+	@$(ECHO)  Target CPU... $(CPU_TARGET)
+	@$(ECHO)  Source OS.... $(OS_SOURCE)
+	@$(ECHO)  Target OS.... $(OS_TARGET)
+	@$(ECHO)  Full Source.. $(FULL_SOURCE)
+	@$(ECHO)  Full Target.. $(FULL_TARGET)
+	@$(ECHO)
+	@$(ECHO)  == Directory info ==
+	@$(ECHO)
+	@$(ECHO)  Required pkgs... $(REQUIRE_PACKAGES)
+	@$(ECHO)
+	@$(ECHO)  Basedir......... $(BASEDIR)
+	@$(ECHO)  FPCDir.......... $(FPCDIR)
+	@$(ECHO)  CrossBinDir..... $(CROSSBINDIR)
+	@$(ECHO)  UnitsDir........ $(UNITSDIR)
+	@$(ECHO)  PackagesDir..... $(PACKAGESDIR)
+	@$(ECHO)
+	@$(ECHO)  GCC library..... $(GCCLIBDIR)
+	@$(ECHO)  Other library... $(OTHERLIBDIR)
+	@$(ECHO)
+	@$(ECHO)  == Tools info ==
+	@$(ECHO)
+	@$(ECHO)  As........ $(AS)
+	@$(ECHO)  Ld........ $(LD)
+	@$(ECHO)  Ar........ $(AR)
+	@$(ECHO)  Rc........ $(RC)
+	@$(ECHO)
+	@$(ECHO)  Mv........ $(MVPROG)
+	@$(ECHO)  Cp........ $(CPPROG)
+	@$(ECHO)  Rm........ $(RMPROG)
+	@$(ECHO)  GInstall.. $(GINSTALL)
+	@$(ECHO)  Echo...... $(ECHO)
+	@$(ECHO)  Shell..... $(SHELL)
+	@$(ECHO)  Date...... $(DATE)
+	@$(ECHO)  FPCMake... $(FPCMAKE)
+	@$(ECHO)  PPUMove... $(PPUMOVE)
+	@$(ECHO)  Upx....... $(UPXPROG)
+	@$(ECHO)  Zip....... $(ZIPPROG)
+	@$(ECHO)
+	@$(ECHO)  == Object info ==
+	@$(ECHO)
+	@$(ECHO)  Target Loaders........ $(TARGET_LOADERS)
+	@$(ECHO)  Target Units.......... $(TARGET_UNITS)
+	@$(ECHO)  Target Implicit Units. $(TARGET_IMPLICITUNITS)
+	@$(ECHO)  Target Programs....... $(TARGET_PROGRAMS)
+	@$(ECHO)  Target Dirs........... $(TARGET_DIRS)
+	@$(ECHO)  Target Examples....... $(TARGET_EXAMPLES)
+	@$(ECHO)  Target ExampleDirs.... $(TARGET_EXAMPLEDIRS)
+	@$(ECHO)
+	@$(ECHO)  Clean Units......... $(CLEAN_UNITS)
+	@$(ECHO)  Clean Files......... $(CLEAN_FILES)
+	@$(ECHO)
+	@$(ECHO)  Install Units....... $(INSTALL_UNITS)
+	@$(ECHO)  Install Files....... $(INSTALL_FILES)
+	@$(ECHO)
+	@$(ECHO)  == Install info ==
+	@$(ECHO)
+	@$(ECHO)  DateStr.............. $(DATESTR)
+	@$(ECHO)  ZipPrefix............ $(ZIPPREFIX)
+	@$(ECHO)  ZipSuffix............ $(ZIPSUFFIX)
+	@$(ECHO)  Install FPC Package.. $(INSTALL_FPCPACKAGE)
+	@$(ECHO)
+	@$(ECHO)  Install base dir..... $(INSTALL_BASEDIR)
+	@$(ECHO)  Install binary dir... $(INSTALL_BINDIR)
+	@$(ECHO)  Install library dir.. $(INSTALL_LIBDIR)
+	@$(ECHO)  Install units dir.... $(INSTALL_UNITDIR)
+	@$(ECHO)  Install source dir... $(INSTALL_SOURCEDIR)
+	@$(ECHO)  Install doc dir...... $(INSTALL_DOCDIR)
+	@$(ECHO)  Install example dir.. $(INSTALL_EXAMPLEDIR)
+	@$(ECHO)  Install data dir..... $(INSTALL_DATADIR)
+	@$(ECHO)
+	@$(ECHO)  Dist destination dir. $(DIST_DESTDIR)
+	@$(ECHO)  Dist zip name........ $(DIST_ZIPNAME)
+	@$(ECHO)
+.PHONY: fpc_info
+fpc_info: $(INFORULES)
+.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \
+	fpc_makefile_dirs
+fpc_makefile:
+	$(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc
+fpc_makefile_sub1:
+ifdef TARGET_DIRS
+	$(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS))
+endif
+ifdef TARGET_EXAMPLEDIRS
+	$(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS))
+endif
+fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS))
+fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2
+fpc_makefiles: fpc_makefile fpc_makefile_dirs
+all: fpc_all
+debug: fpc_debug
+smart: fpc_smart
+release: fpc_release
+examples:
+shared:
+install: fpc_install
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+distinstall:
+zipinstall:
+zipsourceinstall:
+zipexampleinstall:
+zipdistinstall:
+clean: fpc_clean
+distclean: fpc_distclean
+cleanall: fpc_cleanall
+info: fpc_info
+makefiles: fpc_makefiles
+.PHONY: all debug smart release examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info makefiles
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+%$(OEXT) : %.as
+	$(AS) -o $*$(OEXT) $*.as
+$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pas $(SYSDEPS)
+	$(COMPILER) -Us -Sg $(SYSTEMUNIT).pas $(REDIR)
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp $(REDIR)
+strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
+		   $(PROCINC)/strings.inc $(PROCINC)/stringss.inc \
+		   $(SYSTEMUNIT)$(PPUEXT)
+ports$(PPUEXT) : ports.pas objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+doscalls$(PPUEXT) : doscalls.pas strings$(PPUEXT) objects$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+kbdcalls$(PPUEXT) : kbdcalls.pas $(SYSTEMUNIT)$(PPUEXT)
+moucalls$(PPUEXT) : moucalls.pas $(SYSTEMUNIT)$(PPUEXT)
+moncalls$(PPUEXT) : moncalls.pas strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+os2def$(PPUEXT) : os2def.pas $(SYSTEMUNIT)$(PPUEXT)
+pmwin$(PPUEXT) : pmwin.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+pmbitmap$(PPUEXT) : pmbitmap.pas $(SYSTEMUNIT)$(PPUEXT)
+pmgpi$(PPUEXT) : pmgpi.pas pmbitmap$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+pmstddlg$(PPUEXT) : pmstddlg.pas os2def$(PPUEXT) doscalls$(PPUEXT) pmwin$(PPUEXT) pmgpi$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+pmhelp$(PPUEXT) : pmhelp.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+pmdev$(PPUEXT) : pmdev.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+pmspl$(PPUEXT) : pmspl.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+dive$(PPUEXT) : dive.pas os2def$(PPUEXT) pmwin$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+dynlibs$(PPUEXT) : $(INC)/dynlibs.pp doscalls$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+dos$(PPUEXT) : dos.pas $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
+	       doscalls$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+crt$(PPUEXT) : crt.pas $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT)
+objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT)
+printer$(PPUEXT) : printer.pas $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT)
+sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \
+		    objpas$(PPUEXT) dos$(PPUEXT) doscalls$(PPUEXT)
+	$(COMPILER) -I$(OBJPASDIR) sysutils.pp $(REDIR)
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
+	$(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp $(REDIR)
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+	$(COMPILER) $(OBJPASDIR)/math.pp $(REDIR)
+varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
+		    $(OBJPASDIR)/varutilh.inc varutils.pp
+	$(COMPILER) -I$(OBJPASDIR) varutils.pp $(REDIR)
+types$(PPUEXT) : $(OBJPASDIR/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $(OBJPASDIR)/types.pp
+ucomplex$(PPUEXT): $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) -Sg $(INC)/heaptrc.pp $(REDIR)
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
+charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)

rtl/emx/Makefile.fpc

@@ -0,0 +1,190 @@
+#
+#   Makefile.fpc for Free Pascal OS/2 RTL
+#
+
+[package]
+main=rtl
+
+[target]
+loaders=prt0 prt1
+units=$(SYSTEMUNIT) objpas strings \
+      ports os2def doscalls moncalls kbdcalls moucalls viocalls \
+      pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl dive \
+      dos crt objects printer \
+      sysutils math typinfo varutils \
+      charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs \
+      video mouse keyboard variants types
+rsts=math varutils typinfo
+
+[require]
+nortl=y
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+target=emx
+cpu=i386
+
+[compiler]
+includedir=$(INC) $(PROCINC) ../os2
+sourcedir=$(INC) $(PROCINC) ../os2
+targetdir=.
+
+
+[prerules]
+RTL=..
+INC=$(RTL)/inc
+PROCINC=$(RTL)/$(CPU_TARGET)
+
+UNITPREFIX=rtl
+
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+SYSTEMUNIT=system
+else
+SYSTEMUNIT=sysos2
+endif
+
+# Use new feature from 1.0.5 version
+# that generates release PPU files
+# which will not be recompiled
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+
+# Paths
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+
+[rules]
+# Get the system independent include file names.
+# This will set the following variables :
+# SYSINCNAMES
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+
+# Get the processor dependent include file names.
+# This will set the following variables :
+# CPUINCNAMES
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+
+# Put system unit dependencies together.
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+
+
+#
+# Loaders
+#
+
+%$(OEXT) : %.as
+        $(AS) -o $*$(OEXT) $*.as
+
+
+#
+# Base Units (System, strings, os-dependent-base-unit)
+#
+
+$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pas $(SYSDEPS)
+        $(COMPILER) -Us -Sg $(SYSTEMUNIT).pas $(REDIR)
+
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp $(REDIR)
+
+strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
+                   $(PROCINC)/strings.inc $(PROCINC)/stringss.inc \
+                   $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# System Dependent Units
+#
+
+ports$(PPUEXT) : ports.pas objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+doscalls$(PPUEXT) : doscalls.pas strings$(PPUEXT) objects$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+kbdcalls$(PPUEXT) : kbdcalls.pas $(SYSTEMUNIT)$(PPUEXT)
+
+moucalls$(PPUEXT) : moucalls.pas $(SYSTEMUNIT)$(PPUEXT)
+
+moncalls$(PPUEXT) : moncalls.pas strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+os2def$(PPUEXT) : os2def.pas $(SYSTEMUNIT)$(PPUEXT)
+
+pmwin$(PPUEXT) : pmwin.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+pmbitmap$(PPUEXT) : pmbitmap.pas $(SYSTEMUNIT)$(PPUEXT)
+
+pmgpi$(PPUEXT) : pmgpi.pas pmbitmap$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+pmstddlg$(PPUEXT) : pmstddlg.pas os2def$(PPUEXT) doscalls$(PPUEXT) pmwin$(PPUEXT) pmgpi$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+pmhelp$(PPUEXT) : pmhelp.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+pmdev$(PPUEXT) : pmdev.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+pmspl$(PPUEXT) : pmspl.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+dive$(PPUEXT) : dive.pas os2def$(PPUEXT) pmwin$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+dynlibs$(PPUEXT) : $(INC)/dynlibs.pp doscalls$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# TP7 Compatible RTL Units
+#
+
+dos$(PPUEXT) : dos.pas $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
+               doscalls$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+crt$(PPUEXT) : crt.pas $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT)
+
+objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT)
+
+printer$(PPUEXT) : printer.pas $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT)
+
+#graph$(PPUEXT) : graph.pp
+
+#
+# Delphi Compatible Units
+#
+
+sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \
+                    objpas$(PPUEXT) dos$(PPUEXT) doscalls$(PPUEXT)
+        $(COMPILER) -I$(OBJPASDIR) sysutils.pp $(REDIR)
+
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
+        $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp $(REDIR)
+
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+        $(COMPILER) $(OBJPASDIR)/math.pp $(REDIR)
+
+varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
+                    $(OBJPASDIR)/varutilh.inc varutils.pp
+        $(COMPILER) -I$(OBJPASDIR) varutils.pp $(REDIR)
+
+types$(PPUEXT) : $(OBJPASDIR/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $(OBJPASDIR)/types.pp
+
+#
+# Other system-independent RTL Units
+#
+
+ucomplex$(PPUEXT): $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
+
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
+
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) -Sg $(INC)/heaptrc.pp $(REDIR)
+
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
+
+charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# Other system-dependent RTL Units
+#

rtl/emx/dos.pas

@@ -0,0 +1,1235 @@
+{****************************************************************************
+
+    $Id$
+
+                         Free Pascal Runtime-Library
+                              DOS unit for OS/2
+                   Copyright (c) 1997,1999-2000 by Daniel Mantione,
+                   member of the Free Pascal development team
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ ****************************************************************************}
+
+unit dos;
+
+{$ASMMODE ATT}
+
+{***************************************************************************}
+
+interface
+
+{***************************************************************************}
+
+{$PACKRECORDS 1}
+
+uses    Strings, DosCalls;
+
+const   {Bit masks for CPU flags.}
+        fcarry      = $0001;
+        fparity     = $0004;
+        fauxiliary  = $0010;
+        fzero       = $0040;
+        fsign       = $0080;
+        foverflow   = $0800;
+
+        {Bit masks for file attributes.}
+        readonly    = $01;
+        hidden      = $02;
+        sysfile     = $04;
+        volumeid    = $08;
+        directory   = $10;
+        archive     = $20;
+        anyfile     = $3F;
+
+        fmclosed    = $D7B0;
+        fminput     = $D7B1;
+        fmoutput    = $D7B2;
+        fminout     = $D7B3;
+
+type    {Some string types:}
+        comstr=string;              {Filenames can be long in OS/2.}
+        pathstr=string;             {String for pathnames.}
+        dirstr=string;              {String for a directory}
+        namestr=string;             {String for a filename.}
+        extstr=string[40];          {String for an extension. Can be 253
+                                     characters long, in theory, but let's
+                                     say fourty will be enough.}
+
+        {Search record which is used by findfirst and findnext:}
+        searchrec=record
+            case boolean of
+             false: (handle:longint;     {Used in os_OS2 mode}
+                     FStat:PFileFindBuf3;
+                     fill2:array[1..21-SizeOf(longint)-SizeOf(pointer)] of byte;
+                     attr2:byte;
+                     time2:longint;
+                     size2:longint;
+                     name2:string);      {Filenames can be long in OS/2!}
+             true:  (fill:array[1..21] of byte;
+                     attr:byte;
+                     time:longint;
+                     size:longint;
+                     name:string);       {Filenames can be long in OS/2!}
+        end;
+
+{$i filerec.inc}
+{$i textrec.inc}
+
+        {Data structure for the registers needed by msdos and intr:}
+       registers=packed record
+            case i:integer of
+                0:(ax,f1,bx,f2,cx,f3,dx,f4,bp,f5,si,f51,di,f6,ds,f7,es,
+                   f8,flags,fs,gs:word);
+                1:(al,ah,f9,f10,bl,bh,f11,f12,cl,ch,f13,f14,dl,dh:byte);
+                2:(eax,ebx,ecx,edx,ebp,esi,edi:longint);
+            end;
+
+        {Record for date and time:}
+        datetime=record
+            year,month,day,hour,min,sec:word;
+        end;
+
+        {Flags for the exec procedure:
+
+        Starting the program:
+        efwait:        Wait until program terminates.
+        efno_wait:     Don't wait until the program terminates. Does not work
+                       in dos, as DOS cannot multitask.
+        efoverlay:     Terminate this program, then execute the requested
+                       program. WARNING: Exit-procedures are not called!
+        efdebug:       Debug program. Details are unknown.
+        efsession:     Do not execute as child of this program. Use a seperate
+                       session instead.
+        efdetach:      Detached. Function unknown. Info wanted!
+        efpm:          Run as presentation manager program.
+
+        Determining the window state of the program:
+        efdefault:     Run the pm program in it's default situation.
+        efminimize:    Run the pm program minimized.
+        efmaximize:    Run the pm program maximized.
+        effullscreen:  Run the non-pm program fullscreen.
+        efwindowed:    Run the non-pm program in a window.
+
+        Other options are not implemented defined because lack of
+        knowledge about what they do.}
+
+        type    execrunflags=(efwait,efno_wait,efoverlay,efdebug,efsession,
+                              efdetach,efpm);
+                execwinflags=(efdefault,efminimize,efmaximize,effullscreen,
+                              efwindowed);
+
+const
+(* For compatibility with VP/2, used for runflags in Exec procedure. *)
+    ExecFlags: cardinal = ord (efwait);
+
+var doserror:integer;
+    dosexitcode:word;
+
+procedure getdate(var year,month,day,dayofweek:word);
+procedure gettime(var hour,minute,second,sec100:word);
+function dosversion:word;
+procedure setdate(year,month,day:word);
+procedure settime(hour,minute,second,sec100:word);
+procedure getcbreak(var breakvalue:boolean);
+procedure setcbreak(breakvalue:boolean);
+procedure getverify(var verify:boolean);
+procedure setverify(verify : boolean);
+
+function DiskFree (Drive: byte) : int64;
+function DiskSize (Drive: byte) : int64;
+
+procedure findfirst(const path:pathstr;attr:word;var f:searchRec);
+procedure findnext(var f:searchRec);
+procedure findclose(var f:searchRec);
+
+{Is a dummy:}
+procedure swapvectors;
+
+{Not supported:
+procedure getintvec(intno:byte;var vector:pointer);
+procedure setintvec(intno:byte;vector:pointer);
+procedure keep(exitcode:word);
+}
+procedure msdos(var regs:registers);
+procedure intr(intno : byte;var regs:registers);
+
+procedure getfattr(var f;var attr:word);
+procedure setfattr(var f;attr:word);
+
+function fsearch(path:pathstr;dirlist:string):pathstr;
+procedure getftime(var f;var time:longint);
+procedure setftime(var f;time:longint);
+procedure packtime (var d:datetime; var time:longint);
+procedure unpacktime (time:longint; var d:datetime);
+function fexpand(const path:pathstr):pathstr;
+procedure fsplit(path:pathstr;var dir:dirstr;var name:namestr;
+                 var ext:extstr);
+procedure exec(const path:pathstr;const comline:comstr);
+function exec(path:pathstr;runflags:execrunflags;winflags:execwinflags;
+              const comline:comstr):longint;
+function envcount:longint;
+function envstr(index:longint) : string;
+function getenv(const envvar:string): string;
+
+implementation
+
+var     LastSR: SearchRec;
+        EnvC: longint; external name '_envc';
+        EnvP: ppchar; external name '_environ';
+
+type    TBA = array [1..SizeOf (SearchRec)] of byte;
+        PBA = ^TBA;
+
+const   FindResvdMask = $00003737; {Allowed bits in attribute
+                                    specification for DosFindFirst call.}
+
+
+{Import syscall to call it nicely from assembler procedures.}
+
+procedure syscall;external name '___SYSCALL';
+
+
+function fsearch(path:pathstr;dirlist:string):pathstr;
+
+var i,p1:longint;
+    newdir:pathstr;
+
+{$ASMMODE INTEL}
+function CheckFile (FN: ShortString):boolean; assembler;
+asm
+    mov ax, 4300h
+    mov edx, FN      { get pointer to string }
+    inc edx          { avoid length byte     }
+    call syscall
+    mov ax, 0
+    jc @LCFstop
+    test cx, 18h
+    jnz @LCFstop
+    inc ax
+@LCFstop:
+end;
+{$ASMMODE ATT}
+
+begin
+{ check if the file specified exists }
+    if CheckFile (Path + #0) then
+        FSearch := Path
+    else
+        begin
+            {No wildcards allowed in these things:}
+            if (pos('?',path)<>0) or (pos('*',path)<>0) then
+                fsearch:=''
+            else
+                begin
+                    { allow slash as backslash }
+                    for i:=1 to length(dirlist) do
+                       if dirlist[i]='/' then dirlist[i]:='\';
+                    repeat
+                        p1:=pos(';',dirlist);
+                        if p1<>0 then
+                            begin
+                                newdir:=copy(dirlist,1,p1-1);
+                                delete(dirlist,1,p1);
+                            end
+                        else
+                            begin
+                                newdir:=dirlist;
+                                dirlist:='';
+                            end;
+                        if (newdir<>'') and
+                         not (newdir[length(newdir)] in ['\',':']) then
+                            newdir:=newdir+'\';
+                        if CheckFile (NewDir + Path + #0) then
+                            NewDir := NewDir + Path
+                        else
+                            NewDir := '';
+                    until (DirList = '') or (NewDir <> '');
+                    FSearch := NewDir;
+                end;
+        end;
+end;
+
+procedure getftime(var f;var time:longint);
+
+begin
+    asm
+        {Load handle}
+        movl f,%ebx
+        movl (%ebx),%ebx
+        {Get date}
+        movw $0x5700,%ax
+        call syscall
+        shll $16,%edx
+        movw %cx,%dx
+        movl time,%ebx
+        movl %edx,(%ebx)
+        xorb %ah,%ah
+        movw %ax,doserror
+    end;
+end;
+
+procedure SetFTime (var F; Time: longint);
+
+var FStat: PFileStatus3;
+    RC: longint;
+
+begin
+    if os_mode = osOS2 then
+        begin
+            New (FStat);
+            RC := DosQueryFileInfo (FileRec (F).Handle, ilStandard, FStat,
+                                                              SizeOf (FStat^));
+            if RC = 0 then
+                begin
+                    FStat^.DateLastAccess := Hi (Time);
+                    FStat^.DateLastWrite := Hi (Time);
+                    FStat^.TimeLastAccess := Lo (Time);
+                    FStat^.TimeLastWrite := Lo (Time);
+                    RC := DosSetFileInfo (FileRec (F).Handle, ilStandard,
+                                                       FStat, SizeOf (FStat^));
+
+
+                end;
+            DosError := integer(RC);
+            Dispose (FStat);
+        end
+    else
+        asm
+            {Load handle}
+            movl f,%ebx
+            movl (%ebx),%ebx
+            movl time,%ecx
+            shldl $16,%ecx,%edx
+            {Set date}
+            movw $0x5701,%ax
+            call syscall
+            xorb %ah,%ah
+            movw %ax,doserror
+        end;
+end;
+
+procedure msdos(var regs:registers);
+
+{Not recommended for EMX. Only works in DOS mode, not in OS/2 mode.}
+
+begin
+   if os_mode in [osDPMI,osDOS] then
+     intr($21,regs);
+end;
+
+procedure intr(intno:byte;var regs:registers);
+
+{Not recommended for EMX. Only works in DOS mode, not in OS/2 mode.}
+
+begin
+  if os_mode = osos2 then exit;
+  asm
+    jmp .Lstart
+{    .data}
+.Lint86:
+    .byte        0xcd
+.Lint86_vec:
+    .byte        0x03
+    jmp          .Lint86_retjmp
+
+{    .text}
+.Lstart:
+    movb    intno,%al
+    movb    %al,.Lint86_vec
+
+{
+    movl    10(%ebp),%eax
+    incl    %eax
+    incl    %eax
+}
+    movl    regs,%eax
+    {Do not use first int}
+    movl    4(%eax),%ebx
+    movl    8(%eax),%ecx
+    movl    12(%eax),%edx
+    movl    16(%eax),%ebp
+    movl    20(%eax),%esi
+    movl    24(%eax),%edi
+    movl    (%eax),%eax
+
+    jmp     .Lint86
+.Lint86_retjmp:
+    pushf
+    pushl   %ebp
+    pushl   %eax
+    movl    %esp,%ebp
+    {Calc EBP new}
+    addl    $12,%ebp
+{
+    movl    10(%ebp),%eax
+    incl    %eax
+    incl    %eax
+}
+    {Do not use first int}
+    movl    regs,%eax
+
+    popl    (%eax)
+    movl    %ebx,4(%eax)
+    movl    %ecx,8(%eax)
+    movl    %edx,12(%eax)
+    {Restore EBP}
+    popl    %edx
+    movl    %edx,16(%eax)
+    movl    %esi,20(%eax)
+    movl    %edi,24(%eax)
+    {Ignore ES and DS}
+    popl    %ebx            {Flags.}
+    movl    %ebx,32(%eax)
+    {FS and GS too}
+  end;
+end;
+
+procedure exec(const path:pathstr;const comline:comstr);
+
+{Execute a program.}
+
+begin
+    dosexitcode:=word(exec(path,execrunflags(ExecFlags),efdefault,comline));
+end;
+
+function exec(path:pathstr;runflags:execrunflags;winflags:execwinflags;
+              const comline:comstr):longint;
+
+{Execute a program. More suitable for OS/2 than the exec above.}
+
+type    bytearray=array[0..8191] of byte;
+        Pbytearray=^bytearray;
+
+        execstruc=packed record
+            argofs : pointer;    { pointer to arguments (offset)   }
+            envofs : pointer;    { pointer to environment (offset) }
+            nameofs: pointer;    { pointer to file name (offset)   }
+            argseg : word;       { pointer to arguments (selector) }
+            envseg : word;       { pointer to environment (selector}
+            nameseg: word;       { pointer to file name (selector) }
+            numarg : word;       { number of arguments             }
+            sizearg : word;      { size of arguments               }
+            numenv :  word;      { number of env strings           }
+            sizeenv:word;        { size of environment             }
+            mode1,mode2:byte;    { mode byte                       }
+        end;
+
+var args:Pbytearray;
+    env:Pbytearray;
+    i,argsize:word;
+    es:execstruc;
+    esadr:pointer;
+    d:dirstr;
+    n:namestr;
+    e:extstr;
+    p : ppchar;
+    j : integer;
+const
+    ArgsSize = 2048; (* Amount of memory reserved for arguments in bytes. *)
+
+begin
+    getmem(args,ArgsSize);
+    GetMem(env, envc*sizeof(pchar)+16384);
+    {Now setup the arguments. The first argument should be the program
+     name without directory and extension.}
+    fsplit(path,d,n,e);
+    es.numarg:=1;
+    args^[0]:=$80;
+    argsize:=1;
+    for i:=1 to length(n) do
+        begin
+            args^[argsize]:=byte(n[i]);
+            inc(argsize);
+        end;
+    args^[argsize]:=0;
+    inc(argsize);
+    {Now do the real arguments.}
+    i:=1;
+    while i<=length(comline) do
+        begin
+            if comline[i]<>' ' then
+                begin
+                    {Commandline argument found. Copy it.}
+                    inc(es.numarg);
+                    args^[argsize]:=$80;
+                    inc(argsize);
+                    while (i<=length(comline)) and (comline[i]<>' ') do
+                        begin
+                            args^[argsize]:=byte(comline[i]);
+                            inc(argsize);
+                            inc(i);
+                        end;
+                    args^[argsize]:=0;
+                    inc(argsize);
+                end;
+            inc(i);
+        end;
+    args^[argsize]:=0;
+    inc(argsize);
+
+    {Commandline ready, now build the environment.
+
+     Oh boy, I always had the opinion that executing a program under Dos
+     was a hard job!}
+
+    asm
+        movl env,%edi       {Setup destination pointer.}
+        movl envc,%ecx      {Load number of arguments in edx.}
+        movl envp,%esi      {Load env. strings.}
+        xorl %edx,%edx      {Count environment size.}
+.Lexa1:
+        lodsl               {Load a Pchar.}
+        xchgl %eax,%ebx
+.Lexa2:
+        movb (%ebx),%al     {Load a byte.}
+        incl %ebx           {Point to next byte.}
+        stosb               {Store it.}
+        incl %edx           {Increase counter.}
+        cmpb $0,%al         {Ready ?.}
+        jne .Lexa2
+        loop .Lexa1           {Next argument.}
+        stosb               {Store an extra 0 to finish. (AL is now 0).}
+        incl %edx
+        movw %dx,ES.SizeEnv    {Store environment size.}
+    end;
+
+    {Environment ready, now set-up exec structure.}
+    es.argofs:=args;
+    es.envofs:=env;
+    es.numenv:=envc;
+    { set an error - path is too long }
+    { since we must add a zero to the }
+    { end.                            }
+    if length(path) > 254 then
+     begin
+       exec := 8;
+       exit;
+     end;
+    path[length(path)+1] := #0;
+    es.nameofs:=pointer(longint(@path)+1);
+    asm
+        movw %ss,es.argseg
+        movw %ss,es.envseg
+        movw %ss,es.nameseg
+    end;
+    es.sizearg:=argsize;
+    {Typecasting of sets in FPC is a bit hard.}
+    es.mode1:=byte(runflags);
+    es.mode2:=byte(winflags);
+
+    {Now exec the program.}
+    asm
+        leal es,%edx
+        movw $0x7f06,%ax
+        call syscall
+        movl $0,%edi
+        jnc .Lexprg1
+        xchgl %eax,%edi
+        xorl %eax,%eax
+        decl %eax
+    .Lexprg1:
+        movw %di,doserror
+        movl %eax,__RESULT
+    end;
+
+    freemem(args,ArgsSize);
+    FreeMem(env, envc*sizeof(pchar)+16384);
+    {Phew! That's it. This was the most sophisticated procedure to call
+     a system function I ever wrote!}
+end;
+
+function dosversion:word;assembler;
+
+{Returns DOS version in DOS and OS/2 version in OS/2}
+asm
+    movb $0x30,%ah
+    call syscall
+end;
+
+procedure GetDate (var Year, Month, Day, DayOfWeek: word);
+
+begin
+    asm
+        movb $0x2a, %ah
+        call syscall
+        xorb %ah, %ah
+        movl DayOfWeek, %edi
+        stosw
+        movl Day, %edi
+        movb %dl, %al
+        stosw
+        movl Month, %edi
+        movb %dh, %al
+        stosw
+        movl Year, %edi
+        xchgw %ecx, %eax
+        stosw
+    end;
+end;
+
+{$asmmode intel}
+
+procedure SetDate (Year, Month, Day: word);
+var DT: TDateTime;
+begin
+    if os_mode = osOS2 then
+        begin
+            DosGetDateTime (DT);
+            DT.Year := Year;
+            DT.Month := byte (Month);
+            DT.Day := byte (Day);
+            DosSetDateTime (DT);
+        end
+    else
+        asm
+            mov  cx, Year
+            mov  dh, byte ptr Month
+            mov  dl, byte ptr Day
+            mov  ah, 2Bh
+            call syscall
+        end;
+end;
+
+{$asmmode att}
+
+procedure GetTime (var Hour, Minute, Second, Sec100: word); assembler;
+asm
+    movb $0x2c, %ah
+    call syscall
+    xorb %ah, %ah
+    movl Sec100, %edi
+    movb %dl, %al
+    stosw
+    movl Second, %edi
+    movb %dh,%al
+    stosw
+    movl Minute, %edi
+    movb %cl,%al
+    stosw
+    movl Hour, %edi
+    movb %ch,%al
+    stosw
+end;
+
+{$asmmode intel}
+procedure SetTime (Hour, Minute, Second, Sec100: word);
+var DT: TDateTime;
+begin
+    if os_mode = osOS2 then
+        begin
+            DosGetDateTime (DT);
+            DT.Hour := byte (Hour);
+            DT.Minute := byte (Minute);
+            DT.Second := byte (Second);
+            DT.Sec100 := byte (Sec100);
+            DosSetDateTime (DT);
+        end
+    else
+        asm
+            mov  ch, byte ptr Hour
+            mov  cl, byte ptr Minute
+            mov  dh, byte ptr Second
+            mov  dl, byte ptr Sec100
+            mov  ah, 2Dh
+            call syscall
+        end;
+end;
+
+{$asmmode att}
+
+procedure getcbreak(var breakvalue:boolean);
+
+begin
+    breakvalue := True;
+end;
+
+procedure setcbreak(breakvalue:boolean);
+
+begin
+{! Do not use in OS/2. Also not recommended in DOS. Use
+       signal handling instead.
+    asm
+        movb 8(%ebp),%dl
+        movw $0x3301,%ax
+        call syscall
+    end;
+}
+end;
+
+procedure getverify(var verify:boolean);
+
+begin
+  {! Do not use in OS/2.}
+  if os_mode in [osDOS,osDPMI] then
+      asm
+         movb $0x54,%ah
+         call syscall
+         movl verify,%edi
+         stosb
+      end
+  else
+      verify := true;
+  end;
+
+procedure setverify(verify:boolean);
+
+begin
+  {! Do not use in OS/2!}
+  if os_mode in [osDOS,osDPMI] then
+    asm
+        movb verify,%al
+        movb $0x2e,%ah
+        call syscall
+    end;
+ end;
+
+
+function DiskFree (Drive: byte): int64;
+
+var FI: TFSinfo;
+    RC: longint;
+
+begin
+    if (os_mode = osDOS) or (os_mode = osDPMI) then
+    {Function 36 is not supported in OS/2.}
+        asm
+            movb Drive,%dl
+            movb $0x36,%ah
+            call syscall
+            cmpw $-1,%ax
+            je .LDISKFREE1
+            mulw %cx
+            mulw %bx
+            shll $16,%edx
+            movw %ax,%dx
+            movl $0,%eax
+            xchgl %edx,%eax
+            leave
+            ret
+         .LDISKFREE1:
+            cltd
+            leave
+            ret
+        end
+    else
+        {In OS/2, we use the filesystem information.}
+        begin
+            RC := DosQueryFSInfo (Drive, 1, FI, SizeOf (FI));
+            if RC = 0 then
+                DiskFree := int64 (FI.Free_Clusters) *
+                   int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
+            else
+                DiskFree := -1;
+        end;
+end;
+
+function DiskSize (Drive: byte): int64;
+
+var FI: TFSinfo;
+    RC: longint;
+
+begin
+    if (os_mode = osDOS) or (os_mode = osDPMI) then
+        {Function 36 is not supported in OS/2.}
+        asm
+            movb Drive,%dl
+            movb $0x36,%ah
+            call syscall
+            movw %dx,%bx
+            cmpw $-1,%ax
+            je .LDISKSIZE1
+            mulw %cx
+            mulw %bx
+            shll $16,%edx
+            movw %ax,%dx
+            movl $0,%eax
+            xchgl %edx,%eax
+            leave
+            ret
+        .LDISKSIZE1:
+            cltd
+            leave
+            ret
+        end
+    else
+        {In OS/2, we use the filesystem information.}
+        begin
+            RC := DosQueryFSinfo (Drive, 1, FI, SizeOf (FI));
+            if RC = 0 then
+                DiskSize := int64 (FI.Total_Clusters) *
+                   int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
+            else
+                DiskSize := -1;
+        end;
+end;
+
+
+procedure SearchRec2DosSearchRec (var F: SearchRec);
+
+const   NameSize = 255;
+
+var L, I: longint;
+
+begin
+    if os_mode <> osOS2 then
+    begin
+        I := 1;
+        while (I <= SizeOf (LastSR))
+                           and (PBA (@F)^ [I] = PBA (@LastSR)^ [I]) do Inc (I);
+{ Raise "Invalid file handle" RTE if nested FindFirst calls were used. }
+        if I <= SizeOf (LastSR) then RunError (6);
+        l:=length(f.name);
+        for i:=1 to namesize do
+            f.name[i-1]:=f.name[i];
+        f.name[l]:=#0;
+    end;
+end;
+
+procedure DosSearchRec2SearchRec (var F: SearchRec);
+
+const NameSize=255;
+
+var L, I: longint;
+
+type    TRec = record
+            T, D: word;
+        end;
+
+begin
+    if os_mode = osOS2 then with F do
+    begin
+        Name := FStat^.Name;
+        Size := FStat^.FileSize;
+        Attr := byte(FStat^.AttrFile and $FF);
+        TRec (Time).T := FStat^.TimeLastWrite;
+        TRec (Time).D := FStat^.DateLastWrite;
+    end else
+    begin
+        for i:=0 to namesize do
+            if f.name[i]=#0 then
+                begin
+                    l:=i;
+                    break;
+                end;
+        for i:=namesize-1 downto 0 do
+            f.name[i+1]:=f.name[i];
+        f.name[0]:=char(l);
+        Move (F, LastSR, SizeOf (LastSR));
+    end;
+end;
+
+
+    procedure _findfirst(path:pchar;attr:word;var f:searchrec);
+
+    begin
+        asm
+            movl path,%edx
+            movw attr,%cx
+            {No need to set DTA in EMX. Just give a pointer in ESI.}
+            movl f,%esi
+            movb $0x4e,%ah
+            call syscall
+            jnc .LFF
+            movw %ax,doserror
+        .LFF:
+        end;
+    end;
+
+
+procedure FindFirst (const Path: PathStr; Attr: word; var F: SearchRec);
+
+
+var path0: array[0..255] of char;
+    Count: longint;
+
+begin
+    {No error.}
+    DosError := 0;
+    if os_mode = osOS2 then
+    begin
+        New (F.FStat);
+        F.Handle := $FFFFFFFF;
+        Count := 1;
+        DosError := Integer(DosFindFirst (Path, F.Handle,
+                       Attr and FindResvdMask, F.FStat, SizeOf (F.FStat^),
+                                                           Count, ilStandard));
+        if (DosError = 0) and (Count = 0) then DosError := 18;
+    end else
+    begin
+        strPcopy(path0,path);
+        _findfirst(path0,attr,f);
+    end;
+    DosSearchRec2SearchRec (F);
+end;
+
+    procedure _findnext(var f : searchrec);
+
+    begin
+        asm
+            movl f,%esi
+            movb $0x4f,%ah
+            call syscall
+            jnc .LFN
+            movw %ax,doserror
+        .LFN:
+        end;
+    end;
+
+
+procedure FindNext (var F: SearchRec);
+var Count: longint;
+
+
+begin
+    {No error}
+    DosError := 0;
+    SearchRec2DosSearchRec (F);
+    if os_mode = osOS2 then
+    begin
+        Count := 1;
+        DosError := Integer(DosFindNext (F.Handle, F.FStat, SizeOf (F.FStat^), Count));
+        if (DosError = 0) and (Count = 0) then DosError := 18;
+    end else _findnext (F);
+    DosSearchRec2SearchRec (F);
+end;
+
+procedure FindClose (var F: SearchRec);
+begin
+    if os_mode = osOS2 then
+    begin
+        if F.Handle <> $FFFFFFFF then DosError := DosFindClose (F.Handle);
+        Dispose (F.FStat);
+    end;
+end;
+
+procedure swapvectors;
+{For TP compatibility, this exists.}
+begin
+end;
+
+function envcount:longint;assembler;
+asm
+    movl envc,%eax
+end ['EAX'];
+
+function envstr(index : longint) : string;
+
+var hp:Pchar;
+
+begin
+    if (index<=0) or (index>envcount) then
+        begin
+            envstr:='';
+            exit;
+        end;
+    hp:=EnvP[index-1];
+    envstr:=strpas(hp);
+end;
+
+function GetEnv (const EnvVar: string): string;
+(* The assembler version is more than three times as fast as Pascal. *)
+var
+ P: PChar;
+ _EnvVar: string;
+begin
+ _EnvVar := UpCase (EnvVar);
+{$ASMMODE INTEL}
+ asm
+  cld
+  mov ecx, EnvC
+  mov edi, EnvP
+  mov edi, [edi]
+  lea esi, _EnvVar
+  xor eax, eax
+  lodsb
+@NewVar:
+  push ecx
+  push eax
+  push esi
+  mov ecx, -1
+  mov edx, edi
+  mov al, '='
+  repne
+  scasb
+  neg ecx
+  dec ecx
+  dec ecx
+  pop esi
+  pop eax
+  push eax
+  push esi
+  cmp ecx, eax
+  jnz @NotEqual
+  xchg edx, edi
+  repe
+  cmpsb
+  xchg edx, edi
+  jz @Equal
+@NotEqual:
+  xor eax, eax
+  mov ecx, -1
+  repne
+  scasb
+  pop esi
+  pop eax
+  pop ecx
+  dec ecx
+  jecxz @Stop
+  jmp @NewVar
+@Stop:
+  mov P, ecx
+  jmp @End
+@Equal:
+  pop esi
+  pop eax
+  pop ecx  
+  mov P, edi
+@End:
+ end;
+ GetEnv := StrPas (P);
+end;
+{$ASMMODE ATT}
+
+procedure fsplit(path:pathstr;var dir:dirstr;var name:namestr;
+                 var ext:extstr);
+
+var p1,i : longint;
+    dotpos : integer;
+
+begin
+    { allow slash as backslash }
+    for i:=1 to length(path) do
+      if path[i]='/' then path[i]:='\';
+    {Get drive name}
+    p1:=pos(':',path);
+    if p1>0 then
+        begin
+            dir:=path[1]+':';
+            delete(path,1,p1);
+        end
+    else
+        dir:='';
+    { split the path and the name, there are no more path informtions }
+    { if path contains no backslashes                                 }
+    while true do
+        begin
+            p1:=pos('\',path);
+            if p1=0 then
+                break;
+            dir:=dir+copy(path,1,p1);
+              delete(path,1,p1);
+        end;
+   { try to find out a extension }
+   Ext:='';
+   i:=Length(Path);
+   DotPos:=256;
+   While (i>0) Do
+     Begin
+       If (Path[i]='.') Then
+         begin
+           DotPos:=i;
+           break;
+         end;
+       Dec(i);
+     end;
+   Ext:=Copy(Path,DotPos,255);
+   Name:=Copy(Path,1,DotPos - 1);
+end;
+
+(*
+function FExpand (const Path: PathStr): PathStr;
+- declared in fexpand.inc
+*)
+
+{$DEFINE FPC_FEXPAND_UNC} (* UNC paths are supported *)
+{$DEFINE FPC_FEXPAND_DRIVES} (* Full paths begin with drive specification *)
+
+const
+    LFNSupport = true;
+
+{$I fexpand.inc}
+
+{$UNDEF FPC_FEXPAND_DRIVES}
+{$UNDEF FPC_FEXPAND_UNC}
+
+procedure packtime(var d:datetime;var time:longint);
+
+var zs:longint;
+
+begin
+    time:=-1980;
+    time:=time+d.year and 127;
+    time:=time shl 4;
+    time:=time+d.month;
+    time:=time shl 5;
+    time:=time+d.day;
+    time:=time shl 16;
+    zs:=d.hour;
+    zs:=zs shl 6;
+    zs:=zs+d.min;
+    zs:=zs shl 5;
+    zs:=zs+d.sec div 2;
+    time:=time+(zs and $ffff);
+end;
+
+procedure unpacktime (time:longint;var d:datetime);
+
+begin
+    d.sec:=(time and 31) * 2;
+    time:=time shr 5;
+    d.min:=time and 63;
+    time:=time shr 6;
+    d.hour:=time and 31;
+    time:=time shr 5;
+    d.day:=time and 31;
+    time:=time shr 5;
+    d.month:=time and 15;
+    time:=time shr 4;
+    d.year:=time+1980;
+end;
+
+procedure getfattr(var f;var attr : word);
+ { Under EMX, this routine requires     }
+ { the expanded path specification      }
+ { otherwise it will not function       }
+ { properly (CEC)                       }
+var
+ path:  pathstr;
+ buffer:array[0..255] of char;
+begin
+  DosError := 0;
+  path:='';
+  path := StrPas(filerec(f).Name);
+  { Takes care of slash and backslash support }
+  path:=FExpand(path);
+  move(path[1],buffer,length(path));
+  buffer[length(path)]:=#0;
+ asm
+    movw $0x4300,%ax
+    leal buffer,%edx
+    call syscall
+    jnc  .Lnoerror         { is there an error ? }
+    movw %ax,doserror
+  .Lnoerror:
+    movl attr,%ebx
+    movw %cx,(%ebx)
+ end;
+end;
+
+procedure setfattr(var f;attr : word);
+ { Under EMX, this routine requires     }
+ { the expanded path specification      }
+ { otherwise it will not function       }
+ { properly (CEC)                       }
+var
+ path:  pathstr;
+ buffer:array[0..255] of char;
+begin
+  path:='';
+  DosError := 0;
+  path := StrPas(filerec(f).Name);
+  { Takes care of slash and backslash support }
+  path:=FExPand(path);
+  move(path[1],buffer,length(path));
+  buffer[length(path)]:=#0;
+   asm
+     movw $0x4301,%ax
+     leal buffer,%edx
+     movw attr,%cx
+     call syscall
+     jnc  .Lnoerror
+     movw %ax,doserror
+   .Lnoerror:
+  end;
+end;
+
+
+
+procedure InitEnvironment;
+var
+ cnt : integer;
+ ptr : pchar;
+ base : pchar;
+ i: integer;
+ tib : pprocessinfoblock;
+begin
+  { We need to setup the environment     }
+  { only in the case of OS/2             }
+  { otherwise everything is in the stack }
+  if os_Mode in [OsDOS,osDPMI] then
+    exit;
+  cnt := 0;
+  { count number of environment pointers }
+  dosgetinfoblocks (nil, PPProcessInfoBlock (@tib));
+  ptr := pchar(tib^.env);
+  { stringz,stringz...,#0 }
+  i := 0;
+  repeat
+    repeat
+     (inc(i));
+    until (ptr[i] = #0);
+    inc(i);
+    { here, it may be a double null, end of environment }
+    if ptr[i] <> #0 then
+       inc(cnt);
+  until (ptr[i] = #0);
+  { save environment count }
+  envc := cnt;
+  { got count of environment strings }
+  GetMem(envp, cnt*sizeof(pchar)+16384);
+  cnt := 0;
+  ptr := pchar(tib^.env);
+  i:=0;
+  repeat
+    envp[cnt] := ptr;
+    Inc(cnt);
+    { go to next string ... }
+    repeat
+      inc(ptr);
+    until (ptr^ = #0);
+    inc(ptr);
+  until ptr^ = #0;
+  envp[cnt] := #0;
+end;
+
+
+procedure DoneEnvironment;
+begin
+  { it is allocated on the stack for DOS/DPMI }
+  if os_mode = osOs2 then
+     FreeMem(envp, envc*sizeof(pchar)+16384);
+end;
+
+var
+  oldexit : pointer;
+
+
+begin
+ oldexit:=exitproc;
+ exitproc:=@doneenvironment;
+ InitEnvironment;
+end.
+{
+  $Log$
+  Revision 1.1  2002-11-17 16:22:53  hajny
+    + RTL for emx target
+
+  Revision 1.19  2002/09/07 16:01:24  peter
+    * old logs removed and tabs fixed
+
+  Revision 1.18  2002/07/11 16:00:05  hajny
+    * FindFirst fix (invalid attribute bits masked out)
+
+  Revision 1.17  2002/07/07 18:00:48  hajny
+    * DosGetInfoBlock modification to allow overloaded version (in DosCalls)
+
+  Revision 1.16  2002/03/03 11:19:20  hajny
+    * GetEnv rewritten to assembly - 3x faster now
+
+}

rtl/emx/ports.pas

@@ -0,0 +1,155 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by the Free Pascal development team.
+
+    These files adds support for TP styled port accesses (port[],
+    portw[] and portl[] constructs) using Delphi classes.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+(*
+  Warning:
+  1) You have to enable port access in your CONFIG.SYS (IOPL directive),
+     either globally (IOPL=YES), or just for particular application/-s with
+     a need for port access (IOPL=app_name1, appname2, ...).
+  2) Once you access some port, access to this port is enabled all the time
+     for all EMX applications until EMX.DLL is unloaded from memory (i.e.
+     all applications using this library finish).
+*)
+    
+unit Ports;
+
+{ This unit uses classes so ObjFpc mode is required. }
+{$Mode ObjFpc}
+
+interface
+    
+type
+ TPort = class
+  protected
+   procedure WritePort (P: word; Data: byte);
+   function ReadPort (P: word): byte;
+  public
+   property PP [W: word]: byte read readport write writeport; default;
+ end;
+
+ TPortW = class
+  protected
+   procedure WritePort (P: word; Data: word);
+   function ReadPort (P: word): word;
+  public
+   property PP [W: word]: word read readport write writeport; default;
+ end;
+
+ TPortL = class
+  protected
+   procedure WritePort (P: word; Data: longint);
+   function ReadPort (P: word): longint;
+  public
+   property PP [W: word]: longint read readport write writeport; default;
+ end;
+
+ { Non-instantiated vars. As yet, they don't have to be instantiated,
+   because neither member variables nor virtual methods are accessed }
+
+var
+ Port, PortB: TPort;
+ PortW: TPortW;
+ PortL: TPortL;
+
+implementation
+
+{Import syscall to call it nicely from assembler procedures.}
+
+procedure syscall; external name '___SYSCALL';
+
+{$AsmMode ATT}
+
+procedure TPort.WritePort (P: word; Data: byte); assembler;
+asm
+ xorl %ecx, %ecx
+ movw P, %cx
+ movl %ecx, %edx
+ movw $0x7F12, %ax
+ call syscall
+ movw P, %dx
+ movb Data, %al
+ outb %al, %dx
+end;
+
+function TPort.ReadPort (P: word): byte; assembler;
+asm
+ xorl %ecx, %ecx
+ movw P, %cx
+ movl %ecx, %edx
+ movw $0x7F12, %ax
+ call syscall
+ movw P, %dx
+ inb %dx, %al
+end;
+
+procedure TPortW.WritePort (P: word; Data : word); assembler;
+asm
+ xorl %ecx, %ecx
+ movw P, %cx
+ movl %ecx, %edx
+ movw $0x7F12, %ax
+ call syscall
+ movw P, %dx
+ movw Data, %ax
+ outw %ax, %dx
+end;
+
+function TPortW.ReadPort (P: word): word; assembler;
+asm
+ xorl %ecx, %ecx
+ movw P, %cx
+ movl %ecx, %edx
+ movw $0x7F12, %ax
+ call syscall
+ movw P, %dx
+ inw %dx, %ax
+end;
+
+procedure TPortL.WritePort (P: word; Data: longint); assembler;
+asm
+ xorl %ecx, %ecx
+ movw P, %cx
+ movl %ecx, %edx
+ movw $0x7F12, %ax
+ call syscall
+ movw P, %dx
+ movl Data, %eax
+ outl %eax, %dx
+end;
+
+function TPortL.ReadPort (P: word): longint; assembler;
+asm
+ xorl %ecx, %ecx
+ movw P, %cx
+ movl %ecx, %edx
+ movw $0x7F12, %ax
+ call syscall
+ movw P, %dx
+ inl %dx, %eax
+end;
+
+end.
+
+{
+  $Log$
+  Revision 1.1  2002-11-17 16:22:54  hajny
+    + RTL for emx target
+
+  Revision 1.2  2002/09/07 16:01:25  peter
+    * old logs removed and tabs fixed
+
+}

rtl/emx/prt0.as

@@ -0,0 +1,74 @@
+/ prt0.s (emx+fpc) -- Made from crt0.s,
+/                     Copyright (c) 1990-1999-2001 by Eberhard Mattes.
+/                     Changed for Free Pascal in 1997 Daniel Mantione.
+/                     This code is _not_ under the Library GNU Public
+/                     License, because the original is not. See copying.emx
+/                     for details. You should have received it with this
+/                     product, write the author if you haven't.
+
+        .globl  __text
+        .globl  ___SYSCALL
+        .globl  __data
+        .globl  __heap_base
+        .globl  __heap_brk
+        .globl  __heap_end
+        .globl  __init
+
+        .text
+
+__text:
+        push    $__data
+        call    __dos_init
+        jmp     __init
+
+___SYSCALL:
+        call    __dos_syscall
+        ret
+
+        .space  6, 0x90
+
+__init: cld
+        call    __entry1
+
+        call    _main
+        movb    $0x4c,%ah
+        call    ___SYSCALL
+2:      jmp     2b
+
+        .data
+
+/ The data segment starts with a table containing the start and end
+/ addresses of the text, data and bss segments
+
+__data:
+        .long   __text
+        .long   __etext
+        .long   __data
+        .long   __edata
+        .long   __edata
+        .long   __end
+__heap_base:
+        .long   0
+__heap_end:
+        .long   0
+__heap_brk:
+        .long   0
+        .long   0
+        .long   __os2dll
+        .long   0
+        .long   0
+        .long   0x02000000
+        .long   0
+        .long   0
+        .byte   0
+        .space  63, 0
+
+/ Don't touch this. It's EMX vodoo. In short, this causes the __os2dll symbol
+/ point to table of DLL data that the linker includes in the executable.
+
+        .stabs  "__os2dll", 21, 0, 0, 0xffffffff
+        .stabs  "___CTOR_LIST__", 21, 0, 0, 0xffffffff
+        .stabs  "___DTOR_LIST__", 21, 0, 0, 0xffffffff
+        .stabs  "___crtinit1__", 21, 0, 0, 0xffffffff
+        .stabs  "___crtexit1__", 21, 0, 0, 0xffffffff
+        .stabs  "___eh_frame__", 21, 0, 0, 0xffffffff

rtl/emx/prt1.as

@@ -0,0 +1,61 @@
+/ prt1.s (emx+fpk) -- Made from crt2.s and dos.s,
+/                                         Copyright (c) 1990-1999-2000 by Eberhard Mattes.
+/                     Changed for Free Pascal in 1997 Daniel Mantione.
+/                                         This code is _not_ under the Library GNU Public
+/                                         License, because the original is not. See copying.emx
+/                                         for details. You should have received it with this
+/                                         product, write the author if you haven't.
+
+                .globl  __entry1
+                .globl  _environ
+                .globl  _envc
+                .globl  _argv
+                .globl  _argc
+
+                .text
+
+__entry1:
+                popl    %esi
+                cld
+                xorl    %ebp, %ebp
+                leal    (%esp), %edi      /* argv[] */
+                movl    %edi,_environ
+                call    L_ptr_tbl
+                movl    %ecx,_envc
+                movl    %edi,_argv
+                call    L_ptr_tbl
+                movl    %ecx,_argc
+                jmp     *%esi
+
+L_ptr_tbl:
+                xorl    %eax, %eax
+                movl    $-1, %ecx
+1:              incl    %ecx
+                scasl
+                jne     1b
+                ret
+
+/ In executables created with emxbind, the call to _dos_init will
+/ be fixed up at load time to _emx_init of emx.dll.  Under DOS,
+/ this dummy is called instead as there is no fixup.  This module
+/ must be linked statically to avoid having two fixups for the
+/ same location.
+
+                .globl  __dos_init
+                .globl  __dos_syscall
+
+__dos_init:
+                ret     $4
+
+                .align  2, 0x90
+
+__dos_syscall:
+                int     $0x21
+                ret
+
+                .data
+
+                .comm   _environ,       4
+                .comm   _envc,          4
+                .comm   _argv,          4
+                .comm   _argc,          4

rtl/emx/sysos2.pas

@@ -0,0 +1 @@
+{$i system.pas}

rtl/emx/system.pas

@@ -0,0 +1,1075 @@
+{
+ $Id$
+ ****************************************************************************
+
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2002 by Free Pascal development team
+
+    Free Pascal - OS/2 (EMX) runtime library
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+****************************************************************************}
+
+unit {$ifdef VER1_0}sysos2{$else}System{$endif};
+
+{Changelog:
+
+    People:
+
+        DM - Daniel Mantione
+
+    Date:           Description of change:              Changed by:
+
+     -              First released version 0.1.         DM
+
+Coding style:
+
+    My coding style is a bit unusual for Pascal. Nevertheless I friendly ask
+    you to try to make your changes not look all to different. In general,
+    set your IDE to use a tabsize of 4.}
+
+interface
+
+{Link the startup code.}
+{$l prt1.oo2}
+
+{$I SYSTEMH.INC}
+
+type
+    { FK: The fields of this record are OS dependent and they shouldn't  }
+    { be used in a program; only the type TCriticalSection is important. }
+    (* TH: To make things easier, I copied the record definition *)
+    (* from the Win32 version and just added longint variants,   *)
+    (* because it seemed well suited for OS/2 too.               *)
+    TRTLCriticalSection = packed record
+        DebugInfo: pointer;
+        LockCount: longint;
+        RecursionCount: longint;
+        case boolean of
+        false:
+        (OwningThread: DWord;
+        LockSemaphore: DWord;
+        Reserved: DWord);
+        true:
+        (OwningThread2: longint;
+        LockSemaphore2: longint;
+        Reserved2: longint);
+    end;
+
+{$I heaph.inc}
+
+{Platform specific information}
+const
+ LineEnding = #13#10;
+{ LFNSupport is defined separately below!!! }
+ DirectorySeparator = '\';
+ DriveSeparator = ':';
+ PathSeparator = ';';
+{ FileNameCaseSensitive is defined separately below!!! }
+
+type    Tos=(osDOS,osOS2,osDPMI);
+
+var     os_mode:Tos;
+        first_meg:pointer;
+
+type    Psysthreadib=^Tsysthreadib;
+        Pthreadinfoblock=^Tthreadinfoblock;
+        PPThreadInfoBlock=^PThreadInfoBlock;
+        Pprocessinfoblock=^Tprocessinfoblock;
+        PPProcessInfoBlock=^PProcessInfoBlock;
+
+        Tbytearray=array[0..$ffff] of byte;
+        Pbytearray=^Tbytearray;
+
+        Tsysthreadib=record
+            tid,
+            priority,
+            version:longint;
+            MCcount,
+            MCforceflag:word;
+        end;
+
+        Tthreadinfoblock=record
+            pexchain,
+            stack,
+            stacklimit:pointer;
+            tib2:Psysthreadib;
+            version,
+            ordinal:longint;
+        end;
+
+        Tprocessinfoblock=record
+            pid,
+            parentpid,
+            hmte:longint;
+            cmd,
+            env:Pbytearray;
+            flstatus,
+            ttype:longint;
+        end;
+
+const   UnusedHandle=$ffff;
+        StdInputHandle=0;
+        StdOutputHandle=1;
+        StdErrorHandle=2;
+
+        LFNSupport: boolean = true;
+        FileNameCaseSensitive: boolean = false;
+
+        sLineBreak = LineEnding;
+        DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF;
+
+var
+{ C-compatible arguments and environment }
+  argc  : longint;external name '_argc';
+  argv  : ppchar;external name '_argv';
+  envp  : ppchar;external name '_environ';
+
+implementation
+
+{$I SYSTEM.INC}
+
+var
+    heap_base: pointer; external name '__heap_base';
+    heap_brk: pointer; external name '__heap_brk';
+    heap_end: pointer; external name '__heap_end';
+{$IFDEF CONTHEAP}
+    BrkLimit: cardinal;
+{$ENDIF CONTHEAP}
+
+procedure DosGetInfoBlocks (PATIB: PPThreadInfoBlock;
+                            PAPIB: PPProcessInfoBlock); cdecl;
+                            external 'DOSCALLS' index 312;
+
+function DosSetRelMaxFH (var ReqCount, CurMaxFH: longint): longint; cdecl;
+external 'DOSCALLS' index 382;
+
+function DosSetCurrentDir (Name:PChar): longint; cdecl;
+external 'DOSCALLS' index 255;
+
+function DosSetDefaultDisk (DiskNum:longint): longint; cdecl;
+external 'DOSCALLS' index 220;
+
+{ This is not real prototype, but its close enough  }
+{ for us. (The 2nd parameter is acutally a pointer) }
+{ to a structure.                                   }
+function DosCreateDir( Name : pchar; p : pointer): longint; cdecl;
+external 'DOSCALLS' index 270;
+
+function DosDeleteDir( Name : pchar) : longint; cdecl;
+external 'DOSCALLS' index 226;
+
+{This is the correct way to call external assembler procedures.}
+procedure syscall; external name '___SYSCALL';
+
+{
+procedure syscall; external 'EMX' index 2;
+
+procedure emx_init; external 'EMX' index 1;
+}
+
+
+
+   { converts an OS/2 error code to a TP compatible error }
+   { code. Same thing exists under most other supported   }
+   { systems.                                             }
+   { Only call for OS/2 DLL imported routines             }
+   Procedure Errno2InOutRes;
+   Begin
+     { errors 1..18 are the same as in DOS }
+     case InOutRes of
+      { simple offset to convert these error codes }
+      { exactly like the error codes in Win32      }
+      19..31 : InOutRes := InOutRes + 131;
+      { gets a bit more complicated ... }
+      32..33 : InOutRes := 5;
+      38 : InOutRes := 100;
+      39 : InOutRes := 101;
+      112 : InOutRes := 101;
+      110 : InOutRes := 5;
+      114 : InOutRes := 6;
+      290 : InOutRes := 290;
+     end;
+     { all other cases ... we keep the same error code }
+   end;
+
+
+{****************************************************************************
+
+                    Miscellaneous related routines.
+
+****************************************************************************}
+
+{$asmmode intel}
+procedure system_exit; assembler;
+asm
+    mov  ah, 04ch
+    mov  al, byte ptr exitcode
+    call syscall
+end ['EAX'];
+
+{$ASMMODE ATT}
+
+function paramcount:longint;assembler;
+
+asm
+    movl argc,%eax
+    decl %eax
+end ['EAX'];
+
+    function args:pointer;assembler;
+
+    asm
+        movl argv,%eax
+    end ['EAX'];
+
+
+function paramstr(l:longint):string;
+
+var p:^Pchar;
+
+begin
+    { There seems to be a problem with EMX for DOS when trying to }
+    { access paramstr(0), and to avoid problems between DOS and   }
+    { OS/2 they have been separated.                              }
+    if os_Mode = OsOs2 then
+    begin
+    if L = 0 then
+        begin
+            GetMem (P, 260);
+            p[0] := #0;  { in case of error, initialize to empty string }
+{$ASMMODE INTEL}
+            asm
+                mov edx, P
+                mov ecx, 260
+                mov eax, 7F33h
+                call syscall    { error handle already with empty string }
+            end;
+            ParamStr := StrPas (PChar (P));
+            FreeMem (P, 260);
+        end
+    else
+        if (l>0) and (l<=paramcount) then
+            begin
+                p:=args;
+                paramstr:=strpas(p[l]);
+            end
+        else paramstr:='';
+    end
+   else
+    begin
+      p:=args;
+      paramstr:=strpas(p[l]);
+    end;
+end;
+
+
+procedure randomize; assembler;
+asm
+    mov ah, 2Ch
+    call syscall
+    mov word ptr [randseed], cx
+    mov word ptr [randseed + 2], dx
+end;
+
+{$ASMMODE ATT}
+
+{****************************************************************************
+
+                    Heap management releated routines.
+
+****************************************************************************}
+
+
+{ this function allows to extend the heap by calling
+syscall $7f00 resizes the brk area}
+
+function sbrk(size:longint):longint;
+{$IFDEF DUMPGROW}
+var
+  L: longint;
+begin
+  WriteLn ('Trying to grow heap by ', Size, ' to ', HeapSize + Size);
+{$IFDEF CONTHEAP}
+  WriteLn ('BrkLimit is ', BrkLimit);
+{$ENDIF CONTHEAP}
+  asm
+    movl size,%edx
+    movw $0x7f00,%ax
+    call syscall     { result directly in EAX }
+    mov  %eax,L
+  end;
+  WriteLn ('New heap at ', L);
+  Sbrk := L;
+end;
+{$ELSE DUMPGROW}
+                                     assembler;
+asm
+    movl size,%edx
+    movw $0x7f00,%ax
+    call syscall     { result directly in EAX }
+end;
+{$ENDIF DUMPGROW}
+
+function getheapstart:pointer;assembler;
+
+asm
+    movl heap_base,%eax
+end ['EAX'];
+
+function getheapsize:longint;assembler;
+asm
+    movl heap_brk,%eax
+end ['EAX'];
+
+{$i heap.inc}
+
+{****************************************************************************
+
+                          Low Level File Routines
+
+****************************************************************************}
+
+procedure allowslash(p:Pchar);
+
+{Allow slash as backslash.}
+
+var i:longint;
+
+begin
+    for i:=0 to strlen(p) do
+        if p[i]='/' then p[i]:='\';
+end;
+
+procedure do_close(h:longint);
+
+begin
+{ Only three standard handles under real OS/2 }
+  if (h > 4) or
+     ((os_MODE = osOS2) and (h > 2)) then
+   begin
+     asm
+        movb $0x3e,%ah
+        movl h,%ebx
+        call syscall
+        jnc  .Lnoerror           { error code?            }
+        movw  %ax, InOutRes       { yes, then set InOutRes }
+     .Lnoerror:
+     end;
+   end;
+end;
+
+procedure do_erase(p:Pchar);
+
+begin
+    allowslash(p);
+    asm
+        movl P,%edx
+        movb $0x41,%ah
+        call syscall
+        jnc .LERASE1
+        movw %ax,inoutres;
+    .LERASE1:
+    end;
+end;
+
+procedure do_rename(p1,p2:Pchar);
+
+begin
+    allowslash(p1);
+    allowslash(p2);
+    asm
+        movl P1, %edx
+        movl P2, %edi
+        movb $0x56,%ah
+        call syscall
+        jnc .LRENAME1
+        movw %ax,inoutres;
+    .LRENAME1:
+    end;
+end;
+
+function do_read(h,addr,len:longint):longint; assembler;
+asm
+    movl len,%ecx
+    movl addr,%edx
+    movl h,%ebx
+    movb $0x3f,%ah
+    call syscall
+    jnc .LDOSREAD1
+    movw %ax,inoutres;
+    xorl %eax,%eax
+.LDOSREAD1:
+end;
+
+function do_write(h,addr,len:longint) : longint; assembler;
+asm
+    xorl %eax,%eax
+    cmpl $0,len    { 0 bytes to write is undefined behavior }
+    jz   .LDOSWRITE1
+    movl len,%ecx
+    movl addr,%edx
+    movl h,%ebx
+    movb $0x40,%ah
+    call syscall
+    jnc .LDOSWRITE1
+    movw %ax,inoutres;
+.LDOSWRITE1:
+end;
+
+function do_filepos(handle:longint): longint; assembler;
+asm
+    movw $0x4201,%ax
+    movl handle,%ebx
+    xorl %edx,%edx
+    call syscall
+    jnc .LDOSFILEPOS
+    movw %ax,inoutres;
+    xorl %eax,%eax
+.LDOSFILEPOS:
+end;
+
+procedure do_seek(handle,pos:longint); assembler;
+asm
+    movw $0x4200,%ax
+    movl handle,%ebx
+    movl pos,%edx
+    call syscall
+    jnc .LDOSSEEK1
+    movw %ax,inoutres;
+.LDOSSEEK1:
+end;
+
+function do_seekend(handle:longint):longint; assembler;
+asm
+    movw $0x4202,%ax
+    movl handle,%ebx
+    xorl %edx,%edx
+    call syscall
+    jnc .Lset_at_end1
+    movw %ax,inoutres;
+    xorl %eax,%eax
+.Lset_at_end1:
+end;
+
+function do_filesize(handle:longint):longint;
+
+var aktfilepos:longint;
+
+begin
+    aktfilepos:=do_filepos(handle);
+    do_filesize:=do_seekend(handle);
+    do_seek(handle,aktfilepos);
+end;
+
+procedure do_truncate(handle,pos:longint); assembler;
+asm
+(* DOS function 40h isn't safe for this according to EMX documentation *)
+    movl $0x7F25,%eax
+    movl Handle,%ebx
+    movl Pos,%edx
+    call syscall
+    incl %eax
+    movl %ecx, %eax
+    jnz .LTruncate1      { compare the value of EAX to verify error }
+(* File position is undefined after truncation, move to the end. *)
+    movl $0x4202,%eax
+    movl Handle,%ebx
+    movl $0,%edx
+    call syscall
+    jnc .LTruncate2
+.LTruncate1:
+    movw %ax,inoutres;
+.LTruncate2:
+end;
+
+const
+    FileHandleCount: longint = 20;
+
+function Increase_File_Handle_Count: boolean;
+var Err: word;
+    L1, L2: longint;
+begin
+    if os_mode = osOS2 then
+        begin
+            L1 := 10;
+            if DosSetRelMaxFH (L1, L2) <> 0 then
+                Increase_File_Handle_Count := false
+            else
+                if L2 > FileHandleCount then
+                    begin
+                        FileHandleCount := L2;
+                        Increase_File_Handle_Count := true;
+                    end
+                else
+                    Increase_File_Handle_Count := false;
+        end
+    else
+        begin
+            Inc (FileHandleCount, 10);
+            Err := 0;
+            asm
+                movl $0x6700, %eax
+                movl FileHandleCount, %ebx
+                call syscall
+                jnc .LIncFHandles
+                movw %ax, Err
+.LIncFHandles:
+            end;
+            if Err <> 0 then
+                begin
+                    Increase_File_Handle_Count := false;
+                    Dec (FileHandleCount, 10);
+                end
+            else
+                Increase_File_Handle_Count := true;
+        end;
+end;
+
+procedure do_open(var f;p:pchar;flags:longint);
+
+{
+  filerec and textrec have both handle and mode as the first items so
+  they could use the same routine for opening/creating.
+  when (flags and $100)   the file will be append
+  when (flags and $1000)  the file will be truncate/rewritten
+  when (flags and $10000) there is no check for close (needed for textfiles)
+}
+
+var Action: longint;
+
+begin
+    allowslash(p);
+    { close first if opened }
+    if ((flags and $10000)=0) then
+        begin
+            case filerec(f).mode of
+                fminput,fmoutput,fminout : Do_Close(filerec(f).handle);
+                fmclosed:;
+            else
+                begin
+                    inoutres:=102; {not assigned}
+                    exit;
+                end;
+            end;
+       end;
+    { reset file handle }
+    filerec(f).handle := UnusedHandle;
+    Action := 0;
+    { convert filemode to filerec modes }
+    case (flags and 3) of
+        0 : filerec(f).mode:=fminput;
+        1 : filerec(f).mode:=fmoutput;
+        2 : filerec(f).mode:=fminout;
+    end;
+    if (flags and $1000)<>0 then
+        Action := $50000; (* Create / replace *)
+    { empty name is special }
+    if p[0]=#0 then
+        begin
+          case FileRec(f).mode of
+            fminput :
+              FileRec(f).Handle:=StdInputHandle;
+            fminout, { this is set by rewrite }
+            fmoutput :
+              FileRec(f).Handle:=StdOutputHandle;
+            fmappend :
+              begin
+                FileRec(f).Handle:=StdOutputHandle;
+                FileRec(f).mode:=fmoutput; {fool fmappend}
+              end;
+            end;
+            exit;
+        end;
+    Action := Action or (Flags and $FF);
+(* DenyAll if sharing not specified. *)
+    if Flags and 112 = 0 then
+        Action := Action or 16;
+    asm
+        movl $0x7f2b, %eax
+        movl Action, %ecx
+        movl p, %edx
+        call syscall
+        cmpl $0xffffffff, %eax
+        jnz .LOPEN1
+        movw %cx, InOutRes
+        movw UnusedHandle, %ax
+.LOPEN1:
+        movl f,%edx         { Warning : This assumes Handle is first }
+        movw %ax,(%edx)     { field of FileRec                       }
+    end;
+    if (InOutRes = 4) and Increase_File_Handle_Count then
+(* Trying again after increasing amount of file handles *)
+        asm
+            movl $0x7f2b, %eax
+            movl Action, %ecx
+            movl p, %edx
+            call syscall
+            cmpl $0xffffffff, %eax
+            jnz .LOPEN2
+            movw %cx, InOutRes
+            movw UnusedHandle, %ax
+.LOPEN2:
+            movl f,%edx
+            movw %ax,(%edx)
+        end;
+      { for systems that have more handles }
+    if FileRec (F).Handle > FileHandleCount then
+        FileHandleCount := FileRec (F).Handle;
+    if (flags and $100)<>0 then
+        begin
+            do_seekend(filerec(f).handle);
+            FileRec (F).Mode := fmOutput; {fool fmappend}
+        end;
+end;
+
+{$ASMMODE INTEL}
+function do_isdevice (Handle: longint): boolean; assembler;
+(*
+var HT, Attr: longint;
+begin
+    if os_mode = osOS2 then
+        begin
+            if DosQueryHType (Handle, HT, Attr) <> 0 then HT := 1;
+        end
+    else
+*)
+asm
+    mov ebx, Handle
+    mov eax, 4400h
+    call syscall
+    mov eax, 1
+    jc @IsDevEnd
+    test edx, 80h           { verify if it is a file  }
+    jnz @IsDevEnd
+    dec eax                 { nope, so result is zero }
+@IsDevEnd:
+end;
+{$ASMMODE ATT}
+
+
+{*****************************************************************************
+                           UnTyped File Handling
+*****************************************************************************}
+
+{$i file.inc}
+
+{*****************************************************************************
+                           Typed File Handling
+*****************************************************************************}
+
+{$i typefile.inc}
+
+{*****************************************************************************
+                           Text File Handling
+*****************************************************************************}
+
+{$DEFINE EOF_CTRLZ}
+
+{$i text.inc}
+
+{****************************************************************************
+
+                          Directory related routines.
+
+****************************************************************************}
+
+{*****************************************************************************
+                           Directory Handling
+*****************************************************************************}
+
+
+procedure dosdir(func:byte;const s:string);
+
+var buffer:array[0..255] of char;
+
+begin
+    move(s[1],buffer,length(s));
+    buffer[length(s)]:=#0;
+    allowslash(Pchar(@buffer));
+    asm
+        leal buffer,%edx
+        movb func,%ah
+        call syscall
+        jnc  .LDOS_DIRS1
+        movw %ax,inoutres
+    .LDOS_DIRS1:
+    end;
+end;
+
+
+procedure MkDir (const S: string);[IOCHECK];
+
+var buffer:array[0..255] of char;
+    Rc : word;
+
+begin
+  If (s='') or (InOutRes <> 0) then
+   exit;
+ if os_mode = osOs2 then
+    begin
+      move(s[1],buffer,length(s));
+      buffer[length(s)]:=#0;
+      allowslash(Pchar(@buffer));
+      Rc := DosCreateDir(buffer,nil);
+      if Rc <> 0 then
+       begin
+         InOutRes := Rc;
+         Errno2Inoutres;
+       end;
+    end
+  else
+   begin
+     { Under EMX 0.9d DOS this routine call may sometimes fail   }
+     { The syscall documentation indicates clearly that this     }
+     { routine was NOT tested.                                   }
+        DosDir ($39, S);
+end;
+end;
+
+
+procedure rmdir(const s : string);[IOCHECK];
+var buffer:array[0..255] of char;
+    Rc : word;
+begin
+  if (s = '.' ) then
+    InOutRes := 16;
+  If (s='') or (InOutRes <> 0) then
+   exit;
+  if os_mode = osOs2 then
+    begin
+      move(s[1],buffer,length(s));
+      buffer[length(s)]:=#0;
+      allowslash(Pchar(@buffer));
+      Rc := DosDeleteDir(buffer);
+      if Rc <> 0 then
+       begin
+         InOutRes := Rc;
+         Errno2Inoutres;
+       end;
+    end
+  else
+   begin
+     { Under EMX 0.9d DOS this routine call may sometimes fail   }
+     { The syscall documentation indicates clearly that this     }
+     { routine was NOT tested.                                   }
+        DosDir ($3A, S);
+end;
+end;
+
+{$ASMMODE INTEL}
+
+procedure ChDir (const S: string);[IOCheck];
+
+var RC: longint;
+    Buffer: array [0..255] of char;
+
+begin
+  If (s='') or (InOutRes <> 0) then
+   exit;
+(* According to EMX documentation, EMX has only one current directory
+   for all processes, so we'll use native calls under OS/2. *)
+            if os_Mode = osOS2 then
+                begin
+                    if (Length (S) >= 2) and (S [2] = ':') then
+                        begin
+                            RC := DosSetDefaultDisk ((Ord (S [1]) and
+                                                             not ($20)) - $40);
+                            if RC <> 0 then
+                                InOutRes := RC
+                            else
+                                if Length (S) > 2 then
+                                    begin
+                                        Move (S [1], Buffer, Length (S));
+                                        Buffer [Length (S)] := #0;
+                                        AllowSlash (PChar (@Buffer));
+                                        RC := DosSetCurrentDir (@Buffer);
+                                        if RC <> 0 then
+                                         begin
+                                            InOutRes := RC;
+                                            Errno2InOutRes;
+                                         end;
+                                    end;
+                        end
+                    else
+                        begin
+                            Move (S [1], Buffer, Length (S));
+                            Buffer [Length (S)] := #0;
+                            AllowSlash (PChar (@Buffer));
+                            RC := DosSetCurrentDir (@Buffer);
+                            if RC <> 0 then
+                             begin
+                                  InOutRes:= RC;
+                                  Errno2InOutRes;
+                             end;
+                        end;
+                end
+            else
+                if (Length (S) >= 2) and (S [2] = ':') then
+                    begin
+                        asm
+                            mov esi, S
+                            mov al, [esi + 1]
+                            and al, not (20h)
+                            sub al, 41h
+                            mov edx, eax
+                            mov ah, 0Eh
+                            call syscall
+                            mov ah, 19h
+                            call syscall
+                            cmp al, dl
+                            jz @LCHDIR
+                            mov InOutRes, 15
+@LCHDIR:
+                        end;
+                        if (Length (S) > 2) and (InOutRes <> 0) then
+                            { Under EMX 0.9d DOS this routine may sometime }
+                            { fail or crash the system.                    }
+                            DosDir ($3B, S);
+                    end
+                else
+                    { Under EMX 0.9d DOS this routine may sometime }
+                    { fail or crash the system.                    }
+                    DosDir ($3B, S);
+end;
+
+{$ASMMODE ATT}
+
+procedure GetDir (DriveNr: byte; var Dir: ShortString);
+
+{Written by Michael Van Canneyt.}
+
+var sof:Pchar;
+    i:byte;
+
+begin
+    Dir [4] := #0;
+    { Used in case the specified drive isn't available }
+    sof:=pchar(@dir[4]);
+    { dir[1..3] will contain '[drivenr]:\', but is not }
+    { supplied by DOS, so we let dos string start at   }
+    { dir[4]                                           }
+    { Get dir from drivenr : 0=default, 1=A etc... }
+    asm
+        movb drivenr,%dl
+        movl sof,%esi
+        mov  $0x47,%ah
+        call syscall
+        jnc .LGetDir
+        movw %ax, InOutRes
+.LGetDir:
+    end;
+    { Now Dir should be filled with directory in ASCIIZ, }
+    { starting from dir[4]                               }
+    dir[0]:=#3;
+    dir[2]:=':';
+    dir[3]:='\';
+    i:=4;
+    {Conversion to Pascal string }
+    while (dir[i]<>#0) do
+        begin
+            { convert path name to DOS }
+            if dir[i]='/' then
+            dir[i]:='\';
+            dir[0]:=char(i);
+            inc(i);
+        end;
+    { upcase the string (FPC function) }
+    if drivenr<>0 then   { Drive was supplied. We know it }
+        dir[1]:=chr(64+drivenr)
+    else
+        begin
+            { We need to get the current drive from DOS function 19H  }
+            { because the drive was the default, which can be unknown }
+            asm
+                movb $0x19,%ah
+                call syscall
+                addb $65,%al
+                movb %al,i
+            end;
+            dir[1]:=char(i);
+        end;
+    if not (FileNameCaseSensitive) then dir:=upcase(dir);
+end;
+
+
+{*****************************************************************************
+
+                        System unit initialization.
+
+****************************************************************************}
+
+procedure SysInitStdIO;
+begin
+    OpenStdIO(Input,fmInput,StdInputHandle);
+    OpenStdIO(Output,fmOutput,StdOutputHandle);
+    OpenStdIO(StdOut,fmOutput,StdOutputHandle);
+    OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+end;
+
+
+function GetFileHandleCount: longint;
+var L1, L2: longint;
+begin
+    L1 := 0; (* Don't change the amount, just check. *)
+    if DosSetRelMaxFH (L1, L2) <> 0 then GetFileHandleCount := 50
+                                                 else GetFileHandleCount := L2;
+end;
+
+var tib:Pthreadinfoblock;
+
+begin
+    IsConsole := TRUE;
+    IsLibrary := FALSE;
+    {Determine the operating system we are running on.}
+{$ASMMODE INTEL}
+    asm
+        mov os_mode, 0
+        mov eax, 7F0Ah
+        call syscall
+        test bx, 512         {Bit 9 is OS/2 flag.}
+        setne byte ptr os_mode
+        test bx, 4096
+        jz @noRSX
+        mov os_mode, 2
+    @noRSX:
+
+    {Enable the brk area by initializing it with the initial heap size.}
+
+        mov eax, 7F01h
+        mov edx, heap_brk
+        add edx, heap_base
+        call syscall
+        cmp eax, -1
+        jnz @heapok
+        push dword 204
+        call HandleError
+    @heapok:
+{$IFDEF CONTHEAP}
+{ Find out brk limit }
+        mov eax, 7F02h
+        mov ecx, 3
+        call syscall
+        jcxz @heaplimitknown
+        mov eax, 0
+    @heaplimitknown:
+        mov BrkLimit, eax
+{$ELSE CONTHEAP}
+{ Change sbrk behaviour to allocate arbitrary (non-contiguous) memory blocks }
+        mov eax, 7F0Fh
+        mov ecx, 0Ch
+        mov edx, 8
+        call syscall
+{$ENDIF CONTHEAP}
+    end;
+
+    { in OS/2 this will always be nil, but in DOS mode }
+    { this can be changed.                             }
+    first_meg := nil;
+    {Now request, if we are running under DOS,
+     read-access to the first meg. of memory.}
+    if os_mode in [osDOS,osDPMI] then
+        asm
+            mov eax, 7F13h
+            xor ebx, ebx
+            mov ecx, 0FFFh
+            xor edx, edx
+            call syscall
+            jnc  @endmem
+            mov first_meg, eax
+         @endmem:
+        end
+    else
+        begin
+    (* Initialize the amount of file handles *)
+            FileHandleCount := GetFileHandleCount;
+        end;
+    {At 0.9.2, case for enumeration does not work.}
+    case os_mode of
+        osDOS:
+            stackbottom:=cardinal(heap_brk);     {In DOS mode, heap_brk is also the
+                                 stack bottom.}
+        osOS2:
+            begin
+                dosgetinfoblocks(@tib,nil);
+                stackbottom:=cardinal(tib^.stack);
+            end;
+        osDPMI:
+            stackbottom:=0;     {Not sure how to get it, but seems to be
+                                 always zero.}
+    end;
+    exitproc:=nil;
+
+{$ifdef MT}
+    if os_mode = osOS2 then
+        begin
+            { allocate one ThreadVar entry from the OS, we use this entry }
+            { for a pointer to our threadvars                             }
+            if DosAllocThreadLocalMemory (1, DataIndex) <> 0 then RunError (8);
+            { the exceptions use threadvars so do this _before_ initexceptions }
+            AllocateThreadVars;
+        end;
+{$endif MT}
+
+    {Initialize the heap.}
+    initheap;
+
+    { ... and exceptions }
+    SysInitExceptions;
+
+    { ... and I/O }
+    SysInitStdIO;
+
+    { no I/O-Error }
+    inoutres:=0;
+
+{$ifdef HASVARIANT}
+    initvariantmanager;
+{$endif HASVARIANT}
+
+{$IFDEF DUMPGROW}
+ {$IFDEF CONTHEAP}
+    WriteLn ('Initial brk size is ', GetHeapSize);
+    WriteLn ('Brk limit is ', BrkLimit);
+ {$ENDIF CONTHEAP}
+{$ENDIF DUMPGROW}
+end.
+{
+  $Log$
+  Revision 1.1  2002-11-17 16:22:54  hajny
+    + RTL for emx target
+
+  Revision 1.26  2002/10/27 14:29:00  hajny
+    * heap management (hopefully) fixed
+
+  Revision 1.25  2002/10/14 19:39:17  peter
+    * threads unit added for thread support
+
+  Revision 1.24  2002/10/13 09:28:45  florian
+    + call to initvariantmanager inserted
+
+  Revision 1.23  2002/09/07 16:01:25  peter
+    * old logs removed and tabs fixed
+
+  Revision 1.22  2002/07/01 16:29:05  peter
+    * sLineBreak changed to normal constant like Kylix
+
+  Revision 1.21  2002/04/21 15:54:20  carl
+  + initialize some global variables
+
+  Revision 1.20  2002/04/12 17:42:16  carl
+  + generic stack checking
+
+  Revision 1.19  2002/03/11 19:10:33  peter
+    * Regenerated with updated fpcmake
+
+  Revision 1.18  2002/02/10 13:46:20  hajny
+    * heap management corrected (heap_brk)
+
+}

rtl/emx/sysutils.pp

@@ -0,0 +1,969 @@
+{
+    $Id$
+
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Florian Klaempfl
+    member of the Free Pascal development team
+
+    Sysutils unit for OS/2
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit sysutils;
+interface
+
+{$MODE objfpc}
+{ force ansistrings }
+{$H+}
+
+uses
+ Dos;
+
+{ Include platform independent interface part }
+{$i sysutilh.inc}
+
+
+implementation
+
+{ Include platform independent implementation part }
+{$i sysutils.inc}
+
+
+{****************************************************************************
+                        System (imported) calls
+****************************************************************************}
+
+(* "uses DosCalls" could not be used here due to type    *)
+(* conflicts, so needed parts had to be redefined here). *)
+
+type
+ TFileStatus = object
+               end;
+ PFileStatus = ^TFileStatus;
+
+ TFileStatus0 = object (TFileStatus)
+                 DateCreation,        {Date of file creation.}
+                 TimeCreation,        {Time of file creation.}
+                 DateLastAccess,      {Date of last access to file.}
+                 TimeLastAccess,      {Time of last access to file.}
+                 DateLastWrite,       {Date of last modification of file.}
+                 TimeLastWrite: word; {Time of last modification of file.}
+                 FileSize,            {Size of file.}
+                 FileAlloc: longint;  {Amount of space the file really
+                                       occupies on disk.}
+                end;
+ PFileStatus0 = ^TFileStatus0;
+
+ TFileStatus3 = object (TFileStatus)
+                 NextEntryOffset: longint; {Offset of next entry}
+                 DateCreation,             {Date of file creation.}
+                 TimeCreation,             {Time of file creation.}
+                 DateLastAccess,           {Date of last access to file.}
+                 TimeLastAccess,           {Time of last access to file.}
+                 DateLastWrite,            {Date of last modification of file.}
+                 TimeLastWrite: word;      {Time of last modification of file.}
+                 FileSize,                 {Size of file.}
+                 FileAlloc: longint;       {Amount of space the file really
+                                            occupies on disk.}
+                 AttrFile: longint;        {Attributes of file.}
+                end;
+ PFileStatus3 = ^TFileStatus3;
+
+ TFileFindBuf3 = object (TFileStatus3)
+                  Name: ShortString;       {Also possible to use as ASCIIZ.
+                                            The byte following the last string
+                                            character is always zero.}
+                 end;
+ PFileFindBuf3 = ^TFileFindBuf3;
+
+ TFSInfo = record
+            case word of
+             1:
+              (File_Sys_ID,
+               Sectors_Per_Cluster,
+               Total_Clusters,
+               Free_Clusters: longint;
+               Bytes_Per_Sector: word);
+             2:                           {For date/time description,
+                                           see file searching realted
+                                           routines.}
+              (Label_Date,                {Date when volume label was created.}
+               Label_Time: word;          {Time when volume label was created.}
+               VolumeLabel: ShortString); {Volume label. Can also be used
+                                           as ASCIIZ, because the byte
+                                           following the last character of
+                                           the string is always zero.}
+           end;
+ PFSInfo = ^TFSInfo;
+
+ TCountryCode=record
+               Country,           {Country to query info about (0=current).}
+               CodePage: longint; {Code page to query info about (0=current).}
+              end;
+ PCountryCode=^TCountryCode;
+
+ TTimeFmt = (Clock12, Clock24);
+
+ TCountryInfo=record
+               Country, CodePage: longint;  {Country and codepage requested.}
+               case byte of
+                0:
+                 (DateFormat: longint;      {1=ddmmyy 2=yymmdd 3=mmddyy}
+                  CurrencyUnit: array [0..4] of char;
+                  ThousandSeparator: char;  {Thousands separator.}
+                  Zero1: byte;              {Always zero.}
+                  DecimalSeparator: char;   {Decimals separator,}
+                  Zero2: byte;
+                  DateSeparator: char;      {Date separator.}
+                  Zero3: byte;
+                  TimeSeparator: char;      {Time separator.}
+                  Zero4: byte;
+                  CurrencyFormat,           {Bit field:
+                                             Bit 0: 0=indicator before value
+                                                    1=indicator after value
+                                             Bit 1: 1=insert space after
+                                                      indicator.
+                                             Bit 2: 1=Ignore bit 0&1, replace
+                                                      decimal separator with
+                                                      indicator.}
+                  DecimalPlace: byte;       {Number of decimal places used in
+                                             currency indication.}
+                  TimeFormat: TTimeFmt;     {12/24 hour.}
+                  Reserve1: array [0..1] of word;
+                  DataSeparator: char;      {Data list separator}
+                  Zero5: byte;
+                  Reserve2: array [0..4] of word);
+                1:
+                 (fsDateFmt: longint;       {1=ddmmyy 2=yymmdd 3=mmddyy}
+                  szCurrency: array [0..4] of char;
+                                            {null terminated currency symbol}
+                  szThousandsSeparator: array [0..1] of char;
+                                            {Thousands separator + #0}
+                  szDecimal: array [0..1] of char;
+                                            {Decimals separator + #0}
+                  szDateSeparator: array [0..1] of char;
+                                            {Date separator + #0}
+                  szTimeSeparator: array [0..1] of char;
+                                            {Time separator + #0}
+                  fsCurrencyFmt,            {Bit field:
+                                             Bit 0: 0=indicator before value
+                                                    1=indicator after value
+                                             Bit 1: 1=insert space after
+                                                      indicator.
+                                             Bit 2: 1=Ignore bit 0&1, replace
+                                                      decimal separator with
+                                                      indicator}
+                  cDecimalPlace: byte;      {Number of decimal places used in
+                                             currency indication}
+                  fsTimeFmt: byte;          {0=12,1=24 hours}
+                  abReserved1: array [0..1] of word;
+                  szDataSeparator: array [0..1] of char;
+                                            {Data list separator + #0}
+                  abReserved2: array [0..4] of word);
+              end;
+ PCountryInfo=^TCountryInfo;
+
+const
+ ilStandard      = 1;
+ ilQueryEAsize   = 2;
+ ilQueryEAs      = 3;
+ ilQueryFullName = 5;
+
+{This is the correct way to call external assembler procedures.}
+procedure syscall;external name '___SYSCALL';
+
+function DosSetFileInfo (Handle, InfoLevel: longint; AFileStatus: PFileStatus;
+        FileStatusLen: longint): longint; cdecl; external 'DOSCALLS' index 218;
+
+function DosQueryFSInfo (DiskNum, InfoLevel: longint; var Buffer: TFSInfo;
+               BufLen: longint): longint; cdecl; external 'DOSCALLS' index 278;
+
+function DosQueryFileInfo (Handle, InfoLevel: longint;
+           AFileStatus: PFileStatus; FileStatusLen: longint): longint; cdecl;
+                                                 external 'DOSCALLS' index 279;
+
+function DosScanEnv (Name: PChar; var Value: PChar): longint; cdecl;
+                                                 external 'DOSCALLS' index 227;
+
+function DosFindFirst (FileMask: PChar; var Handle: longint; Attrib: longint;
+                       AFileStatus: PFileStatus; FileStatusLen: longint;
+                       var Count: longint; InfoLevel: longint): longint; cdecl;
+                                                 external 'DOSCALLS' index 264;
+function DosFindNext (Handle: longint; AFileStatus: PFileStatus;
+                FileStatusLen: longint; var Count: longint): longint; cdecl;
+                                                 external 'DOSCALLS' index 265;
+
+function DosFindClose (Handle: longint): longint; cdecl;
+                                                 external 'DOSCALLS' index 263;
+
+function DosQueryCtryInfo (Size: longint; var Country: TCountryCode;
+           var Res: TCountryInfo; var ActualSize: longint): longint; cdecl;
+                                                        external 'NLS' index 5;
+
+function DosMapCase (Size: longint; var Country: TCountryCode;
+                       AString: PChar): longint; cdecl; external 'NLS' index 7;
+
+
+{****************************************************************************
+                              File Functions
+****************************************************************************}
+
+const
+ ofRead        = $0000;     {Open for reading}
+ ofWrite       = $0001;     {Open for writing}
+ ofReadWrite   = $0002;     {Open for reading/writing}
+ doDenyRW      = $0010;     {DenyAll (no sharing)}
+ faCreateNew   = $00010000; {Create if file does not exist}
+ faOpenReplace = $00040000; {Truncate if file exists}
+ faCreate      = $00050000; {Create if file does not exist, truncate otherwise}
+
+ FindResvdMask = $00003737; {Allowed bits in attribute
+                             specification for DosFindFirst call.}
+
+{$ASMMODE INTEL}
+function FileOpen (const FileName: string; Mode: integer): longint;
+{$IFOPT H+}
+                                                                    assembler;
+{$ELSE}
+var FN: string;
+begin
+    FN := FileName + #0;
+{$ENDIF}
+    asm
+        mov eax, Mode
+(* DenyAll if sharing not specified. *)
+        test eax, 112
+        jnz @FOpen1
+        or eax, 16
+@FOpen1:
+        mov ecx, eax
+        mov eax, 7F2Bh
+{$IFOPT H+}
+        mov edx, FileName
+{$ELSE}
+        lea edx, FN
+        inc edx
+{$ENDIF}
+        call syscall
+{$IFOPT H-}
+        mov [ebp - 4], eax
+    end;
+{$ENDIF}
+end;
+
+
+function FileCreate (const FileName: string): longint;
+{$IFOPT H+}
+                                                                    assembler;
+{$ELSE}
+var FN: string;
+begin
+    FN := FileName + #0;
+{$ENDIF}
+    asm
+        mov eax, 7F2Bh
+        mov ecx, ofReadWrite or faCreate or doDenyRW   (* Sharing to DenyAll *)
+{$IFOPT H+}
+        mov edx, FileName
+{$ELSE}
+        lea edx, FN
+        inc edx
+{$ENDIF}
+        call syscall
+{$IFOPT H-}
+        mov [ebp - 4], eax
+    end;
+{$ENDIF}
+end;
+
+
+function FileRead (Handle: longint; var Buffer; Count: longint): longint;
+                                                                     assembler;
+asm
+    mov eax, 3F00h
+    mov ebx, Handle
+    mov ecx, Count
+    mov edx, Buffer
+    call syscall
+    jnc @FReadEnd
+    mov eax, -1
+@FReadEnd:
+end;
+
+
+function FileWrite (Handle: longint; const Buffer; Count: longint): longint;
+                                                                     assembler;
+asm
+    mov eax, 4000h
+    mov ebx, Handle
+    mov ecx, Count
+    mov edx, Buffer
+    call syscall
+    jnc @FWriteEnd
+    mov eax, -1
+@FWriteEnd:
+end;
+
+
+function FileSeek (Handle, FOffset, Origin: longint): longint; assembler;
+asm
+    mov eax, Origin
+    mov ah, 42h
+    mov ebx, Handle
+    mov edx, FOffset
+    call syscall
+    jnc @FSeekEnd
+    mov eax, -1
+@FSeekEnd:
+end;
+
+Function FileSeek (Handle : Longint; FOffset,Origin : Int64) : Int64;
+begin
+  {$warning need to add 64bit call }
+  Result:=FileSeek(Handle,Longint(Foffset),Longint(Origin));
+end;
+
+procedure FileClose (Handle: longint);
+begin
+    if (Handle <= 4) or (os_mode = osOS2) and (Handle <= 2) then
+        asm
+            mov eax, 3E00h
+            mov ebx, Handle
+            call syscall
+        end;
+end;
+
+
+function FileTruncate (Handle, Size: longint): boolean; assembler;
+asm
+    mov eax, 7F25h
+    mov ebx, Handle
+    mov edx, Size
+    call syscall
+    jc @FTruncEnd
+    mov eax, 4202h
+    mov ebx, Handle
+    mov edx, 0
+    call syscall
+    mov eax, 0
+    jnc @FTruncEnd
+    dec eax
+@FTruncEnd:
+end;
+
+
+function FileAge (const FileName: string): longint;
+var Handle: longint;
+begin
+    Handle := FileOpen (FileName, 0);
+    if Handle <> -1 then
+        begin
+            Result := FileGetDate (Handle);
+            FileClose (Handle);
+        end
+    else
+        Result := -1;
+end;
+
+
+function FileExists (const FileName: string): boolean;
+{$IFOPT H+}
+                                                       assembler;
+{$ELSE}
+var FN: string;
+begin
+    FN := FileName + #0;
+{$ENDIF}
+asm
+    mov ax, 4300h
+{$IFOPT H+}
+    mov edx, FileName
+{$ELSE}
+    lea edx, FN
+    inc edx
+{$ENDIF}
+    call syscall
+    mov eax, 0
+    jc @FExistsEnd
+    test cx, 18h
+    jnz @FExistsEnd
+    inc eax
+@FExistsEnd:
+{$IFOPT H-}
+end;
+{$ENDIF}
+end;
+
+
+type    TRec = record
+            T, D: word;
+        end;
+        PSearchRec = ^SearchRec;
+
+function FindFirst (const Path: string; Attr: longint; var Rslt: TSearchRec): longint;
+
+var SR: PSearchRec;
+    FStat: PFileFindBuf3;
+    Count: longint;
+    Err: longint;
+
+begin
+    if os_mode = osOS2 then
+        begin
+            New (FStat);
+            Rslt.FindHandle := $FFFFFFFF;
+            Count := 1;
+            Err := DosFindFirst (PChar (Path), Rslt.FindHandle,
+                 Attr and FindResvdMask, FStat, SizeOf (FStat^), Count,
+                                                                   ilStandard);
+            if (Err = 0) and (Count = 0) then Err := 18;
+            FindFirst := -Err;
+            if Err = 0 then
+                begin
+                    Rslt.Name := FStat^.Name;
+                    Rslt.Size := FStat^.FileSize;
+                    Rslt.Attr := FStat^.AttrFile;
+                    Rslt.ExcludeAttr := 0;
+                    TRec (Rslt.Time).T := FStat^.TimeLastWrite;
+                    TRec (Rslt.Time).D := FStat^.DateLastWrite;
+                end;
+            Dispose (FStat);
+        end
+    else
+        begin
+            Err := DOS.DosError;
+            GetMem (SR, SizeOf (SearchRec));
+            Rslt.FindHandle := longint(SR);
+            DOS.FindFirst (Path, Attr, SR^);
+            FindFirst := -DOS.DosError;
+            if DosError = 0 then
+                begin
+                    Rslt.Time := SR^.Time;
+                    Rslt.Size := SR^.Size;
+                    Rslt.Attr := SR^.Attr;
+                    Rslt.ExcludeAttr := 0;
+                    Rslt.Name := SR^.Name;
+                end;
+            DOS.DosError := Err;
+        end;
+end;
+
+
+function FindNext (var Rslt: TSearchRec): longint;
+
+var SR: PSearchRec;
+    FStat: PFileFindBuf3;
+    Count: longint;
+    Err: longint;
+
+begin
+    if os_mode = osOS2 then
+        begin
+            New (FStat);
+            Count := 1;
+            Err := DosFindNext (Rslt.FindHandle, FStat, SizeOf (FStat^),
+                                                                        Count);
+            if (Err = 0) and (Count = 0) then Err := 18;
+            FindNext := -Err;
+            if Err = 0 then
+                begin
+                    Rslt.Name := FStat^.Name;
+                    Rslt.Size := FStat^.FileSize;
+                    Rslt.Attr := FStat^.AttrFile;
+                    Rslt.ExcludeAttr := 0;
+                    TRec (Rslt.Time).T := FStat^.TimeLastWrite;
+                    TRec (Rslt.Time).D := FStat^.DateLastWrite;
+                end;
+            Dispose (FStat);
+        end
+    else
+        begin
+            SR := PSearchRec (Rslt.FindHandle);
+            if SR <> nil then
+                begin
+                    DOS.FindNext (SR^);
+                    FindNext := -DosError;
+                    if DosError = 0 then
+                        begin
+                            Rslt.Time := SR^.Time;
+                            Rslt.Size := SR^.Size;
+                            Rslt.Attr := SR^.Attr;
+                            Rslt.ExcludeAttr := 0;
+                            Rslt.Name := SR^.Name;
+                        end;
+                end;
+        end;
+end;
+
+
+procedure FindClose (var F: TSearchrec);
+
+var SR: PSearchRec;
+
+begin
+    if os_mode = osOS2 then
+        begin
+            DosFindClose (F.FindHandle);
+        end
+    else
+        begin
+            SR := PSearchRec (F.FindHandle);
+            DOS.FindClose (SR^);
+            FreeMem (SR, SizeOf (SearchRec));
+        end;
+    F.FindHandle := 0;
+end;
+
+
+function FileGetDate (Handle: longint): longint; assembler;
+asm
+    mov ax, 5700h
+    mov ebx, Handle
+    call syscall
+    mov eax, -1
+    jc @FGetDateEnd
+    mov ax, dx
+    shld eax, ecx, 16
+@FGetDateEnd:
+end;
+
+
+function FileSetDate (Handle, Age: longint): longint;
+var FStat: PFileStatus0;
+    RC: longint;
+begin
+    if os_mode = osOS2 then
+        begin
+            New (FStat);
+            RC := DosQueryFileInfo (Handle, ilStandard, FStat,
+                                                              SizeOf (FStat^));
+            if RC <> 0 then
+                FileSetDate := -1
+            else
+                begin
+                    FStat^.DateLastAccess := Hi (Age);
+                    FStat^.DateLastWrite := Hi (Age);
+                    FStat^.TimeLastAccess := Lo (Age);
+                    FStat^.TimeLastWrite := Lo (Age);
+                    RC := DosSetFileInfo (Handle, ilStandard, FStat,
+                                                              SizeOf (FStat^));
+                    if RC <> 0 then
+                        FileSetDate := -1
+                    else
+                        FileSetDate := 0;
+                end;
+            Dispose (FStat);
+        end
+    else
+        asm
+            mov ax, 5701h
+            mov ebx, Handle
+            mov cx, word ptr [Age]
+            mov dx, word ptr [Age + 2]
+            call syscall
+            jnc @FSetDateEnd
+            mov eax, -1
+@FSetDateEnd:
+            mov [ebp - 4], eax
+        end;
+end;
+
+
+function FileGetAttr (const FileName: string): longint;
+{$IFOPT H+}
+                                                        assembler;
+{$ELSE}
+var FN: string;
+begin
+    FN := FileName + #0;
+{$ENDIF}
+asm
+    mov ax, 4300h
+{$IFOPT H+}
+    mov edx, FileName
+{$ELSE}
+    lea edx, FN
+    inc edx
+{$ENDIF}
+    call syscall
+    jnc @FGetAttrEnd
+    mov eax, -1
+@FGetAttrEnd:
+{$IFOPT H-}
+    mov [ebp - 4], eax
+end;
+{$ENDIF}
+end;
+
+
+function FileSetAttr (const Filename: string; Attr: longint): longint;
+{$IFOPT H+}
+                                                                     assembler;
+{$ELSE}
+var FN: string;
+begin
+    FN := FileName + #0;
+{$ENDIF}
+asm
+    mov ax, 4301h
+    mov ecx, Attr
+{$IFOPT H+}
+    mov edx, FileName
+{$ELSE}
+    lea edx, FN
+    inc edx
+{$ENDIF}
+    call syscall
+    mov eax, 0
+    jnc @FSetAttrEnd
+    mov eax, -1
+@FSetAttrEnd:
+{$IFOPT H-}
+    mov [ebp - 4], eax
+end;
+{$ENDIF}
+end;
+
+
+function DeleteFile (const FileName: string): boolean;
+{$IFOPT H+}
+                                                       assembler;
+{$ELSE}
+var FN: string;
+begin
+    FN := FileName + #0;
+{$ENDIF}
+asm
+    mov ax, 4100h
+{$IFOPT H+}
+    mov edx, FileName
+{$ELSE}
+    lea edx, FN
+    inc edx
+{$ENDIF}
+    call syscall
+    mov eax, 0
+    jc @FDeleteEnd
+    inc eax
+@FDeleteEnd:
+{$IFOPT H-}
+    mov [ebp - 4], eax
+end;
+{$ENDIF}
+end;
+
+
+function RenameFile (const OldName, NewName: string): boolean;
+{$IFOPT H+}
+                                                       assembler;
+{$ELSE}
+var FN1, FN2: string;
+begin
+    FN1 := OldName + #0;
+    FN2 := NewName + #0;
+{$ENDIF}
+asm
+    mov ax, 5600h
+{$IFOPT H+}
+    mov edx, OldName
+    mov edi, NewName
+{$ELSE}
+    lea edx, FN1
+    inc edx
+    lea edi, FN2
+    inc edi
+{$ENDIF}
+    call syscall
+    mov eax, 0
+    jc @FRenameEnd
+    inc eax
+@FRenameEnd:
+{$IFOPT H-}
+    mov [ebp - 4], eax
+end;
+{$ENDIF}
+end;
+
+
+{****************************************************************************
+                              Disk Functions
+****************************************************************************}
+
+{$ASMMODE ATT}
+
+function DiskFree (Drive: byte): int64;
+
+var FI: TFSinfo;
+    RC: longint;
+
+begin
+    if (os_mode = osDOS) or (os_mode = osDPMI) then
+    {Function 36 is not supported in OS/2.}
+        asm
+            movb Drive,%dl
+            movb $0x36,%ah
+            call syscall
+            cmpw $-1,%ax
+            je .LDISKFREE1
+            mulw %cx
+            mulw %bx
+            shll $16,%edx
+            movw %ax,%dx
+            movl $0,%eax
+            xchgl %edx,%eax
+            leave
+            ret
+         .LDISKFREE1:
+            cltd
+            leave
+            ret
+        end
+    else
+        {In OS/2, we use the filesystem information.}
+        begin
+            RC := DosQueryFSInfo (Drive, 1, FI, SizeOf (FI));
+            if RC = 0 then
+                DiskFree := int64 (FI.Free_Clusters) *
+                   int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
+            else
+                DiskFree := -1;
+        end;
+end;
+
+function DiskSize (Drive: byte): int64;
+
+var FI: TFSinfo;
+    RC: longint;
+
+begin
+    if (os_mode = osDOS) or (os_mode = osDPMI) then
+        {Function 36 is not supported in OS/2.}
+        asm
+            movb Drive,%dl
+            movb $0x36,%ah
+            call syscall
+            movw %dx,%bx
+            cmpw $-1,%ax
+            je .LDISKSIZE1
+            mulw %cx
+            mulw %bx
+            shll $16,%edx
+            movw %ax,%dx
+            movl $0,%eax
+            xchgl %edx,%eax
+            leave
+            ret
+        .LDISKSIZE1:
+            cltd
+            leave
+            ret
+        end
+    else
+        {In OS/2, we use the filesystem information.}
+        begin
+            RC := DosQueryFSinfo (Drive, 1, FI, SizeOf (FI));
+            if RC = 0 then
+                DiskSize := int64 (FI.Total_Clusters) *
+                   int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
+            else
+                DiskSize := -1;
+        end;
+end;
+
+
+function GetCurrentDir: string;
+begin
+ GetDir (0, Result);
+end;
+
+
+function SetCurrentDir (const NewDir: string): boolean;
+begin
+{$I-}
+ ChDir (NewDir);
+ Result := (IOResult = 0);
+{$I+}
+end;
+
+
+function CreateDir (const NewDir: string): boolean;
+begin
+{$I-}
+ MkDir (NewDir);
+ Result := (IOResult = 0);
+{$I+}
+end;
+
+
+function RemoveDir (const Dir: string): boolean;
+begin
+{$I-}
+ RmDir (Dir);
+ Result := (IOResult = 0);
+ {$I+}
+end;
+
+
+{****************************************************************************
+                              Time Functions
+****************************************************************************}
+
+{$asmmode intel}
+procedure GetLocalTime (var SystemTime: TSystemTime); assembler;
+asm
+(* Expects the default record alignment (word)!!! *)
+    mov ah, 2Ah
+    call syscall
+    mov edi, SystemTime
+    mov ax, cx
+    stosw
+    xor eax, eax
+    mov al, dl
+    shl eax, 16
+    mov al, dh
+    stosd
+    push edi
+    mov ah, 2Ch
+    call syscall
+    pop edi
+    xor eax, eax
+    mov al, cl
+    shl eax, 16
+    mov al, ch
+    stosd
+    mov al, dl
+    shl eax, 16
+    mov al, dh
+    stosd
+end;
+{$asmmode default}
+
+
+{****************************************************************************
+                              Misc Functions
+****************************************************************************}
+
+procedure Beep;
+begin
+end;
+
+
+{****************************************************************************
+                              Locale Functions
+****************************************************************************}
+
+procedure InitAnsi;
+var I: byte;
+    Country: TCountryCode;
+begin
+    for I := 0 to 255 do
+        UpperCaseTable [I] := Chr (I);
+    Move (UpperCaseTable, LowerCaseTable, SizeOf (UpperCaseTable));
+    if os_mode = osOS2 then
+        begin
+            FillChar (Country, SizeOf (Country), 0);
+            DosMapCase (SizeOf (UpperCaseTable), Country, @UpperCaseTable);
+        end
+    else
+        begin
+(* !!! TODO: DOS/DPMI mode support!!! *)
+        end;
+    for I := 0 to 255 do
+        if UpperCaseTable [I] <> Chr (I) then
+            LowerCaseTable [Ord (UpperCaseTable [I])] := Chr (I);
+end;
+
+
+procedure InitInternational;
+var Country: TCountryCode;
+    CtryInfo: TCountryInfo;
+    Size: longint;
+    RC: longint;
+begin
+    Size := 0;
+    FillChar (Country, SizeOf (Country), 0);
+    FillChar (CtryInfo, SizeOf (CtryInfo), 0);
+    RC := DosQueryCtryInfo (SizeOf (CtryInfo), Country, CtryInfo, Size);
+    if RC = 0 then
+        begin
+            DateSeparator := CtryInfo.DateSeparator;
+            case CtryInfo.DateFormat of
+             1: begin
+                    ShortDateFormat := 'd/m/y';
+                    LongDateFormat := 'dd" "mmmm" "yyyy';
+                end;
+             2: begin
+                    ShortDateFormat := 'y/m/d';
+                    LongDateFormat := 'yyyy" "mmmm" "dd';
+                end;
+             3: begin
+                    ShortDateFormat := 'm/d/y';
+                    LongDateFormat := 'mmmm" "dd" "yyyy';
+                end;
+            end;
+            TimeSeparator := CtryInfo.TimeSeparator;
+            DecimalSeparator := CtryInfo.DecimalSeparator;
+            ThousandSeparator := CtryInfo.ThousandSeparator;
+            CurrencyFormat := CtryInfo.CurrencyFormat;
+            CurrencyString := PChar (CtryInfo.CurrencyUnit);
+        end;
+    InitAnsi;
+end;
+
+function SysErrorMessage(ErrorCode: Integer): String;
+
+begin
+  Result:=Format(SUnknownErrorCode,[ErrorCode]);
+end;
+
+
+{****************************************************************************
+                              OS Utils
+****************************************************************************}
+
+Function GetEnvironmentVariable(Const EnvVar : String) : String;
+
+var P: PChar;
+
+begin
+    if DosScanEnv (PChar (EnvVar), P) = 0
+                  then GetEnvironmentVariable := StrPas (P)
+                                             else GetEnvironmentVariable := '';
+end;
+
+
+{****************************************************************************
+                              Initialization code
+****************************************************************************}
+
+Initialization
+  InitExceptions;       { Initialize exceptions. OS independent }
+  InitInternational;    { Initialize internationalization settings }
+Finalization
+  DoneExceptions;
+end.
+
+{
+  $Log$
+  Revision 1.1  2002-11-17 16:22:54  hajny
+    + RTL for emx target
+
+  Revision 1.18  2002/09/23 17:42:37  hajny
+    * AnsiString to PChar typecast
+
+  Revision 1.17  2002/09/07 16:01:25  peter
+    * old logs removed and tabs fixed
+
+  Revision 1.16  2002/07/11 16:00:05  hajny
+    * FindFirst fix (invalid attribute bits masked out)
+
+  Revision 1.15  2002/01/25 16:23:03  peter
+    * merged filesearch() fix
+
+}

rtl/emx/threads.pp

@@ -0,0 +1,361 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2002 by the Free Pascal development team.
+
+    OS/2 threading support implementation
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit threads;
+interface
+
+{$S-}
+
+  type
+    { the fields of this record are os dependent  }
+    { and they shouldn't be used in a program     }
+    { only the type TCriticalSection is important }
+    PRTLCriticalSection = ^TRTLCriticalSection;
+    TRTLCriticalSection = packed record
+      DebugInfo : pointer;
+      LockCount : longint;
+      RecursionCount : longint;
+      OwningThread : DWord;
+      LockSemaphore : DWord;
+      Reserved : DWord;
+    end;
+
+{ Include generic thread interface }
+{$i threadh.inc}
+
+
+implementation
+
+
+{*****************************************************************************
+                           Local Api imports
+*****************************************************************************}
+
+const
+ pag_Read = 1;
+ pag_Write = 2;
+ pag_Execute = 4;
+ pag_Guard = 8;
+ pag_Commit = $10;
+ obj_Tile = $40;
+ sem_Indefinite_Wait = -1;
+ dtSuspended = 1;
+ dtStack_Commited = 2;
+
+type
+ TThreadInfo = record
+  F: TThreadFunc;
+  P: pointer;
+ end;
+ PThreadInfo = ^TThreadInfo;
+
+{ import the necessary stuff from the OS }
+function DosAllocThreadLocalMemory (Count: cardinal; var P: pointer): longint;
+                                          cdecl; external 'DOSCALLS' index 454;
+
+function DosFreeThreadLocalMemory (P: pointer): longint; cdecl;
+                                                 external 'DOSCALLS' index 455;
+
+function DosCreateThread (var TID: longint; Address: pointer;
+(* TThreadFunc *)
+        aParam: pointer; Flags: longint; StackSize: longint): longint; cdecl;
+                                                 external 'DOSCALLS' index 311;
+
+procedure DosExit (Action, Result: longint); cdecl;
+                                                 external 'DOSCALLS' index 234;
+
+function DosCreateMutExSem (Name: PChar; var Handle: longint; Attr: longint;
+                State: boolean): longint; cdecl; external 'DOSCALLS' index 331;
+
+function DosCloseMutExSem (Handle: longint): longint; cdecl;
+                                                 external 'DOSCALLS' index 333;
+
+function DosQueryMutExSem (Handle: longint; var PID, TID, Count: longint):
+                                 longint; cdecl; external 'DOSCALLS' index 336;
+
+function DosRequestMutExSem (Handle, Timeout: longint): longint; cdecl;
+                                                 external 'DOSCALLS' index 334;
+
+function DosReleaseMutExSem (Handle: longint): longint; cdecl;
+                                                 external 'DOSCALLS' index 335;
+
+function DosAllocMem (var P: pointer; Size, Flag: longint): longint; cdecl;
+                                                 external 'DOSCALLS' index 299;
+
+function DosFreeMem (P: pointer): longint; cdecl;
+                                                 external 'DOSCALLS' index 304;
+
+function DosEnterCritSec:longint; cdecl; external 'DOSCALLS' index 232;
+
+function DosExitCritSec:longint; cdecl; external 'DOSCALLS' index 233;
+
+
+{*****************************************************************************
+                             Threadvar support
+*****************************************************************************}
+
+{$ifdef HASTHREADVAR}
+const
+ ThreadVarBlockSize: dword = 0;
+
+var
+(* Pointer to an allocated dword space within the local thread *)
+(* memory area. Pointer to the real memory block allocated for *)
+(* thread vars in this block is then stored in this dword.     *)
+ DataIndex: PPointer;
+
+procedure SysInitThreadvar (var Offset: dword; Size: dword);
+begin
+ Offset := ThreadVarBlockSize;
+ Inc (ThreadVarBlockSize, Size);
+end;
+
+function SysRelocateThreadVar (Offset: dword): pointer;
+begin
+ SysRelocateThreadVar := DataIndex^ + Offset;
+end;
+
+procedure SysAllocateThreadVars;
+begin
+ { we've to allocate the memory from the OS }
+ { because the FPC heap management uses     }
+ { exceptions which use threadvars but      }
+ { these aren't allocated yet ...           }
+ { allocate room on the heap for the thread vars }
+ if os_mode = osOS2 then
+ begin
+  if DosAllocMem (DataIndex^, ThreadVarBlockSize, pag_Read or pag_Write
+                                      or pag_Commit) <> 0 then HandleError (8);
+ end else
+ begin
+  (* Allocate the DOS memory here. *)
+
+ end;
+end;
+
+procedure SysReleaseThreadVars;
+begin
+ { release thread vars }
+ if os_mode = osOS2 then DosFreeMem (DataIndex^) else
+ begin
+  (* Deallocate the DOS memory here. *)
+
+ end;
+end;
+
+{ Include OS independent Threadvar initialization }
+{$i threadvar.inc}
+
+    procedure InitThreadVars;
+      begin
+        { We're still running in single thread mode, setup the TLS }
+        TLSKey:=TlsAlloc;
+        { initialize threadvars }
+        init_all_unit_threadvars;
+        { allocate mem for main thread threadvars }
+        SysAllocateThreadVars;
+        { copy main thread threadvars }
+        copy_all_unit_threadvars;
+        { install threadvar handler }
+        fpc_threadvar_relocate_proc:=@SysRelocateThreadvar;
+      end;
+
+{$endif HASTHREADVAR}
+
+
+{*****************************************************************************
+                            Thread starting
+*****************************************************************************}
+
+    const
+      DefaultStackSize = 32768; { including 16384 margin for stackchecking }
+
+    type
+      pthreadinfo = ^tthreadinfo;
+      tthreadinfo = record
+        f : tthreadfunc;
+        p : pointer;
+        stklen : cardinal;
+      end;
+
+    procedure InitThread(stklen:cardinal);
+      begin
+        SysResetFPU;
+        { ExceptAddrStack and ExceptObjectStack are threadvars       }
+        { so every thread has its on exception handling capabilities }
+        SysInitExceptions;
+        { Open all stdio fds again }
+        SysInitStdio;
+        InOutRes:=0;
+        // ErrNo:=0;
+        { Stack checking }
+        StackLength:=stklen;
+        StackBottom:=Sptr - StackLength;
+      end;
+
+
+    procedure DoneThread;
+      begin
+        { Release Threadvars }
+{$ifdef HASTHREADVAR}
+        SysReleaseThreadVars;
+{$endif HASTHREADVAR}
+      end;
+
+
+    function ThreadMain(param : pointer) : pointer;cdecl;
+      var
+        ti : tthreadinfo;
+      begin
+{$ifdef HASTHREADVAR}
+        { Allocate local thread vars, this must be the first thing,
+          because the exception management and io depends on threadvars }
+        SysAllocateThreadVars;
+{$endif HASTHREADVAR}
+        { Copy parameter to local data }
+{$ifdef DEBUG_MT}
+        writeln('New thread started, initialising ...');
+{$endif DEBUG_MT}
+        ti:=pthreadinfo(param)^;
+        dispose(pthreadinfo(param));
+        { Initialize thread }
+        InitThread(ti.stklen);
+        { Start thread function }
+{$ifdef DEBUG_MT}
+        writeln('Jumping to thread function');
+{$endif DEBUG_MT}
+        ThreadMain:=pointer(ti.f(ti.p));
+      end;
+
+
+    function BeginThread(sa : Pointer;stacksize : dword;
+                         ThreadFunction : tthreadfunc;p : pointer;
+                         creationFlags : dword; var ThreadId : DWord) : DWord;
+      var
+        ti : pthreadinfo;
+      begin
+{$ifdef DEBUG_MT}
+        writeln('Creating new thread');
+{$endif DEBUG_MT}
+        { Initialize multithreading if not done }
+        if not IsMultiThread then
+         begin
+{$ifdef HASTHREADVAR}
+           InitThreadVars;
+{$endif HASTHREADVAR}
+           IsMultiThread:=true;
+         end;
+        { the only way to pass data to the newly created thread
+          in a MT safe way, is to use the heap }
+        new(ti);
+        ti^.f:=ThreadFunction;
+        ti^.p:=p;
+        ti^.stklen:=stacksize;
+        { call pthread_create }
+{$ifdef DEBUG_MT}
+        writeln('Starting new thread');
+{$endif DEBUG_MT}
+        BeginThread:=CreateThread(sa,stacksize,@ThreadMain,ti,creationflags,threadid);
+        BeginThread:=threadid;
+      end;
+
+
+    procedure EndThread(ExitCode : DWord);
+      begin
+        DoneThread;
+        ExitThread(ExitCode);
+      end;
+
+
+{*****************************************************************************
+                          Delphi/Win32 compatibility
+*****************************************************************************}
+
+{ we implement these procedures for win32 by importing them }
+{ directly from windows                                     }
+procedure InitCriticalSection(var cs : TRTLCriticalSection);
+  external 'kernel32' name 'InitializeCriticalSection';
+
+procedure DoneCriticalSection(var cs : TRTLCriticalSection);
+  external 'kernel32' name 'DeleteCriticalSection';
+
+procedure EnterCriticalSection(var cs : TRTLCriticalSection);
+  external 'kernel32' name 'EnterCriticalSection';
+
+procedure LeaveCriticalSection(var cs : TRTLCriticalSection);
+  external 'kernel32' name 'LeaveCriticalSection';
+
+
+{*****************************************************************************
+                           Heap Mutex Protection
+*****************************************************************************}
+
+    var
+      HeapMutex : TRTLCriticalSection;
+
+    procedure Win32HeapMutexInit;
+      begin
+         InitCriticalSection(heapmutex);
+      end;
+
+    procedure Win32HeapMutexDone;
+      begin
+         DoneCriticalSection(heapmutex);
+      end;
+
+    procedure Win32HeapMutexLock;
+      begin
+         EnterCriticalSection(heapmutex);
+      end;
+
+    procedure Win32HeapMutexUnlock;
+      begin
+         LeaveCriticalSection(heapmutex);
+      end;
+
+    const
+      Win32MemoryMutexManager : TMemoryMutexManager = (
+        MutexInit : @Win32HeapMutexInit;
+        MutexDone : @Win32HeapMutexDone;
+        MutexLock : @Win32HeapMutexLock;
+        MutexUnlock : @Win32HeapMutexUnlock;
+      );
+
+    procedure InitHeapMutexes;
+      begin
+        SetMemoryMutexManager(Win32MemoryMutexManager);
+      end;
+
+
+{*****************************************************************************
+                             Generic overloaded
+*****************************************************************************}
+
+{ Include generic overloaded routines }
+{$i thread.inc}
+
+initialization
+  InitHeapMutexes;
+end.
+{
+  $Log$
+  Revision 1.1  2002-11-17 16:22:54  hajny
+    + RTL for emx target
+
+  Revision 1.1  2002/10/14 19:39:18  peter
+    * threads unit added for thread support
+
+}
+