VadimLou
Advanced Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Код: procedure TObject.FreeInstance; begin CleanupInstance; {+} PPointer(Self)^ := nil; {+.} _FreeMem(Pointer(Self)); end; procedure TObject.Free; begin {+}if (Self <> nil) // (Self.ClassType <> nil) : and (PPointer(Self)^ <> nil) then{+.} {$IFDEF AUTOREFCOUNT} __ObjRelease; {$ELSE} Destroy; {$ENDIF} end; function _IsClass(const Child: TObject; Parent: TClass): Boolean; begin Result := (Child <> nil) {+} and (PPointer(Child)^ <> nil) and Assigned(Parent) {+.} and Child.InheritsFrom(Parent); end; class function TObject.InheritsFrom(AClass: TClass): Boolean; {$IFDEF PUREPASCAL} {+} var ClassPtr: Pointer; P: Pointer; begin Result := AClass <> nil; if Result then begin ClassPtr := Self; while (ClassPtr <> nil) and (ClassPtr <> Pointer(AClass)) do begin P := PPointer(PByte(ClassPtr) + vmtParent)^; if P = nil then break; ClassPtr := PPointer(P)^; end; Result := ClassPtr = Pointer(AClass); end; end; {+.} {$ELSE !PUREPASCAL} {$IFDEF CPUX86} asm { -> EAX Pointer to our class } { EDX Pointer to AClass } { <- AL Boolean result } {+} // // check ClassPtr // CMP EAX,0 JE @@exit // // check AClass // CMP EDX,0 JNE @@main XOR EAX, EAX JE @@exit @@main: {+.} JMP @@haveVMT ... @@exit: end; {$ENDIF CPUX86} {$ENDIF !PUREPASCAL} | if obj.ClassType == nil then object is released !!! Конечно менеджер памяти может повторно исп-ть эти блоки, но на практике такой финт даст быстрее выявить источник/место/причину бага. | Всего записей: 702 | Зарегистр. 22-07-2004 | Отправлено: 12:40 31-01-2018 | Исправлено: VadimLou, 13:30 31-01-2018 |
|