فهرست منبع

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