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

* BeOS target!

Browse Source
This commit is contained in:
peter 2001-06-02 19:26:03 +00:00
parent a45b29fada
commit 3a02f304b0
13 changed files with 3790 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

855
rtl/beos/Makefile Normal file
View File

@ -0,0 +1,855 @@
#
# Don't edit, this file is generated by fpcmake v1.99.0 [2001/06/02]
#
default: all
override PATH:=$(subst \,/,$(PATH))
ifeq ($(findstring ;,$(PATH)),)
inUnix=1
SEARCHPATH:=$(subst :, ,$(PATH))
else
SEARCHPATH:=$(subst ;, ,$(PATH))
endif
PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
ifeq ($(PWD),)
PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
ifeq ($(PWD),)
nopwd:
@echo You need the GNU utils package to use this Makefile!
@echo Get ftp://ftp.freepascal.org/pub/fpc/dist/go32v2/utilgo32.zip
@exit
else
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,$(MACH_TYPE)),)
inCygWin=1
endif
endif
ifdef inUnix
BATCHEXT=.sh
else
ifdef inOS2
BATCHEXT=.cmd
else
BATCHEXT=.bat
endif
endif
ifdef inUnix
PATHSEP=/
else
PATHSEP:=$(subst /,\,/)
endif
ifdef PWD
BASEDIR:=$(subst \,/,$(shell $(PWD)))
else
BASEDIR=.
endif
override OS_TARGET=beos
override CPU_TARGET=i386
ifndef FPC
ifdef PP
FPC=$(PP)
else
FPC=ppc386
endif
endif
override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
ifndef OS_TARGET
OS_TARGET:=$(shell $(FPC) -iTO)
endif
ifndef OS_SOURCE
OS_SOURCE:=$(shell $(FPC) -iSO)
endif
ifndef CPU_TARGET
CPU_TARGET:=$(shell $(FPC) -iTP)
endif
ifndef CPU_SOURCE
CPU_SOURCE:=$(shell $(FPC) -iSP)
endif
ifndef FPC_VERSION
FPC_VERSION:=$(shell $(FPC) -iV)
endif
export FPC OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FPC_VERSION
ifdef FPCDIR
override FPCDIR:=$(subst \,/,$(FPCDIR))
ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
override FPCDIR=wrong
endif
else
override FPCDIR=wrong
endif
ifeq ($(FPCDIR),wrong)
override FPCDIR=../..
ifeq ($(wildcard $(FPCDIR)/rtl),)
ifeq ($(wildcard $(FPCDIR)/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
UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages)
override PACKAGE_NAME=rtl
RTL=..
INC=$(RTL)/inc
PROCINC=$(RTL)/$(CPU_TARGET)
UNIXINC=$(RTL)/unix
UNITPREFIX=rtl
OBJPASDIR=$(RTL)/objpas
GRAPHDIR=$(INC)/graph
override TARGET_UNITS+=system objpas strings beos dos sysutils typinfo math varutils cpu mmx getopts heaptrc lineinfo
override TARGET_LOADERS+=prt0 cprt0 func dllprt
override TARGET_RSTS+=math varutils
override INSTALL_FPCPACKAGE=y
override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
override COMPILER_TARGETDIR+=.
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
ifndef COPY
COPY:=cp -fp
endif
ifndef COPYTREE
COPYTREE:=cp -rfp
endif
ifndef MOVE
MOVE:=mv -f
endif
ifndef DEL
DEL:=rm -f
endif
ifndef DELTREE
DELTREE:=rm -rf
endif
ifndef INSTALL
ifdef inUnix
INSTALL:=install -c -m 644
else
INSTALL:=$(COPY)
endif
endif
ifndef INSTALLEXE
ifdef inUnix
INSTALLEXE:=install -c -m 755
else
INSTALLEXE:=$(COPY)
endif
endif
ifndef MKDIR
ifdef inUnix
MKDIR:=install -m 755 -d
else
MKDIR:=ginstall -m 755 -d
endif
endif
export ECHO COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
ifndef AS
AS=as
endif
ifndef LD
LD=ld
endif
ifndef RC
RC=rc
endif
PPAS=ppas$(BATCHEXT)
ifdef inUnix
LDCONFIG=ldconfig
else
LDCONFIG=
endif
ifndef PPUMOVE
PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
ifeq ($(PPUMOVE),)
PPUMOVE=
else
PPUMOVE:=$(firstword $(PPUMOVE))
endif
endif
export PPUMOVE
ifndef PPUFILES
PPUFILES:=$(strip $(wildcard $(addsuffix /ppufiles$(SRCEXEEXT),$(SEARCHPATH))))
ifeq ($(PPUFILES),)
PPUFILES=
else
PPUFILES:=$(firstword $(PPUFILES))
endif
endif
export PPUFILES
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
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
ifndef ZIPPROG
ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
ifeq ($(ZIPPROG),)
ZIPPROG=
else
ZIPPROG:=$(firstword $(ZIPPROG))
endif
endif
export ZIPPROG
ZIPOPT=-9
ZIPEXT=.zip
ifndef TARPROG
TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
ifeq ($(TARPROG),)
TARPROG=
else
TARPROG:=$(firstword $(TARPROG))
endif
endif
export TARPROG
ifeq ($(USETAR),bz2)
TAROPT=vI
TAREXT=.tar.bz2
else
TAROPT=vz
TAREXT=.tar.gz
endif
LOADEREXT=.as
EXEEXT=.exe
PPLEXT=.ppl
PPUEXT=.ppu
OEXT=.o
ASMEXT=.s
SMARTEXT=.sl
STATICLIBEXT=.a
SHAREDLIBEXT=.so
LIBPREFIX=lib
RSTEXT=.rst
FPCMADE=fpcmade
ifeq ($(OS_TARGET),go32v1)
PPUEXT=.pp1
OEXT=.o1
ASMEXT=.s1
SMARTEXT=.sl1
STATICLIBEXT=.a1
SHAREDLIBEXT=.so1
LIBPREFIX=
FPCMADE=fpcmade.v1
PACKAGESUFFIX=v1
endif
ifeq ($(OS_TARGET),go32v2)
LIBPREFIX=
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),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=.so
STATICLIBEXT=.ao2
SHAREDLIBEXT=.dll
FPCMADE=fpcmade.os2
ZIPSUFFIX=emx
endif
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
else
ifeq ($(OS_SOURCE),linux)
UNIXINSTALLDIR=1
endif
ifeq ($(OS_SOURCE),freebsd)
UNIXINSTALLDIR=1
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
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
INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(OS_TARGET)
ifdef INSTALL_FPCPACKAGE
INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
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 INSTALL_FPCPACKAGE
INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/src/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
else
INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/src/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
endif
else
ifdef INSTALL_FPCPACKAGE
INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
else
INSTALL_SOURCEDIRL:=$(INSTALL_BASEDIR)/source
endif
endif
endif
ifndef INSTALL_DOCDIR
ifdef UNIXINSTALLDIR
ifdef INSTALL_FPCPACKAGE
INSTALL_DOCDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
else
INSTALL_DOCDIR:=$(INSTALL_PREFIX)/doc/$(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
INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
else
INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
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
override FPCOPTDEF=$(CPU_TARGET)
ifneq ($(OS_TARGET),$(OS_SOURCE))
override FPCOPT+=-T$(OS_TARGET)
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
override FPCOPT+=-Xs -OG2p3 -n
override FPCOPTDEF+=RELEASE
endif
ifdef STRIP
override FPCOPT+=-Xs
endif
ifdef OPTIMIZE
override FPCOPT+=-OG2p3
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 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_TARGETDIR)/
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
ifeq ($(OS_SOURCE),win32)
USEENV=1
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 INSTALLPPUFILES+=$(UNITPPUFILES)
override CLEANPPUFILES+=$(UNITPPUFILES)
endif
fpc_units: $(UNITPPUFILES)
ifdef TARGET_RSTS
override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
override CLEANRSTFILES+=$(RSTFILES)
endif
.PHONY: fpc_packages fpc_all fpc_smart fpc_debug
$(FPCMADE): $(ALLTARGET)
@$(ECHO) Compiled > $(FPCMADE)
fpc_packages: $(COMPILEPACKAGES)
fpc_all: fpc_packages $(FPCMADE)
fpc_smart:
$(MAKE) all LINKSMART=1 CREATESMART=1
fpc_debug:
$(MAKE) all DEBUG=1
.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .pp
%$(PPUEXT): %.pp
$(COMPILER) $<
$(EXECPPAS)
%$(PPUEXT): %.pas
$(COMPILER) $<
$(EXECPPAS)
%$(EXEEXT): %.pp
$(COMPILER) $<
$(EXECPPAS)
%$(EXEEXT): %.pas
$(COMPILER) $<
$(EXECPPAS)
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 INSTALLPPUFILES
ifdef PPUFILES
override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPUFILES))
override INSTALLPPULINKFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(shell $(PPUFILES) -S -O $(INSTALLPPUFILES)))
else
override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(LIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPUFILES))
override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPULINKFILES)))
endif
endif
ifdef INSTALLEXEFILES
override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(INSTALLEXEFILES))
endif
fpc_install: $(INSTALLTARGET)
ifdef INSTALLEXEFILES
$(MKDIR) $(INSTALL_BINDIR)
ifdef UPXPROG
-$(UPXPROG) $(INSTALLEXEFILES)
endif
$(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
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 CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
ifdef PPUFILES
CLEANPPULINKFILES:=$(shell $(PPUFILES) $(CLEANPPUFILES))
else
CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(LIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))))
endif
override CLEANPPULINKFILES:=$(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) $(PPAS) 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) $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
ifdef AOUTEXT
-$(DEL) *$(AOUTEXT)
endif
.PHONY: fpc_info
fpc_info:
@$(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)
@$(ECHO) == Directory info ==
@$(ECHO)
@$(ECHO) Basedir......... $(BASEDIR)
@$(ECHO) FPCDir.......... $(FPCDIR)
@$(ECHO) UnitsDir........ $(UNITSDIR)
@$(ECHO) PackagesDir..... $(PACKAGESDIR)
@$(ECHO)
@$(ECHO) GCC library..... $(GCCLIBDIR)
@$(ECHO) Other library... $(OTHERLIBDIR)
@$(ECHO)
@$(ECHO) == Tools info ==
@$(ECHO)
@$(ECHO) Pwd....... $(PWD)
@$(ECHO) Echo...... $(ECHO)
@$(ECHO) PPUMove... $(PPUMOVE)
@$(ECHO) PPUFiles.. $(PPUFILES)
@$(ECHO) Date...... $(DATE)
@$(ECHO) Upx....... $(UPXPROG)
@$(ECHO) Zip....... $(ZIPPROG)
@$(ECHO)
@$(ECHO) == Object info ==
@$(ECHO)
@$(ECHO) Target Loaders...... $(TARGET_LOADERS)
@$(ECHO) Target Units........ $(TARGET_UNITS)
@$(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)
all: fpc_all
debug: fpc_debug
examples: fpc_examples
smart: fpc_smart
shared: fpc_shared
install: fpc_install
sourceinstall: fpc_sourceinstall
exampleinstall: fpc_exampleinstall
distinstall:
zipinstall:
zipsourceinstall:
zipexampleinstall:
zipdistinstall:
clean: fpc_clean
distclean: fpc_distclean
cleanall: fpc_cleanall
info: fpc_info
.PHONY: all debug examples smart shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info
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)
prt0$(OEXT) : $(CPU_TARGET)/prt0.as
$(AS) -o prt0$(OEXT) $(CPU_TARGET)/prt0.as
cprt0$(OEXT) : $(CPU_TARGET)/cprt0.as
$(AS) -o cprt0$(OEXT) $(CPU_TARGET)/cprt0.as
func$(OEXT) : $(CPU_TARGET)/func.as
$(AS) -o func$(OEXT) $(CPU_TARGET)/func.as
dllprt$(OEXT) : $(CPU_TARGET)/dllprt.as
$(AS) -o dllprt$(OEXT) $(CPU_TARGET)/dllprt.as
system$(PPUEXT) : system.pp sysfiles.inc $(SYSDEPS)
$(COMPILER) -Us -Sg system.pp
objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc system$(PPUEXT)
$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
$(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
system$(PPUEXT)
beos$(PPUEXT) : beos.pp system$(PPUEXT)
dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
beos$(PPUEXT) system$(PPUEXT)
objects$(PPUEXT) : $(INC)/objects.pp $(UNIXINC)/objinc.inc system$(PPUEXT)
sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \
objpas$(PPUEXT) beos$(PPUEXT)
$(COMPILER) -I$(OBJPASDIR) sysutils.pp
typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
$(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/math.pp
gettext$(PPUEXT): $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/gettext.pp
varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
$(OBJPASDIR)/varutilh.inc varutils.pp
$(COMPILER) -I$(OBJPASDIR) $(UNIXINC)/varutils.pp
cpu$(PPUEXT) : $(PROCINC)/cpu.pp system$(PPUEXT)
mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) system$(PPUEXT)
getopts$(PPUEXT) : $(INC)/getopts.pp system$(PPUEXT)
heaptrc$(PPUEXT) : $(INC)/heaptrc.pp system$(PPUEXT)
$(COMPILER) -Sg $(INC)/heaptrc.pp
lineinfo$(PPUEXT) : $(INC)/lineinfo.pp system$(PPUEXT)

147
rtl/beos/Makefile.fpc Normal file
View File

@ -0,0 +1,147 @@
#
# Makefile.fpc for Free Pascal BeOS RTL
#
[package]
main=rtl
[target]
loaders=prt0 cprt0 func dllprt
units=system objpas strings \
beos \
dos \
sysutils typinfo math varutils \
cpu mmx getopts heaptrc lineinfo
rsts=math varutils
[require]
nortl=y
[install]
fpcpackage=y
[default]
fpcdir=../..
target=beos
cpu=i386
[compiler]
includedir=$(INC) $(PROCINC) $(UNIXINC)
sourcedir=$(INC) $(PROCINC) $(UNIXINC)
targetdir=.
[prerules]
RTL=..
INC=$(RTL)/inc
PROCINC=$(RTL)/$(CPU_TARGET)
UNIXINC=$(RTL)/unix
UNITPREFIX=rtl
# 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
#
prt0$(OEXT) : $(CPU_TARGET)/prt0.as
$(AS) -o prt0$(OEXT) $(CPU_TARGET)/prt0.as
cprt0$(OEXT) : $(CPU_TARGET)/cprt0.as
$(AS) -o cprt0$(OEXT) $(CPU_TARGET)/cprt0.as
func$(OEXT) : $(CPU_TARGET)/func.as
$(AS) -o func$(OEXT) $(CPU_TARGET)/func.as
dllprt$(OEXT) : $(CPU_TARGET)/dllprt.as
$(AS) -o dllprt$(OEXT) $(CPU_TARGET)/dllprt.as
#
# system Units (system, Objpas, Strings)
#
system$(PPUEXT) : system.pp sysfiles.inc $(SYSDEPS)
$(COMPILER) -Us -Sg system.pp
objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc system$(PPUEXT)
$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
$(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
system$(PPUEXT)
#
# system Dependent Units
#
beos$(PPUEXT) : beos.pp system$(PPUEXT)
#
# TP7 Compatible RTL Units
#
dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
beos$(PPUEXT) system$(PPUEXT)
objects$(PPUEXT) : $(INC)/objects.pp $(UNIXINC)/objinc.inc system$(PPUEXT)
#
# Delphi Compatible Units
#
sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \
objpas$(PPUEXT) beos$(PPUEXT)
$(COMPILER) -I$(OBJPASDIR) sysutils.pp
typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
$(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/math.pp
gettext$(PPUEXT): $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/gettext.pp
varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
$(OBJPASDIR)/varutilh.inc varutils.pp
$(COMPILER) -I$(OBJPASDIR) $(UNIXINC)/varutils.pp
#
# Other system-independent RTL Units
#
cpu$(PPUEXT) : $(PROCINC)/cpu.pp system$(PPUEXT)
mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) system$(PPUEXT)
getopts$(PPUEXT) : $(INC)/getopts.pp system$(PPUEXT)
heaptrc$(PPUEXT) : $(INC)/heaptrc.pp system$(PPUEXT)
$(COMPILER) -Sg $(INC)/heaptrc.pp
lineinfo$(PPUEXT) : $(INC)/lineinfo.pp system$(PPUEXT)
#
# Other system-dependent RTL Units
#

439
rtl/beos/beos.pp Normal file
View File

@ -0,0 +1,439 @@
unit beos;
interface
type
Stat = packed record
dev:longint; {"device" that this file resides on}
ino:int64; {this file's inode #, unique per device}
mode:dword; {mode bits (rwx for user, group, etc)}
nlink:longint; {number of hard links to this file}
uid:dword; {user id of the owner of this file}
gid:dword; {group id of the owner of this file}
size:int64; {size of this file (in bytes)}
rdev:longint; {device type (not used)}
blksize:longint; {preferref block size for i/o}
atime:longint; {last access time}
mtime:longint; {last modification time}
ctime:longint; {last change time, not creation time}
crtime:longint; {creation time}
end;
PStat=^Stat;
TStat=Stat;
ComStr = String[255];
PathStr = String[255];
DirStr = String[255];
NameStr = String[255];
ExtStr = String[255];
function FStat(Path:String;Var Info:stat):Boolean;
function FStat(var f:File;Var Info:stat):Boolean;
function GetEnv(P: string): pchar;
function FExpand(Const Path: PathStr):PathStr;
function FSearch(const path:pathstr;dirlist:string):pathstr;
procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
function Dirname(Const path:pathstr):pathstr;
function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
function FNMatch(const Pattern,Name:string):Boolean;
{function StringToPPChar(Var S:STring):ppchar;}
function PExists(path:string):boolean;
function FExists(path:string):boolean;
Function Shell(const Command:String):Longint;
implementation
uses strings;
{$i filerec.inc}
{$i textrec.inc}
function sys_stat (a:cardinal;path:pchar;info:pstat;n:longint):longint; cdecl; external name 'sys_stat';
function FStat(Path:String;Var Info:stat):Boolean;
{
Get all information on a file, and return it in Info.
}
var tmp:string;
var p:pchar;
begin
tmp:=path+#0;
p:=@tmp[1];
FStat:=(sys_stat($FF000000,p,@Info,0)=0);
end;
function FStat(var f:File;Var Info:stat):Boolean;
{
Get all information on a file, and return it in Info.
}
begin
FStat:=(sys_stat($FF000000,PChar(@FileRec(f).Name),@Info,0)=0);
end;
Function GetEnv(P:string):Pchar;
{
Searches the environment for a string with name p and
returns a pchar to it's value.
A pchar is used to accomodate for strings of length > 255
}
var
ep : ppchar;
found : boolean;
Begin
p:=p+'='; {Else HOST will also find HOSTNAME, etc}
ep:=envp;
found:=false;
if ep<>nil then
begin
while (not found) and (ep^<>nil) do
begin
if strlcomp(@p[1],(ep^),length(p))=0 then
found:=true
else
inc(ep);
end;
end;
if found then
getenv:=ep^+length(p)
else
getenv:=nil;
{ writeln ('GETENV (',P,') =',getenv);}
end;
Function StringToPPChar(Var S:String; Var nr:longint):ppchar;
{
Create a PPChar to structure of pchars which are the arguments specified
in the string S. Especially usefull for creating an ArgV for Exec-calls
}
var
Buf : ^char;
p : ppchar;
begin
s:=s+#0;
buf:=@s[1];
nr:=0;
while(buf^<>#0) do
begin
while (buf^ in [' ',#8,#10]) do
inc(buf);
inc(nr);
while not (buf^ in [' ',#0,#8,#10]) do
inc(buf);
end;
getmem(p,nr*4);
StringToPPChar:=p;
if p=nil then
begin
{ LinuxError:=sys_enomem;}
exit;
end;
buf:=@s[1];
while (buf^<>#0) do
begin
while (buf^ in [' ',#8,#10]) do
begin
buf^:=#0;
inc(buf);
end;
p^:=buf;
inc(p);
p^:=nil;
while not (buf^ in [' ',#0,#8,#10]) do
inc(buf);
end;
end;
Function FExpand(Const Path:PathStr):PathStr;
var
temp : pathstr;
i,j : longint;
p : pchar;
Begin
{Remove eventual drive - doesn't exist in Linux}
if path[2]=':' then
i:=3
else
i:=1;
temp:='';
{Replace ~/ with $HOME}
if (path[i]='~') and ((i+1>length(path)) or (path[i+1]='/')) then
begin
p:=getenv('HOME');
if not (p=nil) then
Insert(StrPas(p),temp,i);
i:=1;
temp:=temp+Copy(Path,2,255);
end;
{Do we have an absolute path ? No - prefix the current dir}
if temp='' then
begin
if path[i]<>'/' then
begin
{$I-}
getdir(0,temp);
{$I+}
if ioresult<>0 then;
end
else
inc(i);
temp:=temp+'/'+copy(path,i,length(path)-i+1)+'/';
end;
{First remove all references to '/./'}
while pos('/./',temp)<>0 do
delete(temp,pos('/./',temp),2);
{Now remove also all references to '/../' + of course previous dirs..}
repeat
i:=pos('/../',temp);
{Find the pos of the previous dir}
if i>1 then
begin
j:=i-1;
while (j>1) and (temp[j]<>'/') do
dec (j);{temp[1] is always '/'}
delete(temp,j,i-j+3);
end
else
if i=1 then {i=1, so we have temp='/../something', just delete '/../'}
delete(temp,1,3);
until i=0;
{ Remove ending /.. }
i:=pos('/..',temp);
if (i<>0) and (i =length(temp)-2) then
begin
j:=i-1;
while (j>1) and (temp[j]<>'/') do
dec (j);
delete (temp,j,i-j+3);
end;
{ if last character is / then remove it - dir is also a file :-) }
if (length(temp)>0) and (temp[length(temp)]='/') then
dec(byte(temp[0]));
fexpand:=temp;
End;
Function FSearch(const path:pathstr;dirlist:string):pathstr;
{
Searches for a file 'path' in the list of direcories in 'dirlist'.
returns an empty string if not found. Wildcards are NOT allowed.
If dirlist is empty, it is set to '.'
}
Var
NewDir : PathStr;
p1 : Longint;
Info : Stat;
Begin
{Replace ':' with ';'}
for p1:=1to length(dirlist) do
if dirlist[p1]=':' then
dirlist[p1]:=';';
{Check for WildCards}
If (Pos('?',Path) <> 0) or (Pos('*',Path) <> 0) Then
FSearch:='' {No wildcards allowed in these things.}
Else
Begin
Dirlist:='.;'+dirlist;{Make sure current dir is first to be searched.}
Repeat
p1:=Pos(';',DirList);
If p1=0 Then
p1:=255;
NewDir:=Copy(DirList,1,P1 - 1);
if NewDir[Length(NewDir)]<>'/' then
NewDir:=NewDir+'/';
NewDir:=NewDir+Path;
Delete(DirList,1,p1);
if FStat(NewDir,Info) then
Begin
If Pos('./',NewDir)=1 Then
Delete(NewDir,1,2);
{DOS strips off an initial .\}
End
Else
NewDir:='';
Until (DirList='') or (Length(NewDir) > 0);
FSearch:=NewDir;
End;
End;
Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
Var
DotPos,SlashPos,i : longint;
Begin
SlashPos:=0;
DotPos:=256;
i:=Length(Path);
While (i>0) and (SlashPos=0) Do
Begin
If (DotPos=256) and (Path[i]='.') Then
DotPos:=i;
If (Path[i]='/') Then
SlashPos:=i;
Dec(i);
End;
Ext:=Copy(Path,DotPos,255);
Dir:=Copy(Path,1,SlashPos);
Name:=Copy(Path,SlashPos + 1,DotPos - SlashPos - 1);
End;
Function Dirname(Const path:pathstr):pathstr;
{
This function returns the directory part of a complete path.
Unless the directory is root '/', The last character is not
a slash.
}
var
Dir : PathStr;
Name : NameStr;
Ext : ExtStr;
begin
FSplit(Path,Dir,Name,Ext);
if length(Dir)>1 then
Delete(Dir,length(Dir),1);
DirName:=Dir;
end;
Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
{
This function returns the filename part of a complete path. If suf is
supplied, it is cut off the filename.
}
var
Dir : PathStr;
Name : NameStr;
Ext : ExtStr;
begin
FSplit(Path,Dir,Name,Ext);
if Suf<>Ext then
Name:=Name+Ext;
BaseName:=Name;
end;
Function FNMatch(const Pattern,Name:string):Boolean;
Var
LenPat,LenName : longint;
Function DoFNMatch(i,j:longint):Boolean;
Var
Found : boolean;
Begin
Found:=true;
While Found and (i<=LenPat) Do
Begin
Case Pattern[i] of
'?' : Found:=(j<=LenName);
'*' : Begin
{find the next character in pattern, different of ? and *}
while Found and (i<LenPat) do
begin
inc(i);
case Pattern[i] of
'*' : ;
'?' : begin
inc(j);
Found:=(j<=LenName);
end;
else
Found:=false;
end;
end;
{Now, find in name the character which i points to, if the * or ?
wasn't the last character in the pattern, else, use up all the
chars in name}
Found:=true;
if (i<=LenPat) then
begin
repeat
{find a letter (not only first !) which maches pattern[i]}
while (j<=LenName) and (name[j]<>pattern[i]) do
inc (j);
if (j<LenName) then
begin
if DoFnMatch(i+1,j+1) then
begin
i:=LenPat;
j:=LenName;{we can stop}
Found:=true;
end
else
inc(j);{We didn't find one, need to look further}
end;
until (j>=LenName);
end
else
j:=LenName;{we can stop}
end;
else {not a wildcard character in pattern}
Found:=(j<=LenName) and (pattern[i]=name[j]);
end;
inc(i);
inc(j);
end;
DoFnMatch:=Found and (j>LenName);
end;
Begin {start FNMatch}
LenPat:=Length(Pattern);
LenName:=Length(Name);
FNMatch:=DoFNMatch(1,1);
End;
function PExists(path:string):boolean;
begin
PExists:=FExists(path);
end;
function FExists(path:string):boolean;
var
info:stat;
begin
FExists:=Fstat(path,info);
end;
function sys_load_image(a:cardinal; argp:ppchar; envp:ppchar):longint; cdecl; external name 'sys_load_image';
function sys_wait_for_thread (th:longint; var exitcode:longint):longint; cdecl; external name 'sys_wait_for_thread';
Function Shell(const Command:String):Longint;
var s:string;
argv:ppchar;
argc:longint;
th:longint;
begin
s:=Command;
argv:=StringToPPChar(s,argc);
th:=0;
{ writeln ('argc = ',argc);
while argv[th]<>Nil do begin
writeln ('argv[',th,'] = ',argv[th]);
th:=th+1;
end;
}
th:=sys_load_image(argc,argv,system.envp);
if th<0 then begin
shell:=0;
exit;
end;
sys_wait_for_thread(th,Shell);
end;
end.

697
rtl/beos/dos.pp Normal file
View File

@ -0,0 +1,697 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by the Free Pascal development team.
Dos unit for BP7 compatible RTL
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;
interface
uses beos;
const
FileNameLen=255;
type
ComStr = String[FileNameLen];
PathStr = String[FileNameLen];
DirStr = String[FileNameLen];
NameStr = String[FileNameLen];
ExtStr = String[FileNameLen];
Const
LFNSUPPORT=True;
{Bitmasks for CPU Flags}
fcarry = $0001;
fparity = $0004;
fauxiliary = $0010;
fzero = $0040;
fsign = $0080;
foverflow = $0800;
{Bitmasks for file attribute}
readonly = $01;
hidden = $02;
sysfile = $04;
volumeid = $08;
directory = $10;
archive = $20;
anyfile = $3F;
{File Status}
fmclosed = $D7B0;
fminput = $D7B1;
fmoutput = $D7B2;
fminout = $D7B3;
S_IFMT = $F000; { type of file }
S_IFLNK = $A000; { symbolic link }
S_IFREG = $8000; { regular }
S_IFBLK = $6000; { block special }
S_IFDIR = $4000; { directory }
S_IFCHR = $2000; { character special }
S_IFIFO = $1000; { fifo }
{
filerec.inc contains the definition of the filerec.
textrec.inc contains the definition of the textrec.
It is in a separate file to make it available in other units without
having to use the DOS unit for it.
}
{$i filerec.inc}
{$i textrec.inc}
DateTime = packed record
Year,
Month,
Day,
Hour,
Min,
Sec : word;
End;
searchrec = record
fd : longint;
path : string;
fname : string;
attr : byte;
time : longint;
size : longint;
name : string[255];
end;
Var
DosError : integer;
{Info/Date/Time}
Procedure GetDate(var year, month, mday, wday: word);
procedure GetTime(var hour,min,sec,msec,usec:word);
procedure GetTime(var hour,min,sec,sec100:word);
procedure GetTime(Var Hour,Min,Sec:Word);
Procedure UnpackTime(p: longint; var t: datetime);
Procedure PackTime(var t: datetime; var p: longint);
{Exec}
Procedure Exec(const path: pathstr; const comline: comstr);
Function DosExitCode: word;
{Disk}
Procedure FindFirst(const path: pathstr; attr: word; var f: searchRec);
Procedure FindNext(var f: searchRec);
Procedure FindClose(var f: searchRec);
{File}
{Procedure GetFAttr(var f:File; var attr: word);}
procedure GetFTime(var f:File; var time: longint);
procedure GetFTime(f:string; var time: longint);
Procedure SetFTime(var f:File; time : longint);
Function FSearch(path: pathstr; dirlist: string): pathstr;
Function FExpand(const path: pathstr): pathstr;
Procedure FSplit(path: pathstr; var dir: dirstr; var name: namestr; var ext: extstr);
{Environment}
{Function EnvCount: longint;
Function EnvStr(index: integer): string;}
{Misc}
{Procedure SetFAttr(var f; attr: word);
Procedure SetFTime(var f; time: longint);
Procedure GetVerify(var verify: boolean);
Procedure SetVerify(verify: boolean);}
{Do Nothing Functions}
Procedure SwapVectors;
{Procedure GetIntVec(intno: byte; var vector: pointer);
Procedure SetIntVec(intno: byte; vector: pointer);
Procedure Keep(exitcode: word);}
function GetEnv(EnvVar: String): String;
Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Word);
implementation
uses strings;
procedure GetFTime(var f:file; var time: longint);
var info:stat;
t:longint;
dt:DateTime;
begin
if not FStat(F,Info) then begin
t:=0;
doserror:=3;
exit;
end else t:=info.ctime;
EpochToLocal(t,dt.year,dt.month,dt.day,dt.hour,dt.min,dt.sec);
packtime(dt,time);
end;
procedure GetFTime(f:string; var time: longint);
var info:stat;
t:longint;
dt:DateTime;
begin
if not FStat(F,Info) then begin
t:=0;
doserror:=3;
exit;
end else t:=info.ctime;
EpochToLocal(t,dt.year,dt.month,dt.day,dt.hour,dt.min,dt.sec);
packtime(dt,time);
end;
type utimbuf=record actime,modtime:longint; end;
{function _utime (path:pchar;var buf:utimbuf):longint; cdecl; external name 'utime';}
Procedure setftime(var f:file; time : longint);
{var buf:utimbuf;}
begin
{ buf.actime:=time;
buf.modtime:=time;}
{ writeln ('SetFTime ',PChar(@FileRec(f).Name),' := ',time);}
{ if _utime(PChar(@FileRec(f).Name),buf)<>0 then doserror:=3;}
end;
{******************************************************************************
--- Info / Date / Time ---
******************************************************************************}
procedure getdate(var year,month,mday,wday : word);
begin
end;
function sys_time:longint; cdecl; external name 'sys_time';
procedure GetTime(var hour,min,sec,msec,usec:word);
{
Gets the current time, adjusted to local time
}
var
year,day,month:Word;
t : longint;
begin
t:=sys_time;
EpochToLocal(t,year,month,day,hour,min,sec);
msec:=0;
usec:=0;
end;
procedure GetTime(var hour,min,sec,sec100:word);
{ Gets the current time, adjusted to local time }
var usec : word;
begin
gettime(hour,min,sec,sec100,usec);
sec100:=sec100 div 10;
end;
procedure GetTime(Var Hour,Min,Sec:Word);
{
Gets the current time, adjusted to local time
}
var
msec,usec : Word;
Begin
gettime(hour,min,sec,msec,usec);
end;
Procedure packtime(var t : datetime;var p : longint);
Begin
p:=(t.sec shr 1)+(t.min shl 5)+(t.hour shl 11)+(t.day shl 16)+(t.month shl 21)+((t.year-1980) shl 25);
End;
Procedure unpacktime(p : longint;var t : datetime);
Begin
with t do
begin
sec:=(p and 31) shl 1;
min:=(p shr 5) and 63;
hour:=(p shr 11) and 31;
day:=(p shr 16) and 31;
month:=(p shr 21) and 15;
year:=(p shr 25)+1980;
end;
End;
{******************************************************************************
--- Exec ---
******************************************************************************}
Procedure Exec(const path: pathstr; const comline: comstr);
var p:string;
begin
p:=path+' '+comline;
doserror:=beos.shell(p);
end;
Function DosExitCode: word;
begin
dosexitcode:=doserror;
end;
{******************************************************************************
--- File ---
******************************************************************************}
Procedure FSplit(Path: PathStr; Var Dir: DirStr; Var Name: NameStr;Var Ext: ExtStr);
Begin
beos.FSplit(Path,Dir,Name,Ext);
End;
Function FExpand(Const Path: PathStr): PathStr;
Begin
FExpand:=beos.FExpand(Path);
End;
Function FSearch(path : pathstr;dirlist : string) : pathstr;
Var info:stat;
Begin
if (length(Path)>0) and (path[1]='/') and FStat(path,info) then
FSearch:=path
else
FSearch:=beos.FSearch(path,dirlist);
End;
{******************************************************************************
--- Findfirst FindNext ---
******************************************************************************}
{procedure dossearchrec2searchrec(var f : searchrec);
var
len : longint;
begin
len:=StrLen(@f.Name);
Move(f.Name[0],f.Name[1],Len);
f.Name[0]:=chr(len);
end;}
type dirent = packed record
d_dev:longint;
d_pdev:longint;
d_ino:int64;
d_pino:int64;
d_reclen:word;
d_name:array[0..255] of char;
end;
function sys_opendir (a:dword;path:pchar;b:longint):longint; cdecl; external name 'sys_opendir';
function sys_readdir (fd:longint;var de:dirent;a:longint;b:byte):longint; cdecl; external name 'sys_readdir';
procedure findnext(var f : searchRec);
var len:longint;
ent:dirent;
info:stat;
dt:DateTime;
begin
if sys_readdir(f.fd,ent,$11C,1)=0 then begin
doserror:=3;
exit;
end;
{ writeln ('NAME: ',pchar(@ent.d_name[0]));}
len:=StrLen(@ent.d_name);
Move(ent.d_name,f.name[1],len);
f.name[0]:=chr(len);
{ writeln ('NAME: "',f.path+f.name,'"');}
if not FStat(f.path+f.name,info) then begin
writeln ('NOT FOUND');
doserror:=3;
exit;
end;
writeln ('OK');
f.size:=info.size;
f.attr:=0;
if (info.mode and S_IFMT)=S_IFDIR then f.attr:=directory;
EpochToLocal(info.mtime,dt.year,dt.month,dt.day,dt.hour,dt.min,dt.sec);
packtime(dt,f.time);
doserror:=0;
end;
procedure findfirst(const path : pathstr;attr : word;var f : searchRec);
var tmp:string;
info:stat;
ext:string;
begin
tmp:=path;
if tmp='' then tmp:='.';
if FStat(tmp,info) then begin
if ((info.mode and S_IFMT)=S_IFDIR) and (tmp[length(tmp)]<>'/') then tmp:=tmp+'/';
end;
FSplit (tmp,f.path,f.fname,ext);
{ f.path:=FExpand(f.path);}
f.fname:=f.fname+ext;
if length(f.fname)=0 then f.fname:='*';
tmp:=tmp+#0;
f.fd:=sys_opendir ($FF000000,@tmp[1],0);
writeln ('F.PATH=',f.path,' ; ',f.fname);
findnext(f);
end;
Procedure FindClose(Var f: SearchRec);
begin
DosError:=0;
end;
procedure swapvectors;
begin
{ no beos equivalent }
DosError:=0;
end;
{******************************************************************************
--- Environment ---
******************************************************************************}
function envcount : longint;
var
hp : ppchar;
begin
hp:=envp;
envcount:=0;
while assigned(hp^) do
begin
inc(envcount);
hp:=hp+4;
end;
end;
function envstr(index : integer) : string;
begin
if (index<=0) or (index>envcount) then
begin
envstr:='';
exit;
end;
envstr:=strpas(ppchar(envp+4*(index-1))^);
end;
{******************************************************************************
--- Not Supported ---
******************************************************************************}
Procedure keep(exitcode : word);
Begin
End;
Procedure getintvec(intno : byte;var vector : pointer);
Begin
End;
Procedure setintvec(intno : byte;vector : pointer);
Begin
End;
{******************************************************************************
Date and Time related calls
******************************************************************************}
Const
{Date Translation}
C1970=2440588;
D0 = 1461;
D1 = 146097;
D2 =1721119;
Procedure JulianToGregorian(JulianDN:LongInt;Var Year,Month,Day:Word);
Var
YYear,XYear,Temp,TempMonth : LongInt;
Begin
Temp:=((JulianDN-D2) shl 2)-1;
JulianDN:=Temp Div D1;
XYear:=(Temp Mod D1) or 3;
YYear:=(XYear Div D0);
Temp:=((((XYear mod D0)+4) shr 2)*5)-3;
Day:=((Temp Mod 153)+5) Div 5;
TempMonth:=Temp Div 153;
If TempMonth>=10 Then
Begin
inc(YYear);
dec(TempMonth,12);
End;
inc(TempMonth,3);
Month := TempMonth;
Year:=YYear+(JulianDN*100);
end;
Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Word);
{ Transforms Epoch time into local time (hour, minute,seconds) }
Var
DateNum: LongInt;
Begin
Datenum:=(Epoch Div 86400) + c1970;
JulianToGregorian(DateNum,Year,Month,day);
Epoch:=Epoch Mod 86400;
Hour:=Epoch Div 3600;
Epoch:=Epoch Mod 3600;
Minute:=Epoch Div 60;
Second:=Epoch Mod 60;
End;
{
$Log$
Revision 1.1 2001-06-02 19:26:03 peter
* BeOS target!
Revision 1.5 2000/01/07 16:41:29 daniel
* copyright 2000
Revision 1.4 2000/01/07 16:32:23 daniel
* copyright 2000 added
Revision 1.3 1999/01/22 16:22:09 pierre
* Daniel removal of findclose reverted
Revision 1.2 1999/01/22 10:07:02 daniel
- Findclose removed: This is TP incompatible!!
Revision 1.1 1998/12/21 13:07:02 peter
* use -FE
Revision 1.19 1998/11/23 13:53:59 peter
* more fexpand fixes from marco van de voort
Revision 1.18 1998/11/23 12:48:02 peter
* fexpand('o:') fixed to return o:\ (from the mailinglist)
Revision 1.17 1998/11/22 09:33:21 florian
* fexpand bug (temp. strings were too shoort) fixed, was reported
by Marco van de Voort
Revision 1.16 1998/11/17 09:37:41 pierre
* explicit conversion from word dosreg.ax to integer doserror
Revision 1.15 1998/11/01 20:27:18 peter
* fixed some doserror settings
Revision 1.14 1998/10/22 15:05:28 pierre
* fsplit adapted to long filenames
Revision 1.13 1998/09/16 16:47:24 peter
* merged fixes
Revision 1.11.2.2 1998/09/16 16:16:04 peter
* go32v1 compiles again
Revision 1.12 1998/09/11 12:46:44 pierre
* range check problem with LFN attr removed
Revision 1.11.2.1 1998/09/11 12:38:41 pierre
* conversion from LFN attr to Dos attr did not respect range checking
Revision 1.11 1998/08/28 10:45:58 peter
* fixed path buffer in findfirst
Revision 1.10 1998/08/27 10:30:48 pierre
* go32v1 RTL did not compile (LFNsupport outside go32v2 defines !)
I renamed tb_selector to tb_segment because
it is a real mode segment as opposed to
a protected mode selector
Fixed it for go32v1 (remove the $E0000000 offset !)
Revision 1.9 1998/08/26 10:04:01 peter
* new lfn check from mailinglist
* renamed win95 -> LFNSupport
+ tb_selector, tb_offset for easier access to transferbuffer
Revision 1.8 1998/08/16 20:39:49 peter
+ LFN Support
Revision 1.7 1998/08/16 09:12:13 michael
Corrected fexpand behaviour.
Revision 1.6 1998/08/05 21:01:50 michael
applied bugfix from maillist to fsearch
Revision 1.5 1998/05/31 14:18:13 peter
* force att or direct assembling
* cleanup of some files
Revision 1.4 1998/05/22 00:39:22 peter
* go32v1, go32v2 recompiles with the new objects
* remake3 works again with go32v2
- removed some "optimizes" from daniel which were wrong
Revision 1.3 1998/05/21 19:30:47 peter
* objects compiles for linux
+ assign(pchar), assign(char), rename(pchar), rename(char)
* fixed read_text_as_array
+ read_text_as_pchar which was not yet in the rtl
}
Function StringToPPChar(Var S:STring):ppchar;
{
Create a PPChar to structure of pchars which are the arguments specified
in the string S. Especially usefull for creating an ArgV for Exec-calls
}
var
nr : longint;
Buf : ^char;
p : ppchar;
begin
s:=s+#0;
buf:=@s[1];
nr:=0;
while(buf^<>#0) do
begin
while (buf^ in [' ',#8,#10]) do
inc(buf);
inc(nr);
while not (buf^ in [' ',#0,#8,#10]) do
inc(buf);
end;
getmem(p,nr*4);
StringToPPChar:=p;
if p=nil then
begin
{ LinuxError:=sys_enomem;}
exit;
end;
buf:=@s[1];
while (buf^<>#0) do
begin
while (buf^ in [' ',#8,#10]) do
begin
buf^:=#0;
inc(buf);
end;
p^:=buf;
inc(p);
p^:=nil;
while not (buf^ in [' ',#0,#8,#10]) do
inc(buf);
end;
end;
Function Dirname(Const path:pathstr):pathstr;
{
This function returns the directory part of a complete path.
Unless the directory is root '/', The last character is not
a slash.
}
var
Dir : PathStr;
Name : NameStr;
Ext : ExtStr;
begin
FSplit(Path,Dir,Name,Ext);
if length(Dir)>1 then
Delete(Dir,length(Dir),1);
DirName:=Dir;
end;
Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
{
This function returns the filename part of a complete path. If suf is
supplied, it is cut off the filename.
}
var
Dir : PathStr;
Name : NameStr;
Ext : ExtStr;
begin
FSplit(Path,Dir,Name,Ext);
if Suf<>Ext then
Name:=Name+Ext;
BaseName:=Name;
end;
function GetEnv(EnvVar: String): String;
var p:pchar;
begin
p:=beos.GetEnv(EnvVar);
if p=nil then
GetEnv:=''
else
GetEnv:=StrPas(p);
end;
end.

210
rtl/beos/i386/cprt0.as Normal file
View File

@ -0,0 +1,210 @@
.file "cprt0.s"
.data
.align 4
default_environ:
.long 0
.text
.globl _start
.type _start,@function
_start:
pushl %ebp
movl %esp,%ebp
subl $4,%esp
pushl %ebx
call .L6
.L6:
popl %ebx
addl $_GLOBAL_OFFSET_TABLE_+[.-.L6],%ebx
movl argv_save@GOT(%ebx),%eax
movl 12(%ebp),%edi
movl %edi,(%eax)
movl environ@GOT(%ebx),%eax
movl 16(%ebp),%esi
movl %esi,(%eax)
test %esi,%esi
jnz .L4
movl environ@GOT(%ebx),%eax
movl %ebx,%ecx
addl $default_environ@GOTOFF,%ecx
movl %ecx,%edx
movl %edx,(%eax)
.L4:
/* movl %fs:0x4,%eax this doesn't work on BeOS 4.0, let's use find_thread instead */
pushl $0x0
call find_thread
movl __main_thread_id@GOT(%ebx),%edx
movl %eax,(%edx)
pushl %esi
pushl %edi
movl 8(%ebp),%eax
pushl %eax
call _init_c_library_
call _call_init_routines_
movl 8(%ebp),%eax
movl %eax,U_SYSBEOS_ARGC
movl %edi,U_SYSBEOS_ARGV
movl %esi,U_SYSBEOS_ENVP
xorl %ebp,%ebp
call PASCALMAIN
.globl _haltproc
.type _haltproc,@function
_haltproc:
call _thread_do_exit_notification
xorl %ebx,%ebx
movw U_SYSBEOS_EXITCODE,%bx
pushl %ebx
call exit
/* int sys_open (int=0xFF000000, char * name, int mode, int=0, int close_on_exec=0); */
.globl sys_open
.type sys_open,@function
sys_open:
xorl %eax,%eax
int $0x25
ret
/* int sys_close (int handle) */
.globl sys_close
.type sys_close,@function
sys_close:
mov $0x01,%eax
int $0x25
ret
/* int sys_read (int handle, void * buffer, int length) */
.globl sys_read
.type sys_read,@function
sys_read:
movl $0x02,%eax
int $0x25
ret
/* int sys_write (int handle, void * buffer, int length) */
.globl sys_write
.type sys_write,@function
sys_write:
movl $0x3,%eax
int $0x25
ret
/* int sys_lseek (int handle, long long pos, int whence) */
.globl sys_lseek
.type sys_lseek,@function
sys_lseek:
movl $0x5,%eax
int $0x25
ret
/* int sys_time(void) */
.globl sys_time
.type sys_time,@function
sys_time:
movl $0x7,%eax
int $0x25
ret
/* int sys_resize_area */
.globl sys_resize_area
.type sys_resize_area,@function
sys_resize_area:
movl $0x8,%eax
int $0x25
ret
/* int sys_opendir (0xFF000000, chra * name, 0) */
.globl sys_opendir
.type sys_opendir,@function
sys_opendir:
movl $0xC,%eax
int $0x25
ret
/* int sys_create_area */
.globl sys_create_area
.type sys_create_area,@function
sys_create_area:
movl $0x14,%eax
int $0x25
ret
/* int sys_readdir (int handle, void * dirent, 0x11C, 0x01000000) */
.globl sys_readdir
.type sys_readdir,@function
sys_readdir:
movl $0x1C,%eax
int $0x25
ret
/* int sys_mkdir (char=0xFF, char * name, int mode) */
.globl sys_mkdir
.type sys_mkdir,@function
sys_mkdir:
movl $0x1E,%eax
int $0x25
ret
/* int sys_wait_for_thread */
.globl sys_wait_for_thread
.type sys_wait_for_thread,@function
sys_wait_for_thread:
movl $0x22,%eax
int $0x25
ret
/* int sys_rename (int=0xFF000000, char * name, int=0xFF000000, char * newname) */
.globl sys_rename
.type sys_rename,@function
sys_rename:
movl $0x26,%eax
int $0x25
ret
/* int sys_unlink (int=0xFF000000, char * name) */
.globl sys_unlink
.type sys_unlink,@function
sys_unlink:
movl $0x27,%eax
int $0x25
ret
/* int sys_stat (int=0xFF000000, char * name, struct stat * s, int=0) */
.globl sys_stat
.type sys_stat,@function
sys_stat:
movl $0x30,%eax
int $0x25
ret
/* int sys_load_image */
.globl sys_load_image
.type sys_load_image,@function
sys_load_image:
movl $0x34,%eax
int $0x25
ret
/* void sys_exit (int exitcode) */
.globl sys_exit
.type sys_exit,@function
sys_exit:
movl $0x3F,%eax
int $0x25
/* void sys_chdir (char 0xFF, char * name) */
.globl sys_chdir
.type sys_chdir,@function
sys_chdir:
movl $0x57,%eax
int $0x25
ret
/* void sys_rmdir (char 0xFF, char * name) */
.globl sys_rmdir
.type sys_rmdir,@function
sys_rmdir:
movl $0x60,%eax
int $0x25
ret

170
rtl/beos/i386/dllprt.as Normal file
View File

@ -0,0 +1,170 @@
.file "dllprt.cpp"
.text
.p2align 2
.globl _._7FPC_DLL
.type _._7FPC_DLL,@function
_._7FPC_DLL:
.LFB1:
pushl %ebp
.LCFI0:
movl %esp,%ebp
.LCFI1:
pushl %esi
.LCFI2:
pushl %ebx
.LCFI3:
call .L7
.L7:
popl %ebx
addl $_GLOBAL_OFFSET_TABLE_+[.-.L7],%ebx
movl 8(%ebp),%esi
.L3:
movl 12(%ebp),%eax
andl $1,%eax
testl %eax,%eax
je .L5
pushl %esi
.LCFI4:
call __builtin_delete@PLT
addl $4,%esp
jmp .L5
.p2align 4,,7
.L4:
.L5:
.L2:
leal -8(%ebp),%esp
popl %ebx
popl %esi
movl %ebp,%esp
popl %ebp
ret
.LFE1:
.Lfe1:
.size _._7FPC_DLL,.Lfe1-_._7FPC_DLL
.section .rodata
.LC0:
.string "dll"
.data
.align 4
.type _argv,@object
.size _argv,8
_argv:
.long .LC0
.long 0
.align 4
.type _envp,@object
.size _envp,4
_envp:
.long 0
.text
.p2align 2
.globl __7FPC_DLL
.type __7FPC_DLL,@function
__7FPC_DLL:
.LFB2:
pushl %ebp
.LCFI5:
movl %esp,%ebp
.LCFI6:
pushl %ebx
.LCFI7:
call .L11
.L11:
popl %ebx
addl $_GLOBAL_OFFSET_TABLE_+[.-.L11],%ebx
movl U_SYSBEOS_ARGC@GOT(%ebx),%eax
movl $0,(%eax)
movl U_SYSBEOS_ARGV@GOT(%ebx),%eax
movl %ebx,%ecx
addl $_argv@GOTOFF,%ecx
movl %ecx,%edx
movl %edx,(%eax)
movl U_SYSBEOS_ENVP@GOT(%ebx),%eax
movl %ebx,%ecx
addl $_envp@GOTOFF,%ecx
movl %ecx,%edx
movl %edx,(%eax)
call PASCALMAIN__Fv@PLT
.L9:
movl 8(%ebp),%eax
jmp .L8
.L8:
movl -4(%ebp),%ebx
movl %ebp,%esp
popl %ebp
ret
.LFE2:
.Lfe2:
.size __7FPC_DLL,.Lfe2-__7FPC_DLL
.section .eh_frame,"aw",@progbits
__FRAME_BEGIN__:
.4byte .LLCIE1
.LSCIE1:
.4byte 0x0
.byte 0x1
.byte 0x0
.byte 0x1
.byte 0x7c
.byte 0x8
.byte 0xc
.byte 0x4
.byte 0x4
.byte 0x88
.byte 0x1
.align 4
.LECIE1:
.set .LLCIE1,.LECIE1-.LSCIE1
.4byte .LLFDE1
.LSFDE1:
.4byte .LSFDE1-__FRAME_BEGIN__
.4byte .LFB1
.4byte .LFE1-.LFB1
.byte 0x4
.4byte .LCFI0-.LFB1
.byte 0xe
.byte 0x8
.byte 0x85
.byte 0x2
.byte 0x4
.4byte .LCFI1-.LCFI0
.byte 0xd
.byte 0x5
.byte 0x4
.4byte .LCFI2-.LCFI1
.byte 0x86
.byte 0x3
.byte 0x4
.4byte .LCFI3-.LCFI2
.byte 0x83
.byte 0x4
.byte 0x4
.4byte .LCFI4-.LCFI3
.byte 0x2e
.byte 0x4
.align 4
.LEFDE1:
.set .LLFDE1,.LEFDE1-.LSFDE1
.4byte .LLFDE3
.LSFDE3:
.4byte .LSFDE3-__FRAME_BEGIN__
.4byte .LFB2
.4byte .LFE2-.LFB2
.byte 0x4
.4byte .LCFI5-.LFB2
.byte 0xe
.byte 0x8
.byte 0x85
.byte 0x2
.byte 0x4
.4byte .LCFI6-.LCFI5
.byte 0xd
.byte 0x5
.byte 0x4
.4byte .LCFI7-.LCFI6
.byte 0x83
.byte 0x3
.align 4
.LEFDE3:
.set .LLFDE3,.LEFDE3-.LSFDE3
.ident "GCC: (GNU) 2.9-beos-991026"

39
rtl/beos/i386/dllprt.cpp Normal file
View File

@ -0,0 +1,39 @@
#include <stdio.h>
class FPC_DLL
{
public:
FPC_DLL();
// ~FPC_DLL();
};
static FPC_DLL fpc_dll();
//FPC_DLL::~FPC_DLL()
//{
// printf ("main thread ended.");
//}
extern "C" void PASCALMAIN(void);
extern int U_SYSBEOS_ARGC;
extern void * U_SYSBEOS_ARGV;
extern void * U_SYSBEOS_ENVP;
static char * _argv[] = {"dll",0};
static char * _envp[] = {0};
extern "C" void BEGIN()
{
printf ("init\n");
U_SYSBEOS_ARGC=0;
U_SYSBEOS_ARGV = (void *)_argv;
U_SYSBEOS_ENVP = (void *)_envp;
PASCALMAIN();
}
FPC_DLL::FPC_DLL()
{
BEGIN();
}

161
rtl/beos/i386/func.as Normal file
View File

@ -0,0 +1,161 @@
.file "func.s"
.text
.globl _haltproc
.type _haltproc,@function
_haltproc:
xorl %ebx,%ebx
movw U_SYSBEOS_EXITCODE,%bx
pushl %ebx
call sys_exit
/* int sys_open (int=0xFF000000, char * name, int mode, int=0, int close_on_exec=0); */
.globl sys_open
.type sys_open,@function
sys_open:
xorl %eax,%eax
int $0x25
ret
/* int sys_close (int handle) */
.globl sys_close
.type sys_close,@function
sys_close:
mov $0x01,%eax
int $0x25
ret
/* int sys_read (int handle, void * buffer, int length) */
.globl sys_read
.type sys_read,@function
sys_read:
movl $0x02,%eax
int $0x25
ret
/* int sys_write (int handle, void * buffer, int length) */
.globl sys_write
.type sys_write,@function
sys_write:
movl $0x3,%eax
int $0x25
ret
/* int sys_lseek (int handle, long long pos, int whence) */
.globl sys_lseek
.type sys_lseek,@function
sys_lseek:
movl $0x5,%eax
int $0x25
ret
/* int sys_time(void) */
.globl sys_time
.type sys_time,@function
sys_time:
movl $0x7,%eax
int $0x25
ret
/* int sys_resize_area */
.globl sys_resize_area
.type sys_resize_area,@function
sys_resize_area:
movl $0x8,%eax
int $0x25
ret
/* int sys_opendir (0xFF000000, chra * name, 0) */
.globl sys_opendir
.type sys_opendir,@function
sys_opendir:
movl $0xC,%eax
int $0x25
ret
/* int sys_create_area */
.globl sys_create_area
.type sys_create_area,@function
sys_create_area:
movl $0x14,%eax
int $0x25
ret
/* int sys_readdir (int handle, void * dirent, 0x11C, 0x01000000) */
.globl sys_readdir
.type sys_readdir,@function
sys_readdir:
movl $0x1C,%eax
int $0x25
ret
/* int sys_mkdir (char=0xFF, char * name, int mode) */
.globl sys_mkdir
.type sys_mkdir,@function
sys_mkdir:
movl $0x1E,%eax
int $0x25
ret
/* int sys_wait_for_thread */
.globl sys_wait_for_thread
.type sys_wait_for_thread,@function
sys_wait_for_thread:
movl $0x22,%eax
int $0x25
ret
/* int sys_rename (int=0xFF000000, char * name, int=0xFF000000, char * newname) */
.globl sys_rename
.type sys_rename,@function
sys_rename:
movl $0x26,%eax
int $0x25
ret
/* int sys_unlink (int=0xFF000000, char * name) */
.globl sys_unlink
.type sys_unlink,@function
sys_unlink:
movl $0x27,%eax
int $0x25
ret
/* int sys_stat (int=0xFF000000, char * name, struct stat * s, int=0) */
.globl sys_stat
.type sys_stat,@function
sys_stat:
movl $0x30,%eax
int $0x25
ret
/* int sys_load_image */
.globl sys_load_image
.type sys_load_image,@function
sys_load_image:
movl $0x34,%eax
int $0x25
ret
/* void sys_exit (int exitcode) */
.globl sys_exit
.type sys_exit,@function
sys_exit:
movl $0x3F,%eax
int $0x25
/* void sys_chdir (char 0xFF, char * name) */
.globl sys_chdir
.type sys_chdir,@function
sys_chdir:
movl $0x57,%eax
int $0x25
ret
/* void sys_rmdir (char 0xFF, char * name) */
.globl sys_rmdir
.type sys_rmdir,@function
sys_rmdir:
movl $0x60,%eax
int $0x25
ret

174
rtl/beos/i386/prt0.as Normal file
View File

@ -0,0 +1,174 @@
.file "prt0.c"
.text
.globl start
.type start,@function
start:
pushl %ebp
movl %esp,%ebp
movl 16(%ebp),%ecx
movl 12(%ebp),%ebx
movl 8(%ebp),%eax
movl %eax,U_SYSBEOS_ARGC
movl %ebx,U_SYSBEOS_ARGV
movl %ecx,U_SYSBEOS_ENVP
xorl %ebp,%ebp
call PASCALMAIN
.globl _haltproc
.type _haltproc,@function
_haltproc:
xorl %ebx,%ebx
movw U_SYSBEOS_EXITCODE,%bx
pushl %ebx
call sys_exit
/* int sys_open (int=0xFF000000, char * name, int mode, int=0, int close_on_exec=0); */
.globl sys_open
.type sys_open,@function
sys_open:
xorl %eax,%eax
int $0x25
ret
/* int sys_close (int handle) */
.globl sys_close
.type sys_close,@function
sys_close:
mov $0x01,%eax
int $0x25
ret
/* int sys_read (int handle, void * buffer, int length) */
.globl sys_read
.type sys_read,@function
sys_read:
movl $0x02,%eax
int $0x25
ret
/* int sys_write (int handle, void * buffer, int length) */
.globl sys_write
.type sys_write,@function
sys_write:
movl $0x3,%eax
int $0x25
ret
/* int sys_lseek (int handle, long long pos, int whence) */
.globl sys_lseek
.type sys_lseek,@function
sys_lseek:
movl $0x5,%eax
int $0x25
ret
/* int sys_time(void) */
.globl sys_time
.type sys_time,@function
sys_time:
movl $0x7,%eax
int $0x25
ret
/* int sys_resize_area */
.globl sys_resize_area
.type sys_resize_area,@function
sys_resize_area:
movl $0x8,%eax
int $0x25
ret
/* int sys_opendir (0xFF000000, chra * name, 0) */
.globl sys_opendir
.type sys_opendir,@function
sys_opendir:
movl $0xC,%eax
int $0x25
ret
/* int sys_create_area */
.globl sys_create_area
.type sys_create_area,@function
sys_create_area:
movl $0x14,%eax
int $0x25
ret
/* int sys_readdir (int handle, void * dirent, 0x11C, 0x01000000) */
.globl sys_readdir
.type sys_readdir,@function
sys_readdir:
movl $0x1C,%eax
int $0x25
ret
/* int sys_mkdir (char=0xFF, char * name, int mode) */
.globl sys_mkdir
.type sys_mkdir,@function
sys_mkdir:
movl $0x1E,%eax
int $0x25
ret
/* int sys_wait_for_thread */
.globl sys_wait_for_thread
.type sys_wait_for_thread,@function
sys_wait_for_thread:
movl $0x22,%eax
int $0x25
ret
/* int sys_rename (int=0xFF000000, char * name, int=0xFF000000, char * newname) */
.globl sys_rename
.type sys_rename,@function
sys_rename:
movl $0x26,%eax
int $0x25
ret
/* int sys_unlink (int=0xFF000000, char * name) */
.globl sys_unlink
.type sys_unlink,@function
sys_unlink:
movl $0x27,%eax
int $0x25
ret
/* int sys_stat (int=0xFF000000, char * name, struct stat * s, int=0) */
.globl sys_stat
.type sys_stat,@function
sys_stat:
movl $0x30,%eax
int $0x25
ret
/* int sys_load_image */
.globl sys_load_image
.type sys_load_image,@function
sys_load_image:
movl $0x34,%eax
int $0x25
ret
/* void sys_exit (int exitcode) */
.globl sys_exit
.type sys_exit,@function
sys_exit:
movl $0x3F,%eax
int $0x25
/* void sys_chdir (char 0xFF, char * name) */
.globl sys_chdir
.type sys_chdir,@function
sys_chdir:
movl $0x57,%eax
int $0x25
ret
/* void sys_rmdir (char 0xFF, char * name) */
.globl sys_rmdir
.type sys_rmdir,@function
sys_rmdir:
movl $0x60,%eax
int $0x25
ret

96
rtl/beos/objinc.inc Normal file
View File

@ -0,0 +1,96 @@
{ For linux we 'steal' the following from system unit, this way
we don't need to change the system unit interface. }
Var errno : Longint;
{$i sysnr.inc}
{$i errno.inc}
{$i sysconst.inc}
{$i systypes.inc}
{$i syscalls.inc}
FUNCTION FileOpen (Var FileName: AsciiZ; Mode: Word): THandle;
Var LinuxMode : longint;
BEGIN
LinuxMode:=0;
if Mode=stCreate then
Begin
LinuxMode:=Open_Creat;
LinuxMode:=LinuxMode or Open_RdWr;
end
else
Begin
Case (Mode and 3) of
0 : LinuxMode:=LinuxMode or Open_RdOnly;
1 : LinuxMode:=LinuxMode or Open_WrOnly;
2 : LinuxMode:=LinuxMode or Open_RdWr;
end;
end;
FileOpen:=SYS_Open (pchar(@FileName[0]),LinuxMode,438 {666 octal});
If FileOpen=-1 then FileOpen:=0;
DosStreamError:=Errno;
END;
FUNCTION FileRead (Handle: THandle; Var BufferArea; BufferLength: Sw_Word;
Var BytesMoved: Sw_Word): Word;
BEGIN
BytesMoved:=Sys_read (Handle,Pchar(@BufferArea),BufferLength);
DosStreamError:=Errno;
FileRead:=Errno;
END;
FUNCTION FileWrite (Handle: THandle; Var BufferArea; BufferLength: Sw_Word;
Var BytesMoved: Sw_Word): Word;
BEGIN
BytesMoved:=Sys_Write (Handle,Pchar(@BufferArea),BufferLength);
FileWrite:=Errno;
DosStreamError:=Errno;
END;
FUNCTION SetFilePos (Handle: THandle; Pos: LongInt; MoveType: Word;
VAR NewPos: LongInt): Word;
BEGIN
NewPos:=Sys_LSeek (Handle,Pos,MoveType);
SetFilePos:=Errno;
END;
FUNCTION FileClose (Handle: THandle): Word;
BEGIN
Sys_Close (Handle);
DosStreamError:=Errno;
FileClose := Errno;
END;
FUNCTION SetFileSize (Handle: THandle; FileSize: LongInt): Word;
{$IFNDEF BSD}
Var sr : syscallregs;
{$ENDIF}
{$IFDEF DOSSETFILE1}
Actual, Buf: LongInt;
{$ENDIF}
BEGIN
{$IFDEF BSD}
Do_Syscall(Syscall_Nr_ftruncate,handle,filesize,0); {0 -> offset =64 bit}
{$ELSE}
sr.reg2:=Handle;
sr.reg3:=FileSize;
Syscall(syscall_nr_fTruncate,sr);
{$ENDIF}
If Errno=0 then
SetFileSize:=0
else
SetFileSize:=103;
{$IFDEF DOSSETFILE1}
If (Actual = FileSize) Then Begin { No position error }
Actual := FileWrite(Handle, Pointer(@Buf), 0,Actual); { Truncate the file }
If (Actual <> -1) Then SetFileSize := 0 Else { No truncate error }
SetFileSize := 103; { File truncate error }
End Else SetFileSize := 103; { File truncate error }
{$ENDIF}
END;

18
rtl/beos/sysfiles.inc Normal file
View File

@ -0,0 +1,18 @@
const O_RDONLY=0;
const O_WRONLY=1;
const O_RDWR=2;
const O_CREAT = $200;
const O_TRUNC = $400;
const O_APPEND = $800;
{const O_TEXT = $4000;
const O_BINARY = $8000;}
function sys_open (a:cardinal;name:pchar;access:longint;b:longint;c:longint):longint; cdecl; external name 'sys_open';
function sys_close (handle:longint):longint; cdecl; external name 'sys_close';
function sys_read (handle:longint;buffer:pointer;len:longint;var a:longint):longint; cdecl; external name 'sys_read';
function sys_write (handle:longint;buffer:pointer;len:longint;var a:longint):longint; cdecl; external name 'sys_write';
function sys_lseek (handle:longint;pos:int64;whence:longint): int64; cdecl; external name 'sys_lseek';

519
rtl/beos/system.pp Normal file
View File

@ -0,0 +1,519 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by the Free Pascal development team.
This is a prototype file to show all function that need to be implemented
for a new operating system (provided the processor specific
function are already implemented !)
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.
**********************************************************************}
{ no stack check in system }
{$DEFINE SHORT_LINEBREAK}
{$S-}
unit System;
interface
{ include system-independent routine headers }
{$I systemh.inc}
{ include heap support headers }
{$I heaph.inc}
const
FileNameCaseSensitive : boolean = true;
sLineBreak : string[1] = #10;
DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsLF;
var
argc : longint;
argv : ppchar;
envp : ppchar;
UnusedHandle:longint;
StdInputHandle:longint;
StdOutputHandle:longint;
StdErrorHandle:longint;
implementation
{$I sysfiles.inc}
function sys_unlink (a:cardinal;name:pchar):longint; cdecl; external name 'sys_unlink';
function sys_rename (a:cardinal;p1:pchar;b:cardinal;p2:pchar):longint; cdecl; external name 'sys_rename';
function sys_create_area (name:pchar; var start:longint; a,b,c,d:longint):longint; cdecl; external name 'sys_create_area';
function sys_resize_area (handle:cardinal; size:longint):longint; cdecl; external name 'sys_resize_area';
function sys_mkdir (a:cardinal; name:pchar; mode:cardinal):longint; cdecl; external name 'sys_mkdir';
function sys_chdir (a:cardinal; name:pchar):longint; cdecl; external name 'sys_chdir';
function sys_rmdir (a:cardinal; name:pchar):longint; cdecl; external name 'sys_rmdir';
{$I system.inc}
{*****************************************************************************
System Dependent Exit code
*****************************************************************************}
procedure prthaltproc;external name '_haltproc';
procedure system_exit;
begin
asm
jmp prthaltproc
end;
End;
{*****************************************************************************
Stack check code
*****************************************************************************}
procedure int_stackcheck(stack_size:longint);[public,alias:'FPC_STACKCHECK'];
{
called when trying to get local stack if the compiler directive $S
is set this function must preserve esi !!!! because esi is set by
the calling proc for methods it must preserve all registers !!
With a 2048 byte safe area used to write to StdIo without crossing
the stack boundary
}
begin
end;
{*****************************************************************************
ParamStr/Randomize
*****************************************************************************}
{ number of args }
function paramcount : longint;
begin
paramcount := argc - 1;
end;
{ argument number l }
function paramstr(l : longint) : string;
begin
if (l>=0) and (l+1<=argc) then
paramstr:=strpas(argv[l])
else
paramstr:='';
end;
{ set randseed to a new pseudo random value }
procedure randomize;
begin
{regs.realeax:=$2c00;
sysrealintr($21,regs);
hl:=regs.realedx and $ffff;
randseed:=hl*$10000+ (regs.realecx and $ffff);}
randseed:=0;
end;
{*****************************************************************************
Heap Management
*****************************************************************************}
var myheapstart:longint;
myheapsize:longint;
myheaprealsize:longint;
heap_handle:longint;
zero:longint;
{ first address of heap }
function getheapstart:pointer;
begin
getheapstart:=pointer(myheapstart);
end;
{ current length of heap }
function getheapsize:longint;
begin
getheapsize:=myheapsize;
end;
{ function to allocate size bytes more for the program }
{ must return the first address of new data space or -1 if fail }
function Sbrk(size : longint):longint;
var newsize,newrealsize:longint;
begin
if (myheapsize+size)<=myheaprealsize then begin
Sbrk:=myheapstart+myheapsize;
myheapsize:=myheapsize+size;
exit;
end;
newsize:=myheapsize+size;
newrealsize:=(newsize and $FFFFF000)+$1000;
if sys_resize_area(heap_handle,newrealsize)=0 then begin
Sbrk:=myheapstart+myheapsize;
myheapsize:=newsize;
myheaprealsize:=newrealsize;
exit;
end;
Sbrk:=-1;
end;
{ include standard heap management }
{$I heap.inc}
{****************************************************************************
Low level File Routines
All these functions can set InOutRes on errors
****************************************************************************}
{ close a file from the handle value }
procedure do_close(handle : longint);
begin
{ writeln ('CLOSE ',handle);}
if handle<=2 then exit;
InOutRes:=sys_close(handle);
end;
procedure do_erase(p : pchar);
begin
if sys_unlink($FF000000,p)<>0 then InOutRes:=1
else InOutRes:=0;
end;
procedure do_rename(p1,p2 : pchar);
begin
InOutRes:=sys_rename($FF000000,p1,$FF000000,p2);
end;
function do_write(h,addr,len : longint) : longint;
begin
{ if h>0 then begin
sys_write ('WRITE handle=%d ',h);
printf ('addr=%x ',addr);
printf ('len=%d',len);
printf ('%c',10);
end;}
do_write:=sys_write (h,pointer(addr),len,zero);
if (do_write<0) then begin
InOutRes:=do_write;
do_write:=0;
end else InOutRes:=0;
end;
function do_read(h,addr,len : longint) : longint;
begin
{ if h>2 then begin
printf ('READ handle=%d ',h);
printf ('addr=%x ',addr);
printf ('len=%d',len);
end;}
do_read:=sys_read (h,pointer(addr),len,zero);
if (do_read<0) then begin
InOutRes:=do_read;
do_read:=0;
end else InOutRes:=0;
end;
function do_filepos(handle : longint) : longint;
begin
do_filepos:=sys_lseek(handle,0,1); {1=SEEK_CUR}
if (do_filepos<0) then begin
InOutRes:=do_filepos;
do_filepos:=0;
end else InOutRes:=0;
end;
procedure do_seek(handle,pos : longint);
begin
InOutRes:=sys_lseek(handle,pos,0);
if InOutRes>0 then InOutRes:=0;
end;
function do_seekend(handle:longint):longint;
begin
do_seekend:=sys_lseek (handle,0,2); {2=SEEK_END}
if do_seekend<0 then begin
InOutRes:=do_seekend;
do_seekend:=0;
end else InOutRes:=0;
end;
function do_filesize(handle : longint) : longint;
var cur:longint;
begin
cur:=sys_lseek (handle,0,1); {1=SEEK_CUR}
if cur<0 then begin
InOutRes:=cur;
do_filesize:=0;
exit;
end;
do_filesize:=sys_lseek (handle,0,2); {2=SEEK_END}
if do_filesize<0 then begin
InOutRes:=do_filesize;
do_filesize:=0;
exit;
end;
cur:=sys_lseek (handle,cur,0); {0=SEEK_POS}
if cur<0 then begin
InOutRes:=cur;
do_filesize:=0;
exit;
end;
end;
{ truncate at a given position }
procedure do_truncate (handle,pos:longint);
begin
InOutRes:=1;
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 m:longint;
mode,h:longint;
begin
{ printf ('OPEN %d ',longint(f));
printf (' %s',longint(p));
printf (' %x',flags);}
m:=0;
case (flags and $3) of
$0: begin m:=m or O_RDONLY; mode:=fminput; end;
$1: begin m:=m or O_WRONLY; mode:=fmoutput;end;
$2: begin m:=m or O_RDWR; mode:=fminout; end;
end;
if (flags and $100)<>0 then m:=m or O_APPEND;
if (flags and $1000)<>0 then m:=m or O_TRUNC or O_CREAT;
{ if (flags and $10000)<>0 then m:=m or O_TEXT else m:=m or O_BINARY;}
h:=sys_open($FF000000,p,m,0,0);
if h<0 then InOutRes:=h
else InOutRes:=0;
if InOutRes=0 then begin
FileRec(f).handle:=h;
FileRec(f).mode:=mode;
end;
end;
function do_isdevice(handle:longint):boolean;
begin
do_isdevice:=false;
InOutRes:=0;
end;
{*****************************************************************************
UnTyped File Handling
*****************************************************************************}
{$i file.inc}
{*****************************************************************************
Typed File Handling
*****************************************************************************}
{$i typefile.inc}
{*****************************************************************************
Text File Handling
*****************************************************************************}
{ should we consider #26 as the end of a file ? }
{?? $DEFINE EOF_CTRLZ}
{$i text.inc}
{*****************************************************************************
Directory Handling
*****************************************************************************}
procedure mkdir(const s : string);[IOCheck];
var t:string;
begin
t:=s+#0;
InOutRes:=sys_mkdir ($FF000000,@t[1],493);
end;
procedure rmdir(const s : string);[IOCheck];
var t:string;
begin
t:=s+#0;
InOutRes:=sys_rmdir ($FF000000,@t[1]);
end;
procedure chdir(const s : string);[IOCheck];
var t:string;
begin
t:=s+#0;
InOutRes:=sys_chdir ($FF000000,@t[1]);
end;
{*****************************************************************************
getdir procedure
*****************************************************************************}
type dirent = packed record
d_dev:longint;
d_pdev:longint;
d_ino:int64;
d_pino:int64;
d_reclen:word;
d_name:array[0..255] of char;
end;
stat = packed record
dev:longint; {"device" that this file resides on}
ino:int64; {this file's inode #, unique per device}
mode:dword; {mode bits (rwx for user, group, etc)}
nlink:longint; {number of hard links to this file}
uid:dword; {user id of the owner of this file}
gid:dword; {group id of the owner of this file}
size:int64; {size of this file (in bytes)}
rdev:longint; {device type (not used)}
blksize:longint; {preferref block size for i/o}
atime:longint; {last access time}
mtime:longint; {last modification time}
ctime:longint; {last change time, not creation time}
crtime:longint; {creation time}
end;
pstat = ^stat;
function sys_stat (a:cardinal;path:pchar;info:pstat;n:longint):longint; cdecl; external name 'sys_stat';
function FStat(Path:String;Var Info:stat):Boolean;
{
Get all information on a file, and return it in Info.
}
var tmp:string;
var p:pchar;
begin
tmp:=path+#0;
p:=@tmp[1];
FStat:=(sys_stat($FF000000,p,@Info,0)=0);
end;
function sys_opendir (a:cardinal;path:pchar;b:longint):longint; cdecl; external name 'sys_opendir';
function sys_readdir (fd:longint;var de:dirent;a:longint;b:byte):longint; cdecl; external name 'sys_readdir';
function parentdir(fd:longint;dev:longint;ino:int64;var err:longint):string;
var len:longint;
ent:dirent;
name:string;
begin
err:=0;
parentdir:='';
if sys_readdir(fd,ent,$11C,1)=0 then begin
err:=1;
exit;
end;
len:=StrLen(@ent.d_name);
Move(ent.d_name,name[1],len);
name[0]:=chr(len);
{ writeln ('NAME: "',name,'" = ',ent.d_dev,',',ent.d_ino);}
if (dev=ent.d_dev) and (ino=ent.d_ino) then begin
err:=0;
parentdir:='/'+name;
exit;
end;
err:=0;
end;
function getdir2:string;
var tmp:string;
info:stat;
info2:stat;
fd:longint;
name:string;
cur:string;
res:string;
err:longint;
begin
res:='';
cur:='';
repeat
FStat(cur+'.',info);
FStat(cur+'..',info2);
{ writeln ('"." = ',info.dev,',',info.ino);}
if ((info.dev=info2.dev) and (info.ino=info2.ino)) then begin
if res='' then getdir2:='/' else getdir2:=res;
exit;
end;
tmp:=cur+'..'+#0;
fd:=sys_opendir ($FF000000,@tmp[1],0);
repeat
name:=parentdir(fd,info.dev,info.ino,err);
until (err<>0) or (name<>'');
if err<>0 then begin
getdir2:='';
exit;
end;
res:=name+res;
{ writeln(res);}
cur:=cur+'../';
until false;
end;
procedure getdir(drivenr : byte;var dir : shortstring);
begin
drivenr:=0;
dir:=getdir2;
end;
{*****************************************************************************
SystemUnit Initialization
*****************************************************************************}
begin
{ Setup heap }
zero:=0;
myheapsize:=$2000;
myheaprealsize:=$2000;
myheapstart:=0;
heap_handle:=sys_create_area('fpcheap',myheapstart,0,myheaprealsize,0,3);
if heap_handle>0 then begin
InitHeap;
end else system_exit;
{ Setup IO }
StdInputHandle:=0;
StdOutputHandle:=1;
StdErrorHandle:=2;
OpenStdIO(Input,fmInput,StdInputHandle);
OpenStdIO(Output,fmOutput,StdOutputHandle);
OpenStdIO(StdOut,fmOutput,StdOutputHandle);
OpenStdIO(StdErr,fmOutput,StdErrorHandle);
{ Reset IO Error }
InOutRes:=0;
end.
{
$Log$
Revision 1.1 2001-06-02 19:26:03 peter
* BeOS target!
}

265
rtl/beos/sysutils.pp Normal file
View File

@ -0,0 +1,265 @@
{
$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 linux
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
beos,
dos;
{ Include platform independent interface part }
{$i sysutilh.inc}
implementation
{ Include platform independent implementation part }
{$i sysutils.inc}
{****************************************************************************
File Functions
****************************************************************************}
Function FileOpen (Const FileName : string; Mode : Integer) : Longint;
BEGIN
end;
Function FileCreate (Const FileName : String) : Longint;
begin
end;
Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint;
begin
end;
Function FileWrite (Handle : Longint; const Buffer; Count : Longint) : Longint;
begin
end;
Function FileSeek (Handle,FOffset,Origin : Longint) : Longint;
begin
end;
Procedure FileClose (Handle : Longint);
begin
end;
Function FileTruncate (Handle,Size: Longint) : boolean;
begin
end;
Function FileAge (Const FileName : String): Longint;
begin
end;
Function FileExists (Const FileName : String) : Boolean;
begin
end;
Function FindFirst (Const Path : String; Attr : Longint; Var Rslt : TSearchRec) : Longint;
begin
end;
Function FindNext (Var Rslt : TSearchRec) : Longint;
begin
end;
Procedure FindClose (Var F : TSearchrec);
begin
end;
Function FileGetDate (Handle : Longint) : Longint;
begin
end;
Function FileSetDate (Handle,Age : Longint) : Longint;
begin
end;
Function FileGetAttr (Const FileName : String) : Longint;
begin
end;
Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
begin
end;
Function DeleteFile (Const FileName : String) : Boolean;
begin
end;
Function RenameFile (Const OldName, NewName : String) : Boolean;
begin
end;
Function FileSearch (Const Name, DirList : String) : String;
begin
end;
{****************************************************************************
Disk Functions
****************************************************************************}
Function DiskFree(Drive: Byte): int64;
Begin
End;
Function DiskSize(Drive: Byte): int64;
Begin
End;
Function GetCurrentDir : String;
begin
GetDir(0,Result);
end;
Function SetCurrentDir (Const NewDir : String) : Boolean;
begin
{$I-}
ChDir(NewDir);
{$I+}
result := (IOResult = 0);
end;
Function CreateDir (Const NewDir : String) : Boolean;
begin
{$I-}
MkDir(NewDir);
{$I+}
result := (IOResult = 0);
end;
Function RemoveDir (Const Dir : String) : Boolean;
begin
{$I-}
RmDir(Dir);
{$I+}
result := (IOResult = 0);
end;
{****************************************************************************
Misc Functions
****************************************************************************}
procedure Beep;
begin
end;
{****************************************************************************
Locale Functions
****************************************************************************}
Procedure GetLocalTime(var SystemTime: TSystemTime);
begin
end ;
Procedure InitAnsi;
Var
i : longint;
begin
{ Fill table entries 0 to 127 }
for i := 0 to 96 do
UpperCaseTable[i] := chr(i);
for i := 97 to 122 do
UpperCaseTable[i] := chr(i - 32);
for i := 123 to 191 do
UpperCaseTable[i] := chr(i);
Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
for i := 0 to 64 do
LowerCaseTable[i] := chr(i);
for i := 65 to 90 do
LowerCaseTable[i] := chr(i + 32);
for i := 91 to 191 do
LowerCaseTable[i] := chr(i);
Move (CPISO88591LCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
end;
Procedure InitInternational;
begin
InitAnsi;
end;
function SysErrorMessage(ErrorCode: Integer): String;
begin
Str(Errorcode,Result);
Result:='Error '+Result;
end;
{****************************************************************************
OS utility functions
****************************************************************************}
Function GetEnvironmentVariable(Const EnvVar : String) : String;
begin
Result:=StrPas(beos.Getenv(PChar(EnvVar)));
end;
{****************************************************************************
Initialization code
****************************************************************************}
Initialization
InitExceptions; { Initialize exceptions. OS independent }
InitInternational; { Initialize internationalization settings }
Finalization
OutOfMemory.Free;
InValidPointer.Free;
end.
{
$Log$
Revision 1.1 2001-06-02 19:26:03 peter
* BeOS target!
}