From 3f2f5ed559fb741c06bc2dabd278c84555b9844d Mon Sep 17 00:00:00 2001 From: Tomas Hajny Date: Wed, 7 Dec 2011 01:02:56 +0000 Subject: [PATCH] + support for working with thread priorities added git-svn-id: trunk@19765 - --- rtl/os2/systhrd.inc | 155 +++++++++++++++++++++++++++++++++++++------- 1 file changed, 132 insertions(+), 23 deletions(-) diff --git a/rtl/os2/systhrd.inc b/rtl/os2/systhrd.inc index 0da6756e11..7c321cb839 100644 --- a/rtl/os2/systhrd.inc +++ b/rtl/os2/systhrd.inc @@ -34,6 +34,69 @@ const dpThread = 2; dpSameClass = 0; dce_AutoReset = $1000; + qs_End = 0; + qs_Process = 1; + qs_Thread = 256; + +type + PQSTRec = ^TQSTRec; + TQSTRec = record + RecType: cardinal; { Record type } + TID: word; { Thread ID } + Slot: word; { "Unique" thread slot number } + SleepID: cardinal; { Sleep ID thread is sleeping on } + case boolean of + false: ( + Priority: cardinal; { Thread priority (class + level) } + SysTime: cardinal; { Thread system time } + UserTime: cardinal; { Thread user time } + State: byte; { Thread state } + Pad: array [1..3] of byte); { Padding for 32-bit alignment } + true: ( + PrioLevel: byte; { Thread priority level only } + PrioClass: byte; { Thread priority class only } + Pad2: array [1..14] of byte); + end; + + PQSPRec = ^TQSPRec; + TQSPrec = record + RecType: cardinal; { Type of record being processed } + PThrdRec: PQSTRec; { (Far?) pointer to thread records for this process } + PID: word; { Process ID } + PPID: word; { Parent process ID } + ProcType: cardinal; { Process type } + Stat: cardinal; { Process status } + SGID: cardinal; { Process screen group } + hMte: word; { Program module handle for process } + cTCB: word; { Number of TCBs (Thread Control Blocks) in use } + c32PSem: cardinal; { Number of private 32-bit semaphores in use } + p32SemRec: pointer; { (Far?) pointer to head of 32-bit semaphores info } + c16Sem: word; { Number of 16 bit system semaphores in use } + cLib: word; { Number of runtime linked libraries } + cShrMem: word; { Number of shared memory handles } + cFH: word; { Number of open files } + { NOTE: cFH is size of active part of } + { the handle table if QS_FILE specified } + p16SemRec: word; { Far pointer? to head of 16-bit semaphores info } + pLibRec: word; { Far pointer? to list of runtime libraries } + pShrMemRec: word; { Far pointer? to list of shared memory handles } + pFSRec: word; { Far pointer to list of file handles; } + { 0xFFFF means it's closed, otherwise } + { it's an SFN if non-zero } + end; + +(* Simplified version here to avoid need for all record types copied here. *) + PQSPtrRec = ^TQSPtrRec; + TQSPtrRec = record + PGlobalRec: pointer; + PProcRec: PQSPRec; { Pointer to head of process records } + P16SemRec: pointer; + P32SemRec: pointer; + PMemRec: pointer; + PLibRec: pointer; + PShrMemRec: pointer; + PFSRec: pointer; + end; { import the necessary stuff from the OS } function DosAllocThreadLocalMemory (Count: cardinal; var P: pointer): cardinal; @@ -103,6 +166,10 @@ function DosWaitEventSem (Handle: THandle; Timeout: cardinal): cardinal; cdecl; function DosQueryEventSem (Handle: THandle; var Posted: cardinal): cardinal; cdecl; external 'DOSCALLS' index 330; +function DosQuerySysState (EntityList, EntityLevel, PID, TID: cardinal; + var Buffer; BufLen: cardinal): cardinal; cdecl; + external 'DOSCALLS' index 368; + {***************************************************************************** @@ -365,43 +432,85 @@ begin end; -function GetOS2ThreadPriority (ThreadHandle: dword): longint; +function GetOS2ThreadPriority (ThreadHandle: dword): cardinal; +const + BufSize = 32768; (* Sufficient space for > 1000 threads (for one process!) *) +var + PPtrRec: PQSPtrRec; + PTRec: PQSTRec; + BufEnd: PtrUInt; + RC: cardinal; begin -{$WARNING TODO!} -{ - DosQuerySysState -} + GetOS2ThreadPriority := cardinal (-1); + GetMem (PPtrRec, BufSize); + if PPtrRec = nil then + begin + FreeMem (PPtrRec, BufSize); + FPC_ThreadError; + end + else + begin + RC := DosQuerySysState (qs_Process, 0, ProcessID, 0, PPtrRec^, BufSize); + if (RC = 0) and (PPtrRec^.PProcRec <> nil) + and (PPtrRec^.PProcRec^.PThrdRec <> nil) then + begin + BufEnd := PtrUInt (PPtrRec) + BufSize; + PTRec := PPtrRec^.PProcRec^.PThrdRec; + while (PTRec^.RecType = qs_Thread) and (PTRec^.TID <> ThreadHandle) and + (PtrUInt (PTRec) + SizeOf (PTRec^) < BufEnd) do + Inc (PTRec); + if (PTRec^.RecType = qs_Thread) and (PTRec^.TID = ThreadHandle) then + GetOS2ThreadPriority := PTRec^.Priority; + end; + FreeMem (PPtrRec, BufSize); + end; end; +type + TPrio = packed record + PrioLevel: byte; + PrioClass: byte; + Padding: word; + end; + + function SysThreadSetPriority (ThreadHandle: dword; Prio: longint): boolean; {-15..+15, 0=normal} var Delta: longint; + Priority: cardinal; begin -{$WARNING TODO!} -{ - SysThreadSetPriority:=WinThreadSetPriority(threadHandle,Prio); - -Find out current priority first using GetOS2ThreadPriority defined above, then -calculate delta (translate the input scale -15..+15 based on MSDN docs to --31..+31 used by OS/2). - - SysThreadSetPriority := DosSetPriority (dpThread, dpSameClass, Delta, - ThreadHandle); -} + Priority := GetOS2ThreadPriority (ThreadHandle); + if Priority > High (word) then + SysThreadSetPriority := false + else + begin + Delta := Prio * 2; + if Delta + TPrio (PrioLevel) < 0 then + Delta := - TPrio (PrioLevel) + else if Delta + TPrio (PrioLevel) > 31 then + Delta := 31 - TPrio (PrioLevel); + SysThreadSetPriority := + DosSetPriority (dpThread, dpSameClass, Delta, ThreadHandle) = 0; + end; end; function SysThreadGetPriority (ThreadHandle: dword): longint; +var + Priority: cardinal; begin -{$WARNING TODO!} -{ - SysThreadGetPriority:=WinThreadGetPriority(threadHandle); - - Use GetOS2ThreadPriority defined above and translate the OS/2 value 0..31 - to -15..+15 based on MSDN docs. -} + Priority := GetOS2ThreadPriority (ThreadHandle); +(* + Windows priority levels follow a fairly strange logic; let's mimic at least + the part related to the idle priority returning negative numbers. + Result range (based on Windows behaviour) is -15..+15. +*) + if TPrio (Priority).PrioClass = 1 then + SysThreadGetPriority := TPrio (Priority).PrioLevel div 2 - 15 + else + SysThreadGetPriority := TPrio (Priority).PrioLevel div 2; end;