123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530 |
- {
- $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 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 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 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.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
- }
|