From 24384c648b5cbaace2d38dec1debe15213f0cd38 Mon Sep 17 00:00:00 2001 From: peter Date: Mon, 2 Sep 2002 18:42:41 +0000 Subject: [PATCH] * 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 --- rtl/i386/makefile.cpu | 2 +- rtl/i386/rttip.inc | 536 ------------------------------------------ rtl/inc/genrtti.inc | 298 ----------------------- rtl/inc/makefile.inc | 2 +- rtl/inc/rtti.inc | 238 ++++++++++++++++++- rtl/m68k/rttip.inc | 183 -------------- rtl/powerpc/rttip.inc | 23 -- 7 files changed, 234 insertions(+), 1048 deletions(-) delete mode 100644 rtl/i386/rttip.inc delete mode 100644 rtl/inc/genrtti.inc delete mode 100644 rtl/m68k/rttip.inc delete mode 100644 rtl/powerpc/rttip.inc diff --git a/rtl/i386/makefile.cpu b/rtl/i386/makefile.cpu index d24d317fdc..76c3d74488 100644 --- a/rtl/i386/makefile.cpu +++ b/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)) diff --git a/rtl/i386/rttip.inc b/rtl/i386/rttip.inc deleted file mode 100644 index 278eada212..0000000000 --- a/rtl/i386/rttip.inc +++ /dev/null @@ -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 -} - diff --git a/rtl/inc/genrtti.inc b/rtl/inc/genrtti.inc deleted file mode 100644 index 904819e92b..0000000000 --- a/rtl/inc/genrtti.inc +++ /dev/null @@ -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 - -} diff --git a/rtl/inc/makefile.inc b/rtl/inc/makefile.inc index 15a02efc32..0e6c80b7fb 100644 --- a/rtl/inc/makefile.inc +++ b/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)) diff --git a/rtl/inc/rtti.inc b/rtl/inc/rtti.inc index f9100484e0..a946191853 100644 --- a/rtl/inc/rtti.inc +++ b/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 diff --git a/rtl/m68k/rttip.inc b/rtl/m68k/rttip.inc deleted file mode 100644 index d69bc29d7e..0000000000 --- a/rtl/m68k/rttip.inc +++ /dev/null @@ -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 - -} diff --git a/rtl/powerpc/rttip.inc b/rtl/powerpc/rttip.inc deleted file mode 100644 index 877906a392..0000000000 --- a/rtl/powerpc/rttip.inc +++ /dev/null @@ -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 -}