Syntax10.Scn.FntInfoElemsAllocTSyntax10.Scn.FntzStampElemsAlloc4 Nov 4"Title": Threads for Linux "Author": Robert Lichtenberger, tanis@sport3.uibk.ac.at "Abstract": Threads provides threads for Oberon V4 for Linux "Keywords": Threads Multitasking Connecting Oberon Network "Version": 0.10 "From": 18 Dec 97 "Until":  "Changes": 10 Mar 1999 RLI Removed precondition ActiveThread()=oberon for GC procedures. 28 Mar 1999 RLI Fixed bug in SuspendThreads "Hints": You can change the LibraryName Constant if you are using another library. Using Xavier Leroys implementation of pthreads is however recommended. Signal 21 is used to get all thread's stack information. I tried to use SIGUSR1 or SIGUSR2 but these are used by the pthreads library :-('FoldElemsNew#Syntax10.Scn.Fnt%%pthread structure from c header file 'Syntax10b.Scn.FntSyntax10i.Scn.Fnt'#Syntax10.Scn.Fnt**pthread-mutex structure from c header fileN>K2G'- 8 o/+'''''''' '$' 1'' 7'9'  'a'  '(' '' 'hjQ' ''  '''''<'=''M'C')'q'''.(MODULE Threads;  IMPORT Kernel, S := SYSTEM, Ref, Unix; CONST wrapperLibName = "libobwrapper.so"; stackSignal = 31; sigStop = 19; sigCont = 18; TYPE ThreadInternal = POINTER TO RECORD (* implementation dependant *) nextlive, prevlive, nextwaiting: LONGINT; pid, spinlock, signal: LONGINT; signalJmp, cancelJmp: LONGINT; terminated, detached, exited: CHAR; retval, retcode: LONGINT; joining: LONGINT; (* ... *) END; (* struct _pthread { pthread_t p_nextlive, p_prevlive; /* Double chaining of active threads */ pthread_t p_nextwaiting; /* Next element in the queue holding the thr */ int p_pid; /* PID of Unix process */ int p_spinlock; /* Spinlock for synchronized accesses */ int p_signal; /* last signal received */ sigjmp_buf * p_signal_jmp; /* where to siglongjmp on a signal or NULL */ sigjmp_buf * p_cancel_jmp; /* where to siglongjmp on a cancel or NULL */ char p_terminated; /* true if terminated e.g. by pthread_exit */ char p_detached; /* true if detached */ char p_exited; /* true if the assoc. process terminated */ void * p_retval; /* placeholder for return value */ int p_retcode; /* placeholder for return code */ pthread_t p_joining; /* thread joining on that thread or NULL */ struct _pthread_cleanup_buffer * p_cleanup; /* cleanup functions */ char p_cancelstate; /* cancellation state */ char p_canceltype; /* cancellation type (deferred/async) */ char p_canceled; /* cancellation request pending */ int p_errno; /* error returned by last system call */ int p_h_errno; /* error returned by last netdb function */ void * p_specific[PTHREAD_KEYS_MAX]; /* thread-specific data */ }; *) ThreadQueueDesc = RECORD headPtr, tailPtr: LONGINT END; MutexDesc = RECORD spinlock: LONGINT; count: LONGINT; ownerPtr: LONGINT; kind: LONGINT; threadQueue: ThreadQueueDesc END; (*  typedef struct { int m_spinlock; /* Spin lock to guarantee mutual exclusion. */ int m_count; /* 0 if free, > 0 if taken. */ _pthread_descr m_owner; /* Owner of mutex (for recursive mutexes) */ int m_kind; /* Kind of mutex */ struct _pthread_queue m_waiting; /* Threads waiting on this mutex. */ } pthread_mutex_t; *) Timeval = RECORD sec, usec: LONGINT END ; Semaphore* = RECORD m, cs: MutexDesc; count: INTEGER END; Thread* = POINTER TO ThreadDesc; ThreadDesc* = RECORD pthread: LONGINT; stackStart, stackEnd: LONGINT; (* stopper: Semaphore; *) next: Thread END; PType = PROCEDURE; VAR critSection: MutexDesc; activate, ntProt: Semaphore; dummy: INTEGER; libpthread: LONGINT; pthreadCreate: PROCEDURE (pthreadPtr, attributes, proc, arg: LONGINT): INTEGER; pthreadDetach: PROCEDURE (pthread: LONGINT): INTEGER; pthreadJoin: PROCEDURE (pthread, retvaladr: LONGINT): INTEGER; pthreadExit: PROCEDURE (retVal: LONGINT); pthreadKill: PROCEDURE (pthread: LONGINT; signal: INTEGER); pthreadMutexInit: PROCEDURE (mutexPtr, mutexAttrPtr: LONGINT): INTEGER; pthreadMutexLock: PROCEDURE (mutexPtr: LONGINT): INTEGER; pthreadMutexUnlock: PROCEDURE (mutexPtr: LONGINT): INTEGER; pthreadSelf: PROCEDURE (): LONGINT; pthreadCancel: PROCEDURE (pthread: LONGINT): LONGINT; select: PROCEDURE (n, rsadr, wsadr, xsadr, tvadr: LONGINT): LONGINT; wrapper: PROCEDURE (arg: LONGINT); active, oberon, threads, createThread: Thread; nrThreads: INTEGER; wait: BOOLEAN; (* auxiliary functions for pthread handling *) PROCEDURE This (pthread: LONGINT): Thread;  VAR cur: Thread; BEGIN dummy := pthreadMutexLock(S.ADR(critSection)); cur := threads; WHILE (cur # NIL) & (cur.pthread # pthread) DO cur := cur.next END; dummy := pthreadMutexUnlock(S.ADR(critSection)); RETURN cur END This;  (* semaphores *) PROCEDURE (VAR s: Semaphore) Init* (val: INTEGER);  VAR dummy: INTEGER; BEGIN s.count := val; dummy := pthreadMutexInit(S.ADR(s.m), 0); dummy := pthreadMutexInit(S.ADR(s.cs), 0); IF val = 0 THEN dummy := pthreadMutexLock(S.ADR(s.m)) END END Init;  PROCEDURE (VAR s: Semaphore) Down*;  BEGIN dummy := pthreadMutexLock(S.ADR(s.cs)); DEC(s.count); IF s.count <= 0 THEN dummy := pthreadMutexUnlock(S.ADR(s.cs)); dummy := pthreadMutexLock(S.ADR(s.m)) ELSE dummy := pthreadMutexUnlock(S.ADR(s.cs)) END END Down;  PROCEDURE (VAR s: Semaphore) Up*;  BEGIN dummy := pthreadMutexLock(S.ADR(s.cs)); IF s.count <= 0 THEN dummy := pthreadMutexUnlock(S.ADR(s.m)) END; INC(s.count); dummy := pthreadMutexUnlock(S.ADR(s.cs)) END Up;  PROCEDURE (VAR s: Semaphore) TryDown* (): BOOLEAN;  BEGIN dummy := pthreadMutexLock(S.ADR(s.cs)); IF s.count > 0 THEN DEC(s.count); IF s.count <= 0 THEN dummy := pthreadMutexLock(S.ADR(s.m)) END; dummy := pthreadMutexUnlock(S.ADR(s.cs)); RETURN TRUE ELSE dummy := pthreadMutexUnlock(S.ADR(s.cs)); RETURN FALSE END END TryDown;  (* thread handling *) PROCEDURE ^ ActiveThread* (): Thread; PROCEDURE Wrapper (proc: LONGINT);  VAR P: PType; cur, prev, this: Thread; res: INTEGER; BEGIN this := createThread; S.GETREG(5, this.stackEnd); dummy := pthreadMutexUnlock(S.ADR(critSection)); P := S.VAL(PType, proc); P; cur := threads; prev := NIL; WHILE (cur # NIL) & (cur # this) DO prev := cur; cur := cur.next END; IF prev = NIL THEN threads := threads.next ELSE prev.next := cur.next END; pthreadExit(0); END Wrapper;  PROCEDURE Start* (thread: Thread; proc: PROCEDURE; stackLen: LONGINT);  VAR res: INTEGER; BEGIN ASSERT(thread # NIL); thread.stackStart := 0; dummy := pthreadMutexLock(S.ADR(critSection)); (* will be unlocked in Wrapper *) thread.next := threads; threads := thread; (* Add thread to thread queue *) createThread := thread; dummy := pthreadCreate(S.ADR(thread.pthread), 0, S.VAL(LONGINT, wrapper), S.VAL(LONGINT, proc)); dummy := pthreadDetach(thread.pthread); END Start;  PROCEDURE ActiveThread* (): Thread;  VAR t: Thread; BEGIN t := This(pthreadSelf()); ASSERT(t # NIL); RETURN t; END ActiveThread;  PROCEDURE OberonThread* (): Thread;  BEGIN RETURN oberon END OberonThread;  PROCEDURE Kill* (thread: Thread);  VAR cur, prev: Thread; BEGIN dummy := pthreadMutexLock(S.ADR(critSection)); cur := threads; prev := NIL; WHILE (cur # NIL) & (cur # thread) DO prev := cur; cur := cur.next END; dummy := pthreadMutexUnlock(S.ADR(critSection)); IF thread = ActiveThread() THEN IF (prev = NIL) THEN threads := threads.next; ELSE prev.next := cur.next; END; pthreadExit(0) ELSE ASSERT(pthreadCancel(thread.pthread) = 0); IF (prev = NIL) THEN threads := threads.next; ELSE prev.next := cur.next; END; END; END Kill;  PROCEDURE Sleep* (milliSeconds: LONGINT);  VAR time: Timeval; set, dummy: LONGINT; BEGIN time.sec := 0; time.usec := milliSeconds; set := 0; (* man select describes the following line "a fairly portable way to sleep with subsecond precision." *) dummy := select(0, S.ADR(set), S.ADR(set), S.ADR(set), S.ADR(time)) END Sleep;  (* compatibility support *) PROCEDURE RegisterReentrant* (modName: ARRAY OF CHAR);  BEGIN END RegisterReentrant;  PROCEDURE Schedule* (allowed: BOOLEAN);  BEGIN END Schedule;  (* --- Kernel extensions --- *) PROCEDURE SuspendThreads;  VAR cur: Thread; BEGIN wait := TRUE; active := ActiveThread(); nrThreads := 0; cur := threads; WHILE cur # NIL DO INC(nrThreads); cur := cur.next END; cur := threads; WHILE cur # NIL DO pthreadKill(cur.pthread, stackSignal); (* signal to get stack *) cur := cur.next; END; activate.Init(0); ntProt.Init(1); WHILE nrThreads > 0 DO activate.Down; END; END SuspendThreads;  PROCEDURE ResumeThreads;  VAR cur: Thread; BEGIN wait := FALSE; END ResumeThreads;  PROCEDURE EnumThreads (proc: PROCEDURE (thread: LONGINT));  VAR cur: Thread; BEGIN (* ASSERT: all other threads are suspended *) cur := threads; WHILE cur # NIL DO proc(S.ADR(cur^)); cur := cur.next; END; END EnumThreads;  PROCEDURE EnumThreadStack (thread: LONGINT; proc: PROCEDURE (p: LONGINT));  VAR cur: Thread; x, val: LONGINT; tInt: ThreadInternal; BEGIN cur := S.VAL(Thread, thread); IF cur.stackEnd = 0 THEN cur.stackEnd := Kernel.mainStackEnd END; ASSERT(cur.stackStart # 0); ASSERT(cur.stackEnd # 0); FOR x := cur.stackStart TO cur.stackEnd BY 4 DO S.GET(x, val); proc(val); END; END EnumThreadStack;  PROCEDURE GetStackInfo (sig: LONGINT);  (* Gets machine state *) VAR actbp, esp: LONGINT; dummy: LONGINT; (* r: Ref.Rider; *) thread: Thread; BEGIN S.GETREG(5, actbp); S.GET(actbp + 4 * 20, esp); thread := ActiveThread(); thread.stackStart := esp; (* ASSERT(thread # oberon); *) ntProt.Down; DEC(nrThreads); ntProt.Up; IF thread # active THEN activate.Up; WHILE wait DO Sleep(500); END; END; END GetStackInfo;  BEGIN libpthread := Kernel.dlopen(wrapperLibName, 999); Kernel.dlsym(libpthread, "th_create", S.VAL(LONGINT, pthreadCreate)); Kernel.dlsym(libpthread, "th_detach", S.VAL(LONGINT, pthreadDetach)); Kernel.dlsym(libpthread, "th_join", S.VAL(LONGINT, pthreadJoin)); Kernel.dlsym(libpthread, "th_exit", S.VAL(LONGINT, pthreadExit)); Kernel.dlsym(libpthread, "th_kill", S.VAL(LONGINT, pthreadKill)); Kernel.dlsym(libpthread, "th_mutex_init", S.VAL(LONGINT, pthreadMutexInit)); Kernel.dlsym(libpthread, "th_mutex_lock", S.VAL(LONGINT, pthreadMutexLock)); Kernel.dlsym(libpthread, "th_mutex_unlock", S.VAL(LONGINT, pthreadMutexUnlock)); Kernel.dlsym(libpthread, "th_self", S.VAL(LONGINT, pthreadSelf)); Kernel.dlsym(libpthread, "th_cancel", S.VAL(LONGINT, pthreadCancel)); Kernel.dlsym(Kernel.libc, "select", S.VAL(LONGINT, select)); NEW(oberon); oberon.next := NIL; oberon.pthread := pthreadSelf(); threads := oberon; dummy := pthreadMutexInit(S.ADR(critSection), 0); wrapper := Wrapper; Kernel.InstallSignal(stackSignal, GetStackInfo); Kernel.suspendThreads := SuspendThreads; Kernel.resumeThreads := ResumeThreads; Kernel.enumThreads := EnumThreads; Kernel.enumThreadStack := EnumThreadStack;  END Threads. System.Free Threads ~ Threads.Do