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

compiled

rtl/go32v2/exceptn.as

@@ -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
+
+*/

rtl/go32v2/v2prt0.as

@@ -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
-*/
+*/

rtl/go32v2/varutils.pp

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

rtl/inc/dynarr.inc

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

rtl/inc/objpash.inc

@@ -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
+    Const
-          ExceptProc : TExceptProc = Nil;
+       ExceptProc : TExceptProc = Nil;
-          RaiseProc : TExceptProc = Nil;
+       RaiseProc : TExceptProc = Nil;
-
-       Function RaiseList : PExceptObject;
 
+    Function RaiseList : PExceptObject;
 
 {*****************************************************************************
-                              Variant Type
+                              Array of const support
 *****************************************************************************}
 
-    Const
+   const
-       varEmpty     = $0000;
+      vtInteger    = 0;
-       varNull      = $0001;
+      vtBoolean    = 1;
-       varSmallint  = $0002;
+      vtChar       = 2;
-       varInteger   = $0003;
+      vtExtended   = 3;
-       varSingle    = $0004;
+      vtString     = 4;
-       varDouble    = $0005;
+      vtPointer    = 5;
-       varCurrency  = $0006;
+      vtPChar      = 6;
-       varDate      = $0007;
+      vtObject     = 7;
-       varOleStr    = $0008;
+      vtClass      = 8;
-       varDispatch  = $0009;
+      vtWideChar   = 9;
-       varError     = $000A;
+      vtPWideChar  = 10;
-       varBoolean   = $000B;
+      vtAnsiString = 11;
-       varVariant   = $000C;
+      vtCurrency   = 12;
-       varUnknown   = $000D;
+      vtVariant    = 13;
-       varByte      = $0011;
+      vtInterface  = 14;
-       varString    = $0100;
+      vtWideString = 15;
-       varAny       = $0101;
+      vtInt64      = 16;
-       varTypeMask  = $0FFF;
+      vtQWord      = 17;
-       varArray     = $2000;
-       varByRef     = $4000;
 
-       vtInteger    = 0;
+   type
-       vtBoolean    = 1;
+      PVarRec = ^TVarRec;
-       vtChar       = 2;
+      TVarRec = record
-       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
          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);
+           vtWideChar   : (VWideChar: WideChar);
-//           vtPWideChar  : (VPWideChar: PWideChar);
+           vtPWideChar  : (VPWideChar: PWideChar);
            vtAnsiString : (VAnsiString: Pointer);
-//           vtCurrency   : (VCurrency: PCurrency);
+   //           vtCurrency   : (VCurrency: PCurrency);
-//           vtVariant    : (VVariant: PVariant);
+{$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
-
 }

rtl/inc/system.inc

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

rtl/inc/systemh.inc

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

rtl/inc/variant.inc

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

rtl/inc/varianth.inc

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

rtl/netware/errno.inc

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

rtl/objpas/cvarutil.inc

@@ -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  
+    else
-      Raise;  
+      Raise;
-  end;   
+  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
+
+}

rtl/objpas/objpas.pp

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

rtl/objpas/stre.inc

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

rtl/objpas/sysutilh.inc

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

rtl/objpas/sysutils.inc

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

rtl/objpas/varutilh.inc

@@ -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;    
+  PPWideChar          = ^PWideChar;
-  Error               = Longint;  
+  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_OK            = HRESULT($00000000);
-  VAR_TYPEMISMATCH  = HRESULT($80020005); 
+  VAR_TYPEMISMATCH  = HRESULT($80020005);
-  VAR_BADVARTYPE    = HRESULT($80020008); 
+  VAR_BADVARTYPE    = HRESULT($80020008);
-  VAR_EXCEPTION     = HRESULT($80020009); 
+  VAR_EXCEPTION     = HRESULT($80020009);
-  VAR_OVERFLOW      = HRESULT($8002000A); 
+  VAR_OVERFLOW      = HRESULT($8002000A);
-  VAR_BADINDEX      = HRESULT($8002000B); 
+  VAR_BADINDEX      = HRESULT($8002000B);
-  VAR_ARRAYISLOCKED = HRESULT($8002000D); 
+  VAR_ARRAYISLOCKED = HRESULT($8002000D);
-  VAR_NOTIMPL       = HRESULT($80004001); 
+  VAR_NOTIMPL       = HRESULT($80004001);
-  VAR_OUTOFMEMORY   = HRESULT($8007000E); 
+  VAR_OUTOFMEMORY   = HRESULT($8007000E);
-  VAR_INVALIDARG    = HRESULT($80070057); 
+  VAR_INVALIDARG    = HRESULT($80070057);
-  VAR_UNEXPECTED    = HRESULT($8000FFFF); 
+  VAR_UNEXPECTED    = HRESULT($8000FFFF);
 
-  ARR_NONE          = $0000;  
+  ARR_NONE          = $0000;
-  ARR_FIXEDSIZE     = $0010;  
+  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
+
+}

rtl/objpas/varutils.inc

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

rtl/win32/Makefile

@@ -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
+ifdef inUnix
-endif
+MKDIR:=install -m 755 -d
-export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
-ifndef PPUMOVE
-PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(PPUMOVE),)
-PPUMOVE=
 else
-PPUMOVE:=$(firstword $(PPUMOVE))
+MKDIR:=ginstall -m 755 -d
 endif
 endif
-export PPUMOVE
+export ECHO COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
-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
 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: fpc_shared
-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)

rtl/win32/Makefile.fpc

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

rtl/win32/activex.pp

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

rtl/win32/system.pp

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

rtl/win32/varutils.pp

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