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

* fixed and added a lot of stuff to get the Jedi DX( headers

Browse Source 
compiled
This commit is contained in:
florian 2001-08-19 21:02:01 +00:00
parent b1dadc7f1e
commit 6476fbf2fe
22 changed files with 960 additions and 305 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
rtl/go32v2/exceptn.as
View File

@ -359,7 +359,7 @@ Lkbd_chain:
popl %ds
popl %ebx
popl %eax
ljmp %cs:___djgpp_old_kbd
ljmp *%cs:___djgpp_old_kbd
.balign 16,,7
.global ___djgpp_kbd_hdlr_pc98
@ -411,7 +411,7 @@ ___djgpp_timer_hdlr:
.byte 0x2e /* CS: */
testb $4, ___djgpp_hwint_flags /* IRET or chain? */
jne 2f
ljmp %cs:___djgpp_old_timer
ljmp *%cs:___djgpp_old_timer
2:
pushl %eax
movb $0x20,%al /* EOI the interrupt */
@ -483,3 +483,11 @@ already_forced:
.global ___djgpp_hw_lock_end
___djgpp_hw_lock_end:
ret /* LD does weird things */
/*
$Log$
Revision 1.3 2001-08-19 21:02:01 florian
* fixed and added a lot of stuff to get the Jedi DX( headers
compiled
*/

12
rtl/go32v2/v2prt0.as
View File

@ -326,7 +326,7 @@ no_exception:
movw %cs, %bx
/* Call exit procedure with BX=32-bit CS; SI+DI=32-bit handle; DL=exit status */
.byte 0x2e
ljmp sbrk16_api_ofs
ljmp *(sbrk16_api_ofs)
/*-----------------------------------------------------------------------------*/
@ -400,7 +400,7 @@ brk_common:
movw $0x0900, %ax /* disable interrupts */
int $0x31
movl %eax,___sbrk_interrupt_state
lcall sbrk16_api_ofs
lcall *(sbrk16_api_ofs)
setc %dl /* Save carry */
/* popl %eax restore interrupts
@ -918,7 +918,11 @@ ___PROXY_LEN:
/*
$Log$
Revision 1.1 2000-07-13 06:30:40 michael
Revision 1.2 2001-08-19 21:02:01 florian
* fixed and added a lot of stuff to get the Jedi DX( headers
compiled
Revision 1.1 2000/07/13 06:30:40 michael
+ Initial import
Revision 1.15 2000/07/11 09:37:55 pierre
@ -979,4 +983,4 @@ ___PROXY_LEN:
* go32v1, go32v2 recompiles with the new objects
* remake3 works again with go32v2
- removed some "optimizes" from daniel which were wrong
*/
*/

8
rtl/go32v2/varutils.pp
View File

@ -4,7 +4,7 @@
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.
@ -40,7 +40,11 @@ end.
{
$Log$
Revision 1.1 2000-08-29 18:21:58 michael
Revision 1.2 2001-08-19 21:02:01 florian
* fixed and added a lot of stuff to get the Jedi DX( headers
compiled
Revision 1.1 2000/08/29 18:21:58 michael
+ new include files
Revision 1.1 2000/08/29 18:20:13 michael

16
rtl/inc/dynarr.inc
View File

@ -37,17 +37,19 @@ type
function fpc_dynarray_length(p : pointer) : tdynarrayindex;[Public,Alias:'FPC_DYNARRAY_LENGTH']; {$ifdef hascompilerproc} compilerproc; {$endif}
begin
fpc_dynarray_length := 0;
if assigned(p) then
fpc_dynarray_length:=pdynarray(p-sizeof(tdynarray))^.high+1;
fpc_dynarray_length:=pdynarray(p-sizeof(tdynarray))^.high+1
else
fpc_dynarray_length:=0;
end;
function fpc_dynarray_high(p : pointer) : tdynarrayindex;[Public,Alias:'FPC_DYNARRAY_HIGH']; {$ifdef hascompilerproc} compilerproc; {$endif}
begin
fpc_dynarray_high := -1;
if assigned(p) then
fpc_dynarray_high:=pdynarray(p-sizeof(tdynarray))^.high;
fpc_dynarray_high:=pdynarray(p-sizeof(tdynarray))^.high
else
fpc_dynarray_high:=-1;
end;
{ releases and finalizes the data of a dyn. array and sets p to nil }
@ -228,7 +230,11 @@ function fpc_dynarray_copy(var p : pointer;ti : pointer;
{
$Log$
Revision 1.8 2001-08-01 15:00:10 jonas
Revision 1.9 2001-08-19 21:02:01 florian
* fixed and added a lot of stuff to get the Jedi DX( headers
compiled
Revision 1.8 2001/08/01 15:00:10 jonas
+ "compproc" helpers
* renamed several helpers so that their name is the same as their
"public alias", which should facilitate the conversion of processor

102
rtl/inc/objpash.inc
View File

@ -45,6 +45,8 @@
vmtDefaultHandlerStr = vmtMethodStart+28;
type
TextFile = Text;
{ now the let's declare the base classes for the class object }
{ model }
TObject = class;
@ -157,6 +159,11 @@
end;
IInterface = IUnknown;
{$M+}
IInvokable = interface(IInterface)
end;
{$M-}
{ for native dispinterface support }
IDispatch = interface(IUnknown)
['{00020400-0000-0000-C000-000000000046}']
@ -183,6 +190,7 @@
class function NewInstance : TObject;override;
property RefCount : longint read frefcount;
end;
TInterfacedClass = class of TInterfacedObject;
{ some pointer definitions }
PUnknown = ^IUnknown;
@ -203,61 +211,39 @@
Next : PExceptObject;
end;
Const
ExceptProc : TExceptProc = Nil;
RaiseProc : TExceptProc = Nil;
Function RaiseList : PExceptObject;
Const
ExceptProc : TExceptProc = Nil;
RaiseProc : TExceptProc = Nil;
Function RaiseList : PExceptObject;
{*****************************************************************************
Variant Type
Array of const support
*****************************************************************************}
Const
varEmpty = $0000;
varNull = $0001;
varSmallint = $0002;
varInteger = $0003;
varSingle = $0004;
varDouble = $0005;
varCurrency = $0006;
varDate = $0007;
varOleStr = $0008;
varDispatch = $0009;
varError = $000A;
varBoolean = $000B;
varVariant = $000C;
varUnknown = $000D;
varByte = $0011;
varString = $0100;
varAny = $0101;
varTypeMask = $0FFF;
varArray = $2000;
varByRef = $4000;
const
vtInteger = 0;
vtBoolean = 1;
vtChar = 2;
vtExtended = 3;
vtString = 4;
vtPointer = 5;
vtPChar = 6;
vtObject = 7;
vtClass = 8;
vtWideChar = 9;
vtPWideChar = 10;
vtAnsiString = 11;
vtCurrency = 12;
vtVariant = 13;
vtInterface = 14;
vtWideString = 15;
vtInt64 = 16;
vtQWord = 17;
vtInteger = 0;
vtBoolean = 1;
vtChar = 2;
vtExtended = 3;
vtString = 4;
vtPointer = 5;
vtPChar = 6;
vtObject = 7;
vtClass = 8;
vtWideChar = 9;
vtPWideChar = 10;
vtAnsiString = 11;
vtCurrency = 12;
vtVariant = 13;
vtInterface = 14;
vtWideString = 15;
vtInt64 = 16;
vtQWord = 17;
Type
PVarRec = ^TVarRec;
TVarRec = record
type
PVarRec = ^TVarRec;
TVarRec = record
case VType : Longint of
vtInteger : (VInteger: Longint);
vtBoolean : (VBoolean: Boolean);
@ -268,19 +254,26 @@
vtPChar : (VPChar: PChar);
vtObject : (VObject: TObject);
vtClass : (VClass: TClass);
// vtWideChar : (VWideChar: WideChar);
// vtPWideChar : (VPWideChar: PWideChar);
vtWideChar : (VWideChar: WideChar);
vtPWideChar : (VPWideChar: PWideChar);
vtAnsiString : (VAnsiString: Pointer);
// vtCurrency : (VCurrency: PCurrency);
// vtVariant : (VVariant: PVariant);
// vtCurrency : (VCurrency: PCurrency);
{$ifdef HASVARIANT}
vtVariant : (VVariant: PVariant);
{$endif HASVARIANT}
vtInterface : (VInterface: Pointer);
vtWideString : (VWideString: Pointer);
vtInt64 : (VInt64: PInt64);
vtQWord : (VQWord: PQWord);
end;
{
$Log$
Revision 1.12 2001-08-12 22:11:48 peter
Revision 1.13 2001-08-19 21:02:01 florian
* fixed and added a lot of stuff to get the Jedi DX( headers
compiled
Revision 1.12 2001/08/12 22:11:48 peter
* freeandnil added
Revision 1.11 2001/04/13 23:49:48 peter
@ -315,5 +308,4 @@
Revision 1.2 2000/07/13 11:33:45 michael
+ removed logs
}

13
rtl/inc/system.inc
View File

@ -200,6 +200,13 @@ End;
{$i objpas.inc}
{*****************************************************************************
Variant support
*****************************************************************************}
{$ifdef HASVARIANT}
{$i variant.inc}
{$endif HASVARIANT}
{****************************************************************************
Run-Time Type Information (RTTI)
****************************************************************************}
@ -666,7 +673,11 @@ end;
{
$Log$
Revision 1.21 2001-08-01 15:00:10 jonas
Revision 1.22 2001-08-19 21:02:01 florian
* fixed and added a lot of stuff to get the Jedi DX( headers
compiled
Revision 1.21 2001/08/01 15:00:10 jonas
+ "compproc" helpers
* renamed several helpers so that their name is the same as their
"public alias", which should facilitate the conversion of processor

16
rtl/inc/systemh.inc
View File

@ -165,9 +165,6 @@ Type
{ procedure type }
TProcedure = Procedure;
{ Text file }
TextFile = Text;
const
{ Maximum value of the biggest signed and unsigned integer type available}
MaxSIntValue = High(ValSInt);
@ -535,6 +532,13 @@ const
{$i objpash.inc}
{*****************************************************************************
Variant support
*****************************************************************************}
{$ifdef HASVARIANT}
{$i varianth.inc}
{$endif HASVARIANT}
{*****************************************************************************
Internal helper routines support
@ -546,7 +550,11 @@ const
{
$Log$
Revision 1.34 2001-08-01 18:01:20 peter
Revision 1.35 2001-08-19 21:02:01 florian
* fixed and added a lot of stuff to get the Jedi DX( headers
compiled
Revision 1.34 2001/08/01 18:01:20 peter
* WChar fix to compile also with 1.0.x
Revision 1.33 2001/08/01 15:00:11 jonas

279
rtl/inc/variant.inc Normal file
View File

@ -0,0 +1,279 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 2001 by the Free Pascal development team
This include file contains the implementation for variants
support in FPC as far as it is part of the system unit
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.
**********************************************************************}
procedure variant_init(var v : variant);[Public,Alias:'FPC_VARIANT_INIT'];
begin
variantmanager.varinit(v);
end;
procedure variant_clear(var v : variant);[Public,Alias:'FPC_VARIANT_CLEAR'];
begin
variantmanager.varclear(v);
end;
{ Integer }
operator :=(const source : byte) dest : variant;
begin
end;
operator :=(const source : shortint) dest : variant;
begin
end;
operator :=(const source : word) dest : variant;
begin
end;
operator :=(const source : smallint) dest : variant;
begin
end;
operator :=(const source : dword) dest : variant;
begin
end;
operator :=(const source : longint) dest : variant;
begin
end;
operator :=(const source : qword) dest : variant;
begin
end;
operator :=(const source : int64) dest : variant;
begin
end;
{ Boolean }
operator :=(const source : boolean) dest : variant;
begin
end;
operator :=(const source : wordbool) dest : variant;
begin
end;
operator :=(const source : longbool) dest : variant;
begin
end;
{ Chars }
operator :=(const source : char) dest : variant;
begin
end;
operator :=(const source : widechar) dest : variant;
begin
end;
{ Strings }
operator :=(const source : shortstring) dest : variant;
begin
end;
operator :=(const source : ansistring) dest : variant;
begin
end;
operator :=(const source : widestring) dest : variant;
begin
end;
{ Floats }
operator :=(const source : single) dest : variant;
begin
end;
operator :=(const source : double) dest : variant;
begin
end;
operator :=(const source : extended) dest : variant;
begin
end;
operator :=(const source : comp) dest : variant;
begin
end;
{ Misc. }
{ Fixme!!!
operator :=(const source : currency) dest : variant;
begin
end;
operator :=(const source : tdatetime) dest : variant;
begin
end;
}
{**********************************************************************
from Variant assignments
**********************************************************************}
{ Integer }
operator :=(const source : variant) dest : byte;
begin
dest:=variantmanager.vartoint(source);
end;
operator :=(const source : variant) dest : shortint;
begin
dest:=variantmanager.vartoint(source);
end;
operator :=(const source : variant) dest : word;
var
l : longint;
begin
dest:=variantmanager.vartoint(source);
end;
operator :=(const source : variant) dest : smallint;
var
l : longint;
begin
dest:=variantmanager.vartoint(source);
end;
operator :=(const source : variant) dest : dword;
begin
dest:=variantmanager.vartoint(source);
end;
operator :=(const source : variant) dest : longint;
begin
dest:=variantmanager.vartoint(source);
end;
operator :=(const source : variant) dest : qword;
begin
dest:=variantmanager.vartoword64(source);
end;
operator :=(const source : variant) dest : int64;
begin
dest:=variantmanager.vartoint64(source);
end;
{ Boolean }
operator :=(const source : variant) dest : boolean;
begin
dest:=variantmanager.vartobool(source);
end;
operator :=(const source : variant) dest : wordbool;
begin
dest:=variantmanager.vartobool(source);
end;
operator :=(const source : variant) dest : longbool;
begin
dest:=variantmanager.vartobool(source);
end;
{ Chars }
operator :=(const source : variant) dest : char;
begin
end;
operator :=(const source : variant) dest : widechar;
begin
end;
{ Strings }
operator :=(const source : variant) dest : shortstring;
begin
end;
operator :=(const source : variant) dest : ansistring;
begin
variantmanager.vartolstr(dest,source);
end;
operator :=(const source : variant) dest : widestring;
begin
variantmanager.vartowstr(dest,source);
end;
{ Floats }
operator :=(const source : variant) dest : single;
begin
dest:=variantmanager.vartoreal(source);
end;
operator :=(const source : variant) dest : double;
begin
dest:=variantmanager.vartoreal(source);
end;
operator :=(const source : variant) dest : extended;
begin
dest:=variantmanager.vartoreal(source);
end;
operator :=(const source : variant) dest : comp;
begin
dest:=comp(variantmanager.vartoreal(source));
end;
{ Misc. }
{ FIXME !!!!!!!
operator :=(const source : variant) dest : currency;
begin
dest:=variantmanager.vartocurr(source);
end;
operator :=(const source : variant) dest : tdatetime;
begin
end;
}
procedure invalidvariantop;
begin
Runerror(221);
end;
procedure varclear(var v : tvardata);
begin
if not(v.vtype in [varempty,varerror,varnull]) then
invalidvariantop;
end;
procedure initvariantmanager;
var
i : longint;
begin
for i:=0 to (sizeof(tvariantmanager) div sizeof(pointer))-1 do
ppointer(@variantmanager+i*sizeof(pointer))^:=@invalidvariantop;
pointer(variantmanager.varclear):=@varclear
end;
{
$Log$
Revision 1.1 2001-08-19 21:02:01 florian
* fixed and added a lot of stuff to get the Jedi DX( headers
compiled
}

251
rtl/inc/varianth.inc Normal file
View File

@ -0,0 +1,251 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 2001 by the Free Pascal development team
This include file contains the declarations for variants
support in FPC
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.
**********************************************************************}
const
varempty = 0;
varnull = 1;
varsmallint = 2;
varinteger = 3;
varsingle = 4;
vardouble = 5;
varcurrency = 6;
vardate = 7;
varolestr = 8;
vardispatch = 9;
varerror = 10;
varboolean = 11;
varvariant = 12;
varunknown = 13;
vardecimal = 14;
varshortint = 16;
varbyte = 17;
varword = 18;
varlongword = 19;
varint64 = 20;
varqword = 21;
varstrarg = $48;
varstring = $100;
varany = $101;
vartypemask = $fff;
vararray = $2000;
varbyref = $4000;
varword64 = varqword;
type
tvartype = word;
pvararrayboundarray = ^tvararrayboundarray;
pvararraycoorarray = ^tvararraycoorarray;
pvararraybound = ^tvararraybound;
pvararray = ^tvararray;
tvararraybound = packed record
elementcount,lowbound : longint;
end;
tvararray = packed record
dimcount,flags : word;
elementsize,lockcount : longint;
data : pointer;
bounds : array[0..255] of tvararraybound;
end;
tvararrayboundarray = array[0..0] of tvararraybound;
tvararraycoorarray = array[0..0] of longint;
tvarop = (opadd,opsubtract,opmultiply,opdivide,opintdivide,opmodulus,
opshiftleft,opshiftright,opand,opor,opxor,opcompare,opnegate,
opnot,opcmpeq,opcmpne,opcmplt,opcmple,opcmpgt,opcmpge);
tvardata = packed record
vtype : tvartype;
case integer of
0:(res1 : word;
case integer of
0:
(res2,res3 : word;
case word of
varsmallint : (vsmallint : smallint);
varinteger : (vinteger : longint);
varsingle : (vsingle : single);
vardouble : (vdouble : double);
varcurrency : (vcurrency : currency);
vardate : (vdate : tdatetime);
varolestr : (volestr : pwidechar);
vardispatch : (vdispatch : pointer);
varerror : (verror : dword);
varboolean : (vboolean : wordbool);
varunknown : (vunknown : pointer);
// vardecimal : ( : );
varshortint : (vshortint : shortint);
varbyte : (vbyte : byte);
varword : (vword : word);
varlongword : (vlongword : dword);
varint64 : (vint64 : int64);
varqword : (vqword : qword);
varword64 : (vword64 : qword);
varstring : (vstring : pointer);
varany : (vany : pointer);
vararray : (varray : pvararray);
varbyref : (vpointer : pointer);
);
1:
(vlongs : array[0..2] of longint);
);
1:(vwords : array[0..6] of word);
2:(vbytes : array[0..13] of byte);
end;
pcalldesc = ^tcalldesc;
tcalldesc = packed record
calltype,argcount,namedargcount : byte;
argtypes : array[0..255] of byte;
end;
pdispdesc = ^tdispdesc;
tdispdesc = packed record
dispid : longint;
restype : byte;
calldesc : tcalldesc;
end;
tvariantmanager = record
vartoint : function(const v : variant) : longint;
vartoint64 : function(const v : variant) : int64;
vartoword64 : function(const v : variant) : qword;
vartobool : function(const v : variant) : boolean;
vartoreal : function(const v : variant) : extended;
vartocurr : function(const v : variant) : currency;
vartopstr : procedure(var s;const v : variant);
vartolstr : procedure(var s : ansistring;const v : variant);
vartowstr : procedure(var s : widestring;const v : variant);
vartointf : procedure(var intf : iinterface;const v : variant);
vartodisp : procedure(var disp : idispatch;const v : variant);
vartodynarray : procedure(var dynarr : pointer;const v : variant;
typeinfo : pointer);
varfromint : procedure(var dest : variant;const source : longint);
varfromint64 : procedure(var dest : variant;const source : int64);
varfromword64 : procedure(var dest : variant;const source : qword);
varfromreal : procedure(var dest : variant;const source : extended);
{!!!!!!!}
{ operators }
varop : procedure(var left : variant;const right : variant;opcdoe : tvarop);
cmpop : function(const left,right : variant;const opcode : tvarop) : boolean;
varneg : procedure(var v : variant);
varnot : procedure(var v : variant);
{ misc }
varinit : procedure(var v : variant);
varclear : procedure(var v : variant);
varaddref : procedure(var v : variant);
varcopy : procedure(var dest : variant;const source : variant);
varcast : procedure(var dest : variant;const source : variant;vartype : longint);
end;
pvariantmanager = ^tvariantmanager;
var
variantmanager : tvariantmanager;
{**********************************************************************
to Variant assignments
**********************************************************************}
{ Integer }
operator :=(const source : byte) dest : variant;
operator :=(const source : shortint) dest : variant;
operator :=(const source : word) dest : variant;
operator :=(const source : smallint) dest : variant;
operator :=(const source : dword) dest : variant;
operator :=(const source : longint) dest : variant;
operator :=(const source : qword) dest : variant;
operator :=(const source : int64) dest : variant;
{ Boolean }
operator :=(const source : boolean) dest : variant;
operator :=(const source : wordbool) dest : variant;
operator :=(const source : longbool) dest : variant;
{ Chars }
operator :=(const source : char) dest : variant;
operator :=(const source : widechar) dest : variant;
{ Strings }
operator :=(const source : shortstring) dest : variant;
operator :=(const source : ansistring) dest : variant;
operator :=(const source : widestring) dest : variant;
{ Floats }
operator :=(const source : single) dest : variant;
operator :=(const source : double) dest : variant;
operator :=(const source : extended) dest : variant;
operator :=(const source : comp) dest : variant;
{ Misc. }
{ Fixme!!!!
operator :=(const source : currency) dest : variant;
operator :=(const source : tdatetime) dest : variant;
}
{**********************************************************************
from Variant assignments
**********************************************************************}
{ Integer }
operator :=(const source : variant) dest : byte;
operator :=(const source : variant) dest : shortint;
operator :=(const source : variant) dest : word;
operator :=(const source : variant) dest : smallint;
operator :=(const source : variant) dest : dword;
operator :=(const source : variant) dest : longint;
operator :=(const source : variant) dest : qword;
operator :=(const source : variant) dest : int64;
{ Boolean }
operator :=(const source : variant) dest : boolean;
operator :=(const source : variant) dest : wordbool;
operator :=(const source : variant) dest : longbool;
{ Chars }
operator :=(const source : variant) dest : char;
operator :=(const source : variant) dest : widechar;
{ Strings }
operator :=(const source : variant) dest : shortstring;
operator :=(const source : variant) dest : ansistring;
operator :=(const source : variant) dest : widestring;
{ Floats }
operator :=(const source : variant) dest : single;
operator :=(const source : variant) dest : double;
operator :=(const source : variant) dest : extended;
operator :=(const source : variant) dest : comp;
{ Misc. }
{ Fixme!!!!
operator :=(const source : variant) dest : currency;
operator :=(const source : variant) dest : tdatetime;
}
{
$Log$
Revision 1.1 2001-08-19 21:02:02 florian
* fixed and added a lot of stuff to get the Jedi DX( headers
compiled
}

7
rtl/netware/errno.inc
View File

@ -138,8 +138,11 @@
SYS_ELASTERR = SYS_ENOCONTEXT;
{
$Log$
Revision 1.2 2001-04-11 14:17:00 florian
Revision 1.3 2001-08-19 21:02:02 florian
* fixed and added a lot of stuff to get the Jedi DX( headers
compiled
Revision 1.2 2001/04/11 14:17:00 florian
* added logs, fixed email address of Armin, it is
diehl@nordrhein.de
}

50
rtl/objpas/cvarutil.inc
View File

@ -1,3 +1,20 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 2000,2001 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.
**********************************************************************}
{$ifdef HASVARIANT}
Resourcestring
SNoWidestrings = 'No widestrings supported';
@ -20,9 +37,9 @@ Constructor EVariantError.CreateCode (Code : longint);
begin
ErrCode:=Code;
end;
Procedure VariantTypeMismatch;
begin
Raise EVariantError.CreateCode(VAR_TYPEMISMATCH);
end;
@ -39,7 +56,7 @@ end;
{ ---------------------------------------------------------------------
OS-independent functions not present in Windows
---------------------------------------------------------------------}
Function VariantToSmallInt(Const VargSrc : TVarData) : SmallInt;
begin
@ -119,7 +136,7 @@ end;
Function VariantToCurrency(Const VargSrc : TVarData) : Currency;
begin
Try
Try
With VargSrc do
Case (VType and VarTypeMask) of
VarSmallInt: Result:=VSmallInt;
@ -137,15 +154,15 @@ begin
except
On EConvertError do
VariantTypeMismatch;
else
Raise;
end;
else
Raise;
end;
end;
Function VariantToDate(Const VargSrc : TVarData) : TDateTime;
begin
Try
Try
With VargSrc do
Case (VType and VarTypeMask) of
VarSmallInt: Result:=FloatToDateTime(VSmallInt);
@ -165,7 +182,7 @@ begin
VariantTypeMismatch;
else
Raise;
end;
end;
end;
Function VariantToBoolean(Const VargSrc : TVarData) : Boolean;
@ -190,7 +207,7 @@ end;
Function VariantToByte(Const VargSrc : TVarData) : Byte;
begin
Try
Try
With VargSrc do
Case (VType and VarTypeMask) of
VarSmallInt: Result:=VSmallInt;
@ -208,7 +225,16 @@ begin
except
On EConvertError do
VariantTypeMismatch;
else
else
Raise;
end;
end;
end;
{$endif HASVARIANT}
{
$Log$
Revision 1.2 2001-08-19 21:02:02 florian
* fixed and added a lot of stuff to get the Jedi DX( headers
compiled
}

12
rtl/objpas/objpas.pp
View File

@ -28,8 +28,6 @@ unit objpas;
type
integer = longint;
{ Old compilers search for these variables in objpas unit }
{****************************************************************************
Compatibility routines.
****************************************************************************}
@ -56,7 +54,6 @@ unit objpas;
{ ParamStr should return also an ansistring }
Function ParamStr(Param : Integer) : Ansistring;
Type
TResourceIterator = Function (Name,Value : AnsiString; Hash : Longint) : AnsiString;
@ -345,17 +342,19 @@ begin
ResourceStringTable.Tables[TableIndex]^.ResRec[StringIndex].CurrentValue:=Value;
end;
Initialization
ResetResourceTables;
finalization
end.
{
$Log$
Revision 1.6 2001-08-01 21:43:11 peter
Revision 1.7 2001-08-19 21:02:02 florian
* fixed and added a lot of stuff to get the Jedi DX( headers
compiled
Revision 1.6 2001/08/01 21:43:11 peter
* generate error for closefile
Revision 1.5 2000/12/16 15:58:18 jonas
@ -369,5 +368,4 @@ end.
Revision 1.2 2000/07/13 11:33:51 michael
+ removed logs
}

14
rtl/objpas/stre.inc
View File

@ -32,6 +32,7 @@ Const
SAssertError = '%s (%s, line %d)';
SAssertionFailed = 'Assertion failed';
SDiskFull = 'Disk Full';
SDispatchError = 'No variant method call dispatch';
SDivByZero = 'Division by zero';
SEndOfFile = 'Read past end of file';
SExceptionErrorMessage = 'exception at %p';
@ -54,6 +55,8 @@ Const
SInvalidInteger = '"%s" is an invalid integer';
SInvalidOp = 'Invalid floating point operation';
SInvalidPointer = 'Invalid pointer operation';
SInvalidVarCast = 'Invalid variant type case';
SInvalidVarOp = 'Invalid variant operation';
SOutOfMemory = 'Out of memory';
SOverflow = 'Floating point overflow';
SRangeError = 'Range check error';
@ -61,10 +64,17 @@ Const
SUnKnownRunTimeError = 'Unknown Run-Time error : %3.3d';
SUnderflow = 'Floating point underflow';
SUnknownErrorCode = 'Unknown error code: %d';
SVarArrayBounds = 'Variant array bounds error';
SVarArrayCreate = 'Variant array cannot be created';
SVarNotArray = 'Variant doesn''t contain an array';
{
$Log$
Revision 1.4 2000-08-30 06:50:49 michael
Revision 1.5 2001-08-19 21:02:02 florian
* fixed and added a lot of stuff to get the Jedi DX( headers
compiled
Revision 1.4 2000/08/30 06:50:49 michael
+ Merged changes from fixes
Revision 1.3 2000/08/13 17:55:38 michael
@ -76,6 +86,4 @@ Const
Revision 1.1.2.1 2000/08/22 19:21:48 michael
+ Implemented syserrormessage. Made dummies for go32v2 and OS/2
* Changed linux/errors.pp so it uses pchars for storage.
}

8
rtl/objpas/sysutilh.inc
View File

@ -97,6 +97,8 @@ type
EOutOfMemory = Class(EHeapMemoryError);
EAccessViolation = Class(Exception);
EInvalidCast = Class(Exception);
EVariantError = Class(Exception);
{ String conversion errors }
EConvertError = class(Exception);
@ -147,7 +149,11 @@ Type
{
$Log$
Revision 1.10 2001-08-12 22:11:48 peter
Revision 1.11 2001-08-19 21:02:02 florian
* fixed and added a lot of stuff to get the Jedi DX( headers
compiled
Revision 1.10 2001/08/12 22:11:48 peter
* freeandnil added
Revision 1.9 2001/06/03 15:18:01 peter

16
rtl/objpas/sysutils.inc
View File

@ -192,8 +192,18 @@ begin
211 : E:=EAbstractError.Create(SAbstractError);
215 : E:=EIntOverflow.Create(SIntOverflow);
216 : E:=EAccessViolation.Create(SAccessViolation);
// !!!!! 217 : ;
// !!!!! 218 : ;
219 : E:=EInvalidCast.Create(SInvalidCast);
220 : E:=EVariantError.Create(SInvalidVarCast);
221 : E:=EVariantError.Create(SInvalidVarOp);
222 : E:=EVariantError.Create(SDispatchError);
223 : E:=EVariantError.Create(SVarArrayCreate);
224 : E:=EVariantError.Create(SVarNotArray);
225 : E:=EVariantError.Create(SVarArrayBounds);
227 : E:=EAssertionFailed.Create(SAssertionFailed);
// !!!!! 228 : ;
// !!!!! 229 : ;
else
E:=Exception.CreateFmt (SUnKnownRunTimeError,[Errno]);
end;
@ -318,7 +328,11 @@ end;
{
$Log$
Revision 1.5 2001-08-12 22:11:48 peter
Revision 1.6 2001-08-19 21:02:02 florian
* fixed and added a lot of stuff to get the Jedi DX( headers
compiled
Revision 1.5 2001/08/12 22:11:48 peter
* freeandnil added
Revision 1.4 2001/06/03 15:18:01 peter

74
rtl/objpas/varutilh.inc
View File

@ -1,27 +1,45 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 2000,2001 by the Free Pascal development team
This include file contains the implementation for variants
support in FPC as far as it is part of the system unit
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.
**********************************************************************}
{$ifdef HASVARIANT}
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;
PDouble = ^Double;
PCurrency = ^Currency;
TDateTime = Double;
PDate = ^TDateTime;
PPWideChar = ^PWideChar;
Error = Longint;
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;
@ -40,7 +58,7 @@ Type
Data: Pointer;
Bounds: TVarArrayBoundArray;
end;
TVarType = Word;
PVarData = ^TVarData;
TVarData = packed record
@ -75,7 +93,7 @@ Type
Variant = TVarData;
PVariant = ^Variant;
{ Variant functions }
{ 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;
@ -121,21 +139,31 @@ 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);
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_NONE = $0000;
ARR_FIXEDSIZE = $0010;
ARR_OLESTR = $0100;
ARR_UNKNOWN = $0200;
ARR_UNKNOWN = $0200;
ARR_DISPATCH = $0400;
ARR_VARIANT = $0800;
ARR_VARIANT = $0800;
{$endif HASVARIANT}
{
$Log$
Revision 1.2 2001-08-19 21:02:02 florian
* fixed and added a lot of stuff to get the Jedi DX( headers
compiled
}

13
rtl/objpas/varutils.inc
View File

@ -1,7 +1,7 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by the Free Pascal development team
Copyright (c) 1999-2001 by the Free Pascal development team
Variant routines for non-windows oses.
@ -14,7 +14,7 @@
**********************************************************************}
{$ifdef HASVARIANT}
{ ---------------------------------------------------------------------
Some general stuff: Error handling and so on.
---------------------------------------------------------------------}
@ -685,3 +685,12 @@ begin
else
Result:=psa^.ElementSize;
end;
{$endif HASVARIANT}
{
$Log$
Revision 1.4 2001-08-19 21:02:02 florian
* fixed and added a lot of stuff to get the Jedi DX( headers
compiled
}

267
rtl/win32/Makefile
View File

@ -1,11 +1,11 @@
#
# Don't edit, this file is generated by FPCMake Version 1.1 [2001/08/02]
# Don't edit, this file is generated by fpcmake v1.99.0 [2001/08/14]
#
default: all
override PATH:=$(subst \,/,$(PATH))
ifeq ($(findstring ;,$(PATH)),)
inUnix=1
SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
SEARCHPATH:=$(subst :, ,$(PATH))
else
SEARCHPATH:=$(subst ;, ,$(PATH))
endif
@ -34,7 +34,7 @@ inOS2=1
endif
endif
else
ifneq ($(findstring cygwin,$(MACHTYPE)),)
ifneq ($(findstring cygwin,$(MACH_TYPE)),)
inCygWin=1
endif
endif
@ -54,13 +54,6 @@ 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
@ -69,17 +62,8 @@ ifndef FPC
ifdef PP
FPC=$(PP)
else
ifdef inUnix
CPU_SOURCE=$(shell uname -m)
ifeq (m68k,$(CPU_SOURCE))
FPC=ppc68k
else
FPC=ppc386
endif
else
FPC=ppc386
endif
endif
endif
override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
@ -154,7 +138,7 @@ OBJPASDIR=$(RTL)/objpas
GRAPHDIR=$(INC)/graph
include $(WININC)/makefile.inc
WINDOWS_SOURCE_FILES=$(addprefix $(WININC)/,$(addsuffix .inc,$(WINDOWS_FILES)))
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings windows ole2 opengl32 os_types winsock initc dos crt objects graph sysutils typinfo math varutils cpu mmx getopts heaptrc lineinfo wincrt winmouse winevent sockets printer dynlibs video mouse keyboard
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings windows ole2 activex opengl32 os_types winsock initc dos crt objects graph sysutils typinfo math varutils cpu mmx getopts heaptrc lineinfo wincrt winmouse winevent sockets printer dynlibs video mouse keyboard
override TARGET_LOADERS+=wprt0 wdllprt0
override TARGET_RSTS+=math varutils typinfo
override INSTALL_FPCPACKAGE=y
@ -166,7 +150,7 @@ ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
ifeq ($(ECHO),)
ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
ifeq ($(ECHO),)
ECHO=
ECHO:=echo
else
ECHO:=$(firstword $(ECHO))
endif
@ -174,134 +158,43 @@ 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
COPY:=cp -fp
endif
ifndef COPYTREE
COPYTREE:=$(CPPROG) -rfp
COPYTREE:=cp -rfp
endif
ifndef MOVE
MOVE:=$(MVPROG) -f
MOVE:=mv -f
endif
ifndef DEL
DEL:=$(RMPROG) -f
DEL:=rm -f
endif
ifndef DELTREE
DELTREE:=$(RMPROG) -rf
DELTREE:=rm -rf
endif
ifndef INSTALL
ifdef inUnix
INSTALL:=$(GINSTALL) -c -m 644
INSTALL:=install -c -m 644
else
INSTALL:=$(COPY)
endif
endif
ifndef INSTALLEXE
ifdef inUnix
INSTALLEXE:=$(GINSTALL) -c -m 755
INSTALLEXE:=install -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=
ifdef inUnix
MKDIR:=install -m 755 -d
else
PPUMOVE:=$(firstword $(PPUMOVE))
MKDIR:=ginstall -m 755 -d
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
export ECHO COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
ifndef AS
AS=as
endif
@ -317,6 +210,38 @@ LDCONFIG=ldconfig
else
LDCONFIG=
endif
ifndef PPUMOVE
PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
ifeq ($(PPUMOVE),)
PPUMOVE=
else
PPUMOVE:=$(firstword $(PPUMOVE))
endif
endif
export PPUMOVE
ifndef PPUFILES
PPUFILES:=$(strip $(wildcard $(addsuffix /ppufiles$(SRCEXEEXT),$(SEARCHPATH))))
ifeq ($(PPUFILES),)
PPUFILES=
else
PPUFILES:=$(firstword $(PPUFILES))
endif
endif
export PPUFILES
ifndef DATE
DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
ifeq ($(DATE),)
DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
ifeq ($(DATE),)
DATE=
else
DATE:=$(firstword $(DATE))
endif
else
DATE:=$(firstword $(DATE))
endif
endif
export DATE
ifdef DATE
DATESTR:=$(shell $(DATE) +%Y%m%d)
else
@ -341,8 +266,26 @@ UPXPROG=
endif
endif
export UPXPROG
ifndef ZIPPROG
ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
ifeq ($(ZIPPROG),)
ZIPPROG=
else
ZIPPROG:=$(firstword $(ZIPPROG))
endif
endif
export ZIPPROG
ZIPOPT=-9
ZIPEXT=.zip
ifndef TARPROG
TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
ifeq ($(TARPROG),)
TARPROG=
else
TARPROG:=$(firstword $(TARPROG))
endif
endif
export TARPROG
ifeq ($(USETAR),bz2)
TAROPT=vI
TAREXT=.tar.bz2
@ -359,7 +302,7 @@ ASMEXT=.s
SMARTEXT=.sl
STATICLIBEXT=.a
SHAREDLIBEXT=.so
STATICLIBPREFIX=libp
LIBPREFIX=lib
RSTEXT=.rst
FPCMADE=fpcmade
ifeq ($(OS_TARGET),go32v1)
@ -369,12 +312,12 @@ ASMEXT=.s1
SMARTEXT=.sl1
STATICLIBEXT=.a1
SHAREDLIBEXT=.so1
STATICLIBPREFIX=
LIBPREFIX=
FPCMADE=fpcmade.v1
PACKAGESUFFIX=v1
endif
ifeq ($(OS_TARGET),go32v2)
STATICLIBPREFIX=
LIBPREFIX=
FPCMADE=fpcmade.dos
ZIPSUFFIX=go32
endif
@ -411,25 +354,6 @@ SHAREDLIBEXT=.dll
FPCMADE=fpcmade.os2
ZIPSUFFIX=emx
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
ifdef REQUIRE_UNITSDIR
override UNITSDIR+=$(REQUIRE_UNITSDIR)
endif
@ -491,11 +415,9 @@ endif
ifndef INSTALL_UNITDIR
INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(OS_TARGET)
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
@ -635,6 +557,9 @@ endif
ifdef CFGFILE
override FPCOPT+=@$(CFGFILE)
endif
ifeq ($(OS_SOURCE),win32)
USEENV=1
endif
ifdef USEENV
override FPCEXTCMD:=$(FPCOPT)
override FPCOPT:=!FPCEXTCMD
@ -677,7 +602,7 @@ override CLEANRSTFILES+=$(RSTFILES)
endif
.PHONY: fpc_packages fpc_all fpc_smart fpc_debug
$(FPCMADE): $(ALLTARGET)
@$(ECHOREDIR) Compiled > $(FPCMADE)
@$(ECHO) Compiled > $(FPCMADE)
fpc_packages: $(COMPILEPACKAGES)
fpc_all: fpc_packages $(FPCMADE)
fpc_smart:
@ -705,10 +630,14 @@ ifdef INSTALL_UNITS
override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
endif
ifdef INSTALLPPUFILES
override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
ifdef PPUFILES
override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPUFILES))
override INSTALLPPULINKFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(shell $(PPUFILES) -S -O $(INSTALLPPUFILES)))
else
override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(LIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPUFILES))
override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPULINKFILES)))
override INSTALL_CREATEPACKAGEFPC=1
endif
endif
ifdef INSTALLEXEFILES
override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(INSTALLEXEFILES))
@ -721,17 +650,6 @@ ifdef UPXPROG
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)
@ -771,9 +689,13 @@ 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)))
ifdef PPUFILES
CLEANPPULINKFILES:=$(shell $(PPUFILES) $(CLEANPPUFILES))
else
CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(LIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))))
endif
override CLEANPPULINKFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES))
endif
fpc_clean: $(CLEANTARGET)
ifdef CLEANEXEFILES
@ -794,7 +716,7 @@ endif
ifdef LIB_NAME
-$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
endif
-$(DEL) $(FPCMADE) Package.fpc $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
-$(DEL) $(FPCMADE) $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
fpc_distclean: clean
ifdef COMPILER_UNITTARGETDIR
TARGETDIRCLEAN=fpc_clean
@ -838,14 +760,10 @@ fpc_info:
@$(ECHO) == Tools info ==
@$(ECHO)
@$(ECHO) Pwd....... $(PWD)
@$(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) PPUFiles.. $(PPUFILES)
@$(ECHO) Date...... $(DATE)
@$(ECHO) Upx....... $(UPXPROG)
@$(ECHO) Zip....... $(ZIPPROG)
@$(ECHO)
@ -885,9 +803,9 @@ fpc_info:
@$(ECHO)
all: fpc_all
debug: fpc_debug
examples: fpc_examples
smart: fpc_smart
examples:
shared:
shared: fpc_shared
install: fpc_install
sourceinstall: fpc_sourceinstall
exampleinstall: fpc_exampleinstall
@ -900,7 +818,7 @@ clean: fpc_clean
distclean: fpc_distclean
cleanall: fpc_cleanall
info: fpc_info
.PHONY: all debug smart examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info
.PHONY: all debug examples smart shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info
ifneq ($(wildcard fpcmake.loc),)
include fpcmake.loc
endif
@ -925,6 +843,7 @@ strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
windows$(PPUEXT) : windows.pp $(WINDOWS_SOURCE_FILES) $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) -I$(WININC) windows.pp
ole2$(PPUEXT) : ole2.pp windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
activex$(PPUEXT) : activex.pp windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
opengl32$(PPUEXT) : opengl32.pp windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
os_types$(PPUEXT) : $(INC)/os_types.pp
winsock$(PPUEXT) : winsock.pp windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) os_types$(PPUEXT)
@ -950,7 +869,7 @@ typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/math.pp
varutils$(PPUEXT) : varutils.pp $(OBJPASDIR)/cvarutil.inc \
$(OBJPASDIR)/varutilh.inc
objpas$(PPUEXT) $(OBJPASDIR)/varutilh.inc
$(COMPILER) -I$(OBJPASDIR) varutils.pp
cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)

6
rtl/win32/Makefile.fpc
View File

@ -8,7 +8,7 @@ main=rtl
[target]
loaders=wprt0 wdllprt0
units=$(SYSTEMUNIT) objpas strings \
windows ole2 opengl32 os_types winsock initc \
windows ole2 activex opengl32 os_types winsock initc \
dos crt objects graph \
sysutils typinfo math varutils \
cpu mmx getopts heaptrc lineinfo \
@ -120,6 +120,8 @@ windows$(PPUEXT) : windows.pp $(WINDOWS_SOURCE_FILES) $(SYSTEMUNIT)$(PPUEXT)
ole2$(PPUEXT) : ole2.pp windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
activex$(PPUEXT) : activex.pp windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
opengl32$(PPUEXT) : opengl32.pp windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
os_types$(PPUEXT) : $(INC)/os_types.pp
@ -174,7 +176,7 @@ math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/math.pp
varutils$(PPUEXT) : varutils.pp $(OBJPASDIR)/cvarutil.inc \
$(OBJPASDIR)/varutilh.inc
objpas$(PPUEXT) $(OBJPASDIR)/varutilh.inc
$(COMPILER) -I$(OBJPASDIR) varutils.pp
#

67
rtl/win32/activex.pp Normal file
View File

@ -0,0 +1,67 @@
{$MODE OBJFPC}
unit activex;
interface
{$ifdef HASINTERFACES}
uses
windows;
type
polestr = PWideChar;
largeint = int64;
tagSTATSTG = record
pwcsName : POleStr;
dwType : DWord;
cbSize : Largeint;
mtime : TFileTime;
ctime : TFileTime;
atime : TFileTime;
grfMode : DWord;
grfLocksSupported : DWord;
clsid : TCLSID;
grfStateBits : DWord;
reserved : DWord;
end;
TStatStg = tagSTATSTG;
PStatStg = ^TStatStg;
STATSTG = TStatStg;
ISequentialStream = interface(IUnknown)
['{0c733a30-2a1c-11ce-ade5-00aa0044773d}']
function Read(pv : Pointer;cb : DWord;pcbRead : PDWord) : HRESULT;stdcall;
function Write(pv : Pointer;cb : DWord;pcbWritten : PDWord): HRESULT;stdcall;
end;
IStream = interface(ISequentialStream)
['{0000000C-0000-0000-C000-000000000046}']
function Seek(dlibMove : Largeint; dwOrigin: Longint;
out libNewPosition : Largeint): HResult; stdcall;
function SetSize(libNewSize : Largeint) : HRESULT;stdcall;
function CopyTo(stm: IStream;cb : Largeint;out cbRead : Largeint;
out cbWritten: Largeint) : HRESULT;stdcall;
function Commit(grfCommitFlags : Longint) : HRESULT; stdcall;
function Revert : HRESULT; stdcall;
function LockRegion(libOffset : Largeint;cb : Largeint;
dwLockType: Longint) : HRESULT;stdcall;
function UnlockRegion(libOffset: Largeint;cb: Largeint;
dwLockType: Longint) : HRESULT;stdcall;
function Stat(out statstg : TStatStg; grfStatFlag: Longint): HRESULT;stdcall;
function Clone(out stm : IStream) : HRESULT; stdcall;
end;
{$endif HASINTERFACES}
implementation
end.
{
$Log$
Revision 1.1 2001-08-19 21:02:02 florian
* fixed and added a lot of stuff to get the Jedi DX( headers
compiled
}

9
rtl/win32/system.pp
View File

@ -1562,11 +1562,18 @@ begin
InOutRes:=0;
{ Reset internal error variable }
errno:=0;
{$ifdef HASVARIANT}
initvariantmanager;
{$endif HASVARIANT}
end.
{
$Log$
Revision 1.16 2001-07-30 20:53:50 peter
Revision 1.17 2001-08-19 21:02:02 florian
* fixed and added a lot of stuff to get the Jedi DX( headers
compiled
Revision 1.16 2001/07/30 20:53:50 peter
* fixed getdir() that was broken when a directory on a different drive
was asked

13
rtl/win32/varutils.pp
View File

@ -4,7 +4,7 @@
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.
@ -32,10 +32,11 @@ Implementation
Windows external definitions.
---------------------------------------------------------------------}
{$ifdef HASVARIANT}
const
oleaut = 'oleaut32.dll';
{ Variant functions }
{ Variant functions }
function VariantChangeTypeEx(var VargDest: TVarData; const VargSrc: TVarData; LCID: Integer; Flags: Word; VarType: Word): HRESULT; stdcall;external oleaut;
function VariantClear(var Varg: TVarData): HRESULT; stdcall;external oleaut;
@ -65,12 +66,17 @@ function SafeArrayPutElement(psa: PVarArray; Indices: PVarArrayCoorArray; const
function SafeArrayRedim(psa: PVarArray; const NewBound: TVarArrayBound): HRESULT; stdcall;external oleaut;
function SafeArrayUnaccessData(psa: PVarArray): HRESULT; stdcall;external oleaut;
function SafeArrayUnlock(psa: PVarArray): HRESULT; stdcall;external oleaut;
{$endif HASVARIANT}
end.
{
$Log$
Revision 1.1 2000-08-29 18:16:22 michael
Revision 1.2 2001-08-19 21:02:02 florian
* fixed and added a lot of stuff to get the Jedi DX( headers
compiled
Revision 1.1 2000/08/29 18:16:22 michael
+ new include files
Revision 1.2 2000/08/29 17:35:55 michael
@ -78,5 +84,4 @@ end.
Revision 1.1 2000/08/29 08:23:14 michael
+ Initial implementation of varutils
}