Browse Source

* changed ver1_0 defines to temporary defs

peter 25 years ago
parent
commit
94c1f86d79
6 changed files with 99 additions and 78 deletions
  1. 7 4
      rtl/inc/astrings.inc
  2. 58 53
      rtl/inc/objpas.inc
  3. 9 6
      rtl/inc/objpash.inc
  4. 8 4
      rtl/inc/sstrings.inc
  5. 10 7
      rtl/inc/systemh.inc
  6. 7 4
      rtl/inc/wstrings.inc

+ 7 - 4
rtl/inc/astrings.inc

@@ -344,11 +344,11 @@ begin
     HandleErrorFrame(201,get_frame);
     HandleErrorFrame(201,get_frame);
 end;
 end;
 
 
-{$ifdef ver1_0}
+{$ifndef INTERNSETLENGTH}
 Procedure SetLength (Var S : AnsiString; l : Longint);
 Procedure SetLength (Var S : AnsiString; l : Longint);
-{$else ver1_0}
+{$else INTERNSETLENGTH}
 Procedure AnsiStr_SetLength (Var S : AnsiString; l : Longint);[Public,Alias : 'FPC_ANSISTR_SETLENGTH'];
 Procedure AnsiStr_SetLength (Var S : AnsiString; l : Longint);[Public,Alias : 'FPC_ANSISTR_SETLENGTH'];
-{$endif ver1_0}
+{$endif INTERNSETLENGTH}
 {
 {
   Sets The length of string S to L.
   Sets The length of string S to L.
   Makes sure S is unique, and contains enough room.
   Makes sure S is unique, and contains enough room.
@@ -668,7 +668,10 @@ end;
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.6  2000-10-21 18:20:17  florian
+  Revision 1.7  2000-11-06 20:34:24  peter
+    * changed ver1_0 defines to temporary defs
+
+  Revision 1.6  2000/10/21 18:20:17  florian
     * a lot of small changes:
     * a lot of small changes:
        - setlength is internal
        - setlength is internal
        - win32 graph unit extended
        - win32 graph unit extended

+ 58 - 53
rtl/inc/objpas.inc

@@ -32,7 +32,7 @@
            handleerror(219);
            handleerror(219);
       end;
       end;
 
 
-{$ifdef ver1_0}
+{$ifndef HASINTF}
     { dummies for make cycle with 1.0.x }
     { dummies for make cycle with 1.0.x }
     procedure int_do_intf_decr_ref(var i: pointer);[public,alias: 'FPC_INTF_DECR_REF'];
     procedure int_do_intf_decr_ref(var i: pointer);[public,alias: 'FPC_INTF_DECR_REF'];
       begin
       begin
@@ -50,7 +50,7 @@
       begin
       begin
       end;
       end;
 
 
-{$else ver1_0}
+{$else HASINTF}
     { interface helpers }
     { interface helpers }
     procedure int_do_intf_decr_ref(var i: pointer);[public,alias: 'FPC_INTF_DECR_REF'];
     procedure int_do_intf_decr_ref(var i: pointer);[public,alias: 'FPC_INTF_DECR_REF'];
       begin
       begin
@@ -67,8 +67,10 @@
 
 
     procedure int_do_intf_assign(var D: pointer; const S: pointer);[public,alias: 'FPC_INTF_ASSIGN'];
     procedure int_do_intf_assign(var D: pointer; const S: pointer);[public,alias: 'FPC_INTF_ASSIGN'];
       begin
       begin
-         if assigned(S) then IUnknown(S)._AddRef;
-         if assigned(D) then IUnknown(D)._Release;
+         if assigned(S) then
+           IUnknown(S)._AddRef;
+         if assigned(D) then
+           IUnknown(D)._Release;
          D:=S;
          D:=S;
       end;
       end;
 
 
@@ -88,7 +90,7 @@
         else
         else
           int_do_intf_decr_ref(D);
           int_do_intf_decr_ref(D);
       end;
       end;
-{$endif ver1_0}
+{$endif HASINTF}
 
 
 {****************************************************************************
 {****************************************************************************
                                TOBJECT
                                TOBJECT
@@ -187,13 +189,13 @@
       class function TObject.MethodAddress(const name : shortstring) : pointer;
       class function TObject.MethodAddress(const name : shortstring) : pointer;
 
 
         var
         var
-	   UName : ShortString;
+           UName : ShortString;
            methodtable : pmethodnametable;
            methodtable : pmethodnametable;
            i : dword;
            i : dword;
            c : tclass;
            c : tclass;
 
 
         begin
         begin
-	   UName := UpCase(name);
+           UName := UpCase(name);
            c:=self;
            c:=self;
            while assigned(c) do
            while assigned(c) do
              begin
              begin
@@ -243,53 +245,53 @@
 
 
       function TObject.FieldAddress(const name : shortstring) : pointer;
       function TObject.FieldAddress(const name : shortstring) : pointer;
 
 
-	type
-	   PFieldInfo = ^TFieldInfo;
-	   TFieldInfo = packed record
-	     FieldOffset: LongWord;
-	     ClassTypeIndex: Word;
-	     Name: ShortString;
-	   end;
-
-	   PFieldTable = ^TFieldTable;
-	   TFieldTable = packed record
-	     FieldCount: Word;
-	     ClassTable: Pointer;
-	     { Fields: array[Word] of TFieldInfo;  Elements have variant size! }
-	   end;
+        type
+           PFieldInfo = ^TFieldInfo;
+           TFieldInfo = packed record
+             FieldOffset: LongWord;
+             ClassTypeIndex: Word;
+             Name: ShortString;
+           end;
+
+           PFieldTable = ^TFieldTable;
+           TFieldTable = packed record
+             FieldCount: Word;
+             ClassTable: Pointer;
+             { Fields: array[Word] of TFieldInfo;  Elements have variant size! }
+           end;
 
 
         var
         var
-	   UName: ShortString;
-	   CurClassType: TClass;
-	   FieldTable: PFieldTable;
-	   FieldInfo: PFieldInfo;
-	   i: Integer;
+           UName: ShortString;
+           CurClassType: TClass;
+           FieldTable: PFieldTable;
+           FieldInfo: PFieldInfo;
+           i: Integer;
 
 
         begin
         begin
-	   if Length(name) > 0 then
-	   begin
-	     UName := UpCase(name);
-	     CurClassType := ClassType;
-	     while CurClassType <> nil do
-	     begin
-	       FieldTable := PFieldTable((Pointer(CurClassType) + vmtFieldTable)^);
-	       if FieldTable <> nil then
-	       begin
-	         FieldInfo := PFieldInfo(Pointer(FieldTable) + 6);
-	         for i := 0 to FieldTable^.FieldCount - 1 do
-	         begin
-	           if UpCase(FieldInfo^.Name) = UName then
-		   begin
-		     fieldaddress := Pointer(Self) + FieldInfo^.FieldOffset;
-	             exit;
-		   end;
-		   Inc(Pointer(FieldInfo), 7 + Length(FieldInfo^.Name));
-	         end;
-	       end;
-	       { Try again with the parent class type }
-	       CurClassType := CurClassType.ClassParent;
-	     end;
-	   end;
+           if Length(name) > 0 then
+           begin
+             UName := UpCase(name);
+             CurClassType := ClassType;
+             while CurClassType <> nil do
+             begin
+               FieldTable := PFieldTable((Pointer(CurClassType) + vmtFieldTable)^);
+               if FieldTable <> nil then
+               begin
+                 FieldInfo := PFieldInfo(Pointer(FieldTable) + 6);
+                 for i := 0 to FieldTable^.FieldCount - 1 do
+                 begin
+                   if UpCase(FieldInfo^.Name) = UName then
+                   begin
+                     fieldaddress := Pointer(Self) + FieldInfo^.FieldOffset;
+                     exit;
+                   end;
+                   Inc(Pointer(FieldInfo), 7 + Length(FieldInfo^.Name));
+                 end;
+               end;
+               { Try again with the parent class type }
+               CurClassType := CurClassType.ClassParent;
+             end;
+           end;
 
 
            fieldaddress:=nil;
            fieldaddress:=nil;
         end;
         end;
@@ -502,7 +504,7 @@
         begin
         begin
         end;
         end;
 
 
-{$ifndef ver1_0}
+{$ifdef HASINTF}
       function IsGUIDEqual(const guid1, guid2: tguid): boolean;
       function IsGUIDEqual(const guid1, guid2: tguid): boolean;
         begin
         begin
           IsGUIDEqual:=
           IsGUIDEqual:=
@@ -590,7 +592,7 @@
         begin
         begin
           getinterfacetable:=pinterfacetable((pointer(Self)+vmtIntfTable)^);
           getinterfacetable:=pinterfacetable((pointer(Self)+vmtIntfTable)^);
         end;
         end;
-{$endif ver1_0}
+{$endif HASINTF}
 
 
 {****************************************************************************
 {****************************************************************************
                              Exception Support
                              Exception Support
@@ -604,7 +606,10 @@
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.5  2000-11-04 17:52:46  florian
+  Revision 1.6  2000-11-06 20:34:24  peter
+    * changed ver1_0 defines to temporary defs
+
+  Revision 1.5  2000/11/04 17:52:46  florian
     * fixed linker errors
     * fixed linker errors
 
 
   Revision 1.4  2000/11/04 16:29:54  florian
   Revision 1.4  2000/11/04 16:29:54  florian

+ 9 - 6
rtl/inc/objpash.inc

@@ -138,17 +138,17 @@
           { new for gtk, default handler for text based messages }
           { new for gtk, default handler for text based messages }
           procedure DefaultHandlerStr(var message);virtual;
           procedure DefaultHandlerStr(var message);virtual;
 
 
-{$ifndef ver1_0}
+{$ifdef HASINTF}
           { interface functions }
           { interface functions }
           function getinterface(const iid : tguid; out obj) : boolean;
           function getinterface(const iid : tguid; out obj) : boolean;
           function getinterfacebystr(const iidstr : string; out obj) : boolean;
           function getinterfacebystr(const iidstr : string; out obj) : boolean;
           class function getinterfaceentry(const iid : tguid) : pinterfaceentry;
           class function getinterfaceentry(const iid : tguid) : pinterfaceentry;
           class function getinterfaceentrybystr(const iidstr : string) : pinterfaceentry;
           class function getinterfaceentrybystr(const iidstr : string) : pinterfaceentry;
           class function getinterfacetable : pinterfacetable;
           class function getinterfacetable : pinterfacetable;
-{$endif ver1_0}
+{$endif HASINTF}
        end;
        end;
 
 
-{$ifndef ver1_0}
+{$ifdef HASINTF}
        IUnknown = interface
        IUnknown = interface
          ['{00000000-0000-0000-C000-000000000046}']
          ['{00000000-0000-0000-C000-000000000046}']
          function QueryInterface(const iid: tguid; out obj): LongInt; stdcall;
          function QueryInterface(const iid: tguid; out obj): LongInt; stdcall;
@@ -168,7 +168,7 @@
            LocaleID: LongInt; Flags: Word; var params;
            LocaleID: LongInt; Flags: Word; var params;
            VarResult, ExcepInfo, ArgErr: Pointer): Integer; stdcall;
            VarResult, ExcepInfo, ArgErr: Pointer): Integer; stdcall;
        end;
        end;
-{$endif ver1_0}
+{$endif HASINTF}
 
 
        TExceptProc = Procedure (Obj : TObject; Addr,Frame: Pointer);
        TExceptProc = Procedure (Obj : TObject; Addr,Frame: Pointer);
 
 
@@ -183,7 +183,7 @@
 
 
        Const
        Const
           ExceptProc : TExceptProc = Nil;
           ExceptProc : TExceptProc = Nil;
-	  RaiseProc : TExceptProc = Nil;
+          RaiseProc : TExceptProc = Nil;
 
 
        Function RaiseList : PExceptObject;
        Function RaiseList : PExceptObject;
 
 
@@ -258,7 +258,10 @@
        end;
        end;
 {
 {
   $Log$
   $Log$
-  Revision 1.6  2000-11-04 17:31:50  florian
+  Revision 1.7  2000-11-06 20:34:24  peter
+    * changed ver1_0 defines to temporary defs
+
+  Revision 1.6  2000/11/04 17:31:50  florian
     * fixed some out declarations
     * fixed some out declarations
 
 
   Revision 1.5  2000/11/04 16:28:55  florian
   Revision 1.5  2000/11/04 16:28:55  florian

+ 8 - 4
rtl/inc/sstrings.inc

@@ -17,11 +17,12 @@
 ****************************************************************************}
 ****************************************************************************}
 
 
 {$I real2str.inc}
 {$I real2str.inc}
-{$ifdef ver1_0}
+
+{$ifndef INTERNSETLENGTH}
 procedure SetLength(var s:shortstring;len:StrLenInt);
 procedure SetLength(var s:shortstring;len:StrLenInt);
-{$else ver1_0}
+{$else INTERNSETLENGTH}
 procedure Shortstr_SetLength(var s:shortstring;len:StrLenInt);[Public,Alias : 'FPC_SHORTSTR_SETLENGTH'];
 procedure Shortstr_SetLength(var s:shortstring;len:StrLenInt);[Public,Alias : 'FPC_SHORTSTR_SETLENGTH'];
-{$endif ver1_0}
+{$endif INTERNSETLENGTH}
 begin
 begin
   if Len>255 then
   if Len>255 then
    Len:=255;
    Len:=255;
@@ -559,7 +560,10 @@ end;
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.4  2000-10-21 18:20:17  florian
+  Revision 1.5  2000-11-06 20:34:24  peter
+    * changed ver1_0 defines to temporary defs
+
+  Revision 1.4  2000/10/21 18:20:17  florian
     * a lot of small changes:
     * a lot of small changes:
        - setlength is internal
        - setlength is internal
        - win32 graph unit extended
        - win32 graph unit extended

+ 10 - 7
rtl/inc/systemh.inc

@@ -267,9 +267,9 @@ function strpas(p:pchar):shortstring;
 function strlen(p:pchar):longint;
 function strlen(p:pchar):longint;
 
 
 { Shortstring functions }
 { Shortstring functions }
-{$ifdef ver1_0}
+{$ifndef INTERNSETLENGTH}
 Procedure SetLength (Var S : ShortString; l : longint);
 Procedure SetLength (Var S : ShortString; l : longint);
-{$endif ver1_0}
+{$endif INTERNSETLENGTH}
 Function  Copy(const s:shortstring;index:StrLenInt;count:StrLenInt):shortstring;
 Function  Copy(const s:shortstring;index:StrLenInt;count:StrLenInt):shortstring;
 Procedure Delete(Var s:shortstring;index:StrLenInt;count:StrLenInt);
 Procedure Delete(Var s:shortstring;index:StrLenInt;count:StrLenInt);
 Procedure Insert(const source:shortstring;Var s:shortstring;index:StrLenInt);
 Procedure Insert(const source:shortstring;Var s:shortstring;index:StrLenInt);
@@ -304,9 +304,9 @@ function  length(c:char):byte;
                              AnsiString Handling
                              AnsiString Handling
 ****************************************************************************}
 ****************************************************************************}
 
 
-{$ifdef ver1_0}
+{$ifndef INTERNSETLENGTH}
 Procedure SetLength (Var S : AnsiString; l : Longint);
 Procedure SetLength (Var S : AnsiString; l : Longint);
-{$endif ver1_0}
+{$endif INTERNSETLENGTH}
 Procedure UniqueString (Var S : AnsiString);
 Procedure UniqueString (Var S : AnsiString);
 Function  Length (Const S : AnsiString) : Longint;
 Function  Length (Const S : AnsiString) : Longint;
 Function  Copy (Const S : AnsiString; Index,Size : Longint) : AnsiString;
 Function  Copy (Const S : AnsiString; Index,Size : Longint) : AnsiString;
@@ -321,9 +321,9 @@ Function StringOfChar(c : char;l : longint) : AnsiString;
 ****************************************************************************}
 ****************************************************************************}
 
 
 {$ifdef haswidechar}
 {$ifdef haswidechar}
-{$ifdef ver1_0}
+{$ifndef INTERNSETLENGTH}
 Procedure SetLength (Var S : WideString; l : Longint);
 Procedure SetLength (Var S : WideString; l : Longint);
-{$endif ver1_0}
+{$endif INTERNSETLENGTH}
 Procedure UniqueString (Var S : WideString);
 Procedure UniqueString (Var S : WideString);
 Function  Length (Const S : WideString) : Longint;
 Function  Length (Const S : WideString) : Longint;
 Function  Copy (Const S : WideString; Index,Size : Longint) : WideString;
 Function  Copy (Const S : WideString; Index,Size : Longint) : WideString;
@@ -484,7 +484,10 @@ const
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.8  2000-10-23 16:15:40  jonas
+  Revision 1.9  2000-11-06 20:34:24  peter
+    * changed ver1_0 defines to temporary defs
+
+  Revision 1.8  2000/10/23 16:15:40  jonas
     * renamed strlenint to longint since 1.0 doesn't know that type
     * renamed strlenint to longint since 1.0 doesn't know that type
 
 
   Revision 1.7  2000/10/23 14:00:59  florian
   Revision 1.7  2000/10/23 14:00:59  florian

+ 7 - 4
rtl/inc/wstrings.inc

@@ -294,11 +294,11 @@ begin
     HandleErrorFrame(201,get_frame);
     HandleErrorFrame(201,get_frame);
 end;
 end;
 
 
-{$ifdef ver1_0}
+{$ifndef INTERNSETLENGTH}
 Procedure SetLength (Var S : WideString; l : Longint);
 Procedure SetLength (Var S : WideString; l : Longint);
-{$else ver1_0}
+{$else INTERNSETLENGTH}
 Procedure WideStr_SetLength (Var S : WideString; l : Longint);[Public,Alias : 'FPC_WIDESTR_SETLENGTH'];
 Procedure WideStr_SetLength (Var S : WideString; l : Longint);[Public,Alias : 'FPC_WIDESTR_SETLENGTH'];
-{$endif ver1_0}
+{$endif INTERNSETLENGTH}
 {
 {
   Sets The length of string S to L.
   Sets The length of string S to L.
   Makes sure S is unique, and contains enough room.
   Makes sure S is unique, and contains enough room.
@@ -500,7 +500,10 @@ end;}
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.4  2000-10-21 18:20:17  florian
+  Revision 1.5  2000-11-06 20:34:24  peter
+    * changed ver1_0 defines to temporary defs
+
+  Revision 1.4  2000/10/21 18:20:17  florian
     * a lot of small changes:
     * a lot of small changes:
        - setlength is internal
        - setlength is internal
        - win32 graph unit extended
        - win32 graph unit extended