|
|
@@ -630,308 +630,6 @@ end;
|
|
|
{$endif FPC_SYSTEM_HAS_INDEXCHAR0}
|
|
|
|
|
|
|
|
|
-{****************************************************************************
|
|
|
- Object Helpers
|
|
|
-****************************************************************************}
|
|
|
-{$ifndef HAS_GENERICCONSTRUCTOR}
|
|
|
-{$define FPC_SYSTEM_HAS_FPC_HELP_CONSTRUCTOR}
|
|
|
-procedure fpc_help_constructor; assembler; [public,alias:'FPC_HELP_CONSTRUCTOR']; compilerproc;
|
|
|
-asm
|
|
|
-{ Entry without preamble, since we need the ESP of the constructor
|
|
|
- Stack (relative to %ebp):
|
|
|
- 12 Self
|
|
|
- 8 VMT-Address
|
|
|
- 4 main programm-Addr
|
|
|
- 0 %ebp
|
|
|
- edi contains the vmt position
|
|
|
-}
|
|
|
- { eax isn't touched anywhere, so it doesn't have to reloaded }
|
|
|
- movl 8(%ebp),%eax
|
|
|
- { initialise self ? }
|
|
|
- orl %esi,%esi
|
|
|
- jne .LHC_4
|
|
|
- { get memory, but save register first temporary variable }
|
|
|
- subl $4,%esp
|
|
|
- movl %esp,%esi
|
|
|
- { Save Register}
|
|
|
- pushal
|
|
|
- { esi can be destroyed in fpc_getmem!!! (JM) }
|
|
|
- pushl %esi
|
|
|
- { Memory size }
|
|
|
- pushl (%eax)
|
|
|
- call fpc_getmem
|
|
|
- popl %esi
|
|
|
- movl %eax,(%esi)
|
|
|
- movl $-1,8(%ebp)
|
|
|
- popal
|
|
|
- { Avoid 80386DX bug }
|
|
|
- nop
|
|
|
- { Memory position to %esi }
|
|
|
- movl (%esi),%esi
|
|
|
- addl $4,%esp
|
|
|
- { If no memory available : fail() }
|
|
|
- orl %esi,%esi
|
|
|
- jz .LHC_5
|
|
|
- { init self for the constructor }
|
|
|
- movl %esi,12(%ebp)
|
|
|
- { jmp not necessary anymore because next instruction is disabled (JM)
|
|
|
- jmp .LHC_6 }
|
|
|
- { Why was the VMT reset to zero here ????
|
|
|
- I need it fail to know if I should
|
|
|
- zero the VMT field in static objects PM }
|
|
|
-.LHC_4:
|
|
|
- { movl $0,8(%ebp) }
|
|
|
-.LHC_6:
|
|
|
- { is there a VMT address ? }
|
|
|
- orl %eax,%eax
|
|
|
- jnz .LHC_7
|
|
|
- { In case the constructor doesn't do anything, the Zero-Flag }
|
|
|
- { can't be put, because this calls Fail() }
|
|
|
- incl %eax
|
|
|
- ret
|
|
|
-.LHC_7:
|
|
|
- { set zero inside the object }
|
|
|
- pushal
|
|
|
- cld
|
|
|
- movl (%eax),%ecx
|
|
|
- movl %esi,%edi
|
|
|
- movl %ecx,%ebx
|
|
|
- xorl %eax,%eax
|
|
|
- shrl $2,%ecx
|
|
|
- andl $3,%ebx
|
|
|
- rep
|
|
|
- stosl
|
|
|
- movl %ebx,%ecx
|
|
|
- rep
|
|
|
- stosb
|
|
|
- popal
|
|
|
- { avoid the 80386DX bug }
|
|
|
- nop
|
|
|
- { set the VMT address for the new created object }
|
|
|
- { the offset is in %edi since the calling and has not been changed !! }
|
|
|
- movl %eax,(%esi,%edi,1)
|
|
|
- testl %eax,%eax
|
|
|
-.LHC_5:
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-{$define FPC_SYSTEM_HAS_FPC_HELP_FAIL}
|
|
|
-procedure fpc_help_fail;assembler;[public,alias:'FPC_HELP_FAIL']; compilerproc;
|
|
|
-{ should be called with a object that needs to be
|
|
|
- freed if VMT field is at -1
|
|
|
- %edi contains VMT offset in object again }
|
|
|
-asm
|
|
|
- testl %esi,%esi
|
|
|
- je .LHF_1
|
|
|
- cmpl $-1,8(%ebp)
|
|
|
- je .LHF_2
|
|
|
- { reset vmt field to zero for static instances }
|
|
|
- cmpl $0,8(%ebp)
|
|
|
- je .LHF_3
|
|
|
- { main constructor, we can zero the VMT field now }
|
|
|
- movl $0,(%esi,%edi,1)
|
|
|
-.LHF_3:
|
|
|
- { we zero esi to indicate failure }
|
|
|
- xorl %esi,%esi
|
|
|
- jmp .LHF_1
|
|
|
-.LHF_2:
|
|
|
- { get vmt address in eax }
|
|
|
- movl (%esi,%edi,1),%eax
|
|
|
- movl %esi,12(%ebp)
|
|
|
- { push object position }
|
|
|
- pushl %esi
|
|
|
- call fpc_freemem
|
|
|
- { set both object places to zero }
|
|
|
- xorl %esi,%esi
|
|
|
- movl %esi,12(%ebp)
|
|
|
-.LHF_1:
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-{$define FPC_SYSTEM_HAS_FPC_HELP_DESTRUCTOR}
|
|
|
-procedure fpc_help_destructor;assembler;[public,alias:'FPC_HELP_DESTRUCTOR']; compilerproc;
|
|
|
-asm
|
|
|
-{ Stack (relative to %ebp):
|
|
|
- 12 Self
|
|
|
- 8 VMT-Address
|
|
|
- 4 Main program-Addr
|
|
|
- 0 %ebp
|
|
|
- edi contains the vmt position
|
|
|
-}
|
|
|
- pushal
|
|
|
- { Should the object be resolved ? }
|
|
|
- movl 8(%ebp),%eax
|
|
|
- orl %eax,%eax
|
|
|
- jz .LHD_3
|
|
|
- { Yes, get size from SELF! }
|
|
|
- movl 12(%ebp),%eax
|
|
|
- { get VMT-pointer (from Self) to %ebx }
|
|
|
- { the offset is in %edi since the calling and has not been changed !! }
|
|
|
- movl (%eax,%edi,1),%ebx
|
|
|
- { I think for precaution }
|
|
|
- { that we should clear the VMT here }
|
|
|
- movl $0,(%eax,%edi,1)
|
|
|
- { Freemem }
|
|
|
- pushl %eax
|
|
|
- call fpc_freemem
|
|
|
-.LHD_3:
|
|
|
- popal
|
|
|
- { avoid the 80386DX bug }
|
|
|
- nop
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-{$define FPC_SYSTEM_HAS_FPC_NEW_CLASS}
|
|
|
-procedure fpc_new_class;assembler;[public,alias:'FPC_NEW_CLASS']; compilerproc;
|
|
|
-asm
|
|
|
- { to be sure in the future, we save also edit }
|
|
|
- pushl %edi
|
|
|
- { create class ? }
|
|
|
- movl 8(%ebp),%edi
|
|
|
- { if we test eax later without calling newinstance }
|
|
|
- { it must have a value <>0 }
|
|
|
- movl $1,%eax
|
|
|
- testl %edi,%edi
|
|
|
- jz .LNEW_CLASS1
|
|
|
- { save registers !! }
|
|
|
- pushl %ebx
|
|
|
- pushl %ecx
|
|
|
- pushl %edx
|
|
|
- { esi contains the vmt }
|
|
|
- pushl %esi
|
|
|
- { call newinstance (class method!) }
|
|
|
- call *52{vmtNewInstance}(%esi)
|
|
|
- popl %edx
|
|
|
- popl %ecx
|
|
|
- popl %ebx
|
|
|
- { newinstance returns a pointer to the new created }
|
|
|
- { instance in eax }
|
|
|
- { load esi and insert self }
|
|
|
- movl %eax,%esi
|
|
|
-.LNEW_CLASS1:
|
|
|
- movl %esi,8(%ebp)
|
|
|
- testl %eax,%eax
|
|
|
- popl %edi
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-{ Internal alias that can be reference from asm code }
|
|
|
-procedure int_dispose_class;external name 'FPC_DISPOSE_CLASS';
|
|
|
-
|
|
|
-{$define FPC_SYSTEM_HAS_FPC_DISPOSE_CLASS}
|
|
|
-procedure fpc_dispose_class;assembler;[public,alias:'FPC_DISPOSE_CLASS']; compilerproc;
|
|
|
-asm
|
|
|
- { to be sure in the future, we save also edit }
|
|
|
- pushl %edi
|
|
|
- { destroy class ? }
|
|
|
- movl 12(%ebp),%edi
|
|
|
- testl %edi,%edi
|
|
|
- jz .LDISPOSE_CLASS1
|
|
|
- { no inherited call }
|
|
|
- movl (%esi),%edi
|
|
|
- { save registers !! }
|
|
|
- pushl %eax
|
|
|
- pushl %ebx
|
|
|
- pushl %ecx
|
|
|
- pushl %edx
|
|
|
- { push self }
|
|
|
- pushl %esi
|
|
|
- { call freeinstance }
|
|
|
- call *56{vmtFreeInstance}(%edi)
|
|
|
- popl %edx
|
|
|
- popl %ecx
|
|
|
- popl %ebx
|
|
|
- popl %eax
|
|
|
-.LDISPOSE_CLASS1:
|
|
|
- popl %edi
|
|
|
-end;
|
|
|
-
|
|
|
-{$define FPC_SYSTEM_HAS_FPC_HELP_FAIL_CLASS}
|
|
|
-procedure fpc_help_fail_class;assembler;[public,alias:'FPC_HELP_FAIL_CLASS']; compilerproc;
|
|
|
-{ a non zero class must allways be disposed
|
|
|
- VMT is allways at pos 0 }
|
|
|
-asm
|
|
|
- testl %esi,%esi
|
|
|
- je .LHFC_1
|
|
|
- { can't use the compilerproc version as that will generate a
|
|
|
- reference instead of a symbol }
|
|
|
- call int_dispose_class
|
|
|
- { set both object places to zero }
|
|
|
- xorl %esi,%esi
|
|
|
- movl %esi,8(%ebp)
|
|
|
-.LHFC_1:
|
|
|
-end;
|
|
|
-
|
|
|
-{$define FPC_SYSTEM_HAS_FPC_CHECK_OBJECT}
|
|
|
-{ we want the stack for debugging !! PM }
|
|
|
-procedure fpc_check_object(obj : pointer);[public,alias:'FPC_CHECK_OBJECT']; compilerproc;
|
|
|
-begin
|
|
|
-asm
|
|
|
- pushl %edi
|
|
|
- movl obj,%edi
|
|
|
- pushl %eax
|
|
|
- { Here we must check if the VMT pointer is nil before }
|
|
|
- { accessing it... }
|
|
|
- testl %edi,%edi
|
|
|
- jz .Lco_re
|
|
|
- movl (%edi),%eax
|
|
|
- addl 4(%edi),%eax
|
|
|
- jz .Lco_ok
|
|
|
-.Lco_re:
|
|
|
- pushl $210
|
|
|
- call HandleError
|
|
|
-.Lco_ok:
|
|
|
- popl %eax
|
|
|
- popl %edi
|
|
|
- { the adress is pushed : it needs to be removed from stack !! PM }
|
|
|
-end;{ of asm }
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-{$define FPC_SYSTEM_HAS_FPC_CHECK_OBJECT_EXT}
|
|
|
-procedure fpc_check_object_ext;assembler;[public,alias:'FPC_CHECK_OBJECT_EXT']; compilerproc;
|
|
|
-{ checks for a correct vmt pointer }
|
|
|
-{ deeper check to see if the current object is }
|
|
|
-{ really related to the true }
|
|
|
-asm
|
|
|
- pushl %ebp
|
|
|
- movl %esp,%ebp
|
|
|
- pushl %edi
|
|
|
- movl 8(%ebp),%edi
|
|
|
- pushl %ebx
|
|
|
- movl 12(%ebp),%ebx
|
|
|
- pushl %eax
|
|
|
- { Here we must check if the VMT pointer is nil before }
|
|
|
- { accessing it... }
|
|
|
-.Lcoext_obj:
|
|
|
- testl %edi,%edi
|
|
|
- jz .Lcoext_re
|
|
|
- movl (%edi),%eax
|
|
|
- addl 4(%edi),%eax
|
|
|
- jnz .Lcoext_re
|
|
|
- cmpl %edi,%ebx
|
|
|
- je .Lcoext_ok
|
|
|
-.Lcoext_vmt:
|
|
|
- movl 8(%edi),%eax
|
|
|
- cmpl %ebx,%eax
|
|
|
- je .Lcoext_ok
|
|
|
- movl %eax,%edi
|
|
|
- jmp .Lcoext_obj
|
|
|
-.Lcoext_re:
|
|
|
- pushl $219
|
|
|
- call HandleError
|
|
|
-.Lcoext_ok:
|
|
|
- popl %eax
|
|
|
- popl %ebx
|
|
|
- popl %edi
|
|
|
- { the adress and vmt were pushed : it needs to be removed from stack !! PM }
|
|
|
- popl %ebp
|
|
|
- ret $8
|
|
|
-end;
|
|
|
-
|
|
|
-{$endif HAS_GENERICCONSTRUCTOR}
|
|
|
-
|
|
|
-
|
|
|
{****************************************************************************
|
|
|
String
|
|
|
****************************************************************************}
|
michael