mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-30 05:43:51 +02:00
* 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
This commit is contained in:
peter
parent
8a75d59544
commit
24384c648b
@ -2,6 +2,6 @@
|
|||||||
# Here we set processor dependent include file names.
|
# 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))
|
CPUINCNAMES=$(addsuffix .inc,$(CPUNAMES))
|
||||||
|
|
||||||
|
|||||||
@ -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
|
|
||||||
}
|
|
||||||
|
|
||||||
@ -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
|
|
||||||
|
|
||||||
}
|
|
||||||
@ -6,7 +6,7 @@
|
|||||||
|
|
||||||
SYSNAMES=systemh heaph mathh filerec textrec system real2str sstrings innr \
|
SYSNAMES=systemh heaph mathh filerec textrec system real2str sstrings innr \
|
||||||
file typefile text rtti heap astrings objpas objpash except int64 \
|
file typefile text rtti heap astrings objpas objpash except int64 \
|
||||||
generic dynarr varianth variant genrtti
|
generic dynarr varianth variant
|
||||||
|
|
||||||
SYSINCNAMES=$(addsuffix .inc,$(SYSNAMES))
|
SYSINCNAMES=$(addsuffix .inc,$(SYSNAMES))
|
||||||
|
|
||||||
|
|||||||
238
rtl/inc/rtti.inc
238
rtl/inc/rtti.inc
@ -83,16 +83,242 @@ TArrayRec = record
|
|||||||
Info : Pointer;
|
Info : Pointer;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ The actual Routines are implemented per processor. }
|
|
||||||
|
|
||||||
{ Include the cpu dependant part }
|
Procedure fpc_Initialize (Data,TypeInfo : pointer);saveregisters;[Public,Alias : 'FPC_INITIALIZE']; {$ifdef hascompilerproc} compilerproc; {$endif}
|
||||||
{$i rttip.inc}
|
|
||||||
{ Include the generic part }
|
{ this definition is sometimes (depending on switches)
|
||||||
{$i genrtti.inc}
|
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$
|
$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
|
* init and final code in genrtti.inc updated
|
||||||
|
|
||||||
Revision 1.4 2001/04/23 18:25:45 peter
|
Revision 1.4 2001/04/23 18:25:45 peter
|
||||||
|
|||||||
@ -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
|
|
||||||
|
|
||||||
}
|
|
||||||
@ -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
|
|
||||||
}
|
|
||||||
Loading…
Reference in New Issue
Block a user