Subversion Repositories Kolibri OS

Rev

Rev 619 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | Download | RSS feed

  1. {}
  2.  
  3. {XXX: Thread vars & TLS}
  4.  
  5. const
  6.   ThreadVarBlockSize: DWord = 0;
  7.   TLSGrowFor = 4096;
  8.  
  9. type
  10.   PTLSIndex = ^TTLSIndex;
  11.   TTLSIndex = record
  12.     CS: TRTLCriticalSection;
  13.     Slots: array[0..TLSGrowFor - 1] of record
  14.       TID: DWord;
  15.       Value: Pointer;
  16.     end;
  17.   end;
  18.  
  19. var
  20.   TLSKey: PTLSIndex;
  21.  
  22.  
  23. function TLSAlloc(): PTLSIndex;
  24. var
  25.   I: DWord;
  26. begin
  27.   {New(Result);}
  28.   Result := kos_alloc(SizeOf(TTLSIndex));
  29.   InitCriticalSection(Result^.CS);
  30.   {SetLength(Result^.Slots, TLSGrowFor);}
  31.   for I := 0 to TLSGrowFor - 1 do
  32.     Result^.Slots[I].TID := 0;
  33. end;
  34.  
  35.  
  36. function TLSFree(TLSIndex: PTLSIndex): Boolean;
  37. begin
  38.   DoneCriticalSection(TLSIndex^.CS);
  39.   {SetLength(TLSIndex^.Slots, 0);
  40.   Dispose(TLSIndex);}
  41.   kos_free(TLSIndex);
  42.   Result := True;
  43. end;
  44.  
  45.  
  46. procedure TLSSetValue(TLSIndex: PTLSIndex; Value: Pointer);
  47. var
  48.   TID, I, Count, Slot: DWord;
  49. begin
  50.   TID := GetCurrentThreadID();
  51.   EnterCriticalSection(TLSIndex^.CS);
  52.  
  53.   Count := Length(TLSIndex^.Slots);
  54.   Slot := Count;
  55.  
  56.   for I := 0 to Count - 1 do
  57.   if TLSIndex^.Slots[I].TID = TID then
  58.   begin
  59.     Slot := I;
  60.     Break;
  61.   end else
  62.   if TLSIndex^.Slots[I].TID = 0 then
  63.     Slot := I;
  64.  
  65.   if Slot >= Count then
  66.   begin
  67.     Halt(123);
  68.     {SetLength(TLSIndex^.Slots, Count + TLSGrowFor);
  69.     FillChar(TLSIndex^.Slots[Count], TLSGrowFor * SizeOf(TLSIndex^.Slots[0]), #0);
  70.     Slot := Count;}
  71.   end;
  72.  
  73.   TLSIndex^.Slots[Slot].TID := TID;
  74.   TLSIndex^.Slots[Slot].Value := Value;
  75.  
  76.   LeaveCriticalSection(TLSIndex^.CS);
  77. end;
  78.  
  79.  
  80. function TLSGetValue(TLSIndex: PTLSIndex): Pointer;
  81. var
  82.   TID, I, Count: DWord;
  83. begin
  84.   Result := nil;
  85.   TID := GetCurrentThreadID();
  86.  
  87.   EnterCriticalSection(TLSIndex^.CS);
  88.  
  89.   Count := Length(TLSIndex^.Slots);
  90.  
  91.   for I := 0 to Count - 1 do
  92.   if TLSIndex^.Slots[I].TID = TID then
  93.   begin
  94.     Result := TLSIndex^.Slots[I].Value;
  95.     break;
  96.   end;
  97.  
  98.   LeaveCriticalSection(TLSIndex^.CS);
  99. end;
  100.  
  101.  
  102. procedure SysInitThreadVar(var Offset: DWord; Size: DWord);
  103. begin
  104.   Offset := ThreadVarBlockSize;
  105.   Inc(ThreadVarBlockSize, Size);
  106. end;
  107.  
  108. procedure SysAllocateThreadVars;
  109. var
  110.   DataIndex: Pointer;
  111. begin
  112.   {DataIndex := GetMem(ThreadVarBlockSize);}
  113.   DataIndex := kos_alloc(ThreadVarBlockSize);
  114.   FillChar(DataIndex^, ThreadVarBlockSize, #0);
  115.   TLSSetValue(TLSKey, DataIndex);
  116. end;
  117.  
  118. function SysRelocateThreadVar(Offset: DWord): Pointer;
  119. var
  120.   DataIndex: Pointer;
  121. begin
  122.   DataIndex := TLSGetValue(TLSKey);
  123.   if DataIndex = nil then
  124.   begin
  125.     SysAllocateThreadVars;
  126.     DataIndex := TLSGetValue(TLSKey);
  127.   end;
  128.   Result := DataIndex + Offset;
  129. end;
  130.  
  131. procedure SysReleaseThreadVars;
  132. begin
  133.   {FreeMem(TLSGetValue(TLSKey));}
  134.   kos_free(TLSGetValue(TLSKey));
  135. end;
  136.  
  137.  
  138.  
  139. {XXX: Thread}
  140. type
  141.   PThreadInfo = ^TThreadInfo;
  142.   TThreadInfo = record
  143.     Func: TThreadFunc;
  144.     Arg: Pointer;
  145.     StackSize: PtrUInt;
  146.     Stack: Pointer;
  147.   end;
  148.  
  149. procedure DoneThread;
  150. begin
  151.   SysReleaseThreadVars;
  152. end;
  153.  
  154. procedure ThreadMain(ThreadInfo: PThreadInfo);
  155. var
  156.   Result: PtrInt;
  157. begin
  158.   SysAllocateThreadVars;
  159.   with ThreadInfo^ do
  160.   begin
  161.     InitThread(StackSize);
  162.     try
  163.        Result := Func(Arg);
  164.     except
  165.       {TODO: Обработать ошибки}
  166.       WriteLn(StdErr, 'Exception in thread');
  167.     end;
  168.     FreeMem(Stack);
  169.   end;
  170.   asm
  171.     movl $-1, %eax
  172.     int $0x40
  173.   end;
  174. end;
  175.  
  176. function SysBeginThread(sa: Pointer; StackSize: PtrUInt; ThreadFunction: TThreadFunc; Arg: Pointer; CreationFlags: DWord; var ThreadID: TThreadID): TThreadID;
  177. {Stack, esp, ThreadInfo}
  178.  
  179.   procedure EntryThreadMain; assembler;
  180.   asm
  181.     movl %esp, %eax
  182.     jmp ThreadMain
  183.   end;
  184.  
  185. var
  186.   Stack: Pointer;
  187.   ThreadInfo: PThreadInfo;
  188. begin
  189.   if not IsMultiThread then
  190.   begin
  191.     TLSKey := TLSAlloc();
  192.     InitThreadVars(@SysRelocateThreadVar); {XXX: must be @SysRelocateThreadvar}
  193.     IsMultiThread := True;
  194.   end;
  195.  
  196.   StackSize := (StackSize + 3) div 4;
  197.   Stack := GetMem(StackSize + SizeOf(TThreadInfo));
  198.   ThreadInfo := PThreadInfo(PByte(Stack) + StackSize);
  199.   ThreadInfo^.Func := ThreadFunction;
  200.   ThreadInfo^.Arg := Arg;
  201.   ThreadInfo^.StackSize := StackSize;
  202.   ThreadInfo^.Stack := Stack;
  203.   ThreadID := kos_newthread(@EntryThreadMain, ThreadInfo);
  204.   Result := ThreadID;
  205. end;
  206.  
  207.  
  208. procedure SysEndThread(ExitCode: DWord);
  209. begin
  210.   WriteLn('..SysEndThread');
  211.   {TODO: SysEndThread}
  212.   SysReleaseThreadVars;
  213. end;
  214.  
  215.  
  216. function SysSuspendThread(ThreadHandle: TThreadID): DWord;
  217. begin
  218.   {TODO: SysSuspendThread}
  219.   Result := -1;
  220. end;
  221.  
  222.  
  223. function SysResumeThread(ThreadHandle: TThreadID): DWord;
  224. begin
  225.   {TODO: SysResumeThread}
  226.   Result := -1;
  227. end;
  228.  
  229.  
  230. function SysKillThread(ThreadHandle: TThreadID): DWord;
  231. begin
  232.   if kos_killthread(ThreadHandle) then
  233.     Result := 0 else
  234.     Result := -1;
  235. end;
  236.  
  237.  
  238. procedure SysThreadSwitch;
  239. begin
  240.   {$ifdef EMULATOR}
  241.   kos_delay(0);{$else}
  242.   kos_switchthread();{$endif}
  243. end;
  244.  
  245.  
  246. function SysGetCurrentThreadID: TThreadID;
  247. var
  248.   ThreadInfo: TKosThreadInfo;
  249. begin
  250.   kos_threadinfo(@ThreadInfo);
  251.   Result := ThreadInfo.ThreadID;
  252. end;
  253.  
  254.  
  255. {XXX: CriticalSection}
  256. procedure SysInitCriticalSection(var CS);
  257. begin
  258.   PRTLCriticalSection(CS)^.OwningThread := -1;
  259. end;
  260.  
  261. procedure SysDoneCriticalSection(var CS);
  262. begin
  263.   PRTLCriticalSection(CS)^.OwningThread := -1;
  264. end;
  265.  
  266. procedure SysEnterCriticalSection(var CS);
  267. var
  268.   ThisThread: TThreadID;
  269. begin
  270.   ThisThread := GetCurrentThreadId();
  271.   if PRTLCriticalSection(CS)^.OwningThread <> ThisThread then
  272.     while PRTLCriticalSection(CS)^.OwningThread <> -1 do;
  273.   PRTLCriticalSection(CS)^.OwningThread := ThisThread;
  274. end;
  275.  
  276. procedure SysLeaveCriticalSection(var CS);
  277. begin
  278.   if PRTLCriticalSection(CS)^.OwningThread = GetCurrentThreadId() then
  279.     PRTLCriticalSection(CS)^.OwningThread := -1;
  280. end;
  281.  
  282.  
  283. {TODO: RTLEvent}
  284. function SysRTLEventCreate: PRTLEvent;
  285. begin
  286.   Result := nil;
  287. end;
  288.  
  289. procedure SysRTLEventDestroy(State: PRTLEvent);
  290. begin
  291. end;
  292.  
  293.  
  294.  
  295. {$ifndef HAS_MT_MEMORYMANAGER}
  296. var
  297.   HeapMutex: TRTLCriticalSection;
  298.  
  299. procedure KosHeapMutexInit;
  300. begin
  301.   InitCriticalSection(HeapMutex);
  302. end;
  303.  
  304. procedure KosHeapMutexDone;
  305. begin
  306.   DoneCriticalSection(HeapMutex);
  307. end;
  308.  
  309. procedure KosHeapMutexLock;
  310. begin
  311.   EnterCriticalSection(HeapMutex);
  312. end;
  313.  
  314. procedure KosHeapMutexUnlock;
  315. begin
  316.   LeaveCriticalSection(HeapMutex);
  317. end;
  318.  
  319. const
  320.   KosMemoryMutexManager: TMemoryMutexManager = (
  321.     MutexInit: @KosHeapMutexInit;
  322.     MutexDone: @KosHeapMutexDone;
  323.     MutexLock: @KosHeapMutexLock;
  324.     MutexUnlock: @KosHeapMutexUnlock);
  325.  
  326. procedure InitHeapMutexes;
  327. begin
  328.   SetMemoryMutexManager(KosMemoryMutexManager);
  329. end;
  330. {$endif HAS_MT_MEMORYMANAGER}
  331.  
  332.  
  333. var
  334.   KosThreadManager: TThreadManager;
  335.  
  336. procedure InitSystemThreads;
  337. begin
  338.   ThreadID := TThreadID(1);
  339.   with KosThreadManager do
  340.   begin
  341.     InitManager            := nil;
  342.     DoneManager            := nil;
  343.  
  344.     BeginThread            := @SysBeginThread;
  345.     EndThread              := @SysEndThread;
  346.     SuspendThread          := @SysSuspendThread;
  347.     ResumeThread           := @SysResumeThread;
  348.     KillThread             := @SysKillThread;
  349.     ThreadSwitch           := @SysThreadSwitch;
  350.     WaitForThreadTerminate := nil; //@NoWaitForThreadTerminate;
  351.     ThreadSetPriority      := nil; //@NoThreadSetPriority;
  352.     ThreadGetPriority      := nil; //@NoThreadGetPriority;
  353.  
  354.     GetCurrentThreadID     := @SysGetCurrentThreadID;
  355.     InitCriticalSection    := @SysInitCriticalSection;
  356.     DoneCriticalSection    := @SysDoneCriticalSection;
  357.     EnterCriticalSection   := @SysEnterCriticalSection;
  358.     LeaveCriticalSection   := @SysLeaveCriticalSection;
  359.     InitThreadVar          := @SysInitThreadVar;
  360.     RelocateThreadVar      := @SysRelocateThreadVar;
  361.     AllocateThreadVars     := @SysAllocateThreadVars;
  362.     ReleaseThreadVars      := @SysReleaseThreadVars;
  363.  
  364.     BasicEventCreate       := @NoBasicEventCreate;
  365.     BasicEventDestroy      := @NoBasicEventDestroy;
  366.     BasicEventResetEvent   := @NoBasicEventResetEvent;
  367.     BasicEventSetEvent     := @NoBasicEventSetEvent;
  368.     BasicEventWaitFor      := @NoBasicEventWaitFor;
  369.     RTLEventCreate         := @SysRTLEventCreate;
  370.     RTLEventDestroy        := @SysRTLEventDestroy;
  371.     RTLEventSetEvent       := @NoRTLEventSetEvent;
  372.     RTLEventWaitFor        := @NoRTLEventWaitFor;
  373.     RTLEventSync           := @NoRTLEventSync;
  374.     RTLEventWaitForTimeout := @NoRTLEventWaitForTimeout;
  375.  
  376.     SemaphoreInit          := @NoSemaphoreInit;
  377.     SemaphoreDestroy       := @NoSemaphoreDestroy;
  378.     SemaphoreWait          := @NoSemaphoreWait;
  379.     SemaphorePost          := @NoSemaphorePost;
  380.   end;
  381.   SetThreadManager(KosThreadManager);
  382. {$ifndef HAS_MT_MEMORYMANAGER}
  383.   InitHeapMutexes;
  384. {$endif HAS_MT_MEMORYMANAGER}
  385.   ThreadID := GetCurrentThreadID;
  386. end;
  387.