diff --git a/rtl/ntapi.pas b/rtl/ntapi.pas index 7159cea8..52572d95 100644 --- a/rtl/ntapi.pas +++ b/rtl/ntapi.pas @@ -600,6 +600,11 @@ function NtSetInformationThread( ThreadInformationLength:ULONG ):DWORD; stdcall; external 'ntdll'; +function NtTerminateProcess( + ProcessHandle:THandle; + ExitStatus :DWORD + ):DWORD; stdcall; external 'ntdll'; + function NtContinue( Context:PCONTEXT; RaiseAlert:Boolean diff --git a/sys/dev/dev_dmem.pas b/sys/dev/dev_dmem.pas index 28820b9a..a2c8f831 100644 --- a/sys/dev/dev_dmem.pas +++ b/sys/dev/dev_dmem.pas @@ -69,7 +69,7 @@ begin else begin - print_backtrace_c(stderr); + print_backtrace_td(stderr); Assert(False); Result:=EINVAL; end; @@ -83,7 +83,7 @@ begin Writeln('dmem_mmap("',dev^.si_name,'",0x',HexStr(offset,8),',0x',HexStr(paddr),',',nprot,')'); - print_backtrace_c(stderr); + print_backtrace_td(stderr); Assert(False); end; diff --git a/sys/dev/dev_gc.pas b/sys/dev/dev_gc.pas index dfec578b..a7f92dbb 100644 --- a/sys/dev/dev_gc.pas +++ b/sys/dev/dev_gc.pas @@ -81,7 +81,7 @@ begin else begin - print_backtrace_c(stderr); + print_backtrace_td(stderr); Assert(False); Result:=EINVAL; end; diff --git a/sys/kern/kern_exit.pas b/sys/kern/kern_exit.pas index 07381d76..7d35df51 100644 --- a/sys/kern/kern_exit.pas +++ b/sys/kern/kern_exit.pas @@ -64,7 +64,8 @@ implementation uses errno, - systm; + systm, + md_proc; function _WSTATUS(x:Integer):Integer; inline; begin @@ -123,7 +124,7 @@ end; procedure exit1(rv:Integer); begin - Halt(rv); + md_halt(rv); end; procedure sys_sys_exit(rval:Integer); diff --git a/sys/kern/kern_ipmimgr.pas b/sys/kern/kern_ipmimgr.pas index 2e6a715a..782ad653 100644 --- a/sys/kern/kern_ipmimgr.pas +++ b/sys/kern/kern_ipmimgr.pas @@ -256,7 +256,7 @@ begin begin Result:=0; dst:=-1; - print_backtrace_c(stderr); + print_backtrace_td(stderr); Assert(False); end; end; diff --git a/sys/kern/kern_mdbg.pas b/sys/kern/kern_mdbg.pas index b24703df..afc1741a 100644 --- a/sys/kern/kern_mdbg.pas +++ b/sys/kern/kern_mdbg.pas @@ -60,7 +60,7 @@ begin else begin - print_backtrace_c(stderr); + print_backtrace_td(stderr); Assert(False); Result:=EINVAL; end; diff --git a/sys/kern/kern_regmgr.pas b/sys/kern/kern_regmgr.pas index 45fcfe80..f9467e94 100644 --- a/sys/kern/kern_regmgr.pas +++ b/sys/kern/kern_regmgr.pas @@ -77,7 +77,7 @@ begin else begin Writeln(' enc:0x',HexStr(qword(data.enc),16)); - print_backtrace_c(stderr); + print_backtrace_td(stderr); Assert(False); end; end; @@ -108,7 +108,7 @@ begin else begin Writeln(' enc:0x',HexStr(qword(data.enc),16)); - print_backtrace_c(stderr); + print_backtrace_td(stderr); Assert(False); end; end; @@ -121,7 +121,7 @@ begin else begin Writeln('Unhandled regmgr op:0x',HexStr(op,4)); - print_backtrace_c(stderr); + print_backtrace_td(stderr); Assert(False); end; end; diff --git a/sys/kern/trap.pas b/sys/kern/trap.pas index ca94a45f..f66e09e5 100644 --- a/sys/kern/trap.pas +++ b/sys/kern/trap.pas @@ -110,7 +110,7 @@ procedure sig_sti; procedure sig_cli; procedure print_backtrace(var f:text;rip,rbp:Pointer;skipframes:sizeint); -procedure print_backtrace_c(var f:text); +procedure print_backtrace_td(var f:text); procedure fast_syscall; procedure sigcode; @@ -161,7 +161,6 @@ uses vm, vmparam, vm_map, - vm_pmap, vm_fault, machdep, md_context, @@ -170,8 +169,7 @@ uses sysent, subr_dynlib, elf_nid_utils, - ps4libdoc, - x86_fpdbgdisas; + ps4libdoc; const NOT_PCB_FULL_IRET=not PCB_FULL_IRET; @@ -493,10 +491,13 @@ begin Writeln(f,' 0x',HexStr(frame),' ',info.source); end; end else + if (BackTraceStrFunc<>nil) then begin Writeln(f,BackTraceStrFunc(frame)); + end else + begin + Writeln(f,' 0x',HexStr(frame)); end; - end; procedure print_backtrace(var f:text;rip,rbp:Pointer;skipframes:sizeint); @@ -518,7 +519,7 @@ begin end; end; -procedure print_backtrace_c(var f:text); +procedure print_backtrace_td(var f:text); var td:p_kthread; begin @@ -998,7 +999,7 @@ begin begin Result:=trap_pfault(frame,IS_USERMODE(curkthread,frame)); - print_backtrace_c(stderr); + print_backtrace_td(stderr); writeln; end; diff --git a/sys/kern/uipc_syscalls.pas b/sys/kern/uipc_syscalls.pas index 08772ad7..679559b0 100644 --- a/sys/kern/uipc_syscalls.pas +++ b/sys/kern/uipc_syscalls.pas @@ -34,7 +34,7 @@ begin end; else begin - print_backtrace_c(stderr); + print_backtrace_td(stderr); Assert(False); end; end; diff --git a/sys/md/md_context.pas b/sys/md/md_context.pas index 1ae4bb28..c914af61 100644 --- a/sys/md/md_context.pas +++ b/sys/md/md_context.pas @@ -78,6 +78,9 @@ function _get_ctx_flags(src:p_ucontext_t):DWORD; procedure _get_fpcontext(src:PCONTEXT;xstate:Pointer); procedure _set_fpcontext(dst:PCONTEXT;xstate:Pointer); +procedure _get_frame(src:PCONTEXT;dst:p_trapframe;xstate:Pointer); +procedure _set_frame(dst:PCONTEXT;src:p_trapframe;xstate:Pointer); + procedure _get_ucontext(src:PCONTEXT;dst:p_ucontext_t); procedure _set_ucontext(dst:PCONTEXT;src:p_ucontext_t); @@ -178,6 +181,20 @@ begin Result:=Result and (not CONTEXT_AMD64); end; +function _get_ctx_flags(src:p_trapframe):DWORD; +begin + Result:=CONTEXT_INTEGER or CONTEXT_CONTROL; + if ((src^.tf_flags and _MC_HASSEGS)<>0) then + begin + Result:=Result or CONTEXT_SEGMENTS; + end; + if ((src^.tf_flags and _MC_HASFPXSTATE)<>0) then + begin + Result:=Result or CONTEXT_FLOATING_POINT or CONTEXT_XSTATE; + end; + Result:=Result and (not CONTEXT_AMD64); +end; + procedure _get_fpcontext(src:PCONTEXT;xstate:Pointer); var context_ex:PCONTEXT_EX; @@ -218,6 +235,94 @@ begin xs^:=uc_xstate^; end; +procedure _get_frame(src:PCONTEXT;dst:p_trapframe;xstate:Pointer); +var + flags:DWORD; +begin + if (src=nil) or (dst=nil) then Exit; + + flags:=src^.ContextFlags and (not CONTEXT_AMD64); + + if ((flags and CONTEXT_INTEGER)<>0) then + begin + dst^.tf_rax:=src^.Rax; + dst^.tf_rbx:=src^.Rbx; + dst^.tf_rcx:=src^.Rcx; + dst^.tf_rdx:=src^.Rdx; + dst^.tf_rsi:=src^.Rsi; + dst^.tf_rdi:=src^.Rdi; + dst^.tf_r8 :=src^.R8 ; + dst^.tf_r9 :=src^.R9 ; + dst^.tf_r10:=src^.R10; + dst^.tf_r11:=src^.R11; + dst^.tf_r12:=src^.R12; + dst^.tf_r13:=src^.R13; + dst^.tf_r14:=src^.R14; + dst^.tf_r15:=src^.R15; + dst^.tf_rbp:=src^.Rbp; + end; + + if ((flags and CONTEXT_CONTROL)<>0) then + begin + dst^.tf_rsp :=src^.Rsp; + dst^.tf_rip :=src^.Rip; + dst^.tf_rflags:=src^.EFlags; + end; + + if ((flags and CONTEXT_XSTATE)<>0) then + begin + _get_fpcontext(src,xstate); + + dst^.tf_flags:=dst^.tf_flags or _MC_HASFPXSTATE; + end; +end; + +procedure _set_frame(dst:PCONTEXT;src:p_trapframe;xstate:Pointer); +var + flags:DWORD; +begin + if (src=nil) or (dst=nil) then Exit; + + flags:=_get_ctx_flags(src); + + flags:=flags and dst^.ContextFlags; //filter + dst^.ContextFlags:=flags or CONTEXT_AMD64; //update + + if ((flags and CONTEXT_INTEGER)<>0) then + begin + dst^.Rax:=src^.tf_rax; + dst^.Rbx:=src^.tf_rbx; + dst^.Rcx:=src^.tf_rcx; + dst^.Rdx:=src^.tf_rdx; + dst^.Rsi:=src^.tf_rsi; + dst^.Rdi:=src^.tf_rdi; + dst^.R8 :=src^.tf_r8; + dst^.R9 :=src^.tf_r9; + dst^.R10:=src^.tf_r10; + dst^.R11:=src^.tf_r11; + dst^.R12:=src^.tf_r12; + dst^.R13:=src^.tf_r13; + dst^.R14:=src^.tf_r14; + dst^.R15:=src^.tf_r15; + dst^.Rbp:=src^.tf_rbp; + end; + + if ((flags and CONTEXT_CONTROL)<>0) then + begin + dst^.Rsp :=src^.tf_rsp; + dst^.Rip :=src^.tf_rip; + dst^.EFlags:=src^.tf_rflags; + end; + + if ((flags and CONTEXT_FLOATING_POINT)<>0) or + ((flags and CONTEXT_XSTATE)<>0) then + begin + _set_fpcontext(dst,xstate); + end; +end; + +// + procedure _get_ucontext(src:PCONTEXT;dst:p_ucontext_t); var flags:DWORD; diff --git a/sys/md/md_exception.pas b/sys/md/md_exception.pas index 240ecc74..daef49ac 100644 --- a/sys/md/md_exception.pas +++ b/sys/md/md_exception.pas @@ -8,9 +8,11 @@ implementation uses Windows, + sysutils, ntapi, machdep, md_context, + md_proc, kern_thr, trap, signal, @@ -18,69 +20,72 @@ uses vm, vmparam; -function AddVectoredExceptionHandler(FirstHandler: DWORD; VectoredHandler: pointer): pointer; stdcall; - external 'kernel32.dll' name 'AddVectoredExceptionHandler'; -function RemoveVectoredExceptionHandler(VectoredHandlerHandle: pointer): ULONG; stdcall; - external 'kernel32.dll' name 'RemoveVectoredExceptionHandler'; -function GetModuleHandleEx(dwFlags: DWORD; lpModuleName: pointer; var hModule: THandle): BOOL; stdcall; - external 'kernel32.dll' name 'GetModuleHandleExA'; +type + LPTOP_LEVEL_EXCEPTION_FILTER=function(excep:PEXCEPTION_POINTERS):longint; stdcall; + +function SetUnhandledExceptionFilter(lpTopLevelExceptionFilter:Pointer):Pointer; stdcall; external 'kernel32' name 'SetUnhandledExceptionFilter'; +function AddVectoredExceptionHandler(FirstHandler:DWORD;VectoredHandler:Pointer):Pointer; stdcall; external 'kernel32' name 'AddVectoredExceptionHandler'; +function RemoveVectoredExceptionHandler(VectoredHandlerHandle:Pointer): ULONG; stdcall; external 'kernel32' name 'RemoveVectoredExceptionHandler'; +function GetModuleHandleEx(dwFlags:DWORD;lpModuleName:Pointer;var hModule:THandle):BOOL; stdcall; external 'kernel32' name 'GetModuleHandleExA'; function RunErrorCode(const rec: TExceptionRecord): longint; begin - { negative result means 'FPU reset required' } - case rec.ExceptionCode of - STATUS_INTEGER_DIVIDE_BY_ZERO: result := 200; { reDivByZero } - STATUS_FLOAT_DIVIDE_BY_ZERO: result := -208; { !!reZeroDivide } - STATUS_ARRAY_BOUNDS_EXCEEDED: result := 201; { reRangeError } - STATUS_STACK_OVERFLOW: result := 202; { reStackOverflow } - STATUS_FLOAT_OVERFLOW: result := -205; { reOverflow } - STATUS_FLOAT_DENORMAL_OPERAND, - STATUS_FLOAT_UNDERFLOW: result := -206; { reUnderflow } - STATUS_FLOAT_INEXACT_RESULT, - STATUS_FLOAT_INVALID_OPERATION, - STATUS_FLOAT_STACK_CHECK: result := -207; { reInvalidOp } - STATUS_INTEGER_OVERFLOW: result := 215; { reIntOverflow } - STATUS_ILLEGAL_INSTRUCTION: result := -216; - STATUS_ACCESS_VIOLATION: result := 216; { reAccessViolation } - STATUS_CONTROL_C_EXIT: result := 217; { reControlBreak } - STATUS_PRIVILEGED_INSTRUCTION: result := 218; { rePrivilegedInstruction } - STATUS_FLOAT_MULTIPLE_TRAPS, - STATUS_FLOAT_MULTIPLE_FAULTS: result := -255; { indicate FPU reset } - else - result := 255; { reExternalException } - end; + { negative result means 'FPU reset required' } + case rec.ExceptionCode of + STATUS_INTEGER_DIVIDE_BY_ZERO: result := 200; { reDivByZero } + STATUS_FLOAT_DIVIDE_BY_ZERO: result := -208; { !!reZeroDivide } + STATUS_ARRAY_BOUNDS_EXCEEDED: result := 201; { reRangeError } + STATUS_STACK_OVERFLOW: result := 202; { reStackOverflow } + STATUS_FLOAT_OVERFLOW: result := -205; { reOverflow } + STATUS_FLOAT_DENORMAL_OPERAND, + STATUS_FLOAT_UNDERFLOW: result := -206; { reUnderflow } + STATUS_FLOAT_INEXACT_RESULT, + STATUS_FLOAT_INVALID_OPERATION, + STATUS_FLOAT_STACK_CHECK: result := -207; { reInvalidOp } + STATUS_INTEGER_OVERFLOW: result := 215; { reIntOverflow } + STATUS_ILLEGAL_INSTRUCTION: result := -216; + STATUS_ACCESS_VIOLATION: result := 216; { reAccessViolation } + STATUS_CONTROL_C_EXIT: result := 217; { reControlBreak } + STATUS_PRIVILEGED_INSTRUCTION: result := 218; { rePrivilegedInstruction } + STATUS_FLOAT_MULTIPLE_TRAPS, + STATUS_FLOAT_MULTIPLE_FAULTS: result := -255; { indicate FPU reset } + else + result := 255; { reExternalException } + end; end; procedure TranslateMxcsr(mxcsr: longword; var code: longint); begin - { we can return only one value, further one's are lost } - { InvalidOp } - if (mxcsr and 1)<>0 then - code:=-207 - { Denormal } - else if (mxcsr and 2)<>0 then - code:=-206 - { !!reZeroDivide } - else if (mxcsr and 4)<>0 then - code:=-208 - { reOverflow } - else if (mxcsr and 8)<>0 then - code:=-205 - { Underflow } - else if (mxcsr and 16)<>0 then - code:=-206 - { Precision } - else if (mxcsr and 32)<>0 then - code:=-207 - else { this should not happen } - code:=-255 + { we can return only one value, further one's are lost } + { InvalidOp } + if (mxcsr and 1)<>0 then + code:=-207 + { Denormal } + else if (mxcsr and 2)<>0 then + code:=-206 + { !!reZeroDivide } + else if (mxcsr and 4)<>0 then + code:=-208 + { reOverflow } + else if (mxcsr and 8)<>0 then + code:=-205 + { Underflow } + else if (mxcsr and 16)<>0 then + code:=-206 + { Precision } + else if (mxcsr and 32)<>0 then + code:=-207 + else { this should not happen } + code:=-255 end; -function RunErrorCodex64(const rec: TExceptionRecord; const context: TContext): Longint; +function RunErrorCodeSEH(const rec:TExceptionRecord;const context:TContext):Longint; begin Result:=RunErrorCode(rec); if (Result=-255) then - TranslateMxcsr(context.MxCsr,result); + begin + TranslateMxcsr(context.MxCsr,result); + end; end; const @@ -117,8 +122,6 @@ begin rv:=-1; case ExceptionCode of - FPC_EXCEPTION_CODE:; - STATUS_ACCESS_VIOLATION: begin tf_addr:=p^.ExceptionRecord^.ExceptionInformation[1]; @@ -127,8 +130,8 @@ begin //Writeln(HexStr(Get_pc_addr)); uc:=Default(ucontext_t); - _get_ucontext(p^.ContextRecord,@uc); - set_mcontext(td, @uc.uc_mcontext); + + _get_frame(p^.ContextRecord,@td^.td_frame,@td^.td_fpstate); td^.td_frame.tf_trapno:=T_PAGEFLT; td^.td_frame.tf_err :=translate_pageflt_err(p^.ExceptionRecord^.ExceptionInformation[0]); @@ -142,26 +145,46 @@ begin if (rv=0) then begin - get_mcontext(td, @uc.uc_mcontext, TF_HASFPXSTATE); - _set_ucontext(p^.ContextRecord,@uc); + _set_frame(p^.ContextRecord,@td^.td_frame,@td^.td_fpstate); Result:=0; end; + td^.pcb_flags:=td^.pcb_flags and (not PCB_FULL_IRET); + td^.td_frame:=backup; end; function ProcessException2(p:PExceptionPointers):longint; assembler; nostackframe; SysV_ABI_CDecl; asm + //prolog (debugger) + pushq %rbp + movq %rsp,%rbp + movq ProcessException3,%rax call fast_syscall + + //epilog (debugger) + popq %rbp end; +type + TExceptObjProc=function(code: Longint; const rec: TExceptionRecord): Pointer; { Exception } + TExceptClsProc=function(code: Longint): Pointer; { ExceptClass } + function ProcessException(p:PExceptionPointers):longint; stdcall; begin Result:=EXCEPTION_CONTINUE_SEARCH; + //Writeln('rsp:0x',HexStr(p^.ContextRecord^.Rsp,16)); + //Writeln('rsp:0x',HexStr(get_frame)); + if (curkthread=nil) then Exit; + case p^.ExceptionRecord^.ExceptionCode of + FPC_EXCEPTION_CODE :Exit; + EXCEPTION_SET_THREADNAME:Exit; + end; + if not is_guest_addr(QWORD(p^.ExceptionRecord^.ExceptionAddress)) then Exit; //It looks like there is a small stack inside the exception, so you need to switch the context @@ -176,22 +199,88 @@ begin end; end; +function UnhandledException(p:PExceptionPointers):longint; stdcall; var - VEHandler:pointer=nil; + rec:PExceptionRecord; + + adr: Pointer; + Exc: PExceptObject; + Frames: PPointer; + FrameCount: Longint; + code: Longint; + + str:shortstring; + + ExObj:Exception; +begin + Result:=EXCEPTION_CONTINUE_SEARCH; + + case p^.ExceptionRecord^.ExceptionCode of + FPC_EXCEPTION_CODE :Exit; + EXCEPTION_SET_THREADNAME:Exit; + end; + + rec:=p^.ExceptionRecord; + + code:=abs(RunErrorCodeSEH(rec^,p^.ContextRecord^)); + + ExObj:=nil; + + if (rec^.ExceptionCode=FPC_EXCEPTION_CODE) then + begin + ExObj:=Exception(rec^.ExceptionInformation[1]) + end else + if Assigned(ExceptObjProc) then + begin + ExObj:=Exception(TExceptObjProc(ExceptObjProc)(abs(code),rec^)); + end; + + if (ExObj=nil) then + begin + Writeln(stderr,'Runtime error ',code,' at $',hexstr(rec^.ExceptionAddress)); + end else + begin + Writeln(stderr,'An unhandled exception occurred at $',hexstr(rec^.ExceptionAddress)); + Writeln(stderr,ExObj.ClassName,': ',ExObj.Message); + end; + + print_backtrace(stderr, + Pointer(p^.ContextRecord^.Rip), + Pointer(p^.ContextRecord^.Rbp),0); + + ErrorCode:=word(code); + md_halt(code); +end; + +Procedure _Assert(Const Msg,FName:Shortstring;LineNo:Longint;ErrorAddr:Pointer); +begin + If Length(msg)=0 then + write(stderr,'Assertion failed') + else + write(stderr,msg); + Writeln(stderr,' (',FName,', line ',LineNo,').'); + print_backtrace(stderr,Get_pc_addr,get_frame,0); + md_halt(217); +end; + +var + VEHandler:Pointer=nil; + UEHandler:Pointer=nil; + V2Handler:Pointer=nil; procedure InstallExceptionHandler; begin - //SetUnhandledExceptionFilter + AssertErrorProc:=@_Assert; + UEHandler:=SetUnhandledExceptionFilter(@UnhandledException); VEHandler:=AddVectoredExceptionHandler(1,@ProcessException); + V2Handler:=AddVectoredExceptionHandler(0,@UnhandledException); end; procedure UninstallExceptionHandler; begin - if Assigned(VEHandler) then - begin - RemoveVectoredExceptionHandler(VEHandler); - VEHandler:=nil; - end; + SetUnhandledExceptionFilter(UEHandler); + RemoveVectoredExceptionHandler(VEHandler); + RemoveVectoredExceptionHandler(V2Handler); end; initialization diff --git a/sys/md/md_proc.pas b/sys/md/md_proc.pas index 89d6d547..09689b3a 100644 --- a/sys/md/md_proc.pas +++ b/sys/md/md_proc.pas @@ -18,6 +18,8 @@ function cpuset_getproc(var old:Ptruint):Integer; function get_proc_prio():Integer; function set_proc_prio(n:Integer):Integer; +Procedure md_halt(errnum:TExitCode); noreturn; + implementation function cpuset_setproc(new:Ptruint):Integer; @@ -93,6 +95,11 @@ begin SizeOf(info)); end; +Procedure md_halt(errnum:TExitCode); noreturn; +begin + NtTerminateProcess(NtCurrentProcess, errnum); +end; + initialization g_pid:=GetCurrentProcessId; diff --git a/sys/sys_signal.pas b/sys/sys_signal.pas index 5d7e0c64..80427c1e 100644 --- a/sys/sys_signal.pas +++ b/sys/sys_signal.pas @@ -892,7 +892,7 @@ begin SIG_ERR: begin DebugBreak; - Halt(0); + md_halt(0); end; else; end; diff --git a/sys/test/project1.lpr b/sys/test/project1.lpr index 4f3b2446..98fe97f1 100644 --- a/sys/test/project1.lpr +++ b/sys/test/project1.lpr @@ -257,6 +257,11 @@ asm mov %gs:(0x708),%rax end; +function Get_SEH:Pointer; assembler; nostackframe; +asm + mov %gs:(0),%rax +end; + threadvar intr:Integer; @@ -478,6 +483,24 @@ begin //callout_drain(calloutp); end; + +{ +Type + TBacktraceStrFunc = Function (Addr: CodePointer): ShortString; + TErrorProc = Procedure (ErrNo : Longint; Address : CodePointer; Frame : Pointer); + TAbstractErrorProc = Procedure; + TAssertErrorProc = Procedure(const msg,fname:ShortString;lineno:longint;erroraddr:pointer); + TSafeCallErrorProc = Procedure(error : HResult;addr : pointer); + + +const + BacktraceStrFunc : TBacktraceStrFunc = @SysBacktraceStr; + ErrorProc : TErrorProc = nil; + AbstractErrorProc : TAbstractErrorProc = nil; + AssertErrorProc : TAssertErrorProc = @SysAssert; + SafeCallErrorProc : TSafeCallErrorProc = nil; +} + procedure test_thread; sysv_abi_default; var rax:qword; @@ -491,6 +514,12 @@ var calloutp:p_callout; begin + writeln('Get_SEH:0x',HexStr(Get_SEH)); + + //PPointer(nil)^:=nil; + + //Assert(false,'test assert'); + //if (tid<>curkthread^.td_tid) then //begin // calloutp:=AllocMem(SizeOf(t_callout));