浏览代码

* moved genrtti.inc code to rtti
* removed rttip.inc, the generic code is almost as fast and
much easier to maintain and has less risks on bugs

peter 23 年之前
父节点
当前提交
24384c648b
共有 7 个文件被更改,包括 234 次插入1048 次删除
  1. 1 1
      rtl/i386/makefile.cpu
  2. 0 536
      rtl/i386/rttip.inc
  3. 0 298
      rtl/inc/genrtti.inc
  4. 1 1
      rtl/inc/makefile.inc
  5. 232 6
      rtl/inc/rtti.inc
  6. 0 183
      rtl/m68k/rttip.inc
  7. 0 23
      rtl/powerpc/rttip.inc

+ 1 - 1
rtl/i386/makefile.cpu

@@ -2,6 +2,6 @@
 # Here we set processor dependent include file names.
 #
 
-CPUNAMES=i386 math set rttip setjump setjumph
+CPUNAMES=i386 math set setjump setjumph
 CPUINCNAMES=$(addsuffix .inc,$(CPUNAMES))
 

+ 0 - 536
rtl/i386/rttip.inc

@@ -1,536 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by Michael Van Canneyt
-    member of the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-{ Run-Time type information routines - processor dependent part }
-{ I think we should use the pascal version, this code isn't     }
-{ much faster                                                   }
-
-{ define FPC_SYSTEM_HAS_FPC_INITIALIZE}
-(*
-Procedure fpc_Initialize (Data,TypeInfo : pointer);[Public,Alias:'FPC_INITIALIZE']; {$ifdef hascompilerproc} compilerproc; {$endif}
-assembler;
-asm
-// Save registers
-        push    %eax
-        push    %ebx
-        push    %ecx
-        push    %edx
-// decide what type it is
-        movl    TypeInfo,%ebx
-        movb    (%ebx),%al
-        subb    $9,%al
-        jz      .LDoAnsiStringInit
-        decb    %al
-        jz      .LDoAnsiStringInit
-        decb    %al
-        jz      .LDoVariantInit
-        decb    %al
-        jz      .LDoArrayInit
-        decb    %al
-        jz      .LDoRecordInit
-        decb    %al
-        jz      .LDoInterfaceInit
-        decb    %al
-        jz      .LDoClassInit
-        decb    %al
-        jz      .LDoObjectInit
-        decb    %al
-        // what is called here ??? FK
-        jz      .LDoClassInit
-        subb    $4,%al
-        jz      .LDoDynArrayInit
-        jmp     .LExitInitialize
-        // Interfaces
-.LDoInterfaceInit:
-        movl    Data, %eax
-        movl    $0,(%eax)
-        jmp     .LExitInitialize
-        // Variants
-.LDoVariantInit:
-        movl    Data,%eax
-        pushl   %eax
-        call    FPC_VARIANT_INIT
-        jmp     .LExitInitialize
-        // dynamic Array
-.LDoDynArrayInit:
-        movl Data, %eax
-        movl $0,(%eax)
-        jmp    .LExitInitialize
-.LDoObjectInit:
-.LDoClassInit:
-.LDoRecordInit:
-        incl    %ebx
-        movzbl  (%ebx),%eax
-// Skip also recordsize.
-        addl    $5,%eax
-        addl    %eax,%ebx
-// %ebx points to element count. Set in %edx
-        movl    (%ebx),%edx
-        addl    $4,%ebx
-// %ebx points to First element in record
-.LMyRecordInitLoop:
-        decl    %edx
-        jl      .LExitInitialize
-// %ebx points to typeinfo pointer
-// Push type
-        pushl    (%ebx)
-        addl     $4,%ebx
-// %ebx points to offset in record.
-// Us it to calculate data
-        movl    Data,%eax
-        addl    (%ebx),%eax
-        addl     $4,%ebx
-// push data
-        pushl    %eax
-        call    INT_INITIALIZE
-        jmp     .LMyRecordInitLoop
-// Array handling
-.LDoArrayInit:
-// Skip array name !!
-        incl    %ebx
-        movzbl  (%ebx),%eax
-        incl    %eax
-        addl    %eax,%ebx
-// %ebx points to size. Put size in ecx
-        movl    (%ebx),%ecx
-        addl    $4, %ebx
-// %ebx points to count. Put count in %edx
-        movl    (%ebx),%edx
-        addl    $4, %ebx
-// %ebx points to type. Put into ebx.
-// Start treating elements.
-.LMyArrayInitLoop:
-        decl    %edx
-        jl      .LExitInitialize
-// push type
-        pushl   (%ebx)
-// calculate data
-        movl    %ecx,%eax
-        imull    %edx,%eax
-        addl    Data,%eax
-// push data
-        pushl   %eax
-        call    INT_INITIALIZE
-        jmp     .LMyArrayInitLoop
-// AnsiString handling :
-.LDoAnsiStringInit:
-        movl Data, %eax
-        movl $0,(%eax)
-.LExitInitialize:
-        pop     %edx
-        pop     %ecx
-        pop     %ebx
-        pop     %eax
-end;
-*)
-
-{ define FPC_SYSTEM_HAS_FPC_FINALIZE}
-(*
-Procedure fpc_finalize (Data,TypeInfo: Pointer);[Public,Alias:'FPC_FINALIZE']; {$ifdef hascompilerproc} compilerproc; {$endif}
-assembler;
-asm
-        push    %eax
-        push    %ebx
-        push    %ecx
-        push    %edx
-// decide what type it is
-        movl    TypeInfo,%ebx
-        movb    (%ebx),%al
-        subb    $9,%al
-        jz      .LDoAnsiStringFinal
-        decb    %al
-        jz      .LDoAnsiStringFinal
-        decb    %al
-        jz      .LDoVariantFinal
-        decb    %al
-        jz      .LDoArrayFinal
-        decb    %al
-        jz      .LDoRecordFinal
-        decb    %al
-        jz      .LDoInterfaceFinal
-        decb    %al
-        jz      .LDoClassFinal
-        decb    %al
-        jz      .LDoObjectFinal
-        decb    %al
-        // what is called here ??? FK
-        jz      .LDoClassFinal
-        subb    $4,%al
-        jz      .LDoDynArrayFinal
-        jmp     .LExitFinalize
-        // Interfaces
-.LDoInterfaceFinal:
-        pushl   Data
-        call    fpc_Intf_Decr_Ref
-        jmp     .LExitFinalize
-        // Variants
-.LDoVariantFinal:
-        jmp     .LExitFinalize
-        // dynamic Array
-.LDoDynArrayFinal:
-        pushl   TypeInfo
-        pushl   Data
-        call    FPC_DYNARRAY_DECR_REF
-        jmp     .LExitFinalize
-.LDoClassFinal:
-.LDoObjectFinal:
-.LDoRecordFinal:
-        incl    %ebx
-        movzbl  (%ebx),%eax
-// Skip also recordsize.
-        addl    $5,%eax
-        addl    %eax,%ebx
-// %ebx points to element count. Set in %edx
-        movl    (%ebx),%edx
-        addl    $4,%ebx
-// %ebx points to First element in record
-.LMyRecordFinalLoop:
-        decl    %edx
-        jl      .LExitFinalize
-// %ebx points to typeinfo pointer
-// Push type
-        pushl    (%ebx)
-        addl     $4,%ebx
-// %ebx points to offset.
-// Use to calculate data
-        movl    Data,%eax
-        addl    (%ebx),%eax
-        addl     $4,%ebx
-// push data
-        pushl    %eax
-        call    INT_FINALIZE
-        jmp     .LMyRecordFinalLoop
-// Array handling
-.LDoArrayFinal:
-// Skip array name !!
-        incl    %ebx
-        movzbl  (%ebx),%eax
-        incl    %eax
-        addl    %eax,%ebx
-// %ebx points to size. Put size in ecx
-        movl    (%ebx),%ecx
-        addl    $4, %ebx
-// %ebx points to count. Put count in %edx
-        movl    (%ebx),%edx
-        addl    $4, %ebx
-// %ebx points to type. Put into ebx.
-// Start treating elements.
-.LMyArrayFinalLoop:
-        decl    %edx
-        jl      .LExitFinalize
-// push type
-        pushl   (%ebx)
-// calculate data
-        movl    %ecx,%eax
-        imull    %edx,%eax
-        addl    Data,%eax
-// push data
-        pushl   %eax
-        call    INT_FINALIZE
-        jmp     .LMyArrayFinalLoop
-// AnsiString handling :
-.LDoAnsiStringFinal:
-        pushl   Data
-        call    FPC_ANSISTR_DECR_REF
-.LExitFinalize:
-        pop     %edx
-        pop     %ecx
-        pop     %ebx
-        pop     %eax
-end;
-*)
-
-{$define FPC_SYSTEM_HAS_FPC_ADDREF}
-
-Procedure fpc_Addref (Data,TypeInfo : Pointer); [Public,alias : 'FPC_ADDREF'];  {$ifdef hascompilerproc} compilerproc; {$endif}
-Assembler;
-asm
-// Save registers
-        push    %eax
-        push    %ebx
-        push    %ecx
-        push    %edx
-// decide what type it is
-        movl    TypeInfo,%ebx
-        movb    (%ebx),%al
-        subb    $9,%al
-        jz      .LDoAnsiStringAddRef
-        decb    %al
-        jz      .LDoAnsiStringAddRef
-        decb    %al
-        jz      .LDoVariantAddRef
-        decb    %al
-        jz      .LDoArrayAddRef
-        decb    %al
-        jz      .LDoRecordAddRef
-        decb    %al
-        jz      .LDoInterfaceAddRef
-        decb    %al
-        jz      .LDoClassAddRef
-        decb    %al
-        jz      .LDoObjectAddRef
-        decb    %al
-        // what is called here ??? FK
-        jz      .LDoClassAddRef
-        subb    $4,%al
-        jz      .LDoDynArrayAddRef
-        jmp     .LExitAddRef
-        // Interfaces
-.LDoInterfaceAddRef:
-        pushl   Data
-        call    FPC_INTF_INCR_REF
-        jmp     .LExitAddRef
-        // Variants
-.LDoVariantAddRef:
-        jmp     .LExitAddRef
-        // Dynamic Arrays
-.LDoDynArrayAddRef:
-        pushl    Data
-        call    FPC_DYNARRAY_INCR_REF
-        jmp     .LExitAddRef
-.LDoClassAddRef:
-.LDoObjectAddRef:
-.LDoRecordAddRef:
-        incl    %ebx
-        movzbl  (%ebx),%eax
-// Skip also recordsize.
-        addl    $5,%eax
-        addl    %eax,%ebx
-// %ebx points to element count. Set in %edx
-        movl    (%ebx),%edx
-        addl    $4,%ebx
-// %ebx points to First element in record
-.LMyRecordAddRefLoop:
-        decl    %edx
-        jl      .LExitAddRef
-// Push type
-        pushl    (%ebx)
-        addl     $4,%ebx
-// Calculate data
-        movl    Data,%eax
-        addl    (%ebx),%eax
-        addl     $4,%ebx
-// push data
-        pushl    %eax
-        call    INT_ADDREF
-        jmp     .LMyRecordAddRefLoop
-// Array handling
-.LDoArrayAddRef:
-// Skip array name !!
-        incl    %ebx
-        movzbl  (%ebx),%eax
-        incl    %eax
-        addl    %eax,%ebx
-// %ebx points to size. Put size in ecx
-        movl    (%ebx),%ecx
-        addl    $4, %ebx
-// %ebx points to count. Put count in %edx
-        movl    (%ebx),%edx
-        addl    $4, %ebx
-// %ebx points to type. Put into ebx.
-// Start treating elements.
-.LMyArrayAddRefLoop:
-        decl    %edx
-        jl      .LExitAddRef
-// push type
-        pushl   (%ebx)
-// calculate data
-        movl    %ecx,%eax
-        imull    %edx,%eax
-        addl    Data,%eax
-// push data
-        pushl   %eax
-        call    INT_ADDREF
-        jmp     .LMyArrayAddRefLoop
-// AnsiString handling :
-.LDoAnsiStringAddRef:
-        pushl   Data
-        call    FPC_ANSISTR_INCR_REF
-.LExitAddRef:
-        pop     %edx
-        pop     %ecx
-        pop     %ebx
-        pop     %eax
-end;
-
-
-{$define FPC_SYSTEM_HAS_FPC_DECREF}
-Procedure fpc_DecRef (Data,TypeInfo : Pointer); [Public,alias : 'FPC_DECREF']; {$ifdef hascompilerproc} compilerproc; {$endif}
-Assembler;
-asm
-// Save registers
-        push    %eax
-        push    %ebx
-        push    %ecx
-        push    %edx
-// decide what type it is
-        movl    TypeInfo,%ebx
-        movb    (%ebx),%al
-        subb    $9,%al
-        jz      .LDoAnsiStringDecRef
-        decb    %al
-        jz      .LDoAnsiStringDecRef
-        decb    %al
-        jz      .LDoVariantDecRef
-        decb    %al
-        jz      .LDoArrayDecRef
-        decb    %al
-        jz      .LDoRecordDecRef
-        decb    %al
-        jz      .LDoInterfaceDecRef
-        decb    %al
-        jz      .LDoClassDecRef
-        decb    %al
-        jz      .LDoObjectDecRef
-        decb    %al
-        // what is called here ??? FK
-        jz      .LDoClassDecRef
-        subb    $4,%al
-        jz      .LDoDynArrayDecRef
-        jmp     .LExitDecRef
-        // Interfaces
-.LDoInterfaceDecRef:
-        pushl   Data
-        call    FPC_INTF_DECR_REF
-        jmp     .LExitDecRef
-        // Variants
-.LDoVariantDecRef:
-        jmp     .LExitDecRef
-        // Dynamic Arrays
-.LDoDynArrayDecRef:
-        pushl   TypeInfo
-        pushl   Data
-        call    FPC_DYNARRAY_DECR_REF
-        jmp     .LExitDecRef
-.LDoClassDecRef:
-.LDoObjectDecRef:
-.LDoRecordDecRef:
-        incl    %ebx
-        movzbl  (%ebx),%eax
-// Skip also recordsize.
-        addl    $5,%eax
-        addl    %eax,%ebx
-// %ebx points to element count. Set in %edx
-        movl    (%ebx),%edx
-        addl    $4,%ebx
-// %ebx points to First element in record
-.LMyRecordDecRefLoop:
-        decl    %edx
-        jl      .LExitDecRef
-// Push type
-        pushl    (%ebx)
-        addl     $4,%ebx
-// Calculate data
-        movl    Data,%eax
-        addl    (%ebx),%eax
-        addl     $4,%ebx
-// push data
-        pushl    %eax
-        call    INT_DECREF
-        jmp     .LMyRecordDecRefLoop
-// Array handling
-.LDoArrayDecRef:
-// Skip array name !!
-        incl    %ebx
-        movzbl  (%ebx),%eax
-        incl    %eax
-        addl    %eax,%ebx
-// %ebx points to size. Put size in ecx
-        movl    (%ebx),%ecx
-        addl    $4, %ebx
-// %ebx points to count. Put count in %edx
-        movl    (%ebx),%edx
-        addl    $4, %ebx
-// %ebx points to type. Put into ebx.
-// Start treating elements.
-.LMyArrayDecRefLoop:
-        decl    %edx
-        jl      .LExitDecRef
-// push type
-        pushl   (%ebx)
-// calculate data
-        movl    %ecx,%eax
-        imull    %edx,%eax
-        addl    Data,%eax
-// push data
-        pushl   %eax
-        call    INT_DECREF
-        jmp     .LMyArrayDecRefLoop
-// AnsiString handling :
-.LDoAnsiStringDecRef:
-        movl    Data,%eax
-        pushl   %eax
-        call    FPC_ANSISTR_DECR_REF
-.LExitDecRef:
-        pop     %edx
-        pop     %ecx
-        pop     %ebx
-        pop     %eax
-end;
-
-{
-  $Log$
-  Revision 1.14  2002-07-31 11:52:57  jonas
-    * fixed compilation errors with 1.0
-
-  Revision 1.13  2001/12/26 21:03:56  peter
-    * merged fixes from 1.0.x
-
-  Revision 1.12  2001/11/17 16:56:08  florian
-    * init and final code in genrtti.inc updated
-
-  Revision 1.11  2001/11/14 22:59:11  michael
-  + Initial variant support
-
-  Revision 1.10  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
-      specific code in the code generator to processor independent code
-    * some small fixes to the val_ansistring and val_widestring helpers
-      (always immediately exit if the source string is longer than 255
-       chars)
-    * fixed fpc_dynarray_high and fpc_dynarray_length if the dynarray is
-      still nil (used to crash, now return resp -1 and 0)
-
-  Revision 1.9  2001/05/31 22:42:56  florian
-    * some fixes for widestrings and variants
-
-  Revision 1.8  2001/04/23 18:25:44  peter
-    * m68k updates
-
-  Revision 1.7  2000/11/09 17:49:34  florian
-    + FPC_FINALIZEARRAY
-    * Finalize to int_finalize renamed
-
-  Revision 1.6  2000/11/06 21:52:21  florian
-    * another fix for interfaces
-
-  Revision 1.5  2000/11/06 21:35:59  peter
-    * removed some warnings
-
-  Revision 1.4  2000/11/04 16:30:35  florian
-    + interfaces support
-
-  Revision 1.3  2000/10/21 18:20:17  florian
-    * a lot of small changes:
-       - setlength is internal
-       - win32 graph unit extended
-       ....
-
-  Revision 1.2  2000/07/13 11:33:41  michael
-  + removed logs
-}
-

+ 0 - 298
rtl/inc/genrtti.inc

@@ -1,298 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by xxxx
-    member of the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-{ Run-Time type information routines - processor dependent part }
-
-
-{$ifndef FPC_SYSTEM_HAS_FPC_INITIALIZE}
-Procedure fpc_Initialize (Data,TypeInfo : pointer);saveregisters;[Public,Alias : 'FPC_INITIALIZE'];  {$ifdef hascompilerproc} compilerproc; {$endif}
-
-{ this definition is sometimes (depending on switches)
-  already defined or not so define it locally to avoid problems PM }
-Type
-    Pbyte = ^Byte;
-
-Var Temp       : PByte;
-    I          : longint;
-    Size,Count : longint;
-    TInfo : Pointer;
-
-begin
-  Temp:=PByte(TypeInfo);
-  case temp^ of
-    tkAstring,tkWstring,tkInterface,tkDynArray:
-      PPchar(Data)^:=Nil;
-    tkArray:
-      begin
-         inc(temp);
-         I:=temp^;
-         inc(temp,(I+1));                // skip name string;
-         Size:=PArrayRec(Temp)^.Size;    // get element size
-         Count:=PArrayRec(Temp)^.Count;  // get element Count
-         TInfo:=PArrayRec(Temp)^.Info;   // Get element info
-         For I:=0 to Count-1 do
-           int_Initialize (Data+(I*size),TInfo);
-      end;
-    tkRecord,tkClass,tkObject:
-      begin
-         inc(Temp);
-         I:=Temp^;
-         inc(temp,I+1);             // skip name string;
-         { if it isn't necessary, why should we load it ? FK
-           Size:=PRecRec(Temp)^.Size;    // get record size; not needed.
-         }
-         Count:=PRecRec(Temp)^.Count;  // get element Count
-         For I:=1 to count Do
-           With PRecRec(Temp)^.elements[I] do
-             int_Initialize (Data+Offset,Info);
-      end;
-{$ifdef HASVARIANT}
-    tkVariant:
-      variant_init(Variant(PVarData(Data)^))
-{$endif HASVARIANT}
-  end;
-end;
-{$endif}
-
-{$ifndef FPC_SYSTEM_HAS_FPC_FINALIZE}
-
-Procedure fpc_finalize (Data,TypeInfo: Pointer);saveregisters;[Public,Alias : 'FPC_FINALIZE'];  {$ifdef hascompilerproc} compilerproc; {$endif}
-
-{ this definition is sometimes (depending on switches)
-  already defined or not so define it locally to avoid problems PM }
-Type
-    Pbyte = ^Byte;
-    PPointer = ^Pointer;
-Var Temp       : PByte;
-    I          : longint;
-    Size,Count : longint;
-    TInfo : Pointer;
-
-begin
-  Temp:=PByte(TypeInfo);
-  case temp^ of
-    tkAstring,tkWstring:
-      fpc_AnsiStr_Decr_Ref(PPointer(Data)^);
-    tkArray :
-      begin
-         inc(Temp);
-         I:=temp^;
-         inc(temp,I+1);                   // skip name string;
-         Size:=PArrayRec(Temp)^.Size;     // get element size
-         Count:=PArrayRec(Temp)^.Count;   // get element Count
-         TInfo:=PArrayRec(Temp)^.Info;    // Get element info
-         For I:=0 to Count-1 do
-           int_Finalize (Data+(I*size),TInfo);
-      end;
-    tkRecord,tkObject,tkClass:
-      begin
-         inc(Temp);
-         I:=Temp^;
-         inc(temp,I+1);                // skip name string;
-         { if it isn't necessary, why should we load it? FK
-           Size:=PRecRec(Temp)^.Size;    // get record size; not needed.
-         }
-         Count:=PRecRec(Temp)^.Count;  // get element Count
-         For I:=1 to count do
-           With PRecRec(Temp)^.elements[I] do
-             int_Finalize (Data+Offset,Info);
-      end;
-{$ifdef HASINTF}
-    tkInterface:
-      Intf_Decr_Ref(PPointer(Data)^);
-{$endif HASINTF}
-    tkDynArray:
-      fpc_dynarray_decr_ref(PPointer(Data)^,TypeInfo);
-{$ifdef HASVARIANT}
-    tkVariant:
-      variant_clear(Variant(PVarData(Data)^))
-{$endif HASVARIANT}
-  end;
-end;
-{$endif}
-
-{$ifndef FPC_SYSTEM_HAS_FPC_ADDREF}
-
-Procedure fpc_Addref (Data,TypeInfo : Pointer);saveregisters; [Public,alias : 'FPC_ADDREF'];  {$ifdef hascompilerproc} compilerproc; {$endif}
-
-{ this definition is sometimes (depending on switches)
-  already defined or not so define it locally to avoid problems PM }
-Type
-    Pbyte = ^Byte;
-    PPointer = ^Pointer;
-Var Temp       : PByte;
-    I          : longint;
-    Size,Count : longint;
-    TInfo : Pointer;
-begin
-  Temp:=PByte(TypeInfo);
-  case temp^ of
-    tkAstring :
-      fpc_AnsiStr_Incr_Ref(PPointer(Data)^);
-    tkWstring :
-      fpc_WideStr_Incr_Ref(PPointer(Data)^);
-    tkArray :
-      begin
-        Inc(Temp);
-        I:=temp^;
-        inc(temp,I+1);               // skip name string;
-        Size:=PArrayRec(Temp)^.Size;     // get element size
-        Count:=PArrayRec(Temp)^.Count;  // get element Count
-        TInfo:=PArrayRec(Temp)^.Info;   // Get element info
-        For I:=0 to Count-1 do
-          int_AddRef (Data+(I*size),TInfo);
-      end;
-    tkrecord :
-      begin
-        Inc(Temp);
-        I:=Temp^;
-        temp:=temp+(I+1);             // skip name string;
-        Size:=PRecRec(Temp)^.Size;    // get record size; not needed.
-        Count:=PRecRec(Temp)^.Count;  // get element Count
-        For I:=1 to count do
-          With PRecRec(Temp)^.elements[I] do
-            int_AddRef (Data+Offset,Info);
-      end;
-    tkDynArray:
-      fpc_dynarray_incr_ref(PPointer(Data)^);
-{$ifdef HASINTF}
-    tkInterface:
-      Intf_Incr_Ref(PPointer(Data)^);
-{$endif HASINTF}
-  end;
-end;
-{$endif}
-
-
-{$ifdef hascompilerproc}
-{ alias for internal use }
-{ we use another name else the compiler gets puzzled because of the wrong forward def }
-procedure fpc_systemDecRef (Data, TypeInfo : Pointer);saveregisters;[external name 'FPC_DECREF'];
-{$endif compilerproc}
-
-{$ifndef FPC_SYSTEM_HAS_FPC_DECREF}
-
-Procedure fpc_DecRef (Data, TypeInfo : Pointer);saveregisters;[Public,alias : 'FPC_DECREF'];  {$ifdef hascompilerproc} compilerproc; {$endif}
-{ this definition is sometimes (depending on switches)
-  already defined or not so define it locally to avoid problems PM }
-Type
-    Pbyte = ^Byte;
-    PPointer = ^Pointer;
-Var Temp       : PByte;
-    I          : longint;
-    Size,Count : longint;
-    TInfo : Pointer;
-
-begin
-  Temp:=PByte(TypeInfo);
-  case temp^ of
-    { see AddRef for comment about below construct (JM) }
-    tkAstring:
-      fpc_AnsiStr_Decr_Ref(PPointer(Data)^);
-    tkWstring:
-      fpc_WideStr_Decr_Ref(PPointer(Data)^);
-    tkArray:
-      begin
-         inc(Temp);
-         I:=temp^;
-         inc(temp,I+1);               // skip name string;
-         Size:=PArrayRec(Temp)^.Size;     // get element size
-         Count:=PArrayRec(Temp)^.Count;  // get element Count
-         TInfo:=PArrayRec(Temp)^.Info;   // Get element info
-         For I:=0 to Count-1 do
-           fpc_systemDecRef (Data+(I*size),TInfo);
-      end;
-    tkrecord:
-      begin
-      Temp:=Temp+1;
-      I:=Temp^;
-      temp:=temp+(I+1);             // skip name string;
-      Size:=PRecRec(Temp)^.Size;    // get record size; not needed.
-      Count:=PRecRec(Temp)^.Count;  // get element Count
-      For I:=1 to count do
-        With PRecRec(Temp)^.elements[I] do
-          fpc_systemDecRef (Data+Offset,Info);
-      end;
-    tkDynArray:
-      fpc_dynarray_decr_ref(PPointer(Data)^,TypeInfo);
-{$ifdef HASINTF}
-    tkInterface:
-      Intf_Decr_Ref(PPointer(Data)^);
-{$endif HASINTF}
-  end;
-end;
-{$endif}
-
-{$ifndef FPC_SYSTEM_HAS_FPC_FINALIZEARRAY}
-procedure fpc_finalize_array(data,typeinfo : pointer;count,size : longint); [Public,Alias:'FPC_FINALIZEARRAY'];  {$ifdef hascompilerproc} compilerproc; {$endif}
-  var
-     i : longint;
-  begin
-     for i:=0 to count-1 do
-       int_finalize(data+size*i,typeinfo);
-  end;
-{$endif}
-
-{
- $Log$
- Revision 1.13  2002-07-29 21:28:17  florian
-   * several fixes to get further with linux/ppc system unit compilation
-
- Revision 1.12  2002/04/25 20:14:57  peter
-   * updated compilerprocs
-   * incr ref count has now a value argument instead of var
-
- Revision 1.11  2002/04/24 16:15:35  peter
-   * fpc_finalize_array renamed
-
- Revision 1.10  2001/11/30 16:25:35  jonas
-   * fixed web bug 1707:
-      * tvarsym.getvaluesize doesn't return 0 anymore for dynarrays (found
-        by Florian)
-      * in genrtti, some more ppointer(data)^ tricks were necessary
-
- Revision 1.9  2001/11/22 07:33:08  michael
-  * Fixed memory corruption with finalize() of ansistring in a class
-
- Revision 1.8  2001/11/17 16:56:08  florian
-   * init and final code in genrtti.inc updated
-
- Revision 1.7  2001/11/17 10:29:48  florian
-   * make cycle for win32 fixed
-
- Revision 1.6  2001/11/14 22:59:11  michael
-   + Initial variant support
-
- Revision 1.5  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
-     specific code in the code generator to processor independent code
-   * some small fixes to the val_ansistring and val_widestring helpers
-     (always immediately exit if the source string is longer than 255
-      chars)
-   * fixed fpc_dynarray_high and fpc_dynarray_length if the dynarray is
-     still nil (used to crash, now return resp -1 and 0)
-
- Revision 1.4  2001/06/28 19:18:57  peter
-   * ansistr fix merged
-
- Revision 1.3  2001/05/28 20:43:17  peter
-   * more saveregisters added (merged)
-
- Revision 1.2  2001/04/23 18:25:44  peter
-   * m68k updates
-
-}

+ 1 - 1
rtl/inc/makefile.inc

@@ -6,7 +6,7 @@
 
 SYSNAMES=systemh heaph mathh filerec textrec system real2str sstrings innr \
          file typefile text rtti heap astrings objpas objpash except int64 \
-         generic dynarr varianth variant genrtti
+         generic dynarr varianth variant
 
 SYSINCNAMES=$(addsuffix .inc,$(SYSNAMES))
 

+ 232 - 6
rtl/inc/rtti.inc

@@ -83,16 +83,242 @@ TArrayRec = record
   Info : Pointer;
   end;
 
-{ The actual Routines are implemented per processor. }
 
-{ Include the cpu dependant part }
-{$i rttip.inc}
-{ Include the generic part }
-{$i genrtti.inc}
+Procedure fpc_Initialize (Data,TypeInfo : pointer);saveregisters;[Public,Alias : 'FPC_INITIALIZE'];  {$ifdef hascompilerproc} compilerproc; {$endif}
+
+{ this definition is sometimes (depending on switches)
+  already defined or not so define it locally to avoid problems PM }
+Type
+    Pbyte = ^Byte;
+
+Var Temp       : PByte;
+    I          : longint;
+    Size,Count : longint;
+    TInfo : Pointer;
+
+begin
+  Temp:=PByte(TypeInfo);
+  case temp^ of
+    tkAstring,tkWstring,tkInterface,tkDynArray:
+      PPchar(Data)^:=Nil;
+    tkArray:
+      begin
+         inc(temp);
+         I:=temp^;
+         inc(temp,(I+1));                // skip name string;
+         Size:=PArrayRec(Temp)^.Size;    // get element size
+         Count:=PArrayRec(Temp)^.Count;  // get element Count
+         TInfo:=PArrayRec(Temp)^.Info;   // Get element info
+         For I:=0 to Count-1 do
+           int_Initialize (Data+(I*size),TInfo);
+      end;
+    tkRecord,tkClass,tkObject:
+      begin
+         inc(Temp);
+         I:=Temp^;
+         inc(temp,I+1);             // skip name string;
+         { if it isn't necessary, why should we load it ? FK
+           Size:=PRecRec(Temp)^.Size;    // get record size; not needed.
+         }
+         Count:=PRecRec(Temp)^.Count;  // get element Count
+         For I:=1 to count Do
+           With PRecRec(Temp)^.elements[I] do
+             int_Initialize (Data+Offset,Info);
+      end;
+{$ifdef HASVARIANT}
+    tkVariant:
+      variant_init(Variant(PVarData(Data)^))
+{$endif HASVARIANT}
+  end;
+end;
+
+
+Procedure fpc_finalize (Data,TypeInfo: Pointer);saveregisters;[Public,Alias : 'FPC_FINALIZE'];  {$ifdef hascompilerproc} compilerproc; {$endif}
+
+{ this definition is sometimes (depending on switches)
+  already defined or not so define it locally to avoid problems PM }
+Type
+    Pbyte = ^Byte;
+    PPointer = ^Pointer;
+Var Temp       : PByte;
+    I          : longint;
+    Size,Count : longint;
+    TInfo : Pointer;
+
+begin
+  Temp:=PByte(TypeInfo);
+  case temp^ of
+    tkAstring :
+      fpc_AnsiStr_Decr_Ref(PPointer(Data)^);
+{$ifdef HASWIDESTRING}
+    tkWstring :
+      fpc_WideStr_Decr_Ref(PPointer(Data)^);
+{$endif HASWIDESTRING}
+    tkArray :
+      begin
+         inc(Temp);
+         I:=temp^;
+         inc(temp,I+1);                   // skip name string;
+         Size:=PArrayRec(Temp)^.Size;     // get element size
+         Count:=PArrayRec(Temp)^.Count;   // get element Count
+         TInfo:=PArrayRec(Temp)^.Info;    // Get element info
+         For I:=0 to Count-1 do
+           int_Finalize (Data+(I*size),TInfo);
+      end;
+    tkRecord,tkObject,tkClass:
+      begin
+         inc(Temp);
+         I:=Temp^;
+         inc(temp,I+1);                // skip name string;
+         { if it isn't necessary, why should we load it? FK
+           Size:=PRecRec(Temp)^.Size;    // get record size; not needed.
+         }
+         Count:=PRecRec(Temp)^.Count;  // get element Count
+         For I:=1 to count do
+           With PRecRec(Temp)^.elements[I] do
+             int_Finalize (Data+Offset,Info);
+      end;
+{$ifdef HASINTF}
+    tkInterface:
+      Intf_Decr_Ref(PPointer(Data)^);
+{$endif HASINTF}
+    tkDynArray:
+      fpc_dynarray_decr_ref(PPointer(Data)^,TypeInfo);
+{$ifdef HASVARIANT}
+    tkVariant:
+      variant_clear(Variant(PVarData(Data)^))
+{$endif HASVARIANT}
+  end;
+end;
+
+
+Procedure fpc_Addref (Data,TypeInfo : Pointer);saveregisters; [Public,alias : 'FPC_ADDREF'];  {$ifdef hascompilerproc} compilerproc; {$endif}
+
+{ this definition is sometimes (depending on switches)
+  already defined or not so define it locally to avoid problems PM }
+Type
+    Pbyte = ^Byte;
+    PPointer = ^Pointer;
+Var Temp       : PByte;
+    I          : longint;
+    Size,Count : longint;
+    TInfo : Pointer;
+begin
+  Temp:=PByte(TypeInfo);
+  case temp^ of
+    tkAstring :
+      fpc_AnsiStr_Incr_Ref(PPointer(Data)^);
+{$ifdef HASWIDESTRING}
+    tkWstring :
+      fpc_WideStr_Incr_Ref(PPointer(Data)^);
+{$endif HASWIDESTRING}
+    tkArray :
+      begin
+        Inc(Temp);
+        I:=temp^;
+        inc(temp,I+1);               // skip name string;
+        Size:=PArrayRec(Temp)^.Size;     // get element size
+        Count:=PArrayRec(Temp)^.Count;  // get element Count
+        TInfo:=PArrayRec(Temp)^.Info;   // Get element info
+        For I:=0 to Count-1 do
+          int_AddRef (Data+(I*size),TInfo);
+      end;
+    tkrecord :
+      begin
+        Inc(Temp);
+        I:=Temp^;
+        temp:=temp+(I+1);             // skip name string;
+        Size:=PRecRec(Temp)^.Size;    // get record size; not needed.
+        Count:=PRecRec(Temp)^.Count;  // get element Count
+        For I:=1 to count do
+          With PRecRec(Temp)^.elements[I] do
+            int_AddRef (Data+Offset,Info);
+      end;
+    tkDynArray:
+      fpc_dynarray_incr_ref(PPointer(Data)^);
+{$ifdef HASINTF}
+    tkInterface:
+      Intf_Incr_Ref(PPointer(Data)^);
+{$endif HASINTF}
+  end;
+end;
+
+
+{ alias for internal use }
+{ we use another name else the compiler gets puzzled because of the wrong forward def }
+procedure fpc_systemDecRef (Data, TypeInfo : Pointer);saveregisters;[external name 'FPC_DECREF'];
+
+Procedure fpc_DecRef (Data, TypeInfo : Pointer);saveregisters;[Public,alias : 'FPC_DECREF'];  {$ifdef hascompilerproc} compilerproc; {$endif}
+{ this definition is sometimes (depending on switches)
+  already defined or not so define it locally to avoid problems PM }
+Type
+    Pbyte = ^Byte;
+    PPointer = ^Pointer;
+Var Temp       : PByte;
+    I          : longint;
+    Size,Count : longint;
+    TInfo : Pointer;
+
+begin
+  Temp:=PByte(TypeInfo);
+  case temp^ of
+    { see AddRef for comment about below construct (JM) }
+    tkAstring:
+      fpc_AnsiStr_Decr_Ref(PPointer(Data)^);
+{$ifdef HASWIDESTRING}      
+    tkWstring:
+      fpc_WideStr_Decr_Ref(PPointer(Data)^);
+{$endif HASWIDESTRING}      
+    tkArray:
+      begin
+         inc(Temp);
+         I:=temp^;
+         inc(temp,I+1);               // skip name string;
+         Size:=PArrayRec(Temp)^.Size;     // get element size
+         Count:=PArrayRec(Temp)^.Count;  // get element Count
+         TInfo:=PArrayRec(Temp)^.Info;   // Get element info
+         For I:=0 to Count-1 do
+           fpc_systemDecRef (Data+(I*size),TInfo);
+      end;
+    tkrecord:
+      begin
+      Temp:=Temp+1;
+      I:=Temp^;
+      temp:=temp+(I+1);             // skip name string;
+      Size:=PRecRec(Temp)^.Size;    // get record size; not needed.
+      Count:=PRecRec(Temp)^.Count;  // get element Count
+      For I:=1 to count do
+        With PRecRec(Temp)^.elements[I] do
+          fpc_systemDecRef (Data+Offset,Info);
+      end;
+    tkDynArray:
+      fpc_dynarray_decr_ref(PPointer(Data)^,TypeInfo);
+{$ifdef HASINTF}
+    tkInterface:
+      Intf_Decr_Ref(PPointer(Data)^);
+{$endif HASINTF}
+  end;
+end;
+
+
+procedure fpc_finalize_array(data,typeinfo : pointer;count,size : longint); [Public,Alias:'FPC_FINALIZEARRAY'];  {$ifdef hascompilerproc} compilerproc; {$endif}
+  var
+     i : longint;
+  begin
+     for i:=0 to count-1 do
+       int_finalize(data+size*i,typeinfo);
+  end;
+
+
 
 {
   $Log$
-  Revision 1.5  2001-11-17 16:56:08  florian
+  Revision 1.6  2002-09-02 18:42:41  peter
+    * moved genrtti.inc code to rtti
+    * removed rttip.inc, the generic code is almost as fast and
+      much easier to maintain and has less risks on bugs
+
+  Revision 1.5  2001/11/17 16:56:08  florian
     * init and final code in genrtti.inc updated
 
   Revision 1.4  2001/04/23 18:25:45  peter

+ 0 - 183
rtl/m68k/rttip.inc

@@ -1,183 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by xxxx
-    member of the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-{ Run-Time type information routines - processor dependent part }
-
-
-Procedure Initialize (Data,TypeInfo : pointer);[Alias : 'FPC_INITIALIZE'];
-
-{ this definition is sometimes (depending on switches)
-  already defined or not so define it locally to avoid problems PM }
-Type
-    Pbyte = ^Byte;
-Var Temp       : PByte;
-    I          : longint;
-    Size,Count : longint;
-    TInfo : Pointer;
-     
-begin
-  Temp:=PByte(TypeInfo);
-  case temp^ of 
-    tkLstring,tkWstring : PPchar(Data)^:=Nil;
-    tkArray :
-      begin
-      temp:=Temp+1;
-      I:=temp^; 
-      temp:=temp+(I+1);               // skip name string;
-      Size:=PArrayRec(Temp)^.Size;     // get element size
-      Count:=PArrayRec(Temp)^.Count;  // get element Count
-      TInfo:=PArrayRec(Temp)^.Info;   // Get element info 
-      For I:=0 to Count-1 do
-        Initialize (Data+(I*size),TInfo);   
-      end; 
-    tkrecord :
-      begin
-      Temp:=Temp+1;
-      I:=Temp^;
-      temp:=temp+(I+1);             // skip name string;
-      Size:=PRecRec(Temp)^.Size;    // get record size; not needed.
-      Count:=PRecRec(Temp)^.Count;  // get element Count
-      For I:=1 to count Do 
-        With PRecRec(Temp)^.elements[I] do
-          Initialize (Data+Offset,Info);
-      end;
-  end;
-end;
-
-Procedure Finalize (Data,TypeInfo: Pointer);[Alias : 'FPC_FINALIZE'];
-
-{ this definition is sometimes (depending on switches)
-  already defined or not so define it locally to avoid problems PM }
-Type
-    Pbyte = ^Byte;
-Var Temp       : PByte;
-    I          : longint;
-    Size,Count : longint;
-    TInfo : Pointer;
-
-begin
-  Temp:=PByte(TypeInfo);
-  case temp^ of 
-    tkLstring,tkWstring : Decr_Ansi_ref(Data);
-    tkArray :
-      begin
-      Temp:=Temp+1;
-      I:=temp^; 
-      temp:=temp+(I+1);               // skip name string;
-      Size:=PArrayRec(Temp)^.Size;     // get element size
-      Count:=PArrayRec(Temp)^.Count;  // get element Count
-      TInfo:=PArrayRec(Temp)^.Info;   // Get element info 
-      For I:=0 to Count-1 do
-        Finalize (Data+(I*size),TInfo);   
-      end; 
-    tkrecord :
-      begin
-      Temp:=Temp+1;
-      I:=Temp^;
-      temp:=temp+(I+1);             // skip name string;
-      Size:=PRecRec(Temp)^.Size;    // get record size; not needed.
-      Count:=PRecRec(Temp)^.Count;  // get element Count
-      For I:=1 to count do 
-        With PRecRec(Temp)^.elements[I] do
-          Finalize (Data+Offset,Info);
-      end;
-  end;
-end;
-
-Procedure Addref (Data,TypeInfo : Pointer); [alias : 'FPC_ADDREF'];
-
-{ this definition is sometimes (depending on switches)
-  already defined or not so define it locally to avoid problems PM }
-Type
-    Pbyte = ^Byte;
-Var Temp       : PByte;
-    I          : longint;
-    Size,Count : longint;
-    TInfo : Pointer;
-
-begin
-  Temp:=PByte(TypeInfo);
-  case temp^ of 
-    tkLstring,tkWstring : Incr_Ansi_ref(Data);
-    tkArray :
-      begin
-      Temp:=Temp+1;
-      I:=temp^; 
-      temp:=temp+(I+1);               // skip name string;
-      Size:=PArrayRec(Temp)^.Size;     // get element size
-      Count:=PArrayRec(Temp)^.Count;  // get element Count
-      TInfo:=PArrayRec(Temp)^.Info;   // Get element info 
-      For I:=0 to Count-1 do
-        AddRef (Data+(I*size),TInfo);   
-      end; 
-    tkrecord :
-      begin
-      Temp:=Temp+1;
-      I:=Temp^;
-      temp:=temp+(I+1);             // skip name string;
-      Size:=PRecRec(Temp)^.Size;    // get record size; not needed.
-      Count:=PRecRec(Temp)^.Count;  // get element Count
-      For I:=1 to count do 
-        With PRecRec(Temp)^.elements[I] do
-          AddRef (Data+Offset,Info);
-      end;
-  end;
-end;
-
-Procedure DecRef (Data, TypeInfo : Pointer);[Public,alias : 'FPC_DECREF'];
-{ this definition is sometimes (depending on switches)
-  already defined or not so define it locally to avoid problems PM }
-Type
-    Pbyte = ^Byte;
-Var Temp       : PByte;
-    I          : longint;
-    Size,Count : longint;
-    TInfo : Pointer;
-
-begin
-  Temp:=PByte(TypeInfo);
-  case temp^ of 
-    tkLstring,tkWstring : Decr_Ansi_ref(Data);
-    tkArray :
-      begin
-      Temp:=Temp+1;
-      I:=temp^; 
-      temp:=temp+(I+1);               // skip name string;
-      Size:=PArrayRec(Temp)^.Size;     // get element size
-      Count:=PArrayRec(Temp)^.Count;  // get element Count
-      TInfo:=PArrayRec(Temp)^.Info;   // Get element info 
-      For I:=0 to Count-1 do
-        DecRef (Data+(I*size),TInfo);   
-      end; 
-    tkrecord :
-      begin
-      Temp:=Temp+1;
-      I:=Temp^;
-      temp:=temp+(I+1);             // skip name string;
-      Size:=PRecRec(Temp)^.Size;    // get record size; not needed.
-      Count:=PRecRec(Temp)^.Count;  // get element Count
-      For I:=1 to count do 
-        With PRecRec(Temp)^.elements[I] do
-          DecRef (Data+Offset,Info);
-      end;
-  end;
-end;
-
-{
-  $Log$
-  Revision 1.2  2000-07-13 11:33:50  michael
-  + removed logs
- 
-}

+ 0 - 23
rtl/powerpc/rttip.inc

@@ -1,23 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 2002 by Jonas Maebe and other members of the
-    Free Pascal development team
-
-    Implementation of processor optimized RTTI code
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-{
-  $Log$
-  Revision 1.1  2002-07-28 20:43:49  florian
-    * several fixes for linux/powerpc
-    * several fixes to MT
-}