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

+ new include files

Browse Source
This commit is contained in:
michael 2000-08-29 18:16:22 +00:00
parent 05f78681c5
commit e50e70bef2
12 changed files with 613 additions and 678 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

140
rtl/go32v2/Makefile
View File

@ -1,5 +1,5 @@
#
# Makefile generated by fpcmake v1.00 [2000/08/14]
# Makefile generated by fpcmake v0.99.13 [2000/03/28]
#
defaultrule: all
@ -203,7 +203,7 @@ endif
# Targets
override LOADEROBJECTS+=prt0 exceptn fpu
override UNITOBJECTS+=$(SYSTEMUNIT) objpas strings go32 dpmiexcp initc ports profile dxeload emu387 dos crt objects printer graph sysutils math typinfo cpu mmx getopts heaptrc lineinfo msmouse
override UNITOBJECTS+=$(SYSTEMUNIT) objpas strings go32 dpmiexcp initc ports profile dxeload emu387 dos crt objects printer graph sysutils math typinfo cpu mmx getopts heaptrc lineinfo msmouse varutils
override RSTOBJECTS+=math
# Clean
@ -604,19 +604,6 @@ DOCINSTALLDIR=$(BASEINSTALLDIR)/doc
endif
endif
# Where to install the examples, under linux we use the doc dir
# because the copytree command will create a subdir itself
ifndef EXAMPLEINSTALLDIR
ifdef inlinux
EXAMPLEINSTALLDIR=$(DOCINSTALLDIR)/examples
else
EXAMPLEINSTALLDIR=$(BASEINSTALLDIR)/examples
endif
ifdef EXAMPLESUBDIR
EXAMPLEINSTALLDIR:=$(EXAMPLEINSTALLDIR)/$(EXAMPLESUBDIR)
endif
endif
# Where the some extra (data)files will be stored
ifndef DATAINSTALLDIR
DATAINSTALLDIR=$(BASEINSTALLDIR)
@ -652,28 +639,28 @@ ifneq ($(OS_TARGET),$(OS_SOURCE))
override FPCOPT+=-T$(OS_TARGET)
endif
# User dirs should be first, so they are looked at first
ifdef UNITDIR
override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
ifdef UNITSDIR
override FPCOPT+=-Fu$(UNITSDIR)
endif
ifdef LIBDIR
override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
ifdef NEEDINCDIR
override FPCOPT+=$(addprefix -Fi,$(NEEDINCDIR))
endif
ifdef OBJDIR
override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
endif
ifdef INCDIR
override FPCOPT+=$(addprefix -Fi,$(INCDIR))
# Target dirs
ifdef TARGETDIR
override FPCOPT+=-FE$(TARGETDIR)
endif
# Smartlinking
ifdef LINKSMART
override FPCOPT+=-XX
override FPCOPT+=-CX
endif
# Smartlinking creation
# Smartlinking
ifdef CREATESMART
override FPCOPT+=-CX
override FPCOPT+=-XX
endif
# Debug
@ -706,24 +693,22 @@ ifdef VERBOSE
override FPCOPT+=-vwni
endif
ifdef UNITSDIR
override FPCOPT+=-Fu$(UNITSDIR)
endif
ifdef NEEDINCDIR
override FPCOPT+=$(addprefix -Fi,$(NEEDINCDIR))
endif
# Target dirs
ifdef TARGETDIR
override FPCOPT+=-FE$(TARGETDIR)
endif
# Add commandline options last so they can override
# Add commandline options
ifdef OPT
override FPCOPT+=$(OPT)
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
# Add defines from FPCOPTDEF to FPCOPT
ifdef FPCOPTDEF
@ -775,14 +760,10 @@ install: fpc_install
sourceinstall: fpc_sourceinstall
exampleinstall: fpc_exampleinstall
zipinstall: fpc_zipinstall
zipsourceinstall: fpc_zipsourceinstall
zipexampleinstall: fpc_zipexampleinstall
clean: fpc_clean
distclean: fpc_distclean
@ -791,7 +772,7 @@ cleanall: fpc_cleanall
info: fpc_info
.PHONY: all debug smart shared showinstall install sourceinstall exampleinstall zipinstall zipsourceinstall zipexampleinstall clean distclean cleanall info
.PHONY: all debug smart shared showinstall install sourceinstall zipinstall zipsourceinstall clean distclean cleanall info
#####################################################################
# Loaders
@ -839,11 +820,9 @@ fpc_units: $(UNITPPUFILES)
# Resource strings
#####################################################################
ifdef RSTOBJECTS
override RSTFILES=$(addsuffix $(RSTEXT),$(RSTOBJECTS))
override CLEANRSTFILES+=$(RSTFILES)
endif
#####################################################################
# General compile rules
@ -887,12 +866,6 @@ fpc_debug:
.PHONY: fpc_smart fpc_shared
ifdef LIBVERSION
LIBFULLNAME=$(LIBNAME).$(LIBVERSION)
else
LIBFULLNAME=$(LIBNAME)
endif
# Default sharedlib units are all unit objects
ifndef SHAREDLIBUNITOBJECTS
SHAREDLIBUNITOBJECTS:=$(UNITOBJECTS)
@ -906,7 +879,7 @@ ifdef inlinux
ifndef LIBNAME
@$(ECHO) "LIBNAME not set"
else
$(PPUMOVE) $(SHAREDLIBUNITOBJECTS) -o$(LIBFULLNAME)
$(PPUMOVE) $(SHAREDLIBUNITOBJECTS) -o$(LIBNAME)
endif
else
@$(ECHO) "Shared Libraries not supported"
@ -924,9 +897,14 @@ endif
ifdef INSTALLPPUFILES
ifdef PPUFILES
ifdef inlinux
INSTALLPPULINKFILES:=$(shell $(PPUFILES) -S -O $(INSTALLPPUFILES))
INSTALLPPULIBFILES:=$(shell $(PPUFILES) -L $(INSTALLPPUFILES))
else
INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(LIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))))
INSTALLPPULINKFILES:=$(shell $(PPUFILES) $(INSTALLPPUFILES))
endif
else
INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)))
endif
endif
@ -939,11 +917,8 @@ ifdef INSTALLPPUFILES
ifneq ($(INSTALLPPULINKFILES),)
@$(ECHO) -e $(addprefix "\n"$(UNITINSTALLDIR)/,$(INSTALLPPULINKFILES))
endif
ifneq ($(wildcard $(LIBFULLNAME)),)
@$(ECHO) $(LIBINSTALLDIR)/$(LIBFULLNAME)
ifdef inlinux
@$(ECHO) $(LIBINSTALLDIR)/$(LIBNAME)
endif
ifneq ($(INSTALLPPULIBFILES),)
@$(ECHO) -e $(addprefix "\n"$(LIBINSTALLDIR)/,$(INSTALLPPULIBFILES))
endif
endif
ifdef EXTRAINSTALLFILES
@ -966,12 +941,9 @@ ifdef INSTALLPPUFILES
ifneq ($(INSTALLPPULINKFILES),)
$(INSTALL) $(INSTALLPPULINKFILES) $(UNITINSTALLDIR)
endif
ifneq ($(wildcard $(LIBFULLNAME)),)
ifneq ($(INSTALLPPULIBFILES),)
$(MKDIR) $(LIBINSTALLDIR)
$(INSTALL) $(LIBFULLNAME) $(LIBINSTALLDIR)
ifdef inlinux
ln -sf $(LIBFULLNAME) $(LIBINSTALLDIR)/$(LIBNAME)
endif
$(INSTALL) $(INSTALLPPULIBFILES) $(LIBINSTALLDIR)
endif
endif
ifdef EXTRAINSTALLFILES
@ -993,24 +965,6 @@ fpc_sourceinstall: clean
$(MKDIR) $(SOURCEINSTALLDIR)
$(COPYTREE) $(SOURCETOPDIR) $(SOURCEINSTALLDIR)
#####################################################################
# exampleinstall rules
#####################################################################
.PHONY: fpc_exampleinstall
fpc_exampleinstall: $(addsuffix _clean,$(EXAMPLEDIROBJECTS))
ifdef EXAMPLESOURCEFILES
$(MKDIR) $(EXAMPLEINSTALLDIR)
$(COPY) $(EXAMPLESOURCEFILES) $(EXAMPLEINSTALLDIR)
endif
ifdef EXAMPLEDIROBJECTS
ifndef EXAMPLESOURCEFILES
$(MKDIR) $(EXAMPLEINSTALLDIR)
endif
$(COPYTREE) $(addsuffix /*,$(EXAMPLEDIROBJECTS)) $(EXAMPLEINSTALLDIR)
endif
#####################################################################
# Zip
#####################################################################
@ -1072,11 +1026,6 @@ endif
fpc_zipsourceinstall:
$(MAKE) fpc_zipinstall ZIPTARGET=sourceinstall PACKAGESUFFIX=src
.PHONY: fpc_zipexampleinstall
fpc_zipexampleinstall:
$(MAKE) fpc_zipinstall ZIPTARGET=exampleinstall PACKAGESUFFIX=exm
#####################################################################
# Clean rules
#####################################################################
@ -1091,7 +1040,7 @@ ifdef CLEANPPUFILES
ifdef PPUFILES
CLEANPPULINKFILES:=$(shell $(PPUFILES) $(CLEANPPUFILES))
else
CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(LIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))))
CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)))
endif
endif
@ -1110,9 +1059,6 @@ ifdef CLEANRSTFILES
endif
ifdef EXTRACLEANFILES
-$(DEL) $(EXTRACLEANFILES)
endif
ifdef LIBNAME
-$(DEL) $(LIBNAME) $(LIBFULLNAME)
endif
-$(DEL) $(FPCMADE) $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
@ -1281,6 +1227,10 @@ typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/math.pp $(REDIR)
varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.pp $(OBJPASDIR)/varutils.inc \
$(OBJPASDIR)/varutilh.inc varutils.pp
$(COMPILER) -I$(OBJPASDIR) varutils.pp $(REDIR)
#
# Other system-independent RTL Units
#

6
rtl/go32v2/Makefile.fpc
View File

@ -9,7 +9,7 @@ units=$(SYSTEMUNIT) objpas strings \
dos crt objects printer graph \
sysutils math typinfo \
cpu mmx getopts heaptrc lineinfo \
msmouse
msmouse varutils
rst=math
[require]
@ -153,6 +153,10 @@ typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/math.pp $(REDIR)
varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.pp $(OBJPASDIR)/varutils.inc \
$(OBJPASDIR)/varutilh.inc varutils.pp
$(COMPILER) -I$(OBJPASDIR) varutils.pp $(REDIR)
#
# Other system-independent RTL Units
#

50
rtl/go32v2/varutils.pp Normal file
View File

@ -0,0 +1,50 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by the Free Pascal development team
Interface and OS-dependent part of variant support
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.
**********************************************************************}
{$MODE ObjFPC}
Unit varutils;
Interface
Uses sysutils;
// Read definitions.
{$i varutilh.inc}
Implementation
// Code common to all platforms.
{$i cvarutil.inc}
// Code common to non-win32 platforms.
{$i varutils.inc}
end.
{
$Log$
Revision 1.1 2000-08-29 18:21:58 michael
+ new include files
Revision 1.1 2000/08/29 18:20:13 michael
+ new include files
}

136
rtl/linux/Makefile
View File

@ -1,5 +1,5 @@
#
# Makefile generated by fpcmake v1.00 [2000/07/11]
# Makefile generated by fpcmake v0.99.13 [2000/03/28]
#
defaultrule: all
@ -229,7 +229,6 @@ endif
# Libraries
LIBNAME=libfprtl.so
LIBVERSION=1.0
SHAREDLIBUNITOBJECTS=$(SYSTEMUNIT) objpas strings linux ports dos crt objects printer sysutils typinfo math cpu mmx getopts heaptrc errors sockets ipc dl dynlibs varutils
# Info
@ -606,19 +605,6 @@ DOCINSTALLDIR=$(BASEINSTALLDIR)/doc
endif
endif
# Where to install the examples, under linux we use the doc dir
# because the copytree command will create a subdir itself
ifndef EXAMPLEINSTALLDIR
ifdef inlinux
EXAMPLEINSTALLDIR=$(DOCINSTALLDIR)/examples
else
EXAMPLEINSTALLDIR=$(BASEINSTALLDIR)/examples
endif
ifdef EXAMPLESUBDIR
EXAMPLEINSTALLDIR:=$(EXAMPLEINSTALLDIR)/$(EXAMPLESUBDIR)
endif
endif
# Where the some extra (data)files will be stored
ifndef DATAINSTALLDIR
DATAINSTALLDIR=$(BASEINSTALLDIR)
@ -654,28 +640,28 @@ ifneq ($(OS_TARGET),$(OS_SOURCE))
override FPCOPT+=-T$(OS_TARGET)
endif
# User dirs should be first, so they are looked at first
ifdef UNITDIR
override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
ifdef UNITSDIR
override FPCOPT+=-Fu$(UNITSDIR)
endif
ifdef LIBDIR
override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
ifdef NEEDINCDIR
override FPCOPT+=$(addprefix -Fi,$(NEEDINCDIR))
endif
ifdef OBJDIR
override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
endif
ifdef INCDIR
override FPCOPT+=$(addprefix -Fi,$(INCDIR))
# Target dirs
ifdef TARGETDIR
override FPCOPT+=-FE$(TARGETDIR)
endif
# Smartlinking
ifdef LINKSMART
override FPCOPT+=-XX
override FPCOPT+=-CX
endif
# Smartlinking creation
# Smartlinking
ifdef CREATESMART
override FPCOPT+=-CX
override FPCOPT+=-XX
endif
# Debug
@ -708,24 +694,22 @@ ifdef VERBOSE
override FPCOPT+=-vwni
endif
ifdef UNITSDIR
override FPCOPT+=-Fu$(UNITSDIR)
endif
ifdef NEEDINCDIR
override FPCOPT+=$(addprefix -Fi,$(NEEDINCDIR))
endif
# Target dirs
ifdef TARGETDIR
override FPCOPT+=-FE$(TARGETDIR)
endif
# Add commandline options last so they can override
# Add commandline options
ifdef OPT
override FPCOPT+=$(OPT)
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
# Add defines from FPCOPTDEF to FPCOPT
ifdef FPCOPTDEF
@ -777,14 +761,10 @@ install: fpc_install
sourceinstall: fpc_sourceinstall
exampleinstall: fpc_exampleinstall
zipinstall: fpc_zipinstall
zipsourceinstall: fpc_zipsourceinstall
zipexampleinstall: fpc_zipexampleinstall
clean: fpc_clean
distclean: fpc_distclean
@ -793,7 +773,7 @@ cleanall: fpc_cleanall
info: fpc_info
.PHONY: all debug smart shared showinstall install sourceinstall exampleinstall zipinstall zipsourceinstall zipexampleinstall clean distclean cleanall info
.PHONY: all debug smart shared showinstall install sourceinstall zipinstall zipsourceinstall clean distclean cleanall info
#####################################################################
# Loaders
@ -841,11 +821,9 @@ fpc_units: $(UNITPPUFILES)
# Resource strings
#####################################################################
ifdef RSTOBJECTS
override RSTFILES=$(addsuffix $(RSTEXT),$(RSTOBJECTS))
override CLEANRSTFILES+=$(RSTFILES)
endif
#####################################################################
# General compile rules
@ -889,12 +867,6 @@ fpc_debug:
.PHONY: fpc_smart fpc_shared
ifdef LIBVERSION
LIBFULLNAME=$(LIBNAME).$(LIBVERSION)
else
LIBFULLNAME=$(LIBNAME)
endif
# Default sharedlib units are all unit objects
ifndef SHAREDLIBUNITOBJECTS
SHAREDLIBUNITOBJECTS:=$(UNITOBJECTS)
@ -908,7 +880,7 @@ ifdef inlinux
ifndef LIBNAME
@$(ECHO) "LIBNAME not set"
else
$(PPUMOVE) $(SHAREDLIBUNITOBJECTS) -o$(LIBFULLNAME)
$(PPUMOVE) $(SHAREDLIBUNITOBJECTS) -o$(LIBNAME)
endif
else
@$(ECHO) "Shared Libraries not supported"
@ -926,7 +898,12 @@ endif
ifdef INSTALLPPUFILES
ifdef PPUFILES
ifdef inlinux
INSTALLPPULINKFILES:=$(shell $(PPUFILES) -S -O $(INSTALLPPUFILES))
INSTALLPPULIBFILES:=$(shell $(PPUFILES) -L $(INSTALLPPUFILES))
else
INSTALLPPULINKFILES:=$(shell $(PPUFILES) $(INSTALLPPUFILES))
endif
else
INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)))
endif
@ -941,11 +918,8 @@ ifdef INSTALLPPUFILES
ifneq ($(INSTALLPPULINKFILES),)
@$(ECHO) -e $(addprefix "\n"$(UNITINSTALLDIR)/,$(INSTALLPPULINKFILES))
endif
ifneq ($(wildcard $(LIBFULLNAME)),)
@$(ECHO) $(LIBINSTALLDIR)/$(LIBFULLNAME)
ifdef inlinux
@$(ECHO) $(LIBINSTALLDIR)/$(LIBNAME)
endif
ifneq ($(INSTALLPPULIBFILES),)
@$(ECHO) -e $(addprefix "\n"$(LIBINSTALLDIR)/,$(INSTALLPPULIBFILES))
endif
endif
ifdef EXTRAINSTALLFILES
@ -968,12 +942,9 @@ ifdef INSTALLPPUFILES
ifneq ($(INSTALLPPULINKFILES),)
$(INSTALL) $(INSTALLPPULINKFILES) $(UNITINSTALLDIR)
endif
ifneq ($(wildcard $(LIBFULLNAME)),)
ifneq ($(INSTALLPPULIBFILES),)
$(MKDIR) $(LIBINSTALLDIR)
$(INSTALL) $(LIBFULLNAME) $(LIBINSTALLDIR)
ifdef inlinux
ln -sf $(LIBFULLNAME) $(LIBINSTALLDIR)/$(LIBNAME)
endif
$(INSTALL) $(INSTALLPPULIBFILES) $(LIBINSTALLDIR)
endif
endif
ifdef EXTRAINSTALLFILES
@ -995,24 +966,6 @@ fpc_sourceinstall: clean
$(MKDIR) $(SOURCEINSTALLDIR)
$(COPYTREE) $(SOURCETOPDIR) $(SOURCEINSTALLDIR)
#####################################################################
# exampleinstall rules
#####################################################################
.PHONY: fpc_exampleinstall
fpc_exampleinstall: $(addsuffix _clean,$(EXAMPLEDIROBJECTS))
ifdef EXAMPLESOURCEFILES
$(MKDIR) $(EXAMPLEINSTALLDIR)
$(COPY) $(EXAMPLESOURCEFILES) $(EXAMPLEINSTALLDIR)
endif
ifdef EXAMPLEDIROBJECTS
ifndef EXAMPLESOURCEFILES
$(MKDIR) $(EXAMPLEINSTALLDIR)
endif
$(COPYTREE) $(addsuffix /*,$(EXAMPLEDIROBJECTS)) $(EXAMPLEINSTALLDIR)
endif
#####################################################################
# Zip
#####################################################################
@ -1074,11 +1027,6 @@ endif
fpc_zipsourceinstall:
$(MAKE) fpc_zipinstall ZIPTARGET=sourceinstall PACKAGESUFFIX=src
.PHONY: fpc_zipexampleinstall
fpc_zipexampleinstall:
$(MAKE) fpc_zipinstall ZIPTARGET=exampleinstall PACKAGESUFFIX=exm
#####################################################################
# Clean rules
#####################################################################
@ -1112,9 +1060,6 @@ ifdef CLEANRSTFILES
endif
ifdef EXTRACLEANFILES
-$(DEL) $(EXTRACLEANFILES)
endif
ifdef LIBNAME
-$(DEL) $(LIBNAME) $(LIBFULLNAME)
endif
-$(DEL) $(FPCMADE) $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
@ -1298,8 +1243,9 @@ math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
gettext$(PPUEXT): $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/gettext.pp $(REDIR)
varutils$(PPUEXT) : $(OBJPASDIR)/varutils.pp $(OBJPASDIR)/varutils.inc
$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/varutils.pp $(REDIR)
varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.pp $(OBJPASDIR)/varutils.inc \
$(OBJPASDIR)/varutilh.inc varutils.pp
$(COMPILER) -I$(OBJPASDIR) varutils.pp $(REDIR)
#
# Other system-independent RTL Units

5
rtl/linux/Makefile.fpc
View File

@ -179,8 +179,9 @@ math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
gettext$(PPUEXT): $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/gettext.pp $(REDIR)
varutils$(PPUEXT) : $(OBJPASDIR)/varutils.pp $(OBJPASDIR)/varutils.inc
$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/varutils.pp $(REDIR)
varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.pp $(OBJPASDIR)/varutils.inc \
$(OBJPASDIR)/varutilh.inc varutils.pp
$(COMPILER) -I$(OBJPASDIR) varutils.pp $(REDIR)
#
# Other system-independent RTL Units

47
rtl/linux/varutils.pp Normal file
View File

@ -0,0 +1,47 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by the Free Pascal development team
Interface and OS-dependent part of variant support
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.
**********************************************************************}
{$MODE ObjFPC}
Unit varutils;
Interface
Uses sysutils;
// Read definitions.
{$i varutilh.inc}
Implementation
// Code common to all platforms.
{$i cvarutil.inc}
// Code common to non-win32 platforms.
{$i varutils.inc}
end.
{
$Log$
Revision 1.1 2000-08-29 18:20:13 michael
+ new include files
}

214
rtl/objpas/cvarutil.inc Normal file
View File

@ -0,0 +1,214 @@
Resourcestring
SNoWidestrings = 'No widestrings supported';
SNoInterfaces = 'No interfaces supported';
Procedure NoWidestrings;
begin
Raise Exception.Create(SNoWideStrings);
end;
Procedure NoInterfaces;
begin
Raise Exception.Create(SNoInterfaces);
end;
Constructor EVariantError.CreateCode (Code : longint);
begin
ErrCode:=Code;
end;
Procedure VariantTypeMismatch;
begin
Raise EVariantError.CreateCode(VAR_TYPEMISMATCH);
end;
Function ExceptionToVariantError (E : Exception): HResult;
begin
If E is EoutOfMemory then
Result:=VAR_OUTOFMEMORY
else
Result:=VAR_EXCEPTION;
end;
{ ---------------------------------------------------------------------
OS-independent functions not present in Windows
---------------------------------------------------------------------}
Function VariantToSmallInt(Const VargSrc : TVarData) : SmallInt;
begin
With VargSrc do
Case (VType and VarTypeMask) of
VarSmallInt: Result:=VSmallInt;
VarInteger : Result:=VInteger;
VarSingle : Result:=Round(VSingle);
VarDouble : Result:=Round(VDouble);
VarCurrency: Result:=Round(VCurrency);
VarDate : Result:=Round(VDate);
VarOleStr : NoWideStrings;
VarBoolean : Result:=SmallInt(VBoolean);
VarByte : Result:=VByte;
else
VariantTypeMismatch;
end;
end;
Function VariantToLongint(Const VargSrc : TVarData) : Longint;
begin
With VargSrc do
Case (VType and VarTypeMask) of
VarSmallInt: Result:=VSmallInt;
VarInteger : Result:=VInteger;
VarSingle : Result:=Round(VSingle);
VarDouble : Result:=Round(VDouble);
VarCurrency: Result:=Round(VCurrency);
VarDate : Result:=Round(VDate);
VarOleStr : NoWideStrings;
VarBoolean : Result:=Longint(VBoolean);
VarByte : Result:=VByte;
else
VariantTypeMismatch;
end;
end;
Function VariantToSingle(Const VargSrc : TVarData) : Single;
begin
With VargSrc do
Case (VType and VarTypeMask) of
VarSmallInt: Result:=VSmallInt;
VarInteger : Result:=VInteger;
VarSingle : Result:=VSingle;
VarDouble : Result:=VDouble;
VarCurrency: Result:=VCurrency;
VarDate : Result:=VDate;
VarOleStr : NoWideStrings;
VarBoolean : Result:=Longint(VBoolean);
VarByte : Result:=VByte;
else
VariantTypeMismatch;
end;
end;
Function VariantToDouble(Const VargSrc : TVarData) : Double;
begin
With VargSrc do
Case (VType and VarTypeMask) of
VarSmallInt: Result:=VSmallInt;
VarInteger : Result:=VInteger;
VarSingle : Result:=VSingle;
VarDouble : Result:=VDouble;
VarCurrency: Result:=VCurrency;
VarDate : Result:=VDate;
VarOleStr : NoWideStrings;
VarBoolean : Result:=Longint(VBoolean);
VarByte : Result:=VByte;
else
VariantTypeMismatch;
end;
end;
Function VariantToCurrency(Const VargSrc : TVarData) : Currency;
begin
Try
With VargSrc do
Case (VType and VarTypeMask) of
VarSmallInt: Result:=VSmallInt;
VarInteger : Result:=VInteger;
VarSingle : Result:=FloatToCurr(VSingle);
VarDouble : Result:=FloatToCurr(VDouble);
VarCurrency: Result:=VCurrency;
VarDate : Result:=FloatToCurr(VDate);
VarOleStr : NoWideStrings;
VarBoolean : Result:=Longint(VBoolean);
VarByte : Result:=VByte;
else
VariantTypeMismatch;
end;
except
On EConvertError do
VariantTypeMismatch;
else
Raise;
end;
end;
Function VariantToDate(Const VargSrc : TVarData) : TDateTime;
begin
Try
With VargSrc do
Case (VType and VarTypeMask) of
VarSmallInt: Result:=FloatToDateTime(VSmallInt);
VarInteger : Result:=FloatToDateTime(VInteger);
VarSingle : Result:=FloatToDateTime(VSingle);
VarDouble : Result:=FloatToDateTime(VDouble);
VarCurrency: Result:=FloatToDateTime(VCurrency);
VarDate : Result:=VDate;
VarOleStr : NoWideStrings;
VarBoolean : Result:=FloatToDateTime(Longint(VBoolean));
VarByte : Result:=FloatToDateTime(VByte);
else
VariantTypeMismatch;
end;
except
On EConvertError do
VariantTypeMismatch;
else
Raise;
end;
end;
Function VariantToBoolean(Const VargSrc : TVarData) : Boolean;
begin
With VargSrc do
Case (VType and VarTypeMask) of
VarSmallInt: Result:=VSmallInt<>0;
VarInteger : Result:=VInteger<>0;
VarSingle : Result:=VSingle<>0;
VarDouble : Result:=VDouble<>0;
VarCurrency: Result:=VCurrency<>0;
VarDate : Result:=VDate<>0;
VarOleStr : NoWideStrings;
VarBoolean : Result:=VBoolean;
VarByte : Result:=VByte<>0;
else
VariantTypeMismatch;
end;
end;
Function VariantToByte(Const VargSrc : TVarData) : Byte;
begin
Try
With VargSrc do
Case (VType and VarTypeMask) of
VarSmallInt: Result:=VSmallInt;
VarInteger : Result:=VInteger;
VarSingle : Result:=Round(VSingle);
VarDouble : Result:=Round(VDouble);
VarCurrency: Result:=Round(VCurrency);
VarDate : Result:=Round(VDate);
VarOleStr : NoWideStrings;
VarBoolean : Result:=Longint(VBoolean);
VarByte : Result:=VByte;
else
VariantTypeMismatch;
end;
except
On EConvertError do
VariantTypeMismatch;
else
Raise;
end;
end;

141
rtl/objpas/varutilh.inc Normal file
View File

@ -0,0 +1,141 @@
Type
// Types needed to make this work. These should be moved to the system unit.
currency = int64;
HRESULT = Longint;
PSmallInt = ^Smallint;
PLongint = ^Longint;
PSingle = ^Single;
PDouble = ^Double;
PCurrency = ^Currency;
TDateTime = Double;
PDate = ^TDateTime;
PPWideChar = ^PWideChar;
Error = Longint;
PError = ^Error;
PWordBool = ^WordBool;
PByte = ^Byte;
EVarianterror = Class(Exception)
ErrCode : longint;
Constructor CreateCode(Code : Longint);
end;
TVarArrayBound = packed record
ElementCount: Longint;
LowBound: Longint;
end;
TVarArrayBoundArray = Array [0..0] of TVarArrayBound;
PVarArrayBoundArray = ^TVarArrayBoundArray;
TVarArrayCoorArray = Array [0..0] of Longint;
PVarArrayCoorArray = ^TVarArrayCoorArray;
PVarArray = ^TVarArray;
TVarArray = packed record
DimCount: Word;
Flags: Word;
ElementSize: Longint;
LockCount: Integer;
Data: Pointer;
Bounds: TVarArrayBoundArray;
end;
TVarType = Word;
PVarData = ^TVarData;
TVarData = packed record
VType: TVarType;
case Integer of
0: (Reserved1: Word;
case Integer of
0: (Reserved2, Reserved3: Word;
case Integer of
varSmallInt: (VSmallInt: SmallInt);
varInteger: (VInteger: Longint);
varSingle: (VSingle: Single);
varDouble: (VDouble: Double);
varCurrency: (VCurrency: Currency);
varDate: (VDate: Double);
varOleStr: (VOleStr: PWideChar);
varDispatch: (VDispatch: Pointer);
varError: (VError: LongWord);
varBoolean: (VBoolean: WordBool);
varUnknown: (VUnknown: Pointer);
varByte: (VByte: Byte);
varString: (VString: Pointer);
varAny: (VAny: Pointer);
varArray: (VArray: PVarArray);
varByRef: (VPointer: Pointer);
);
1: (VLongs: array[0..2] of LongInt);
);
2: (VWords: array [0..6] of Word);
3: (VBytes: array [0..13] of Byte);
end;
Variant = TVarData;
PVariant = ^Variant;
{ Variant functions }
function VariantChangeTypeEx(var VargDest: TVarData; const VargSrc: TVarData; LCID: Integer; Flags: Word; VarType: Word): HRESULT; stdcall;
function VariantClear(var Varg: TVarData): HRESULT; stdcall;
function VariantCopy(var VargDest: TVarData; const VargSrc: TVarData): HRESULT; stdcall;
function VariantCopyInd(var VargDest: TVarData; const VargSrc: TVarData): HRESULT; stdcall;
function VariantInit(var Varg: TVarData): HRESULT; stdcall;
{ Variant array functions }
function SafeArrayAccessData(psa: PVarArray; var ppvdata: Pointer): HRESULT; stdcall;
function SafeArrayAllocData(psa: PVarArray): HRESULT; stdcall;
function SafeArrayAllocDescriptor(DimCount: Integer; var psa: PVarArray): HRESULT; stdcall;
function SafeArrayCopy(psa: PVarArray; var psaout: PVarArray): HRESULT; stdcall;
function SafeArrayCopyData(psa, psaOut: PVarArray): HRESULT; stdcall;
function SafeArrayCreate(VarType, Dim: Integer; const Bounds: TVarArrayBoundArray): PVarArray; stdcall;
function SafeArrayDestroy(psa: PVarArray): HRESULT; stdcall;
function SafeArrayDestroyData(psa: PVarArray): HRESULT; stdcall;
function SafeArrayDestroyDescriptor(psa: PVarArray): HRESULT; stdcall;
function SafeArrayGetDim(psa: PVarArray): Integer; stdcall;
function SafeArrayGetElemSize(psa: PVarArray): LongWord; stdcall;
function SafeArrayGetElement(psa: PVarArray; Indices: PVarArrayCoorArray; Data: Pointer): HRESULT; stdcall;
function SafeArrayGetLBound(psa: PVarArray; Dim: Integer; var LBound: Integer): HRESULT; stdcall;
function SafeArrayGetUBound(psa: PVarArray; Dim: Integer; var UBound: Integer): HRESULT; stdcall;
function SafeArrayLock(psa: PVarArray): HRESULT; stdcall;
function SafeArrayPtrOfIndex(psa: PVarArray; Indices: PVarArrayCoorArray; var Address: Pointer): HRESULT; stdcall;
function SafeArrayPutElement(psa: PVarArray; Indices: PVarArrayCoorArray; const Data: Pointer): HRESULT; stdcall;
function SafeArrayRedim(psa: PVarArray; const NewBound: TVarArrayBound): HRESULT; stdcall;
function SafeArrayUnaccessData(psa: PVarArray): HRESULT; stdcall;
function SafeArrayUnlock(psa: PVarArray): HRESULT; stdcall;
{ Conversion routines NOT in windows oleaut }
Function VariantToSmallInt(Const VargSrc : TVarData) : SmallInt;
Function VariantToLongint(Const VargSrc : TVarData) : Longint;
Function VariantToSingle(Const VargSrc : TVarData) : Single;
Function VariantToDouble(Const VargSrc : TVarData) : Double;
Function VariantToCurrency(Const VargSrc : TVarData) : Currency;
Function VariantToDate(Const VargSrc : TVarData) : TDateTime;
Function VariantToBoolean(Const VargSrc : TVarData) : Boolean;
Function VariantToByte(Const VargSrc : TVarData) : Byte;
// Names match the ones in Borland varutils unit.
const
VAR_OK = HRESULT($00000000);
VAR_TYPEMISMATCH = HRESULT($80020005);
VAR_BADVARTYPE = HRESULT($80020008);
VAR_EXCEPTION = HRESULT($80020009);
VAR_OVERFLOW = HRESULT($8002000A);
VAR_BADINDEX = HRESULT($8002000B);
VAR_ARRAYISLOCKED = HRESULT($8002000D);
VAR_NOTIMPL = HRESULT($80004001);
VAR_OUTOFMEMORY = HRESULT($8007000E);
VAR_INVALIDARG = HRESULT($80070057);
VAR_UNEXPECTED = HRESULT($8000FFFF);
ARR_NONE = $0000;
ARR_FIXEDSIZE = $0010;
ARR_OLESTR = $0100;
ARR_UNKNOWN = $0200;
ARR_DISPATCH = $0400;
ARR_VARIANT = $0800;

386
rtl/objpas/varutils.pp
View File

@ -1,386 +0,0 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by the Free Pascal development team
Interface and OS-independent part of variant support
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.
**********************************************************************}
{$MODE ObjFPC}
Unit varutils;
Interface
Uses sysutils;
Type
// Types needed to make this work. These should be moved to the system unit.
currency = int64;
HRESULT = Longint;
PSmallInt = ^Smallint;
PLongint = ^Longint;
PSingle = ^Single;
PDouble = ^Double;
PCurrency = ^Currency;
TDateTime = Double;
PDate = ^TDateTime;
PPWideChar = ^PWideChar;
Error = Longint;
PError = ^Error;
PWordBool = ^WordBool;
PByte = ^Byte;
EVarianterror = Class(Exception)
ErrCode : longint;
Constructor CreateCode(Code : Longint);
end;
TVarArrayBound = packed record
ElementCount: Longint;
LowBound: Longint;
end;
TVarArrayBoundArray = Array [0..0] of TVarArrayBound;
PVarArrayBoundArray = ^TVarArrayBoundArray;
TVarArrayCoorArray = Array [0..0] of Longint;
PVarArrayCoorArray = ^TVarArrayCoorArray;
PVarArray = ^TVarArray;
TVarArray = packed record
DimCount: Word;
Flags: Word;
ElementSize: Longint;
LockCount: Integer;
Data: Pointer;
Bounds: TVarArrayBoundArray;
end;
TVarType = Word;
PVarData = ^TVarData;
TVarData = packed record
VType: TVarType;
case Integer of
0: (Reserved1: Word;
case Integer of
0: (Reserved2, Reserved3: Word;
case Integer of
varSmallInt: (VSmallInt: SmallInt);
varInteger: (VInteger: Longint);
varSingle: (VSingle: Single);
varDouble: (VDouble: Double);
varCurrency: (VCurrency: Currency);
varDate: (VDate: Double);
varOleStr: (VOleStr: PWideChar);
varDispatch: (VDispatch: Pointer);
varError: (VError: LongWord);
varBoolean: (VBoolean: WordBool);
varUnknown: (VUnknown: Pointer);
varByte: (VByte: Byte);
varString: (VString: Pointer);
varAny: (VAny: Pointer);
varArray: (VArray: PVarArray);
varByRef: (VPointer: Pointer);
);
1: (VLongs: array[0..2] of LongInt);
);
2: (VWords: array [0..6] of Word);
3: (VBytes: array [0..13] of Byte);
end;
Variant = TVarData;
PVariant = ^Variant;
{ Variant functions }
function VariantChangeTypeEx(var VargDest: TVarData; const VargSrc: TVarData; LCID: Integer; Flags: Word; VarType: Word): HRESULT; stdcall;
function VariantClear(var Varg: TVarData): HRESULT; stdcall;
function VariantCopy(var VargDest: TVarData; const VargSrc: TVarData): HRESULT; stdcall;
function VariantCopyInd(var VargDest: TVarData; const VargSrc: TVarData): HRESULT; stdcall;
function VariantInit(var Varg: TVarData): HRESULT; stdcall;
{ Variant array functions }
function SafeArrayAccessData(psa: PVarArray; var ppvdata: Pointer): HRESULT; stdcall;
function SafeArrayAllocData(psa: PVarArray): HRESULT; stdcall;
function SafeArrayAllocDescriptor(DimCount: Integer; var psa: PVarArray): HRESULT; stdcall;
function SafeArrayCopy(psa: PVarArray; var psaout: PVarArray): HRESULT; stdcall;
function SafeArrayCopyData(psa, psaOut: PVarArray): HRESULT; stdcall;
function SafeArrayCreate(VarType, Dim: Integer; const Bounds: TVarArrayBoundArray): PVarArray; stdcall;
function SafeArrayDestroy(psa: PVarArray): HRESULT; stdcall;
function SafeArrayDestroyData(psa: PVarArray): HRESULT; stdcall;
function SafeArrayDestroyDescriptor(psa: PVarArray): HRESULT; stdcall;
function SafeArrayGetDim(psa: PVarArray): Integer; stdcall;
function SafeArrayGetElemSize(psa: PVarArray): LongWord; stdcall;
function SafeArrayGetElement(psa: PVarArray; Indices: PVarArrayCoorArray; Data: Pointer): HRESULT; stdcall;
function SafeArrayGetLBound(psa: PVarArray; Dim: Integer; var LBound: Integer): HRESULT; stdcall;
function SafeArrayGetUBound(psa: PVarArray; Dim: Integer; var UBound: Integer): HRESULT; stdcall;
function SafeArrayLock(psa: PVarArray): HRESULT; stdcall;
function SafeArrayPtrOfIndex(psa: PVarArray; Indices: PVarArrayCoorArray; var Address: Pointer): HRESULT; stdcall;
function SafeArrayPutElement(psa: PVarArray; Indices: PVarArrayCoorArray; const Data: Pointer): HRESULT; stdcall;
function SafeArrayRedim(psa: PVarArray; const NewBound: TVarArrayBound): HRESULT; stdcall;
function SafeArrayUnaccessData(psa: PVarArray): HRESULT; stdcall;
function SafeArrayUnlock(psa: PVarArray): HRESULT; stdcall;
{ Conversion routines NOT in windows oleaut }
Function VariantToSmallInt(Const VargSrc : TVarData) : SmallInt;
Function VariantToLongint(Const VargSrc : TVarData) : Longint;
Function VariantToSingle(Const VargSrc : TVarData) : Single;
Function VariantToDouble(Const VargSrc : TVarData) : Double;
Function VariantToCurrency(Const VargSrc : TVarData) : Currency;
Function VariantToDate(Const VargSrc : TVarData) : TDateTime;
Function VariantToBoolean(Const VargSrc : TVarData) : Boolean;
Function VariantToByte(Const VargSrc : TVarData) : Byte;
// Names match the ones in Borland varutils unit.
const
VAR_OK = HRESULT($00000000);
VAR_TYPEMISMATCH = HRESULT($80020005);
VAR_BADVARTYPE = HRESULT($80020008);
VAR_EXCEPTION = HRESULT($80020009);
VAR_OVERFLOW = HRESULT($8002000A);
VAR_BADINDEX = HRESULT($8002000B);
VAR_ARRAYISLOCKED = HRESULT($8002000D);
VAR_NOTIMPL = HRESULT($80004001);
VAR_OUTOFMEMORY = HRESULT($8007000E);
VAR_INVALIDARG = HRESULT($80070057);
VAR_UNEXPECTED = HRESULT($8000FFFF);
ARR_NONE = $0000;
ARR_FIXEDSIZE = $0010;
ARR_OLESTR = $0100;
ARR_UNKNOWN = $0200;
ARR_DISPATCH = $0400;
ARR_VARIANT = $0800;
Implementation
Resourcestring
SNoWidestrings = 'No widestrings supported';
SNoInterfaces = 'No interfaces supported';
Procedure NoWidestrings;
begin
Raise Exception.Create(SNoWideStrings);
end;
Procedure NoInterfaces;
begin
Raise Exception.Create(SNoInterfaces);
end;
Constructor EVariantError.CreateCode (Code : longint);
begin
ErrCode:=Code;
end;
Procedure VariantTypeMismatch;
begin
Raise EVariantError.CreateCode(VAR_TYPEMISMATCH);
end;
Function ExceptionToVariantError (E : Exception): HResult;
begin
If E is EoutOfMemory then
Result:=VAR_OUTOFMEMORY
else
Result:=VAR_EXCEPTION;
end;
{$i varutils.inc}
{ ---------------------------------------------------------------------
OS-independent functions not present in Windows
---------------------------------------------------------------------}
Function VariantToSmallInt(Const VargSrc : TVarData) : SmallInt;
begin
With VargSrc do
Case (VType and VarTypeMask) of
VarSmallInt: Result:=VSmallInt;
VarInteger : Result:=VInteger;
VarSingle : Result:=Round(VSingle);
VarDouble : Result:=Round(VDouble);
VarCurrency: Result:=Round(VCurrency);
VarDate : Result:=Round(VDate);
VarOleStr : NoWideStrings;
VarBoolean : Result:=SmallInt(VBoolean);
VarByte : Result:=VByte;
else
VariantTypeMismatch;
end;
end;
Function VariantToLongint(Const VargSrc : TVarData) : Longint;
begin
With VargSrc do
Case (VType and VarTypeMask) of
VarSmallInt: Result:=VSmallInt;
VarInteger : Result:=VInteger;
VarSingle : Result:=Round(VSingle);
VarDouble : Result:=Round(VDouble);
VarCurrency: Result:=Round(VCurrency);
VarDate : Result:=Round(VDate);
VarOleStr : NoWideStrings;
VarBoolean : Result:=Longint(VBoolean);
VarByte : Result:=VByte;
else
VariantTypeMismatch;
end;
end;
Function VariantToSingle(Const VargSrc : TVarData) : Single;
begin
With VargSrc do
Case (VType and VarTypeMask) of
VarSmallInt: Result:=VSmallInt;
VarInteger : Result:=VInteger;
VarSingle : Result:=VSingle;
VarDouble : Result:=VDouble;
VarCurrency: Result:=VCurrency;
VarDate : Result:=VDate;
VarOleStr : NoWideStrings;
VarBoolean : Result:=Longint(VBoolean);
VarByte : Result:=VByte;
else
VariantTypeMismatch;
end;
end;
Function VariantToDouble(Const VargSrc : TVarData) : Double;
begin
With VargSrc do
Case (VType and VarTypeMask) of
VarSmallInt: Result:=VSmallInt;
VarInteger : Result:=VInteger;
VarSingle : Result:=VSingle;
VarDouble : Result:=VDouble;
VarCurrency: Result:=VCurrency;
VarDate : Result:=VDate;
VarOleStr : NoWideStrings;
VarBoolean : Result:=Longint(VBoolean);
VarByte : Result:=VByte;
else
VariantTypeMismatch;
end;
end;
Function VariantToCurrency(Const VargSrc : TVarData) : Currency;
begin
Try
With VargSrc do
Case (VType and VarTypeMask) of
VarSmallInt: Result:=VSmallInt;
VarInteger : Result:=VInteger;
VarSingle : Result:=FloatToCurr(VSingle);
VarDouble : Result:=FloatToCurr(VDouble);
VarCurrency: Result:=VCurrency;
VarDate : Result:=FloatToCurr(VDate);
VarOleStr : NoWideStrings;
VarBoolean : Result:=Longint(VBoolean);
VarByte : Result:=VByte;
else
VariantTypeMismatch;
end;
except
On EConvertError do
VariantTypeMismatch;
else
Raise;
end;
end;
Function VariantToDate(Const VargSrc : TVarData) : TDateTime;
begin
Try
With VargSrc do
Case (VType and VarTypeMask) of
VarSmallInt: Result:=FloatToDateTime(VSmallInt);
VarInteger : Result:=FloatToDateTime(VInteger);
VarSingle : Result:=FloatToDateTime(VSingle);
VarDouble : Result:=FloatToDateTime(VDouble);
VarCurrency: Result:=FloatToDateTime(VCurrency);
VarDate : Result:=VDate;
VarOleStr : NoWideStrings;
VarBoolean : Result:=FloatToDateTime(Longint(VBoolean));
VarByte : Result:=FloatToDateTime(VByte);
else
VariantTypeMismatch;
end;
except
On EConvertError do
VariantTypeMismatch;
else
Raise;
end;
end;
Function VariantToBoolean(Const VargSrc : TVarData) : Boolean;
begin
With VargSrc do
Case (VType and VarTypeMask) of
VarSmallInt: Result:=VSmallInt<>0;
VarInteger : Result:=VInteger<>0;
VarSingle : Result:=VSingle<>0;
VarDouble : Result:=VDouble<>0;
VarCurrency: Result:=VCurrency<>0;
VarDate : Result:=VDate<>0;
VarOleStr : NoWideStrings;
VarBoolean : Result:=VBoolean;
VarByte : Result:=VByte<>0;
else
VariantTypeMismatch;
end;
end;
Function VariantToByte(Const VargSrc : TVarData) : Byte;
begin
Try
With VargSrc do
Case (VType and VarTypeMask) of
VarSmallInt: Result:=VSmallInt;
VarInteger : Result:=VInteger;
VarSingle : Result:=Round(VSingle);
VarDouble : Result:=Round(VDouble);
VarCurrency: Result:=Round(VCurrency);
VarDate : Result:=Round(VDate);
VarOleStr : NoWideStrings;
VarBoolean : Result:=Longint(VBoolean);
VarByte : Result:=VByte;
else
VariantTypeMismatch;
end;
except
On EConvertError do
VariantTypeMismatch;
else
Raise;
end;
end;
end.

135
rtl/win32/Makefile
View File

@ -1,5 +1,5 @@
#
# Makefile generated by fpcmake v1.00 [2000/07/11]
# Makefile generated by fpcmake v0.99.13 [2000/03/28]
#
defaultrule: all
@ -599,19 +599,6 @@ DOCINSTALLDIR=$(BASEINSTALLDIR)/doc
endif
endif
# Where to install the examples, under linux we use the doc dir
# because the copytree command will create a subdir itself
ifndef EXAMPLEINSTALLDIR
ifdef inlinux
EXAMPLEINSTALLDIR=$(DOCINSTALLDIR)/examples
else
EXAMPLEINSTALLDIR=$(BASEINSTALLDIR)/examples
endif
ifdef EXAMPLESUBDIR
EXAMPLEINSTALLDIR:=$(EXAMPLEINSTALLDIR)/$(EXAMPLESUBDIR)
endif
endif
# Where the some extra (data)files will be stored
ifndef DATAINSTALLDIR
DATAINSTALLDIR=$(BASEINSTALLDIR)
@ -647,28 +634,28 @@ ifneq ($(OS_TARGET),$(OS_SOURCE))
override FPCOPT+=-T$(OS_TARGET)
endif
# User dirs should be first, so they are looked at first
ifdef UNITDIR
override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
ifdef UNITSDIR
override FPCOPT+=-Fu$(UNITSDIR)
endif
ifdef LIBDIR
override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
ifdef NEEDINCDIR
override FPCOPT+=$(addprefix -Fi,$(NEEDINCDIR))
endif
ifdef OBJDIR
override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
endif
ifdef INCDIR
override FPCOPT+=$(addprefix -Fi,$(INCDIR))
# Target dirs
ifdef TARGETDIR
override FPCOPT+=-FE$(TARGETDIR)
endif
# Smartlinking
ifdef LINKSMART
override FPCOPT+=-XX
override FPCOPT+=-CX
endif
# Smartlinking creation
# Smartlinking
ifdef CREATESMART
override FPCOPT+=-CX
override FPCOPT+=-XX
endif
# Debug
@ -701,24 +688,22 @@ ifdef VERBOSE
override FPCOPT+=-vwni
endif
ifdef UNITSDIR
override FPCOPT+=-Fu$(UNITSDIR)
endif
ifdef NEEDINCDIR
override FPCOPT+=$(addprefix -Fi,$(NEEDINCDIR))
endif
# Target dirs
ifdef TARGETDIR
override FPCOPT+=-FE$(TARGETDIR)
endif
# Add commandline options last so they can override
# Add commandline options
ifdef OPT
override FPCOPT+=$(OPT)
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
# Add defines from FPCOPTDEF to FPCOPT
ifdef FPCOPTDEF
@ -770,14 +755,10 @@ install: fpc_install
sourceinstall: fpc_sourceinstall
exampleinstall: fpc_exampleinstall
zipinstall: fpc_zipinstall
zipsourceinstall: fpc_zipsourceinstall
zipexampleinstall: fpc_zipexampleinstall
clean: fpc_clean
distclean: fpc_distclean
@ -786,7 +767,7 @@ cleanall: fpc_cleanall
info: fpc_info
.PHONY: all debug smart shared showinstall install sourceinstall exampleinstall zipinstall zipsourceinstall zipexampleinstall clean distclean cleanall info
.PHONY: all debug smart shared showinstall install sourceinstall zipinstall zipsourceinstall clean distclean cleanall info
#####################################################################
# Loaders
@ -834,11 +815,9 @@ fpc_units: $(UNITPPUFILES)
# Resource strings
#####################################################################
ifdef RSTOBJECTS
override RSTFILES=$(addsuffix $(RSTEXT),$(RSTOBJECTS))
override CLEANRSTFILES+=$(RSTFILES)
endif
#####################################################################
# General compile rules
@ -882,12 +861,6 @@ fpc_debug:
.PHONY: fpc_smart fpc_shared
ifdef LIBVERSION
LIBFULLNAME=$(LIBNAME).$(LIBVERSION)
else
LIBFULLNAME=$(LIBNAME)
endif
# Default sharedlib units are all unit objects
ifndef SHAREDLIBUNITOBJECTS
SHAREDLIBUNITOBJECTS:=$(UNITOBJECTS)
@ -901,7 +874,7 @@ ifdef inlinux
ifndef LIBNAME
@$(ECHO) "LIBNAME not set"
else
$(PPUMOVE) $(SHAREDLIBUNITOBJECTS) -o$(LIBFULLNAME)
$(PPUMOVE) $(SHAREDLIBUNITOBJECTS) -o$(LIBNAME)
endif
else
@$(ECHO) "Shared Libraries not supported"
@ -919,7 +892,12 @@ endif
ifdef INSTALLPPUFILES
ifdef PPUFILES
ifdef inlinux
INSTALLPPULINKFILES:=$(shell $(PPUFILES) -S -O $(INSTALLPPUFILES))
INSTALLPPULIBFILES:=$(shell $(PPUFILES) -L $(INSTALLPPUFILES))
else
INSTALLPPULINKFILES:=$(shell $(PPUFILES) $(INSTALLPPUFILES))
endif
else
INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)))
endif
@ -934,11 +912,8 @@ ifdef INSTALLPPUFILES
ifneq ($(INSTALLPPULINKFILES),)
@$(ECHO) -e $(addprefix "\n"$(UNITINSTALLDIR)/,$(INSTALLPPULINKFILES))
endif
ifneq ($(wildcard $(LIBFULLNAME)),)
@$(ECHO) $(LIBINSTALLDIR)/$(LIBFULLNAME)
ifdef inlinux
@$(ECHO) $(LIBINSTALLDIR)/$(LIBNAME)
endif
ifneq ($(INSTALLPPULIBFILES),)
@$(ECHO) -e $(addprefix "\n"$(LIBINSTALLDIR)/,$(INSTALLPPULIBFILES))
endif
endif
ifdef EXTRAINSTALLFILES
@ -961,12 +936,9 @@ ifdef INSTALLPPUFILES
ifneq ($(INSTALLPPULINKFILES),)
$(INSTALL) $(INSTALLPPULINKFILES) $(UNITINSTALLDIR)
endif
ifneq ($(wildcard $(LIBFULLNAME)),)
ifneq ($(INSTALLPPULIBFILES),)
$(MKDIR) $(LIBINSTALLDIR)
$(INSTALL) $(LIBFULLNAME) $(LIBINSTALLDIR)
ifdef inlinux
ln -sf $(LIBFULLNAME) $(LIBINSTALLDIR)/$(LIBNAME)
endif
$(INSTALL) $(INSTALLPPULIBFILES) $(LIBINSTALLDIR)
endif
endif
ifdef EXTRAINSTALLFILES
@ -988,24 +960,6 @@ fpc_sourceinstall: clean
$(MKDIR) $(SOURCEINSTALLDIR)
$(COPYTREE) $(SOURCETOPDIR) $(SOURCEINSTALLDIR)
#####################################################################
# exampleinstall rules
#####################################################################
.PHONY: fpc_exampleinstall
fpc_exampleinstall: $(addsuffix _clean,$(EXAMPLEDIROBJECTS))
ifdef EXAMPLESOURCEFILES
$(MKDIR) $(EXAMPLEINSTALLDIR)
$(COPY) $(EXAMPLESOURCEFILES) $(EXAMPLEINSTALLDIR)
endif
ifdef EXAMPLEDIROBJECTS
ifndef EXAMPLESOURCEFILES
$(MKDIR) $(EXAMPLEINSTALLDIR)
endif
$(COPYTREE) $(addsuffix /*,$(EXAMPLEDIROBJECTS)) $(EXAMPLEINSTALLDIR)
endif
#####################################################################
# Zip
#####################################################################
@ -1067,11 +1021,6 @@ endif
fpc_zipsourceinstall:
$(MAKE) fpc_zipinstall ZIPTARGET=sourceinstall PACKAGESUFFIX=src
.PHONY: fpc_zipexampleinstall
fpc_zipexampleinstall:
$(MAKE) fpc_zipinstall ZIPTARGET=exampleinstall PACKAGESUFFIX=exm
#####################################################################
# Clean rules
#####################################################################
@ -1105,9 +1054,6 @@ ifdef CLEANRSTFILES
endif
ifdef EXTRACLEANFILES
-$(DEL) $(EXTRACLEANFILES)
endif
ifdef LIBNAME
-$(DEL) $(LIBNAME) $(LIBFULLNAME)
endif
-$(DEL) $(FPCMADE) $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
@ -1286,8 +1232,9 @@ typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/math.pp $(REDIR)
varutils$(PPUEXT) : $(OBJPASDIR)/varutils.pp varutils.inc
$(COMPILER) -I. -I$(OBJPASDIR) $(OBJPASDIR)/varutils.pp $(REDIR)
varutils$(PPUEXT) : varutils.pp $(OBJPASDIR)/cvarutil.inc \
$(OBJPASDIR)/varutilh.inc
$(COMPILER) -I$(OBJPASDIR) varutils.pp $(REDIR)
#
# Other system-independent RTL Units

5
rtl/win32/Makefile.fpc
View File

@ -160,8 +160,9 @@ typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/math.pp $(REDIR)
varutils$(PPUEXT) : $(OBJPASDIR)/varutils.pp varutils.inc
$(COMPILER) -I. -I$(OBJPASDIR) $(OBJPASDIR)/varutils.pp $(REDIR)
varutils$(PPUEXT) : varutils.pp $(OBJPASDIR)/cvarutil.inc \
$(OBJPASDIR)/varutilh.inc
$(COMPILER) -I$(OBJPASDIR) varutils.pp $(REDIR)
#
# Other system-independent RTL Units

26
rtl/win32/varutils.inc → rtl/win32/varutils.pp
View File

@ -3,8 +3,8 @@
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by the Free Pascal development team
Windows import statements for variant support.
Interface and OS-dependent part of variant support
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
@ -13,6 +13,21 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{$MODE ObjFPC}
Unit varutils;
Interface
Uses sysutils;
{$i varutilh.inc}
Implementation
{$i cvarutil.inc}
{ ---------------------------------------------------------------------
Windows external definitions.
---------------------------------------------------------------------}
@ -51,9 +66,14 @@ function SafeArrayRedim(psa: PVarArray; const NewBound: TVarArrayBound): HRESULT
function SafeArrayUnaccessData(psa: PVarArray): HRESULT; stdcall;external oleaut;
function SafeArrayUnlock(psa: PVarArray): HRESULT; stdcall;external oleaut;
end.
{
$Log$
Revision 1.2 2000-08-29 17:35:55 michael
Revision 1.1 2000-08-29 18:16:22 michael
+ new include files
Revision 1.2 2000/08/29 17:35:55 michael
+ Compiles on win32 also now
Revision 1.1 2000/08/29 08:23:14 michael