- remove go32v1 support

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

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

rtl/go32v1/Makefile

@@ -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)

rtl/go32v1/Makefile.fpc

@@ -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)

rtl/go32v1/crt.pp

@@ -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<WinMaxX then
-   DosmemFillword($b800,((y-1)*ScreenWidth+(x-1))*2,WinMaxX-x+1,fil);
-End;
-
-
-
-Function WhereX: Byte;
-{
-  Return current X-position of cursor.
-}
-var
-  x,y : longint;
-Begin
-  GetScreenCursor(x,y);
-  WhereX:=x-WinMinX+1;
-End;
-
-
-
-Function WhereY: Byte;
-{
-  Return current Y-position of cursor.
-}
-var
-  x,y : longint;
-Begin
-  GetScreenCursor(x,y);
-  WhereY:=y-WinMinY+1;
-End;
-
-
-{*************************************************************************
-                            KeyBoard
-*************************************************************************}
-
-var
-   is_last : boolean;
-   last    : char;
-
-function readkey : char;
-var
-  char2 : char;
-  char1 : char;
-begin
-  if is_last then
-   begin
-     is_last:=false;
-     readkey:=last;
-   end
-  else
-   begin
-     asm
-        movb    $0,%ah
-        pushl   %ebp
-        int     $0x16
-        popl    %ebp
-        movb    %al,char1
-        movb    %ah,char2
-     end;
-     if char1=#0 then
-      begin
-        is_last:=true;
-        last:=char2;
-      end;
-     readkey:=char1;
-   end;
-end;
-
-
-function keypressed : boolean;
-begin
-  if is_last then
-   begin
-     keypressed:=true;
-     exit;
-   end
-  else
-   begin
-     asm
-        movb    $1,%ah
-        pushl   %ebp
-        int     $0x16
-        popl    %ebp
-        setnz   %al
-        movb    %al,__RESULT
-     end;
-   end;
-end;
-
-
-{*************************************************************************
-                                   Delay
-*************************************************************************}
-
-procedure Delayloop;assembler;
-asm
-.LDelayLoop1:
-        subl    $1,%eax
-        jc      .LDelayLoop2
-        cmpl    %fs:(%edi),%ebx
-        je      .LDelayLoop1
-.LDelayLoop2:
-end;
-
-
-procedure initdelay;assembler;
-asm
-        movl    $0x46c,%edi
-        movl    $-28,%edx
-        movl    %fs:(%edi),%ebx
-.LInitDel1:
-        cmpl    %fs:(%edi),%ebx
-        je      .LInitDel1
-        movl    %fs:(%edi),%ebx
-        movl    %edx,%eax
-        call    DelayLoop
-
-        notl    %eax
-        xorl    %edx,%edx
-        movl    $55,%ecx
-        divl    %ecx
-        movl    %eax,DelayCnt
-end;
-
-
-procedure Delay(MS: Word);assembler;
-asm
-        movzwl  MS,%ecx
-        jecxz   .LDelay2
-        movl    $0x400,%edi
-        movl    DelayCnt,%edx
-        movl    %fs:(%edi),%ebx
-.LDelay1:
-        movl    %edx,%eax
-        call    DelayLoop
-        loop    .LDelay1
-.LDelay2:
-end;
-
-
-procedure sound(hz : word);
-begin
-  if hz=0 then
-   begin
-     nosound;
-     exit;
-   end;
-  asm
-        movzwl  hz,%ecx
-        movl    $1193046,%eax
-        cltd
-        divl    %ecx
-        movl    %eax,%ecx
-        movb    $0xb6,%al
-        outb    %al,$0x43
-        movb    %cl,%al
-        outb    %al,$0x42
-        movb    %ch,%al
-        outb    %al,$0x42
-        inb     $0x61,%al
-        orb     $0x3,%al
-        outb    %al,$0x61
-  end ['EAX','ECX','EDX'];
-end;
-
-
-procedure nosound;
-begin
-  asm
-        inb     $0x61,%al
-        andb    $0xfc,%al
-        outb    %al,$0x61
-  end ['EAX'];
-end;
-
-
-
-{****************************************************************************
-                          HighLevel Crt Functions
-****************************************************************************}
-
-procedure removeline(y : longint);
-var
-  fil : word;
-begin
-  fil:=32 or (textattr shl 8);
-  y:=WinMinY+y-1;
-  While (y<WinMaxY) do
-   begin
-     dosmemmove($b800,(y*ScreenWidth+(WinMinX-1))*2,
-                $b800,((y-1)*ScreenWidth+(WinMinX-1))*2,(WinMaxX-WinMinX+1)*2);
-     inc(y);
-   end;
-  dosmemfillword($b800,((WinMaxY-1)*ScreenWidth+(WinMinX-1))*2,(WinMaxX-WinMinX+1),fil);
-end;
-
-
-procedure delline;
-begin
-  removeline(wherey);
-end;
-
-
-procedure insline;
-var
-  my,y : longint;
-  fil : word;
-begin
-  fil:=32 or (textattr shl 8);
-  y:=WhereY;
-  my:=WinMaxY-WinMinY;
-  while (my>=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.bufpos<f.bufend then
-                 begin
-                   WriteChar(f.bufptr^[f.bufpos]);
-                   inc(f.bufpos);
-                 end;
-          #79 : while f.bufpos<f.bufend do
-                 begin
-                   WriteChar(f.bufptr^[f.bufpos]);
-                   inc(f.bufpos);
-                 end;
-         end;
-    ^S,
-    #8 : BackSpace;
-    ^Y,
-   #27 : begin
-           f.bufpos:=f.bufend;
-           while f.bufend>0 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<f.bufsize-2 then
-        begin
-          f.buffer[f.bufpos]:=ch;
-          inc(f.bufpos);
-          WriteChar(ch);
-        end;
-     end;
-    end;
-  until false;
-  f.bufpos:=0;
-  SetScreenCursor(CurrX,CurrY);
-  CrtRead:=0;
-End;
-
-
-Function CrtReturn:Integer;
-Begin
-  CrtReturn:=0;
-end;
-
-
-Function CrtClose(Var F: TextRec): Integer;
-Begin
-  F.Mode:=fmClosed;
-  CrtClose:=0;
-End;
-
-
-Function CrtOpen(Var F: TextRec): Integer;
-Begin
-  If F.Mode=fmOutput Then
-   begin
-     TextRec(F).InOutFunc:=@CrtWrite;
-     TextRec(F).FlushFunc:=@CrtWrite;
-   end
-  Else
-   begin
-     F.Mode:=fmInput;
-     TextRec(F).InOutFunc:=@CrtRead;
-     TextRec(F).FlushFunc:=@CrtReturn;
-   end;
-  TextRec(F).CloseFunc:=@CrtClose;
-  CrtOpen:=0;
-End;
-
-
-procedure AssignCrt(var F: Text);
-begin
-  Assign(F,'');
-  TextRec(F).OpenFunc:=@CrtOpen;
-end;
-
-
-var
-  x,y : longint;
-begin
-{ Load startup values }
-  ScreenWidth:=GetScreenWidth;
-  ScreenHeight:=GetScreenHeight;
-  WindMax:=(ScreenWidth-1) or ((ScreenHeight-1) shl 8);
-{ Load TextAttr }
-  GetScreenCursor(x,y);
-  dosmemget($b800,((y-1)*ScreenWidth+(x-1))*2+1,TextAttr,1);
-  dosmemget($40,$49,lastmode,1);
-{ Redirect the standard output }
-  assigncrt(Output);
-  Rewrite(Output);
-  TextRec(Output).Handle:=StdOutputHandle;
-  assigncrt(Input);
-  Reset(Input);
-  TextRec(Input).Handle:=StdInputHandle;
-{ Calculates delay calibration }
-  initdelay;
-end.
-
-{
-  $Log$
-  Revision 1.2  2000-07-13 11:33:38  michael
-  + removed logs
- 
-}

rtl/go32v1/disk.inc

@@ -1,83 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by the Free Pascal development team
-
-    Disk functions from Delphi's sysutils.pas
-
-    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 DiskFree (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.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
- 
-}

rtl/go32v1/dos.pp

@@ -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
- 
-}

rtl/go32v1/filutil.inc

@@ -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
- 
-}

rtl/go32v1/go32.pp

@@ -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 (source<dest) then
-           { copy backward for overlapping }
-           asm
-              pushw %es
-              pushw %ds
-              std
-              movl count,%ecx
-              movl source,%esi
-              movl dest,%edi
-              movw dseg,%ax
-              movw %ax,%es
-              movw sseg,%ax
-              movw %ax,%ds
-              addl %ecx,%esi
-              addl %ecx,%edi
-              movl %ecx,%eax
-              andl $3,%ecx
-              orl %ecx,%ecx
-              jz .LSEG_MOVE1
-
-              { calculate esi and edi}
-              decl %esi
-              decl %edi
-              rep
-              movsb
-              incl %esi
-              incl %edi
-           .LSEG_MOVE1:
-              subl $4,%esi
-              subl $4,%edi
-              movl %eax,%ecx
-              shrl $2,%ecx
-              rep
-              movsl
-              cld
-              popw %ds
-              popw %es
-           end ['ESI','EDI','ECX'];
-      end;
-
-    procedure outportb(port : word;data : byte);
-
-      begin
-         asm
-            movw port,%dx
-            movb data,%al
-            outb %al,%dx
-         end ['EAX','EDX'];
-      end;
-
-    procedure outportw(port : word;data : word);
-
-      begin
-         asm
-            movw port,%dx
-            movw data,%ax
-            outw %ax,%dx
-         end ['EAX','EDX'];
-      end;
-
-    procedure outportl(port : word;data : longint);
-
-      begin
-         asm
-            movw port,%dx
-            movl data,%eax
-            outl %eax,%dx
-         end ['EAX','EDX'];
-      end;
-
-    function inportb(port : word) : byte;
-
-      begin
-         asm
-            movw port,%dx
-            inb %dx,%al
-            movb %al,__RESULT
-         end ['EAX','EDX'];
-      end;
-
-    function inportw(port : word) : word;
-
-      begin
-         asm
-            movw port,%dx
-            inw %dx,%ax
-            movw %ax,__RESULT
-         end ['EAX','EDX'];
-      end;
-
-    function inportl(port : word) : longint;
-
-      begin
-         asm
-            movw port,%dx
-            inl %dx,%eax
-            movl %eax,__RESULT
-         end ['EAX','EDX'];
-      end;
-
-
-{ to give easy port access like tp with port[] }
-
-procedure tport.writeport(p : word;data : byte);assembler;
-asm
-        movw    p,%dx
-        movb    data,%al
-        outb    %al,%dx
-end ['EAX','EDX'];
-
-
-function tport.readport(p : word) : byte;assembler;
-asm
-        movw    p,%dx
-        inb     %dx,%al
-end ['EAX','EDX'];
-
-
-procedure tportw.writeport(p : word;data : word);assembler;
-asm
-        movw    p,%dx
-        movw    data,%ax
-        outw    %ax,%dx
-end ['EAX','EDX'];
-
-
-function tportw.readport(p : word) : word;assembler;
-asm
-        movw    p,%dx
-        inw     %dx,%ax
-end ['EAX','EDX'];
-
-
-procedure tportl.writeport(p : word;data : longint);assembler;
-asm
-        movw    p,%dx
-        movl    data,%eax
-        outl    %eax,%dx
-end ['EAX','EDX'];
-
-
-function tportl.readport(p : word) : longint;assembler;
-asm
-        movw    p,%dx
-        inl     %dx,%eax
-end ['EAX','EDX'];
-
-
-    function get_cs : word;assembler;
-      asm
-            movw %cs,%ax
-      end;
-
-
-    function get_ss : word;assembler;
-      asm
-            movw %ss,%ax
-      end;
-
-
-    function get_ds : word;assembler;
-      asm
-            movw %ds,%ax
-      end;
-
-
-    procedure test_int31(flag : longint);[alias : 'test_int31'];
-      begin
-         asm
-            pushl %ebx
-            movw  $0,INT31ERROR
-            movl  flag,%ebx
-            testb $1,%bl
-            jz    .L1
-            movw  %ax,INT31ERROR
-            xorl  %eax,%eax
-            jmp   .L2
-            .L1:
-            movl  $1,%eax
-            .L2:
-            popl  %ebx
-         end;
-      end;
-
-    function set_pm_interrupt(vector : byte;const intaddr : tseginfo) : boolean;
-
-      begin
-         asm
-            movl intaddr,%eax
-            movl (%eax),%edx
-            movw 4(%eax),%cx
-            movl $0x205,%eax
-            movb vector,%bl
-            int $0x31
-            pushf
-            call test_int31
-            movb %al,__RESULT
-         end;
-      end;
-
-    function set_rm_interrupt(vector : byte;const intaddr : tseginfo) : boolean;
-
-      begin
-         asm
-            movl intaddr,%eax
-            movw (%eax),%dx
-            movw 4(%eax),%cx
-            movl $0x201,%eax
-            movb vector,%bl
-            int $0x31
-            pushf
-            call test_int31
-            movb %al,__RESULT
-         end;
-      end;
-
-    function set_pm_exception_handler(e : byte;const intaddr : tseginfo) : boolean;
-
-      begin
-         asm
-            movl intaddr,%eax
-            movl (%eax),%edx
-            movw 4(%eax),%cx
-            movl $0x212,%eax
-            movb e,%bl
-            int $0x31
-            pushf
-            call test_int31
-            movb %al,__RESULT
-         end;
-      end;
-
-    function set_exception_handler(e : byte;const intaddr : tseginfo) : boolean;
-
-      begin
-         asm
-            movl intaddr,%eax
-            movl (%eax),%edx
-            movw 4(%eax),%cx
-            movl $0x203,%eax
-            movb e,%bl
-            int $0x31
-            pushf
-            call test_int31
-            movb %al,__RESULT
-         end;
-      end;
-
-    function get_pm_exception_handler(e : byte;var intaddr : tseginfo) : boolean;
-
-      begin
-         asm
-            movl $0x210,%eax
-            movb e,%bl
-            int $0x31
-            pushf
-            call test_int31
-            movb %al,__RESULT
-            movl intaddr,%eax
-            movl %edx,(%eax)
-            movw %cx,4(%eax)
-         end;
-      end;
-
-    function get_exception_handler(e : byte;var intaddr : tseginfo) : boolean;
-
-      begin
-         asm
-            movl $0x202,%eax
-            movb e,%bl
-            int $0x31
-            pushf
-            call test_int31
-            movb %al,__RESULT
-            movl intaddr,%eax
-            movl %edx,(%eax)
-            movw %cx,4(%eax)
-         end;
-      end;
-
-    function get_pm_interrupt(vector : byte;var intaddr : tseginfo) : boolean;
-
-      begin
-         asm
-            movb vector,%bl
-            movl $0x204,%eax
-            int $0x31
-            pushf
-            call test_int31
-            movb %al,__RESULT
-            movl intaddr,%eax
-            movl %edx,(%eax)
-            movw %cx,4(%eax)
-         end;
-      end;
-
-    function get_rm_interrupt(vector : byte;var intaddr : tseginfo) : boolean;
-
-      begin
-         asm
-            movb vector,%bl
-            movl $0x200,%eax
-            int $0x31
-            pushf
-            call test_int31
-            movb %al,__RESULT
-            movl intaddr,%eax
-            movzwl %dx,%edx
-            movl %edx,(%eax)
-            movw %cx,4(%eax)
-         end;
-      end;
-
-    function free_rm_callback(var intaddr : tseginfo) : boolean;
-      begin
-         asm
-            movl intaddr,%eax
-            movw (%eax),%dx
-            movw 4(%eax),%cx
-            movl $0x304,%eax
-            int $0x31
-            pushf
-            call test_int31
-            movb %al,__RESULT
-         end;
-      end;
-
-    { here we must use ___v2prt0_ds_alias instead of from v2prt0.s
-    because the exception processor sets the ds limit to $fff
-    at hardware exceptions }
-
-    function get_rm_callback(pm_func : pointer;const reg : trealregs;var rmcb : tseginfo) : boolean;
-      begin
-         asm
-            movl  pm_func,%esi
-            movl  reg,%edi
-            pushw %es
-            movw  %ds,%ax
-            movw  %ax,%es
-            pushw %ds
-            movw  %cs,%ax
-            movw  %ax,%ds
-            movl  $0x303,%eax
-            int   $0x31
-            popw  %ds
-            popw  %es
-            pushf
-            call test_int31
-            movb %al,__RESULT
-            movl  rmcb,%eax
-            movzwl %dx,%edx
-            movl  %edx,(%eax)
-            movw  %cx,4(%eax)
-         end;
-      end;
-
-    function allocate_ldt_descriptors(count : word) : word;
-
-      begin
-         asm
-            movw count,%cx
-            xorl %eax,%eax
-            int $0x31
-            movw %ax,__RESULT
-         end;
-      end;
-
-    function free_ldt_descriptor(d : word) : boolean;
-
-      begin
-         asm
-            movw d,%bx
-            movl $1,%eax
-            int $0x31
-            pushf
-            call test_int31
-            movb %al,__RESULT
-         end;
-      end;
-
-    function segment_to_descriptor(seg : word) : word;
-
-      begin
-         asm
-            movw seg,%bx
-            movl $2,%eax
-            int $0x31
-            movw %ax,__RESULT
-         end;
-      end;
-
-    function get_next_selector_increment_value : word;
-
-      begin
-         asm
-            movl $3,%eax
-            int $0x31
-            movw %ax,__RESULT
-         end;
-      end;
-
-    function get_segment_base_address(d : word) : longint;
-
-      begin
-         asm
-            movw d,%bx
-            movl $6,%eax
-            int $0x31
-            xorl %eax,%eax
-            movw %dx,%ax
-            shll $16,%ecx
-            orl %ecx,%eax
-            movl %eax,__RESULT
-         end;
-      end;
-
-    function get_page_size:longint;
-      begin
-        asm
-           movl $0x604,%eax
-           int $0x31
-           shll $16,%ebx
-           movw %cx,%bx
-           movl %ebx,__RESULT
-        end;
-      end;
-
-    function request_linear_region(linearaddr, size : longint;
-                                   var blockhandle : longint) : boolean;
-      var
-         pageofs : longint;
-
-      begin
-         pageofs:=linearaddr and $3ff;
-         linearaddr:=linearaddr-pageofs;
-         size:=size+pageofs;
-         asm
-            movl $0x504,%eax
-            movl linearaddr,%ebx
-            movl size,%ecx
-            movl $1,%edx
-            xorl %esi,%esi
-            int $0x31
-            pushf
-            call test_int31
-            movb %al,__RESULT
-            movl blockhandle,%eax
-            movl %esi,(%eax)
-            movl %ebx,pageofs
-         end;
-         if pageofs<>linearaddr 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
- 
-}

rtl/go32v1/msmouse.pp

@@ -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
- 
-}

rtl/go32v1/objinc.inc

@@ -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
- 
-}

rtl/go32v1/printer.pp

@@ -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
- 
-}

rtl/go32v1/prt0.as

@@ -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
-#
-#

rtl/go32v1/system.pp

@@ -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
-
-}