diff --git a/install/man/man1/fpc.1 b/install/man/man1/fpc.1 index e6ca18e322..bed1c9eb43 100644 --- a/install/man/man1/fpc.1 +++ b/install/man/man1/fpc.1 @@ -430,9 +430,6 @@ Specifies the target operating system. can be one of the following: .RS .TP -.I GO32V1 -DOS and version 1 of the DJ DELORIE extender (no longer maintained). -.TP .I GO32V2 DOS and version 2 of the DJ DELORIE extender. .TP diff --git a/install/man/man1/ppc386.1 b/install/man/man1/ppc386.1 index d246ed8c75..6ade0250fb 100644 --- a/install/man/man1/ppc386.1 +++ b/install/man/man1/ppc386.1 @@ -436,9 +436,6 @@ Specifies the target operating system. can be one of the following: .RS .TP -.I GO32V1 -DOS and version 1 of the DJ DELORIE extender (no longer maintained). -.TP .I GO32V2 DOS and version 2 of the DJ DELORIE extender. .TP diff --git a/rtl/go32v1/Makefile b/rtl/go32v1/Makefile deleted file mode 100644 index 201fc635d1..0000000000 --- a/rtl/go32v1/Makefile +++ /dev/null @@ -1,1171 +0,0 @@ -# -# Don't edit, this file is generated by FPCMake Version 1.1 [2002/03/19] -# -default: all -MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware -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 -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))) -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 -OS_TARGET=go32v1 -CPU_TARGET=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 -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=../inc -PROCINC=../$(CPU_TARGET) -ifdef RELEASE -override FPCOPT+=-Ur -endif -OBJPASDIR=$(RTL)/objpas -GRAPHDIR=$(INC)/graph -SYSTEMUNIT=system -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings go32 dos crt objects printer sysutils math typinfo cpu mmx getopts heaptrc msmouse -override TARGET_LOADERS+=prt0 -override INSTALL_FPCPACKAGE=y -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -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),sunos) -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_TARGET),sunos) -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),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=.ppa -ASMEXT=.asm -OEXT=.o -SMARTEXT=.sl -STATICLIBEXT=.a -SHAREDLIBEXT=.library -FPCMADE=fpcmade.amg -endif -ifeq ($(OS_TARGET),atari) -PPUEXT=.ppt -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 -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 -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) 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 -SYSTEMPPU=$(addsuffix $(PPUEXT),$(SYSTEMUNIT)) -include $(INC)/makefile.inc -SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES)) -include $(PROCINC)/makefile.cpu -SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES)) -SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS) -prt0$(OEXT) : prt0.as - $(AS) -o prt0$(OEXT) prt0.as -system$(PPUEXT) : system.pp $(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) -go32$(PPUEXT) : go32.pp objpas$(PPUEXT) system$(PPUEXT) -dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc \ - go32$(PPUEXT) strings$(PPUEXT) system$(PPUEXT) -crt$(PPUEXT) : crt.pp $(INC)/textrec.inc go32$(PPUEXT) system$(PPUEXT) -objects$(PPUEXT) : $(INC)/objects.pp objinc.inc system$(PPUEXT) -printer$(PPUEXT) : printer.pp system$(PPUEXT) -sysutils$(PPUEXT) : $(OBJPASDIR)/sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \ - filutil.inc disk.inc objpas$(PPUEXT) dos$(PPUEXT) go32$(PPUEXT) - $(COMPILER) -I$(OBJPASDIR) $(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 -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 -msmouse$(PPUEXT) : msmouse.pp system$(PPUEXT) diff --git a/rtl/go32v1/Makefile.fpc b/rtl/go32v1/Makefile.fpc deleted file mode 100644 index 0b1eb20f2d..0000000000 --- a/rtl/go32v1/Makefile.fpc +++ /dev/null @@ -1,144 +0,0 @@ -# -# Makefile.fpc for Go32v1 RTL -# - -[package] -main=rtl - -[target] -loaders=prt0 -units=$(SYSTEMUNIT) objpas strings \ - go32 \ - dos crt objects printer \ - sysutils math typinfo \ - cpu mmx getopts heaptrc \ - msmouse - -[require] -nortl=y - -[install] -fpcpackage=y - -[default] -fpcdir=../.. -target=go32v1 -cpu=i386 - -[compiler] -includedir=$(INC) $(PROCINC) -sourcedir=$(INC) $(PROCINC) -targetdir=. - - -[prerules] -RTL=.. -INC=../inc -PROCINC=../$(CPU_TARGET) - -# 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 - -# Define Go32v2 Units -SYSTEMUNIT=system - - -[rules] -SYSTEMPPU=$(addsuffix $(PPUEXT),$(SYSTEMUNIT)) - -# 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) : prt0.as - $(AS) -o prt0$(OEXT) prt0.as - -# -# Base Units (System, strings, os-dependent-base-unit) -# - -system$(PPUEXT) : system.pp $(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 -# - -go32$(PPUEXT) : go32.pp objpas$(PPUEXT) system$(PPUEXT) - -# -# TP7 Compatible RTL Units -# - -dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc \ - go32$(PPUEXT) strings$(PPUEXT) system$(PPUEXT) - -crt$(PPUEXT) : crt.pp $(INC)/textrec.inc go32$(PPUEXT) system$(PPUEXT) - -objects$(PPUEXT) : $(INC)/objects.pp objinc.inc system$(PPUEXT) - -printer$(PPUEXT) : printer.pp system$(PPUEXT) - -# -# Delphi Compatible Units -# - -sysutils$(PPUEXT) : $(OBJPASDIR)/sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \ - filutil.inc disk.inc objpas$(PPUEXT) dos$(PPUEXT) go32$(PPUEXT) - $(COMPILER) -I$(OBJPASDIR) $(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 - -# -# 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 - -# -# Other system-dependent RTL Units -# - -msmouse$(PPUEXT) : msmouse.pp system$(PPUEXT) diff --git a/rtl/go32v1/crt.pp b/rtl/go32v1/crt.pp deleted file mode 100644 index 9b21ff42fa..0000000000 --- a/rtl/go32v1/crt.pp +++ /dev/null @@ -1,821 +0,0 @@ -{ - $Id$ - This file is part of the Free Pascal run time library. - Copyright (c) 1999-2000 by the Free Pascal development team. - - Borland Pascal 7 Compatible CRT Unit for Go32V1 and Go32V2 - - 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 crt; -interface - -const -{ CRT modes } - BW40 = 0; { 40x25 B/W on Color Adapter } - CO40 = 1; { 40x25 Color on Color Adapter } - BW80 = 2; { 80x25 B/W on Color Adapter } - CO80 = 3; { 80x25 Color on Color Adapter } - Mono = 7; { 80x25 on Monochrome Adapter } - Font8x8 = 256; { Add-in for ROM font } - -{ Mode constants for 3.0 compatibility } - C40 = CO40; - C80 = CO80; - -{ Foreground and background color constants } - Black = 0; - Blue = 1; - Green = 2; - Cyan = 3; - Red = 4; - Magenta = 5; - Brown = 6; - LightGray = 7; - -{ Foreground color constants } - DarkGray = 8; - LightBlue = 9; - LightGreen = 10; - LightCyan = 11; - LightRed = 12; - LightMagenta = 13; - Yellow = 14; - White = 15; - -{ Add-in for blinking } - Blink = 128; - -var - -{ Interface variables } - CheckBreak: Boolean; { Enable Ctrl-Break } - CheckEOF: Boolean; { Enable Ctrl-Z } - DirectVideo: Boolean; { Enable direct video addressing } - CheckSnow: Boolean; { Enable snow filtering } - LastMode: Word; { Current text mode } - TextAttr: Byte; { Current text attribute } - WindMin: Word; { Window upper left coordinates } - WindMax: Word; { Window lower right coordinates } - -{ Interface procedures } -procedure AssignCrt(var F: Text); -function KeyPressed: Boolean; -function ReadKey: Char; -procedure TextMode(Mode: Integer); -procedure Window(X1,Y1,X2,Y2: Byte); -procedure GotoXY(X,Y: Byte); -function WhereX: Byte; -function WhereY: Byte; -procedure ClrScr; -procedure ClrEol; -procedure InsLine; -procedure DelLine; -procedure TextColor(Color: Byte); -procedure TextBackground(Color: Byte); -procedure LowVideo; -procedure HighVideo; -procedure NormVideo; -procedure Delay(MS: Word); -procedure Sound(Hz: Word); -procedure NoSound; - -{Extra Functions} -procedure cursoron; -procedure cursoroff; -procedure cursorbig; - - -implementation - -uses - go32; - - -{$ASMMODE ATT} - -var - DelayCnt, { don't modify this var name, as it is hard coded } - ScreenWidth, - ScreenHeight : longint; - - -{ - definition of textrec is in textrec.inc -} -{$i textrec.inc} - - -{**************************************************************************** - Low level Routines -****************************************************************************} - -procedure setscreenmode(mode : byte); -begin - asm - movb 8(%ebp),%al - xorb %ah,%ah - pushl %ebp - int $0x10 - popl %ebp - end; -end; - - -function GetScreenHeight : longint; -begin - dosmemget($40,$84,getscreenheight,1); - inc(getscreenheight); -end; - - -function GetScreenWidth : longint; -begin - dosmemget($40,$4a,getscreenwidth,1); -end; - - -procedure SetScreenCursor(x,y : longint); -begin - asm - movb $0x02,%ah - movb $0,%bh - movb y,%dh - movb x,%dl - subw $0x0101,%dx - pushl %ebp - int $0x10 - popl %ebp - end; -end; - - -procedure GetScreenCursor(var x,y : longint); -begin - x:=0; - y:=0; - dosmemget($40,$50,x,1); - dosmemget($40,$51,y,1); - inc(x); - inc(y); -end; - - -{**************************************************************************** - Helper Routines -****************************************************************************} - -Function WinMinX: Byte; -{ - Current Minimum X coordinate -} -Begin - WinMinX:=(WindMin and $ff)+1; -End; - - - -Function WinMinY: Byte; -{ - Current Minimum Y Coordinate -} -Begin - WinMinY:=(WindMin shr 8)+1; -End; - - - -Function WinMaxX: Byte; -{ - Current Maximum X coordinate -} -Begin - WinMaxX:=(WindMax and $ff)+1; -End; - - - -Function WinMaxY: Byte; -{ - Current Maximum Y coordinate; -} -Begin - WinMaxY:=(WindMax shr 8) + 1; -End; - - - -Function FullWin:boolean; -{ - Full Screen 80x25? Window(1,1,80,25) is used, allows faster routines -} -begin - FullWin:=(WinMinX=1) and (WinMinY=1) and - (WinMaxX=ScreenWidth) and (WinMaxY=ScreenHeight); -end; - - -{**************************************************************************** - Public Crt Functions -****************************************************************************} - - -procedure textmode(mode : integer); -begin - lastmode:=mode; - mode:=mode and $ff; - setscreenmode(mode); - screenwidth:=getscreenwidth; - screenheight:=getscreenheight; - windmin:=0; - windmax:=(screenwidth-1) or ((screenheight-1) shl 8); -end; - - -Procedure TextColor(Color: Byte); -{ - Switch foregroundcolor -} -Begin - TextAttr:=(Color and $f) or (TextAttr and $70); - If (Color>15) Then TextAttr:=TextAttr Or Blink; -End; - - - -Procedure TextBackground(Color: Byte); -{ - Switch backgroundcolor -} -Begin - TextAttr:=((Color shl 4) and ($f0 and not Blink)) or (TextAttr and ($0f OR Blink) ); -End; - - - -Procedure HighVideo; -{ - Set highlighted output. -} -Begin - TextColor(TextAttr Or $08); -End; - - - -Procedure LowVideo; -{ - Set normal output -} -Begin - TextColor(TextAttr And $77); -End; - - - -Procedure NormVideo; -{ - Set normal back and foregroundcolors. -} -Begin - TextColor(7); - TextBackGround(0); -End; - - -Procedure GotoXy(X: Byte; Y: Byte); -{ - Go to coordinates X,Y in the current window. -} -Begin - If (X>0) and (X<=WinMaxX- WinMinX+1) and - (Y>0) and (Y<=WinMaxY-WinMinY+1) Then - Begin - Inc(X,WinMinX-1); - Inc(Y,WinMinY-1); - SetScreenCursor(x,y); - End; -End; - - -Procedure Window(X1, Y1, X2, Y2: Byte); -{ - Set screen window to the specified coordinates. -} -Begin - if (X1>X2) or (X2>ScreenWidth) or - (Y1>Y2) or (Y2>ScreenHeight) then - exit; - WindMin:=((Y1-1) Shl 8)+(X1-1); - WindMax:=((Y2-1) Shl 8)+(X2-1); - GoToXY(1,1); -End; - - -Procedure ClrScr; -{ - Clear the current window, and set the cursor on 1,1 -} -var - fil : word; - y : longint; -begin - fil:=32 or (textattr shl 8); - if FullWin then - DosmemFillWord($b800,0,ScreenHeight*ScreenWidth,fil) - else - begin - for y:=WinMinY to WinMaxY do - DosmemFillWord($b800,((y-1)*ScreenWidth+(WinMinX-1))*2,WinMaxX-WinMinX+1,fil); - end; - Gotoxy(1,1); -end; - - -Procedure ClrEol; -{ - Clear from current position to end of line. -} -var - x,y : longint; - fil : word; -Begin - GetScreenCursor(x,y); - fil:=32 or (textattr shl 8); - if x=y) do - begin - dosmemmove($b800,(((WinMinY+my-1)-1)*ScreenWidth+(WinMinX-1))*2, - $b800,(((WinMinY+my)-1)*ScreenWidth+(WinMinX-1))*2,(WinMaxX-WinMinX+1)*2); - dec(my); - end; - dosmemfillword($b800,(((WinMinY+y-1)-1)*ScreenWidth+(WinMinX-1))*2,(WinMaxX-WinMinX+1),fil); -end; - - - - -{**************************************************************************** - Extra Crt Functions -****************************************************************************} - -procedure cursoron; -begin - asm - movb $1,%ah - movb $10,%cl - movb $9,%ch - pushl %ebp - int $0x10 - popl %ebp - end; -end; - - -procedure cursoroff; -begin - asm - movb $1,%ah - movb $-1,%cl - movb $-1,%ch - pushl %ebp - int $0x10 - popl %ebp - end; -end; - - -procedure cursorbig; -begin - asm - movb $1,%ah - movw $110,%cx - pushl %ebp - int $0x10 - popl %ebp - end; -end; - - -{***************************************************************************** - Read and Write routines -*****************************************************************************} - -var - CurrX,CurrY : longint; - -Procedure WriteChar(c:char); -var - chattr : word; -begin - case c of - #10 : inc(CurrY); - #13 : CurrX:=WinMinX; - #8 : begin - if CurrX>WinMinX then - dec(CurrX); - end; - #7 : begin { beep } - end; - else - begin - chattr:=(textattr shl 8) or byte(c); - dosmemput($b800,((CurrY-1)*ScreenWidth+(CurrX-1))*2,chattr,2); - inc(CurrX); - end; - end; - if CurrX>WinMaxX then - begin - CurrX:=WinMinX; - inc(CurrY); - end; - while CurrY>WinMaxY do - begin - removeline(1); - dec(CurrY); - end; -end; - - -Function CrtWrite(var f : textrec):integer; -var - i : longint; -begin - GetScreenCursor(CurrX,CurrY); - for i:=0 to f.bufpos-1 do - WriteChar(f.buffer[i]); - SetScreenCursor(CurrX,CurrY); - f.bufpos:=0; - CrtWrite:=0; -end; - - -Function CrtRead(Var F: TextRec): Integer; - - procedure BackSpace; - begin - if (f.bufpos>0) and (f.bufpos=f.bufend) then - begin - WriteChar(#8); - WriteChar(' '); - WriteChar(#8); - dec(f.bufpos); - dec(f.bufend); - end; - end; - -var - ch : Char; -Begin - GetScreenCursor(CurrX,CurrY); - f.bufpos:=0; - f.bufend:=0; - repeat - if f.bufpos>f.bufend then - f.bufend:=f.bufpos; - SetScreenCursor(CurrX,CurrY); - ch:=readkey; - case ch of - #0 : case readkey of - #71 : while f.bufpos>0 do - begin - dec(f.bufpos); - WriteChar(#8); - end; - #75 : if f.bufpos>0 then - begin - dec(f.bufpos); - WriteChar(#8); - end; - #77 : if f.bufpos0 do - BackSpace; - end; - #13 : begin - WriteChar(#13); - WriteChar(#10); - f.bufptr^[f.bufend]:=#13; - f.bufptr^[f.bufend+1]:=#10; - inc(f.bufend,2); - break; - end; - #26 : if CheckEOF then - begin - f.bufptr^[f.bufend]:=#26; - inc(f.bufend); - break; - end; - else - begin - if f.bufpos $FFFF then - result := Regs.Ax * Regs.Bx * Regs.Cx - else - result := -1; -end; - - -Function DiskSize (Drive : Byte) : Longint; -var - Regs: Registers; -begin - Regs.Dl := Drive; - Regs.Ah := $36; - Intr($21, Regs); - if Regs.Ax <> $FFFF then - result := Regs.Ax * Regs.Cx * Regs.Dx - else - result := -1; -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; - - -{ - $Log$ - Revision 1.2 2000-07-13 11:33:38 michael - + removed logs - -} diff --git a/rtl/go32v1/dos.pp b/rtl/go32v1/dos.pp deleted file mode 100644 index 48e80a5f0f..0000000000 --- a/rtl/go32v1/dos.pp +++ /dev/null @@ -1,713 +0,0 @@ -{ - $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 - Go32; - -Const - {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; - - -Type - comstr = string[127]; { command line string } - pathstr = string[79]; { string for a file path } - dirstr = string[67]; { string for a directory } - namestr = string[8]; { string for a file name } - extstr = string[4]; { string for an extension } - -{ - 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 = packed record - fill : array[1..21] of byte; - attr : byte; - time : longint; - reserved : word; { requires the DOS extender (DJ GNU-C) } - size : longint; - name : string[15]; { the same size as declared by (DJ GNU C) } - end; - - 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; - -Var - DosError : integer; - -{Interrupt} -Procedure Intr(intno: byte; var regs: registers); -Procedure MSDos(var regs: registers); - -{Info/Date/Time} -Function DosVersion: Word; -Procedure GetDate(var year, month, mday, wday: word); -Procedure GetTime(var hour, minute, second, sec100: word); -procedure SetDate(year,month,day: word); -Procedure SetTime(hour,minute,second,sec100: 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} -Function DiskFree(drive: byte) : longint; -Function DiskSize(drive: byte) : longint; -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; var attr: word); -Procedure GetFTime(var f; var 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; -Function GetEnv(envvar: string): string; - -{Misc} -Procedure SetFAttr(var f; attr: word); -Procedure SetFTime(var f; time: longint); -Procedure GetCBreak(var breakvalue: boolean); -Procedure SetCBreak(breakvalue: boolean); -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); - -implementation - -uses - strings; - -{$ASMMODE ATT} - -{****************************************************************************** - --- Dos Interrupt --- -******************************************************************************} - -var - dosregs : registers; - - procedure LoadDosError; - begin - if (dosregs.flags and carryflag) <> 0 then - { conversion from word to integer !! - gave a Bound check error if ax is $FFFF !! PM } - doserror:=integer(dosregs.ax) - else - doserror:=0; - end; - - -{$ASMMODE DIRECT} - procedure intr(intno : byte;var regs : registers); - - begin - asm - .data - int86: - .byte 0xcd - int86_vec: - .byte 0x03 - jmp int86_retjmp - - .text - movl 8(%ebp),%eax - movb %al,int86_vec - - movl 10(%ebp),%eax - // do not use first int - addl $2,%eax - - 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 int86 - int86_retjmp: - pushf - pushl %ebp - pushl %eax - movl %esp,%ebp - // calc EBP new - addl $12,%ebp - movl 10(%ebp),%eax - // do not use first int - addl $2,%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; -{$ASMMODE ATT} - - -procedure msdos(var regs : registers); -begin - intr($21,regs); -end; - - -{****************************************************************************** - --- Info / Date / Time --- -******************************************************************************} - -function dosversion : word; -begin - dosregs.ax:=$3000; - msdos(dosregs); - dosversion:=dosregs.ax; -end; - - -procedure getdate(var year,month,mday,wday : word); -begin - dosregs.ax:=$2a00; - msdos(dosregs); - wday:=dosregs.al; - year:=dosregs.cx; - month:=dosregs.dh; - mday:=dosregs.dl; -end; - - -procedure setdate(year,month,day : word); -begin - dosregs.cx:=year; - dosregs.dh:=month; - dosregs.dl:=day; - dosregs.ah:=$2b; - msdos(dosregs); -end; - - -procedure gettime(var hour,minute,second,sec100 : word); -begin - dosregs.ah:=$2c; - msdos(dosregs); - hour:=dosregs.ch; - minute:=dosregs.cl; - second:=dosregs.dh; - sec100:=dosregs.dl; -end; - - -procedure settime(hour,minute,second,sec100 : word); -begin - dosregs.ch:=hour; - dosregs.cl:=minute; - dosregs.dh:=second; - dosregs.dl:=sec100; - dosregs.ah:=$2d; - msdos(dosregs); - DosError:=0; -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 --- -******************************************************************************} - -var - lastdosexitcode : word; - -procedure exec(const path : pathstr;const comline : comstr); -var - i : longint; - b : array[0..255] of char; -begin - doserror:=0; - for i:=1to length(path) do - if path[i]='/' then - b[i-1]:='\' - else - b[i-1]:=path[i]; - b[i]:=' '; - inc(i); - move(comline[1],b[i],length(comline)); - inc(i,length(comline)); - b[i]:=#0; - asm - leal b,%ebx - movw $0xff07,%ax - int $0x21 - movw %ax,LastDosExitCode - end; -end; - - -function dosexitcode : word; -begin - dosexitcode:=lastdosexitcode; -end; - - -procedure getcbreak(var breakvalue : boolean); -begin - dosregs.ax:=$3300; - msdos(dosregs); - breakvalue:=dosregs.dl<>0; -end; - - -procedure setcbreak(breakvalue : boolean); -begin - dosregs.ax:=$3301; - dosregs.dl:=ord(breakvalue); - msdos(dosregs); -end; - - -procedure getverify(var verify : boolean); -begin - dosregs.ah:=$54; - msdos(dosregs); - verify:=dosregs.al<>0; -end; - - -procedure setverify(verify : boolean); -begin - dosregs.ah:=$2e; - dosregs.al:=ord(verify); - msdos(dosregs); -end; - - -{****************************************************************************** - --- Disk --- -******************************************************************************} - -function diskfree(drive : byte) : longint; -begin - dosregs.dl:=drive; - dosregs.ah:=$36; - msdos(dosregs); - if dosregs.ax<>$FFFF then - diskfree:=dosregs.ax*dosregs.bx*dosregs.cx - else - diskfree:=-1; -end; - - -function disksize(drive : byte) : longint; -begin - dosregs.dl:=drive; - dosregs.ah:=$36; - msdos(dosregs); - if dosregs.ax<>$FFFF then - disksize:=dosregs.ax*dosregs.cx*dosregs.dx - else - disksize:=-1; -end; - - -{****************************************************************************** - --- DosFindfirst DosFindNext --- -******************************************************************************} - -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; - - -procedure Dosfindfirst(path : pchar;attr : word;var f : searchrec); -var - i : longint; -begin - { allow slash as backslash } - for i:=0 to strlen(path) do - if path[i]='/' then path[i]:='\'; - asm - movl f,%edx - movb $0x1a,%ah - int $0x21 - movl path,%edx - movzwl attr,%ecx - movb $0x4e,%ah - int $0x21 - jnc .LFF - movw %ax,DosError - .LFF: - end; - dossearchrec2searchrec(f); -end; - - -procedure Dosfindnext(var f : searchrec); -begin - asm - movl 12(%ebp),%edx - movb $0x1a,%ah - int $0x21 - movb $0x4f,%ah - int $0x21 - jnc .LFN - movw %ax,DosError - .LFN: - end; - dossearchrec2searchrec(f); -end; - - -{****************************************************************************** - --- Findfirst FindNext --- -******************************************************************************} - -procedure findfirst(const path : pathstr;attr : word;var f : searchRec); -var - path0 : array[0..256] of char; -begin - doserror:=0; - strpcopy(path0,path); - Dosfindfirst(path0,attr,f); -end; - - -procedure findnext(var f : searchRec); -begin - doserror:=0; - Dosfindnext(f); -end; - - -Procedure FindClose(Var f: SearchRec); -begin - DosError:=0; -end; - - -procedure swapvectors; -begin - DosError:=0; -end; - - -{****************************************************************************** - --- File --- -******************************************************************************} - -procedure fsplit(path : pathstr;var dir : dirstr;var name : namestr;var ext : extstr); -var - p1,i : longint; -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 } - begin - p1:=pos('.',path); - if p1>0 then - begin - ext:=copy(path,p1,4); - delete(path,p1,length(path)-p1+1); - end - else - ext:=''; - name:=path; - end; -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 *) - -{$I fexpand.inc} - -{$UNDEF FPC_FEXPAND_DRIVES} -{$UNDEF FPC_FEXPAND_UNC} - - -Function FSearch(path: pathstr; dirlist: string): pathstr; -var - i,p1 : longint; - s : searchrec; - newdir : pathstr; -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+'\'; - findfirst(newdir+path,anyfile,s); - if doserror=0 then - newdir:=newdir+path - else - newdir:=''; - until (dirlist='') or (newdir<>''); - fsearch:=newdir; - end; -end; - - -{****************************************************************************** - --- Get/Set File Time,Attr --- -******************************************************************************} - -procedure getftime(var f;var time : longint); -begin - dosregs.bx:=textrec(f).handle; - dosregs.ax:=$5700; - msdos(dosregs); - loaddoserror; - time:=(dosregs.dx shl 16)+dosregs.cx; -end; - - -procedure setftime(var f;time : longint); -begin - dosregs.bx:=textrec(f).handle; - dosregs.cx:=time and $ffff; - dosregs.dx:=time shr 16; - dosregs.ax:=$5701; - msdos(dosregs); - loaddoserror; -end; - - -procedure getfattr(var f;var attr : word); -begin - dosregs.edx:=longint(@filerec(f).name); - dosregs.ax:=$4300; - msdos(dosregs); - LoadDosError; - Attr:=dosregs.cx; -end; - - -procedure setfattr(var f;attr : word); -begin - dosregs.edx:=longint(@filerec(f).name); - dosregs.ax:=$4301; - dosregs.cx:=attr; - msdos(dosregs); - LoadDosError; -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; - - -Function GetEnv(envvar: string): string; -var - hp : ppchar; - hs : string; - eqpos : longint; -begin - envvar:=upcase(envvar); - hp:=envp; - getenv:=''; - while assigned(hp^) do - begin - hs:=strpas(hp^); - eqpos:=pos('=',hs); - if copy(hs,1,eqpos-1)=envvar then - begin - getenv:=copy(hs,eqpos+1,255); - exit; - end; - hp:=hp+4; - end; -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; - - -end. -{ - $Log$ - Revision 1.4 2001-11-23 00:27:22 carl - * updated behavior of some routines to conform to docs - - Revision 1.3 2001/03/10 09:57:51 hajny - * FExpand without IOResult change, remaining direct asm removed - - Revision 1.2 2000/07/13 11:33:38 michael - + removed logs - -} diff --git a/rtl/go32v1/filutil.inc b/rtl/go32v1/filutil.inc deleted file mode 100644 index 0d1befea2b..0000000000 --- a/rtl/go32v1/filutil.inc +++ /dev/null @@ -1,173 +0,0 @@ -{ - $Id$ - This file is part of the Free Pascal run time library. - Copyright (c) 1999-2000 by the Free Pascal development team - - File utility calls - - 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. - - **********************************************************************} - - -Function FileOpen (Const FileName : string; Mode : Integer) : Longint; - -Begin - //!! Needs implementing -end; - - -Function FileCreate (Const FileName : String) : Longint; - -begin - //!! Needs implementing -end; - - -Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint; - -begin - //!! Needs implementing -end; - - -Function FileWrite (Handle : Longint; const Buffer; Count : Longint) : Longint; - -begin - //!! Needs implementing -end; - - -Function FileSeek (Handle,FOffset,Origin : Longint) : Longint; - -begin - //!! Needs implementing -end; - - -Procedure FileClose (Handle : Longint); - -begin - //!! Needs implementing -end; - - -Function FileAge (Const FileName : String): Longint; - -begin - //!! Needs implementing -end; - - -Function FileExists (Const FileName : String) : Boolean; - -begin - //!! Needs implementing -end; - - -Function FindFirst (Const Path : String; Attr : Longint; Var Rslt : TSearchRec) : Longint; - -begin - //!! Needs implementing -end; - - -Function FindNext (Var Rslt : TSearchRec) : Longint; - -begin - //!! Needs implementing -end; - - -Procedure FindClose (Var F : TSearchrec); - -begin - //!! Needs implementing -end; - - -Function FileTruncate (Handle,Size: Longint) : boolean; -begin - //!! Needs implementing -end; - - -Function FileGetDate (Handle : Longint) : Longint; - -begin - //!! Needs implementing -end; - - -Function FileSetDate (Handle,Age : Longint) : Longint; - -begin - //!! Needs implementing -end; - - -Function FileGetAttr (Const FileName : String) : Longint; - -begin - //!! Needs implementing -end; - - -Function FileSetAttr (Const Filename : String; Attr: longint) : Longint; - -begin - //!! Needs implementing -end; - - -Function DeleteFile (Const FileName : String) : Boolean; - -begin - //!! Needs implementing -end; - - -Function RenameFile (Const OldName, NewName : String) : Boolean; - -begin - //!! Needs implementing -end; - - -Function FileSearch (Const Name, DirList : String) : String; - -begin - //!! Needs implementing -end; - - -Procedure GetLocalTime(var SystemTime: TSystemTime); -begin -end ; - - -{ --------------------------------------------------------------------- - Internationalization settings - ---------------------------------------------------------------------} - -procedure InitAnsi; -begin -end; - -Procedure InitInternational; -begin -end; - - -{ - $Log$ - Revision 1.2 2000-07-13 11:33:38 michael - + removed logs - -} diff --git a/rtl/go32v1/go32.pp b/rtl/go32v1/go32.pp deleted file mode 100644 index 003c5d885f..0000000000 --- a/rtl/go32v1/go32.pp +++ /dev/null @@ -1,1217 +0,0 @@ -{ - $Id$ - This file is part of the Free Pascal run time library. - and implements some stuff for protected mode programming - Copyright (c) 1999-2000 by 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 go32; - -{$mode objfpc} -{$S-}{no stack check, used by DPMIEXCP !! } - - interface - - const - { contants for the run modes returned by get_run_mode } - rm_unknown = 0; - rm_raw = 1; { raw (without HIMEM) } - rm_xms = 2; { XMS (for example with HIMEM, without EMM386) } - rm_vcpi = 3; { VCPI (for example HIMEM and EMM386) } - rm_dpmi = 4; { DPMI (for example DOS box or 386Max) } - - { flags } - carryflag = $001; - parityflag = $004; - auxcarryflag = $010; - zeroflag = $040; - signflag = $080; - trapflag = $100; - interruptflag = $200; - directionflag = $400; - overflowflag = $800; - - type - tmeminfo = record - available_memory, - available_pages, - available_lockable_pages, - linear_space, - unlocked_pages, - available_physical_pages, - total_physical_pages, - free_linear_space, - max_pages_in_paging_file, - reserved0, - reserved1, - reserved2 : longint; - end; - - tseginfo = record - offset : pointer; - segment : word; - end; - - trealregs = record - case integer of - 1: { 32-bit } (EDI, ESI, EBP, Res, EBX, EDX, ECX, EAX: longint; - Flags, ES, DS, FS, GS, IP, CS, SP, SS: word); - 2: { 16-bit } (DI, DI2, SI, SI2, BP, BP2, R1, R2: word; - BX, BX2, DX, DX2, CX, CX2, AX, AX2: word); - 3: { 8-bit } (stuff: array[1..4] of longint; - BL, BH, BL2, BH2, DL, DH, DL2, DH2, - CL, CH, CL2, CH2, AL, AH, AL2, AH2: byte); - 4: { Compat } (RealEDI, RealESI, RealEBP, RealRES, - RealEBX, RealEDX, RealECX, RealEAX: longint; - RealFlags, - RealES, RealDS, RealFS, RealGS, - RealIP, RealCS, RealSP, RealSS: word); - end; - - registers = trealregs; - - { this works only with real DPMI } - function allocate_ldt_descriptors(count : word) : word; - function free_ldt_descriptor(d : word) : boolean; - function segment_to_descriptor(seg : word) : word; - function get_next_selector_increment_value : word; - function get_segment_base_address(d : word) : longint; - function set_segment_base_address(d : word;s : longint) : boolean; - function set_segment_limit(d : word;s : longint) : boolean; - function set_descriptor_access_right(d : word;w : word) : longint; - function create_code_segment_alias_descriptor(seg : word) : word; - function get_linear_addr(phys_addr : longint;size : longint) : longint; - function get_segment_limit(d : word) : longint; - function get_descriptor_access_right(d : word) : longint; - function get_page_size:longint; - function map_device_in_memory_block(handle,offset,pagecount,device:longint):boolean; - function realintr(intnr : word;var regs : trealregs) : boolean; - - { is needed for functions which need a real mode buffer } - function global_dos_alloc(bytes : longint) : longint; - function global_dos_free(selector : word) : boolean; - - var - { selector for the DOS memory (only usable if in DPMI mode) } - dosmemselector : word; - { result of dpmi call } - int31error : word; - - { this procedure copies data where the source and destination } - { are specified by 48 bit pointers } - { Note: the procedure checks only for overlapping if } - { source selector=destination selector } - procedure seg_move(sseg : word;source : longint;dseg : word;dest : longint;count : longint); - - { fills a memory area specified by a 48 bit pointer with c } - procedure seg_fillchar(seg : word;ofs : longint;count : longint;c : char); - procedure seg_fillword(seg : word;ofs : longint;count : longint;w : word); - - {************************************} - { this works with all PM interfaces: } - {************************************} - - function get_meminfo(var meminfo : tmeminfo) : boolean; - function get_pm_interrupt(vector : byte;var intaddr : tseginfo) : boolean; - function set_pm_interrupt(vector : byte;const intaddr : tseginfo) : boolean; - function get_rm_interrupt(vector : byte;var intaddr : tseginfo) : boolean; - function set_rm_interrupt(vector : byte;const intaddr : tseginfo) : boolean; - function get_exception_handler(e : byte;var intaddr : tseginfo) : boolean; - function set_exception_handler(e : byte;const intaddr : tseginfo) : boolean; - function get_pm_exception_handler(e : byte;var intaddr : tseginfo) : boolean; - function set_pm_exception_handler(e : byte;const intaddr : tseginfo) : boolean; - function free_rm_callback(var intaddr : tseginfo) : boolean; - function get_rm_callback(pm_func : pointer;const reg : trealregs;var rmcb : tseginfo) : boolean; - function get_cs : word; - function get_ds : word; - function get_ss : word; - - { locking functions } - function allocate_memory_block(size:longint):longint; - function free_memory_block(blockhandle : longint) : boolean; - function request_linear_region(linearaddr, size : longint; - var blockhandle : longint) : boolean; - function lock_linear_region(linearaddr, size : longint) : boolean; - function lock_data(var data;size : longint) : boolean; - function lock_code(functionaddr : pointer;size : longint) : boolean; - function unlock_linear_region(linearaddr, size : longint) : boolean; - function unlock_data(var data;size : longint) : boolean; - function unlock_code(functionaddr : pointer;size : longint) : boolean; - - { disables and enables interrupts } - procedure disable; - procedure enable; - - function inportb(port : word) : byte; - function inportw(port : word) : word; - function inportl(port : word) : longint; - - procedure outportb(port : word;data : byte); - procedure outportw(port : word;data : word); - procedure outportl(port : word;data : longint); - function get_run_mode : word; - - function transfer_buffer : longint; - function tb_segment : longint; - function tb_offset : longint; - function tb_size : longint; - procedure copytodos(var addr; len : longint); - procedure copyfromdos(var addr; len : longint); - - procedure dpmi_dosmemput(seg : word;ofs : word;var data;count : longint); - procedure dpmi_dosmemget(seg : word;ofs : word;var data;count : longint); - procedure dpmi_dosmemmove(sseg,sofs,dseg,dofs : word;count : longint); - procedure dpmi_dosmemfillchar(seg,ofs : word;count : longint;c : char); - procedure dpmi_dosmemfillword(seg,ofs : word;count : longint;w : word); - - -type - tport = class - procedure writeport(p : word;data : byte); - function readport(p : word) : byte; - property pp[w : word] : byte read readport write writeport;default; - end; - - tportw = class - procedure writeport(p : word;data : word); - function readport(p : word) : word; - property pp[w : word] : word read readport write writeport;default; - end; - - tportl = class - procedure writeport(p : word;data : longint); - function readport(p : word) : longint; - property pp[w : word] : longint read readport write writeport;default; - end; -var -{ we don't need to initialize port, because neither member - variables nor virtual methods are accessed } - port, - portb : tport; - portw : tportw; - portl : tportl; - - const - { this procedures are assigned to the procedure which are needed } - { for the current mode to access DOS memory } - { It's strongly recommended to use this procedures! } - dosmemput : procedure(seg : word;ofs : word;var data;count : longint)=dpmi_dosmemput; - dosmemget : procedure(seg : word;ofs : word;var data;count : longint)=dpmi_dosmemget; - dosmemmove : procedure(sseg,sofs,dseg,dofs : word;count : longint)=dpmi_dosmemmove; - dosmemfillchar : procedure(seg,ofs : word;count : longint;c : char)=dpmi_dosmemfillchar; - dosmemfillword : procedure(seg,ofs : word;count : longint;w : word)=dpmi_dosmemfillword; - - implementation - - { the following procedures copy from and to DOS memory without DPMI, - these are not necessary for go32v2, because that requires dpmi (PFV) } - - procedure raw_dosmemput(seg : word;ofs : word;var data;count : longint); - - begin - move(data,pointer($e0000000+seg*16+ofs)^,count); - end; - - procedure raw_dosmemget(seg : word;ofs : word;var data;count : longint); - - begin - move(pointer($e0000000+seg*16+ofs)^,data,count); - end; - - procedure raw_dosmemmove(sseg,sofs,dseg,dofs : word;count : longint); - - begin - move(pointer($e0000000+sseg*16+sofs)^,pointer($e0000000+dseg*16+dofs)^,count); - end; - - procedure raw_dosmemfillchar(seg,ofs : word;count : longint;c : char); - - begin - fillchar(pointer($e0000000+seg*16+ofs)^,count,c); - end; - - procedure raw_dosmemfillword(seg,ofs : word;count : longint;w : word); - - begin - fillword(pointer($e0000000+seg*16+ofs)^,count,w); - end; - - - { the following procedures copy from and to DOS memory using DPMI } - procedure dpmi_dosmemput(seg : word;ofs : word;var data;count : longint); - - begin - seg_move(get_ds,longint(@data),dosmemselector,seg*16+ofs,count); - end; - - procedure dpmi_dosmemget(seg : word;ofs : word;var data;count : longint); - - begin - seg_move(dosmemselector,seg*16+ofs,get_ds,longint(@data),count); - end; - - procedure dpmi_dosmemmove(sseg,sofs,dseg,dofs : word;count : longint); - - begin - seg_move(dosmemselector,sseg*16+sofs,dosmemselector,dseg*16+dofs,count); - end; - - procedure dpmi_dosmemfillchar(seg,ofs : word;count : longint;c : char); - - begin - seg_fillchar(dosmemselector,seg*16+ofs,count,c); - end; - - procedure dpmi_dosmemfillword(seg,ofs : word;count : longint;w : word); - - begin - seg_fillword(dosmemselector,seg*16+ofs,count,w); - end; - - function global_dos_alloc(bytes : longint) : longint; - - begin - asm - movl bytes,%ebx - orl $0x10,%ebx // round up - shrl $0x4,%ebx // convert to Paragraphs - movl $0x100,%eax // function 0x100 - int $0x31 - shll $0x10,%eax // return Segment in hi(Result) - movw %dx,%ax // return Selector in lo(Result) - movl %eax,__result - end; - end; - - function global_dos_free(selector : word) : boolean; - - begin - asm - movw Selector,%dx - movl $0x101,%eax - int $0x31 - setnc %al - movb %al,__RESULT - end; - end; - - function realintr(intnr : word;var regs : trealregs) : boolean; - - begin - regs.realsp:=0; - regs.realss:=0; - asm - movw intnr,%bx - xorl %ecx,%ecx - movl regs,%edi - { es is always equal ds } - movl $0x300,%eax - int $0x31 - setnc %al - movb %al,__RESULT - end; - end; - - procedure seg_fillchar(seg : word;ofs : longint;count : longint;c : char); - - begin - asm - movl ofs,%edi - movl count,%ecx - movb c,%dl - { load es with selector } - pushw %es - movw seg,%ax - movw %ax,%es - { fill eax with duplicated c } - { so we can use stosl } - movb %dl,%dh - movw %dx,%ax - shll $16,%eax - movw %dx,%ax - movl %ecx,%edx - shrl $2,%ecx - cld - rep - stosl - movl %edx,%ecx - andl $3,%ecx - rep - stosb - popw %es - end ['EAX','ECX','EDX','EDI']; - end; - - procedure seg_fillword(seg : word;ofs : longint;count : longint;w : word); - - begin - asm - movl ofs,%edi - movl count,%ecx - movw w,%dx - { load segment } - pushw %es - movw seg,%ax - movw %ax,%es - { fill eax } - movw %dx,%ax - shll $16,%eax - movw %dx,%ax - movl %ecx,%edx - shrl $1,%ecx - cld - rep - stosl - movl %edx,%ecx - andl $1,%ecx - rep - stosw - popw %es - end ['EAX','ECX','EDX','EDI']; - end; - - procedure seg_move(sseg : word;source : longint;dseg : word;dest : longint;count : longint); - - begin - if count=0 then - exit; - if (sseg<>dseg) or ((sseg=dseg) and (source>dest)) then - asm - pushw %es - pushw %ds - cld - movl count,%ecx - movl source,%esi - movl dest,%edi - movw dseg,%ax - movw %ax,%es - movw sseg,%ax - movw %ax,%ds - movl %ecx,%eax - shrl $2,%ecx - rep - movsl - movl %eax,%ecx - andl $3,%ecx - rep - movsb - popw %ds - popw %es - end ['ESI','EDI','ECX','EAX'] - else if (sourcelinearaddr then - request_linear_region:=false; - end; - - function allocate_memory_block(size:longint):longint; - begin - asm - movl $0x501,%eax - movl size,%ecx - movl %ecx,%ebx - shrl $16,%ebx - andl $65535,%ecx - int $0x31 - jnc .Lallocate_mem_block_err - xorl %ebx,%ebx - xorl %ecx,%ecx - .Lallocate_mem_block_err: - shll $16,%ebx - movw %cx,%bx - shll $16,%esi - movw %di,%si - movl %ebx,__RESULT - end; - end; - - function free_memory_block(blockhandle : longint) : boolean; - begin - asm - movl blockhandle,%esi - movl %esi,%edi - shll $16,%esi - movl $0x502,%eax - int $0x31 - pushf - call test_int31 - movb %al,__RESULT - end; - end; - - function lock_linear_region(linearaddr, size : longint) : boolean; - - begin - asm - movl $0x600,%eax - movl linearaddr,%ecx - movl %ecx,%ebx - shrl $16,%ebx - movl size,%esi - movl %esi,%edi - shrl $16,%esi - int $0x31 - pushf - call test_int31 - movb %al,__RESULT - end; - end; - - function lock_data(var data;size : longint) : boolean; - - var - linearaddr : longint; - - begin - if get_run_mode <> 4 then - exit; - linearaddr:=longint(@data)+get_segment_base_address(get_ds); - lock_data:=lock_linear_region(linearaddr,size); - end; - - function lock_code(functionaddr : pointer;size : longint) : boolean; - - var - linearaddr : longint; - - begin - if get_run_mode<>rm_dpmi then - exit; - linearaddr:=longint(functionaddr)+get_segment_base_address(get_cs); - lock_code:=lock_linear_region(linearaddr,size); - end; - - function unlock_linear_region(linearaddr,size : longint) : boolean; - - begin - asm - movl $0x601,%eax - movl linearaddr,%ecx - movl %ecx,%ebx - shrl $16,%ebx - movl size,%esi - movl %esi,%edi - shrl $16,%esi - int $0x31 - pushf - call test_int31 - movb %al,__RESULT - end; - end; - - function unlock_data(var data;size : longint) : boolean; - - var - linearaddr : longint; - begin - if get_run_mode<>rm_dpmi then - exit; - linearaddr:=longint(@data)+get_segment_base_address(get_ds); - unlock_data:=unlock_linear_region(linearaddr,size); - end; - - function unlock_code(functionaddr : pointer;size : longint) : boolean; - - var - linearaddr : longint; - begin - if get_run_mode <>rm_dpmi then - exit; - linearaddr:=longint(functionaddr)+get_segment_base_address(get_cs); - unlock_code:=unlock_linear_region(linearaddr,size); - end; - - function set_segment_base_address(d : word;s : longint) : boolean; - - begin - asm - movw d,%bx - leal s,%eax - movw (%eax),%dx - movw 2(%eax),%cx - movl $7,%eax - int $0x31 - pushf - call test_int31 - movb %al,__RESULT - end; - end; - - function set_descriptor_access_right(d : word;w : word) : longint; - - begin - asm - movw d,%bx - movw w,%cx - movl $9,%eax - int $0x31 - pushf - call test_int31 - movw %ax,__RESULT - end; - end; - - function set_segment_limit(d : word;s : longint) : boolean; - - begin - asm - movw d,%bx - leal s,%eax - movw (%eax),%dx - movw 2(%eax),%cx - movl $8,%eax - int $0x31 - pushf - call test_int31 - movb %al,__RESULT - end; - end; - - function get_descriptor_access_right(d : word) : longint; - - begin - asm - movzwl d,%eax - lar %eax,%eax - jz .L_ok - xorl %eax,%eax - .L_ok: - movl %eax,__RESULT - end; - end; - function get_segment_limit(d : word) : longint; - - begin - asm - movzwl d,%eax - lsl %eax,%eax - jz .L_ok2 - xorl %eax,%eax - .L_ok2: - movl %eax,__RESULT - end; - end; - - function create_code_segment_alias_descriptor(seg : word) : word; - - begin - asm - movw seg,%bx - movl $0xa,%eax - int $0x31 - pushf - call test_int31 - movw %ax,__RESULT - end; - end; - - function get_meminfo(var meminfo : tmeminfo) : boolean; - - begin - asm - movl meminfo,%edi - movl $0x500,%eax - int $0x31 - pushf - movb %al,__RESULT - call test_int31 - end; - end; - - function get_linear_addr(phys_addr : longint;size : longint) : longint; - - begin - asm - movl phys_addr,%ebx - movl %ebx,%ecx - shrl $16,%ebx - movl size,%esi - movl %esi,%edi - shrl $16,%esi - movl $0x800,%eax - int $0x31 - pushf - call test_int31 - shll $16,%ebx - movw %cx,%bx - movl %ebx,__RESULT - end; - end; - - procedure disable;assembler; - - asm - cli - end; - - procedure enable;assembler; - - asm - sti - end; - - var - _run_mode : word;external name '_run_mode'; - - function get_run_mode : word; - - begin - asm - movw _run_mode,%ax - movw %ax,__RESULT - end ['EAX']; - end; - - function map_device_in_memory_block(handle,offset,pagecount,device:longint):boolean; - begin - asm - movl device,%edx - movl handle,%esi - xorl %ebx,%ebx - movl pagecount,%ecx - movl $0x0508,%eax - int $0x31 - pushf - setnc %al - movb %al,__RESULT - call test_int31 - end; - end; - - var - _core_selector : word;external name '_core_selector'; - - function get_core_selector : word; - - begin - asm - movw _core_selector,%ax - movw %ax,__RESULT - end; - end; - - -{***************************************************************************** - Transfer Buffer -*****************************************************************************} - - function transfer_buffer : longint; - begin - transfer_buffer := go32_info_block.linear_address_of_transfer_buffer; - end; - - - function tb_segment : longint; - begin - { all real mode memory is mapped to $E000000 location !! } - tb_segment:=(go32_info_block.linear_address_of_transfer_buffer shr 4) and $FFFF; - end; - - - function tb_offset : longint; - begin - tb_offset:=go32_info_block.linear_address_of_transfer_buffer and $f; - end; - - - function tb_size : longint; - begin - tb_size := go32_info_block.size_of_transfer_buffer; - end; - - - procedure copytodos(var addr; len : longint); - begin - if len>tb_size then - runerror(217); - move(addr,pointer(transfer_buffer)^,len); - end; - - - procedure copyfromdos(var addr; len : longint); - begin - if len>tb_size then - runerror(217); - move(pointer(transfer_buffer)^,addr,len); - end; - - - -begin - int31error:=0; - if not (get_run_mode=rm_dpmi) then - begin - dosmemget:=@raw_dosmemget; - dosmemput:=@raw_dosmemput; - dosmemmove:=@raw_dosmemmove; - dosmemfillchar:=@raw_dosmemfillchar; - dosmemfillword:=@raw_dosmemfillword; - end - else - begin - dosmemselector:=get_core_selector; - end; -end. - -{ - $Log$ - Revision 1.2 2000-07-13 11:33:38 michael - + removed logs - -} diff --git a/rtl/go32v1/msmouse.pp b/rtl/go32v1/msmouse.pp deleted file mode 100644 index 1bdd8767b9..0000000000 --- a/rtl/go32v1/msmouse.pp +++ /dev/null @@ -1,396 +0,0 @@ -{ - $Id$ - This file is part of the Free Pascal run time library. - Copyright (c) 1999-2000 by 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 MSMouse; -Interface - -{ - Mouse support functions and procedures, with error checking: if mouse - isn't present then the routine ends. If you want to remove error checking, - remove the next define. -} - -{$DEFINE MOUSECHECK} - -{initializes the mouse with the default values for the current screen mode} - Function InitMouse:Boolean; - -{shows mouse pointer,text+graphics screen support} - Procedure ShowMouse; - -{hides mouse pointer} - Procedure HideMouse; - -{reads mouse position in pixels (divide by 8 to get text position in standard - text mode) and reads the buttons state: - bit 1 set -> left button pressed - bit 2 set -> right button pressed - bit 3 set -> middle button pressed - Have a look at the example program in the manual to see how you can use this} - Procedure GetMouseState(var x,y, buttons :Longint); - -{returns true if the left button is pressed} - Function LPressed:Boolean; - -{returns true if the right button is pressed} - Function RPressed:Boolean; - -{returns true if the middle button is pressed} - Function MPressed:Boolean; - -{positions the mouse pointer} - Procedure SetMousePos(x,y:Longint); - -{returns at which position "button" was last pressed in x,y and returns the - number of times this button has been pressed since the last time this - function was called with "button" as parameter. For button you can use the - LButton, RButton and MButton constants for resp. the left, right and middle - button} - Function GetLastButtonPress(button:Longint;var x,y:Longint): Longint; - -{returns at which position "button" was last released in x,y and returns the - number of times this button has been re since the last time. For button - you can use the LButton, RButton and MButton constants for resp. the left, - right and middle button} -Function GetLastButtonRelease (button : Longint; var x,y:Longint): Longint; - -{sets mouse's x range, with Min and Max resp. the higest and the lowest - column (in pixels) in between which the mouse cursor can move} - Procedure SetMouseXRange (Min,Max:Longint); - -{sets mouse's y range, with Min and Max resp. the higest and the lowest - row (in pixels) in between which the mouse cursor can move} - Procedure SetMouseYRange (Min,Max:Longint); - -{set the window coordinates in which the mouse cursor can move} - Procedure SetMouseWindow(x1,y1,x2,y2:Longint); - -{sets the mouse shape in text mode: background and foreground color and the - Ascii value with which the character on screen is XOR'ed when the cursor - moves over it. Set to 0 for a "transparent" cursor} - Procedure SetMouseShape(ForeColor,BackColor,Ascii:Byte); - -{sets the mouse ascii in text mode. The difference between this one and - SetMouseShape, is that the foreground and background colors stay the same - and that the Ascii code you enter is the character that you will get on - screen; there's no XOR'ing} - Procedure SetMouseAscii(Ascii:Byte); - -{set mouse speed in mickey's/pixel; default: horizontal: 8; vertical: 16} - Procedure SetMouseSpeed(Horizontal ,Vertical:Longint); - -{set a rectangle on screen that mouse will disappear if it is moved into} - Procedure SetMouseHideWindow(x1,y1,x2,y2:Longint); - -Const LButton = 1; {left button} - RButton = 2; {right button} - MButton = 4; {middle button} - -Var - MouseFound: Boolean; - -Implementation - -{$asmmode ATT} - -Function InitMouse: Boolean; -begin - asm - xorl %eax,%eax - pushl %ebp - int $0x33 - popl %ebp - cmpw $0xffff,%ax - setz %al - movb %al,__RESULT - end; -end; - - -Procedure ShowMouse; -begin -{$IFDEF MOUSECHECK} - If (Not MouseFound) Then Exit; -{$ENDIF} - asm - movl $1,%eax - pushl %ebp - int $0x33 - popl %ebp - end; -end; - -Procedure HideMouse; -begin -{$IFDEF MOUSECHECK} - If (Not MouseFound) Then Exit; -{$ENDIF} - asm - movl $2,%eax - pushl %ebp - int $0x33 - popl %ebp - end; -end; - -Procedure GetMouseState(var x,y,buttons:Longint); -begin -{$IFDEF MOUSECHECK} - If (Not MouseFound) Then Exit; -{$ENDIF} - asm - movl $3,%eax - pushl %ebp - int $0x33 - popl %ebp - andl $0xffff,%ecx - andl $0xffff,%edx - movl x,%eax - movl %ecx,(%eax) - movl y,%eax - movl %edx,(%eax) - movl buttons,%eax - movw %bx,(%eax) - end; -end; - -Function LPressed:Boolean; -Begin -{$IFDEF MOUSECHECK} - If (Not MouseFound) Then Exit; -{$ENDIF} - asm - movl $3,%eax - pushl %ebp - int $0x33 - popl %ebp - movl %ebx,%eax - andl $1,%eax - movb %al,__RESULT - end; -end; - -Function RPressed:Boolean; -Begin -{$IFDEF MOUSECHECK} - If (Not MouseFound) Then Exit; -{$ENDIF} - asm - movl $3,%eax - pushl %ebp - int $0x33 - popl %ebp - movl %ebx,%eax - shrl $1,%eax - andl $1,%eax - movb %al,__RESULT - end; -end; - -Function MPressed:Boolean; -Begin -{$IFDEF MOUSECHECK} - If (Not MouseFound) Then Exit; -{$ENDIF} - asm - movl $3,%eax - pushl %ebp - int $0x33 - popl %ebp - movl %ebx,%eax - shrl $2,%eax - andl $1,%eax - movb %al,__RESULT - end; -end; - -Procedure SetMousePos(x,y:Longint); -Begin -{$IFDEF MOUSECHECK} - If (Not MouseFound) Then Exit; -{$ENDIF} - asm - movl $4,%eax - movl x,%ecx - movl y,%edx - pushl %ebp - int $0x33 - popl %ebp - End; -End; - -Function GetLastButtonPress(Button: Longint;var x,y:Longint):Longint; -Begin -{$IFDEF MOUSECHECK} - If (Not MouseFound) Then Exit; -{$ENDIF} - asm - movl $5,%eax - movl button,%ebx - shrl $1, %ebx {0 = left, 1 = right, 2 = middle} - pushl %ebp - int $0x33 - popl %ebp - andl $0xffff,%ebx - andl $0xffff,%edx - andl $0xffff,%ecx - movl %ebx, __RESULT - movl x,%eax - movl %ecx,(%eax) - movl y,%eax - movl %edx,(%eax) - end; -end; - -Function GetLastButtonRelease (button : Longint; var x,y:Longint): Longint; -begin -{$IFDEF MOUSECHECK} - If (Not MouseFound) Then Exit; -{$ENDIF} - asm - movl $6,%eax - movl button,%ebx - shrl $1, %ebx {0 = left, 1 = right, 2 = middle} - pushl %ebp - int $0x33 - popl %ebp - andl $0xffff,%ebx - andl $0xffff,%ecx - andl $0xffff,%edx - movl %ebx,__RESULT - movl x,%eax - movl %ecx,(%eax) - movl y,%eax - movl %edx,(%eax) - end; -end; - -Procedure SetMouseXRange (Min,Max:Longint); -begin -{$IFDEF MOUSECHECK} - If (Not MouseFound) Then Exit; -{$ENDIF} - asm - movl $7,%eax - movl min,%ecx - movl max,%edx - pushl %ebp - int $0x33 - popl %ebp - end; -end; - -Procedure SetMouseYRange (min,max:Longint); -begin -{$IFDEF MOUSECHECK} - If (Not MouseFound) Then Exit; -{$ENDIF} - asm - movl $8,%eax - movl min,%ecx - movl max,%edx - pushl %ebp - int $0x33 - popl %ebp - end; -end; - -Procedure SetMouseWindow(x1,y1,x2,y2:Longint); -Begin -{$IFDEF MOUSECHECK} - If (Not MouseFound) Then Exit; -{$ENDIF} - SetMouseXRange(x1,x2); - SetMouseYRange(y1,y2); -End; - -Procedure SetMouseShape(ForeColor,BackColor,Ascii:Byte); -Begin -{$IFDEF MOUSECHECK} - If (Not MouseFound) Then Exit; -{$ENDIF} - asm - xorl %ebx,%ebx - movl $0xa,%eax - movl $0xffff,%ecx - xorl %edx,%edx - movb BackColor,%dh - shlb $4,%dh - addb ForeColor,%dh - movb Ascii,%dl - pushl %ebp - int $0x33 - popl %ebp - End; -End; - -Procedure SetMouseAscii(Ascii:byte); -Begin -{$IFDEF MOUSECHECK} - If (Not MouseFound) Then Exit; -{$ENDIF} - asm - xorl %ebx,%ebx - movl $0xa,%eax - movl $0xff00,%ecx - xorl %edx,%edx - movb Ascii,%dl - pushl %ebp - int $0x33 - popl %ebp - End; -End; - -Procedure SetMouseHideWindow(x1,y1,x2,y2:Longint); -Begin -{$IFDEF MOUSECHECK} - If (Not MouseFound) Then Exit; -{$ENDIF} - asm - movl $0x0010,%eax - movl x1,%ecx - movl y1,%edx - movl x2,%esi - movl y2,%edi - pushl %ebp - int $0x33 - popl %ebp - end; -End; - -Procedure SetMouseSpeed(Horizontal,Vertical:Longint); -Begin -{$IFDEF MOUSECHECK} - If (Not MouseFound) Then Exit; -{$ENDIF} - asm - movl $0x0f,%eax - movl Horizontal,%ecx - movl Vertical,%edx - pushl %ebp - int $0x33 - popl %ebp - end; -End; - -Begin - MouseFound := InitMouse; -End. - -{ - $Log$ - Revision 1.2 2000-07-13 11:33:38 michael - + removed logs - -} diff --git a/rtl/go32v1/objinc.inc b/rtl/go32v1/objinc.inc deleted file mode 100644 index b077f9860f..0000000000 --- a/rtl/go32v1/objinc.inc +++ /dev/null @@ -1,179 +0,0 @@ -{ - $Id$ - This file is part of the Free Pascal run time library. - Copyright (c) 1999-2000 by the Free Pascal development team. - - Includefile for objects.pp implementing OS-dependent file routines - for Go32V1 - - 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. - - ********************************************************************** -} - -{---------------------------------------------------------------------------} -{ FileClose -> Platforms DOS - Not checked } -{---------------------------------------------------------------------------} -FUNCTION FileClose(Handle: THandle): word; -begin - asm - xor %bx,%bx - movw handle,%bx - movb $0x3e,%ah - pushl %ebp - int $0x21 - popl %ebp - end; - FileClose := 0; -end; - -{---------------------------------------------------------------------------} -{ FileOpen -> Platforms DOS - Checked 05May1998 CEC } -{ Returns 0 on failure } -{---------------------------------------------------------------------------} - -FUNCTION FileOpen (Var FileName: AsciiZ; Mode: Word): THandle; -var - AMode: word; -begin - if Mode=stCreate then - Begin - AMode:=$8302; - end - else - Begin - Case (Mode and 3) of - 0 : AMode:=$8001; - 1 : AMode:=$8404; - 2 : AMode:=$8404; - end; - end; - asm - xorl %eax, %eax - movw %ax, DosStreamError - movl FileName, %ebx - movw $0xff02, %ax - movw AMode, %cx - pushl %ebp - int $0x21 - popl %ebp - jnc .Lexit1 - movw %ax, DosStreamError { Hold Error } - xorl %eax, %eax { Open Failed } - .Lexit1: - movw %ax, __RESULT - END; -end; - - -{***************************************************************************} -{ DosSetFilePtr -> Platforms DOS - Checked 05May1998 CEC } -{***************************************************************************} -FUNCTION SetFilePos (Handle: THandle; Pos: LongInt; MoveType: Word; -Var Actual: LongInt): Word; -Var - val : longint; -BEGIN - asm - movw MoveType, %ax; { Load move type } - movb $0x42, %ah; - movl pos, %edx; { Load file position } - andl $0xffff,%edx { Only keep low word } - movl pos, %ecx - shrl $16,%ecx; - movw Handle, %bx; { Load file handle } - pushl %ebp; - int $0x21; { Position the file } - popl %ebp; - jc .Lexit4 - shll $16,%edx - movzwl %ax,%eax - orl %edx,%eax - movl %eax,val { Update new position } - xorl %eax, %eax; - .Lexit4: - movw %ax, DosStreamError { DOS error returned } - .Lend: - END; - Actual := val; - SetFilePos := DosStreamError; { Return any error } -END; - - -{---------------------------------------------------------------------------} -{ FileRead -> Platforms DOS - Checked 05May1998 CEC } -{---------------------------------------------------------------------------} -FUNCTION FileRead (Handle: THandle; Var Buf; Count: Sw_Word; -Var Actual: Sw_Word): Word; -BEGIN - asm - movl count,%ecx - movl buf,%edx - xorl %ebx,%ebx - movw handle,%bx - movb $0x3f,%ah - int $0x21 - jnc .LDOSREAD1 - movw %ax,DosStreamError - xorl %eax,%eax - .LDOSREAD1: - end; - Actual:=Count; - FileRead:=DosStreamError; -end; - - -{---------------------------------------------------------------------------} -{ FileWrite -> Platforms DOS - Checked 05May1998 CEC } -{---------------------------------------------------------------------------} -FUNCTION FileWrite (Handle: THandle; Var Buf; Count: Sw_Word; Var Actual: Sw_Word): Word; -BEGIN - Actual:=0; - asm - movl Count,%ecx - movl buf,%edx - xorl %ebx,%ebx - movw Handle,%bx - movb $0x40,%ah - pushl %ebp - int $0x21 - pop %ebp - jnc .LDOSWRITE1 - movw %ax,DosStreamError - .LDOSWRITE1: - end; - Actual:=Count; - FileWrite:=DosStreamError; -end; - - -{---------------------------------------------------------------------------} -{ SetFileSize -> Platforms DOS - Not Checked } -{---------------------------------------------------------------------------} -FUNCTION SetFileSize (Handle: THandle; FileSize: LongInt): Word; -VAR Actual, Buf: LongInt; -BEGIN - SetFilePos(Handle,FileSize,0,Actual); - If (Actual = FileSize) Then - Begin - Actual := FileWrite(Handle, Pointer(@Buf), 0,Actual); { Truncate the file } - If (Actual <> -1) Then - SetFileSize := 0 - Else - SetFileSize := 103; { File truncate error } - End - Else - SetFileSize := 103; { File truncate error } -END; - -{ - $Log$ - Revision 1.2 2000-07-13 11:33:38 michael - + removed logs - -} diff --git a/rtl/go32v1/printer.pp b/rtl/go32v1/printer.pp deleted file mode 100644 index bf11192eec..0000000000 --- a/rtl/go32v1/printer.pp +++ /dev/null @@ -1,46 +0,0 @@ -{ - $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 - - Printer 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 printer; -interface - -var - lst : text; - -implementation - -var - old_exit : pointer; - -procedure printer_exit; -begin - close(lst); - exitproc:=old_exit; -end; - - -begin - assign(lst,'PRN'); - rewrite(lst); - old_exit:=exitproc; - exitproc:=@printer_exit; -end. -{ - $Log$ - Revision 1.2 2000-07-13 11:33:38 michael - + removed logs - -} diff --git a/rtl/go32v1/prt0.as b/rtl/go32v1/prt0.as deleted file mode 100644 index 1365306109..0000000000 --- a/rtl/go32v1/prt0.as +++ /dev/null @@ -1,200 +0,0 @@ -# -# $Id$ -# This file is part of the Free Pascal run time library. -# Copyright (c) 1999-2000 by the Free Pascal development team. -# -# Go32V1 Startup code -# -# 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. -# -# ********************************************************************** -# -# Called as start(argc, argv, envp) -# -# gs:edx points to prog_info structure. All other registers are OBSOLETE -# but included for backwards compatibility -# -.text - .globl _start -_start: - .globl start -start: -# the first instruction must be movl %eax, -# because that is the way GO32V2 makes the difference between V1 and V2 coff format - movl %eax,__hard_master - movl %esi,___pid - movl %edi,___transfer_buffer - movl %ebx,_ScreenPrimary - movl %ebp,_ScreenSecondary - cmpl $0, %edx - je Lcopy_none - movw %gs,%cx - movw %ds,%ax - cmpw %cx,%ax - je Lcopy_none -# set the right size - movl $40,U_SYSTEM_GO32_INFO_BLOCK - - movl %gs:(%edx), %ecx - cmpl U_SYSTEM_GO32_INFO_BLOCK, %ecx - jbe Lcopy_less - movl U_SYSTEM_GO32_INFO_BLOCK, %ecx -Lcopy_less: - movl $U_SYSTEM_GO32_INFO_BLOCK, %edi - addl $3, %ecx - andl $0xfffffffc, %ecx - movl %ecx, (%edi) - addl $4, %edi - addl $4, %edx - subl $4, %ecx -Lcopy_more: - movl %gs:(%edx), %eax - movl %eax, (%edi) - addl $4, %edx - addl $4, %edi - subl $4, %ecx - jnz Lcopy_more - - movl U_SYSTEM_GO32_INFO_BLOCK+4, %eax - movl %eax, _ScreenPrimary - movl U_SYSTEM_GO32_INFO_BLOCK+8, %eax - movl %eax, _ScreenSecondary - movl U_SYSTEM_GO32_INFO_BLOCK+12, %eax - movl %eax, ___transfer_buffer - movl U_SYSTEM_GO32_INFO_BLOCK+20, %eax - movl %eax, ___pid - movl U_SYSTEM_GO32_INFO_BLOCK+24, %eax - movl %eax, __hard_master - - jmp Lcopy_done - -Lcopy_none: - movl %ebx,U_SYSTEM_GO32_INFO_BLOCK+4 - movl %ebp,U_SYSTEM_GO32_INFO_BLOCK+8 - movl %edi,U_SYSTEM_GO32_INFO_BLOCK+12 - movl $4096,U_SYSTEM_GO32_INFO_BLOCK+16 - movl %esi,U_SYSTEM_GO32_INFO_BLOCK+20 - movl %eax,U_SYSTEM_GO32_INFO_BLOCK+24 - movl $28, U_SYSTEM_GO32_INFO_BLOCK -Lcopy_done: - - movw U_SYSTEM_GO32_INFO_BLOCK+36,%ax - movw %ax,_run_mode -# I need a value for the stack bottom, -# According to Pierre, from the source code of go32v1 -# the stack is 256Kb in length - movl %esp,%eax - subl $0x40000,%eax - movl %eax,__stkbottom - - movw U_SYSTEM_GO32_INFO_BLOCK+26,%ax - movw %ax,_core_selector - movl U_SYSTEM_GO32_INFO_BLOCK+28,%eax - movl %eax,U_SYSTEM_STUB_INFO - xorl %esi,%esi - xorl %edi,%edi - xorl %ebp,%ebp - xorl %ebx,%ebx - - movl %esp,%ebx - movl $0x0,%ebp - movl %esp,%ebx - movl 8(%ebx),%eax - movl %eax,_environ - movl %eax,U_SYSTEM_ENVP - movl 4(%ebx),%eax - movl %eax,_args - movl %eax,U_SYSTEM_ARGV - movl (%ebx),%eax - movl %eax,_argc - movl %eax,U_SYSTEM_ARGC - - call PASCALMAIN - -exit_again: - movl $0x4c00,%eax - int $0x21 - jmp exit_again - - ret - -.data - .globl _argc -_argc: - .long 0 - - .globl _args -_args: - .long 0 - - .globl _environ -_environ: - .long 0 - - .globl __stkbottom -__stkbottom: - .long 0 - - .globl _run_mode -_run_mode: - .word 0 - - .globl _core_selector -_core_selector: - .word 0 - - .globl ___pid -___pid: - .long 42 - - .globl ___transfer_buffer -___transfer_buffer: - .long 0 - - .globl _ScreenPrimary -_ScreenPrimary: - .long 0 - - .globl _ScreenSecondary -_ScreenSecondary: - .long 0 - - .globl __hard_master -__hard_master: - .byte 0 - - .globl __hard_slave -__hard_slave: - .byte 0 - - .globl __core_select -__core_select: - .short 0 -# -# $Log$ -# Revision 1.1 2000-07-13 06:30:34 michael -# + Initial import -# -# Revision 1.3 2000/01/07 16:41:30 daniel -# * copyright 2000 -# -# Revision 1.2 2000/01/07 16:32:23 daniel -# * copyright 2000 added -# -# Revision 1.1 1998/12/21 13:07:02 peter -# * use -FE -# -# Revision 1.4 1998/08/04 13:35:34 carl -# * stack size default is 256Kb! not 16K! as information stated by Pierre -# -# Revision 1.3 1998/05/22 00:39:32 peter -# * go32v1, go32v2 recompiles with the new objects -# * remake3 works again with go32v2 -# - removed some "optimizes" from daniel which were wrong -# -# diff --git a/rtl/go32v1/system.pp b/rtl/go32v1/system.pp deleted file mode 100644 index 2bc42eb566..0000000000 --- a/rtl/go32v1/system.pp +++ /dev/null @@ -1,662 +0,0 @@ -{ - $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. - - 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 system; -interface - -{ include system-independent routine headers } - -{$I systemh.inc} - -{ include heap support headers } - -{$I heaph.inc} - -{Platform specific information} -const - LineEnding = #13#10; -{ LFNSupport is a variable here, defined below!!! } - DirectorySeparator = '\'; - DriveSeparator = ':'; - PathSeparator = ';'; - FileNameCaseSensitive = false; - -const -{ Default filehandles } - UnusedHandle = $ffff; - StdInputHandle = 0; - StdOutputHandle = 1; - StdErrorHandle = 2; - -{ Default memory segments (Tp7 compatibility) } - seg0040 = $0040; - segA000 = $A000; - segB000 = $B000; - segB800 = $B800; - -var -{ C-compatible arguments and environment } - argc : longint; - argv : ppchar; - envp : ppchar; - -type -{ Dos Extender info } - p_stub_info = ^t_stub_info; - t_stub_info = packed record - magic : array[0..15] of char; - size : longint; - minstack : longint; - memory_handle : longint; - initial_size : longint; - minkeep : word; - ds_selector : word; - ds_segment : word; - psp_selector : word; - cs_selector : word; - env_size : word; - basename : array[0..7] of char; - argv0 : array [0..15] of char; - dpmi_server : array [0..15] of char; - end; - - t_go32_info_block = packed record - size_of_this_structure_in_bytes : longint; {offset 0} - linear_address_of_primary_screen : longint; {offset 4} - linear_address_of_secondary_screen : longint; {offset 8} - linear_address_of_transfer_buffer : longint; {offset 12} - size_of_transfer_buffer : longint; {offset 16} - pid : longint; {offset 20} - master_interrupt_controller_base : byte; {offset 24} - slave_interrupt_controller_base : byte; {offset 25} - selector_for_linear_memory : word; {offset 26} - linear_address_of_stub_info_structure : longint; {offset 28} - linear_address_of_original_psp : longint; {offset 32} - run_mode : word; {offset 36} - run_mode_info : word; {offset 38} - end; - -var - stub_info : p_stub_info; - go32_info_block : t_go32_info_block; - LFNSupport : boolean; - -{ Needed for CRT unit } -function do_read(h,addr,len : longint) : longint; - - -implementation - -{ include system independent routines } - -{$I system.inc} - -{$ASMMODE DIRECT} -procedure int_stackcheck(stack_size:longint);[public,alias:'FPC_STACKCHECK']; -begin -{ 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 - - } - asm - pushl %eax - pushl %ebx - movl stack_size,%ebx - addl $2048,%ebx - movl %esp,%eax - subl %ebx,%eax -{$ifdef SYSTEMDEBUG} - movl U_SYSTEM_LOWESTSTACK,%ebx - cmpl %eax,%ebx - jb _is_not_lowest - movl %eax,U_SYSTEM_LOWESTSTACK - _is_not_lowest: -{$endif SYSTEMDEBUG} - movl __stkbottom,%ebx - cmpl %eax,%ebx - jae __short_on_stack - popl %ebx - popl %eax - leave - ret $4 - __short_on_stack: - { can be usefull for error recovery !! } - popl %ebx - popl %eax - end['EAX','EBX']; - HandleError(202); -end; - -function paramcount : longint; -begin - paramcount := argc - 1; -end; - - -function paramstr(l : longint) : string; -begin - if (l>=0) and (l+1<=argc) then - paramstr:=strpas(argv[l]) - else - paramstr:=''; -end; - - -procedure randomize; -Begin - asm - movb $0x2c,%ah - int $0x21 - shll $16,%ecx - movw %dx,%cx - movl %ecx,randseed - end; -end; - - -{***************************************************************************** - Heap Management -*****************************************************************************} - -function getheapstart:pointer;assembler; -asm - leal HEAP,%eax -end ['EAX']; - - -function getheapsize:longint;assembler; -asm - movl HEAPSIZE,%eax -end ['EAX']; - - -function Sbrk(size : longint) : longint;assembler; -asm - movl size,%ebx - movl $0x4a01,%eax - int $0x21 -end; - -{ include standard heap management } -{$I heap.inc} - - -{**************************************************************************** - Low Level File Routines - ****************************************************************************} - -procedure AllowSlash(p:pchar); -var - i : longint; -begin -{ allow slash as backslash } - for i:=0 to strlen(p) do - if p[i]='/' then p[i]:='\'; -end; - - -procedure do_close(h : longint);assembler; -asm - movl h,%ebx - movb $0x3e,%ah - pushl %ebp - int $0x21 - popl %ebp - jnc .LCLOSE1 - movw %ax,inoutres -.LCLOSE1: -end; - - -procedure do_erase(p : pchar); -begin - AllowSlash(p); - asm - movl p,%edx - movb $0x41,%ah - pushl %ebp - int $0x21 - popl %ebp - 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 - pushl %ebp - int $0x21 - popl %ebp - jnc .LRENAME1 - movw %ax,inoutres -.LRENAME1: - end; -end; - - -function do_write(h,addr,len : longint) : longint;assembler; -asm - movl len,%ecx - movl addr,%edx - movl h,%ebx - movb $0x40,%ah - int $0x21 - jnc .LDOSWRITE1 - movw %ax,inoutres - xorl %eax,%eax -.LDOSWRITE1: -end; - - -function do_read(h,addr,len : longint) : longint;assembler; -asm - movl len,%ecx - movl addr,%edx - movl h,%ebx - movb $0x3f,%ah - int $0x21 - jnc .LDOSREAD1 - movw %ax,inoutres - xorl %eax,%eax -.LDOSREAD1: -end; - - -function do_filepos(handle : longint) : longint;assembler; -asm - movl $0x4201,%eax - movl handle,%ebx - xorl %ecx,%ecx - xorl %edx,%edx - pushl %ebp - int $0x21 - popl %ebp - jnc .LDOSFILEPOS1 - movw %ax,inoutres - xorl %eax,%eax - jmp .LDOSFILEPOS2 -.LDOSFILEPOS1: - shll $16,%edx - movzwl %ax,%eax - orl %edx,%eax -.LDOSFILEPOS2: -end; - - -procedure do_seek(handle,pos : longint);assembler; -asm - movl $0x4200,%eax - movl handle,%ebx - movl pos,%edx - movl %edx,%ecx - shrl $16,%ecx - pushl %ebp - int $0x21 - popl %ebp - jnc .LDOSSEEK1 - movw %ax,inoutres -.LDOSSEEK1: -end; - - -function do_seekend(handle : longint) : longint;assembler; -asm - movl $0x4202,%eax - movl handle,%ebx - xorl %ecx,%ecx - xorl %edx,%edx - pushl %ebp - int $0x21 - popl %ebp - jnc .Lset_at_end1 - movw %ax,inoutres - xorl %eax,%eax - jmp .Lset_at_end2 -.Lset_at_end1: - shll $16,%edx - movzwl %ax,%eax - orl %edx,%eax -.Lset_at_end2: -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 - movl $0x4200,%eax - movl handle,%ebx - movl pos,%edx - movl %edx,%ecx - shrl $16,%ecx - pushl %ebp - int $0x21 - popl %ebp - jc .LTruncate1 - movl handle,%ebx - movl %ebp,%edx - xorl %ecx,%ecx - movb $0x40,%ah - int $0x21 - jnc .LTruncate2 -.LTruncate1: - movw %ax,inoutres -.LTruncate2: -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 - oflags : 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; - oflags:=$8404; -{ convert filemode to filerec modes } - case (flags and 3) of - 0 : begin - filerec(f).mode:=fminput; - oflags:=$8001; - end; - 1 : filerec(f).mode:=fmoutput; - 2 : filerec(f).mode:=fminout; - end; - if (flags and $1000)<>0 then - begin - filerec(f).mode:=fmoutput; - oflags:=$8302; - end - else - if (flags and $100)<>0 then - begin - filerec(f).mode:=fmoutput; - oflags:=$8404; - end; -{ 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; - asm - movl $0xff02,%eax - movl oflags,%ecx - movl p,%ebx - int $0x21 - jnc .LOPEN1 - movw %ax,inoutres - movw $0xffff,%ax -.LOPEN1: - movl f,%edx - movw %ax,(%edx) - end; - if (flags and $100)<>0 then - do_seekend(filerec(f).handle); -end; - - -function do_isdevice(handle : longint):boolean;assembler; -asm - movl $0x4400,%eax - movl handle,%ebx - pushl %ebp - int $0x21 - popl %ebp - jnc .LDOSDEVICE - movw %ax,inoutres - xorl %edx,%edx - .LDOSDEVICE: - movl %edx,%eax - shrl $7,%eax - andl $1,%eax -end; - - - -{***************************************************************************** - UnTyped File Handling -*****************************************************************************} - -{$i file.inc} - -{***************************************************************************** - Typed File Handling -*****************************************************************************} - -{$i typefile.inc} - -{***************************************************************************** - Text File Handling -*****************************************************************************} - -{$DEFINE EOF_CTRLZ} - -{$i text.inc} - -{***************************************************************************** - 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 - int $0x21 - jnc .LDOS_DIRS1 - movw %ax,inoutres -.LDOS_DIRS1: - end; -end; - - -procedure mkdir(const s : string);[IOCheck]; -begin - If InOutRes <> 0 then exit; - DosDir($39,s); -end; - - -procedure rmdir(const s : string);[IOCheck]; -begin - If InOutRes <> 0 then exit; - DosDir($3a,s); -end; - - -procedure chdir(const s : string);[IOCheck]; -begin - If InOutRes <> 0 then exit; - DosDir($3b,s); -end; - - -procedure GetDir (DriveNr: byte; var Dir: ShortString); -var - temp : array[0..255] of char; - sof : pchar; - i : byte; - Err: boolean; -begin - 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 - movw $0x4700,%ax - movb %al,Err - int $0x21 - jnc .LGetDir - movw %ax, InOutRes - incb Err -.LGetDir: - end; - if Err and (DriveNr <> 0) then - begin - Dir := char (DriveNr + 64) + ':\'; - Exit; - end; -{ Now Dir should be filled with directory in ASCIIZ starting from dir[4] } - dir[0]:=#3; - dir[2]:=':'; - dir[3]:='\'; - i:=4; -{ conversation to Pascal string } - while (dir[i]<>#0) do - begin - { convert path name to DOS } - if dir[i]='/' then - dir[i]:='\'; - dir[0]:=chr(i); - inc(i); - end; -{ upcase the string } - if drivenr<>0 then { Drive was supplied. We know it } - dir[1]:=chr(65+drivenr-1) - 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 - int $0x21 - addb $65,%al - movb %al,i - end; - dir[1]:=chr(i); - end; - dir:=upcase(dir); -end; - - -{***************************************************************************** - System Dependent Exit code -*****************************************************************************} -Procedure system_exit; -var - err : byte; -begin - flush(stderr); - err:=exitcode and $ff; - asm - movl $0x4c00,%eax - movb err,%al - int $0x21 - end; -end; - -{***************************************************************************** - SystemUnit Initialization -*****************************************************************************} - -Begin -{$ifdef SYSTEMDEBUG} -{ to test stack depth } - loweststack:=maxlongint; -{$endif} -{ Setup heap } - InitHeap; -{ Setup stdin, stdout and stderr } - 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.8 2001-07-29 13:50:44 peter - * merged updates from v10 - - Revision 1.7 2001/06/30 18:55:49 hajny - * GetDir fix for inaccessible drives - - Revision 1.6 2001/06/19 20:46:07 hajny - * platform specific constants moved after systemh.inc, BeOS omission corrected - - Revision 1.5 2001/06/13 22:22:59 hajny - + platform specific information - - Revision 1.4 2001/03/21 21:08:20 hajny - * GetDir fixed - - Revision 1.3 2001/03/10 09:57:51 hajny - * FExpand without IOResult change, remaining direct asm removed - - Revision 1.2 2000/07/13 11:33:38 michael - + removed logs - -}