(* * LANGUAGE : ANS FORTH * PROJECT : iForth * DESCRIPTION : Device & OS dependent code * CATEGORY : Multiple OS-threads * AUTHOR : Marcel Hendrix * LAST CHANGE : Jan 16, 1999, mhx; debugged extensively, vsn, 2.12, networking is ok!? * LAST CHANGE : Jan 1, 1999, mhx; debugged ATTACH, decided to drop named pipes * LAST CHANGE : December 31, 1998, Marcel Hendrix; ATTACH for slave processors * LAST CHANGE : December 28, 1998, Marcel Hendrix; sockets work * LAST CHANGE : December 27, 1998, Marcel Hendrix; enabled socket alternative * LAST CHANGE : December 19, 1998, Marcel Hendrix; PAR SELECT (?)DEFAULT (?)TIMEOUT (?)GUARD * LAST CHANGE : December 19, 1998, Marcel Hendrix; a clunky SELECT works (bad syntax) * LAST CHANGE : December 18, 1998, Marcel Hendrix; channels work * LAST CHANGE : December 17, 1998, Marcel Hendrix; semaphores work * LAST CHANGE : December 13, 1998, Marcel Hendrix; threads work *) DOC (* The trick for starting threads is making use of the word CALLBACK . Note 1: Creating threads and channels is done through handles. These should be separately destroyed after threads exit. Note 2: KILL-ALL kills tasks but does not recover their resources, e.g. killing a task that is controlling a mutex is very bad. Note 3: tForth's :I , :F , TIMES and REPLICATE are not available. Note 4: Threads DO NOT have separate USER areas. One irritating result is that .S does not work (because the base of the stacks is not known.) A thread should have access to it ThreadID so it can do ABORT or ExitThread without killing the main Forth. A USER area also can be used to pass parameters, start address, and results. Bugs ---- 1. When a thread writes to a channel, the OS gets a chance to deschedule it. This causes trouble when writing data from a global buffer to a channel; a second thread could try to re-use the buffer. *Always* use the stack, or have TRUE local buffers. You can do: ( n1 n2 .. n channel -- ) >R >R SP@ R> CELLS R> CHANNEL-SEND etc.: the stack doubles as a buffer. This won't work in tForth, where the stack grow up, not down. 2. (Before version 2.12, this is not yet retested) The order of the keywords between SELECT ENDSELECT is critical. The textually last GUARD starts *first*. The main problem seems to be that writing is not possible when there are no readers, or the reverse (open-chan failure). 3. If the iForth on one of the computers on the net is killed, the rest of the net will hang. That is, the rest of the computers is not smart enough to kill and re-open all of their sockets. I guess the exiting computer should send some sort of global reset? 4. The RUN-CHANNEL example sometimes prints garbage when executed as: FORTH> 2000 run-channels cr many As the threads do not hang, I guess the character counts are OK, so the mess is caused when printing the stuff. To Do ----- Make CALLBACK get a USER area. This makes for superior error handling ( THROW ), debugging ( .S ) and maybe even parameter passing ( :I and :F ). *) ENDDOC NEEDS -miscutil REVISION -threads "ÄÄÄ OS Threads Version 2.12 ÄÄÄ" PRIVATES ( tattr pointer to thread security attributes ssize initial thread stack size, in bytes addr pointer to thread function arg argument for new thread flags creation flags -- SUSPENDED == 0 IDaddr pointer to returned thread identifier ) : CreateThread ( tattr ssize addr arg flags 'ID -- handle ) 6 #236 SYSCALL DROP ;P -- Exit a thread. : ExitThread ( returncode -- ) [ CR .( ExitThread :: add test so we don't kill the main thread.) ] 1 #237 SYSCALL 2DROP ;P -- KILL : a function that probably should be avoided. -- Only KILL when you know exactly what the thread is doing. Does NOT deallocate -- the thread's stack and other resources. : KillThread ( handle -- ) [ CR .( KillThread :: add test so we don't kill the main thread.) ] 1 #198 SYSCALL 2DROP ;P -- Works for threads, not for channels. : KILL-ALL ( addr count -- ) CELLS BOUNDS ?DO I @ KillThread =CELL +LOOP ;P -- If you don't call this after a thread finishes, TaskManager will show a handle leak. : RemoveHandle ( handle -- ) 1 #197 SYSCALL 2DROP ;P : REMOVE-ALL ( addr count -- ) CELLS BOUNDS ?DO I @ RemoveHandle =CELL +LOOP ;P -- Given stored thread handles in an array, wait for ALL of them to finish. : MultiWaitFor ( addr count -- ) 2 #238 SYSCALL 2DROP ;P -- Given stored thread handles in an array, wait for ANY of them to finish. -- Timeout == -1 means infinite wait. -- Returned index == -1 means the timeout fired. Others: addr[index] : MultiWaitOr ( addr count timeout -- index ) 3 #239 SYSCALL DROP ;P DOC (* A semaphore in the t/iForth sense is a WinNT mutexed section. Using a critical section didn't work as well. *) ENDDOC : SEMAPHORE ( "name" ) CREATE HERE 0 , 1 #176 SYSCALL 2DROP ; : GETSEMAPHORE ( sema -- ) 1 #177 SYSCALL 2DROP ; : RELEASESEMAPHORE ( sema -- ) 1 #178 SYSCALL 2DROP ; SEMAPHORE PRIVATE : {{ GETSEMAPHORE ; : }} RELEASESEMAPHORE ; DOC (* Channels are implemented with blocking sockets. CHANNEL foo does not exist in the file system. To open a CHANNEL on another machine, that machine's name must be known ( e.g. "frunobulax" note: no leading "\\" ) It is possible to connect threads to *any* machine if we know its $hostname . *) ENDDOC #100000 =: _infinite_ PRIVATE ( largest timeout needed, in milliseconds ) : ?SOCKET ( err -- ) ?DUP IF CR ." error #" DUP DEC. 1 #220 SYSCALL TYPE ENDIF ;P : ?CHAN" ( exec: ior -- ) POSTPONE ?DUP POSTPONE IF POSTPONE DUP POSTPONE ?SOCKET POSTPONE CR &" POSTPONE SLITERAL POSTPONE TYPE POSTPONE ExitThread POSTPONE THEN ; IMMEDIATE DOC (* Both sides of a connection create a channel. To write to a channel nothing special is needed (an anonymous lsocket handles the client read requests). To read from a channel the name of the other party is needed. If the other party is on the same machine we (optionally) use $hostname -- if not, we have a setup problem. Syntax: CHANNEL c0 ( same machine write/read ) CHANNEL c1 $" frunobulax" c1 ATTACH ( other party is on \\frunobulax ) *) ENDDOC CREATE $hostname #129 ALLOT $hostname 1+ #128 2 #221 SYSCALL [IF] CR .( host name error) ABORT [THEN] $hostname C! DOC (* A chan# must match *exactly* with the chan#s on other machines working on the same problem. So master and slaves should have exactly the same channel creation/destruction strategy. This is easiest accomplished by having a single program file contain both MASTER and CLIENT sections, with a separate SETUP section allocating channels. *) ENDDOC #31459 VALUE chan# PRIVATE : connect-chan ( lsocket -- socket ) 1 #229 SYSCALL ?CHAN" connect-chan" ;P ( blocking! ) : disconnect ( lsocket -- ) 1 #227 SYSCALL 2DROP ;P ( don't want errors ) : ATTACH ( c-addr 'chan -- ) CELL+ ! ; : write-chan ( c-addr u socket -- ) -ROT 3 #226 SYSCALL ?CHAN" write-chan" DROP ;P : close-chan ( socket -- ) 1 #227 SYSCALL NIP ?CHAN" close-chan" ;P : create-chan ( chan# -- lsocket ) 1 #222 SYSCALL ?CHAN" create-chan" DUP 1 ( /queue) 2 #228 SYSCALL DROP ?CHAN" listen-chan" ;P -- The loop is essential. You will notice a few seconds (!) startup delay. : open-chan ( c-addr u chan# -- socket ) #19 0 DO 3DUP 3 #223 SYSCALL DUP 0= IF DROP >R 3DROP R> UNLOOP EXIT ENDIF 2DROP LOOP 3DUP 3 #223 SYSCALL ?DUP IF ?SOCKET DROP CR ." open-chan error, channel ID #" DEC. ." where: " TYPE ExitThread ELSE >R 3DROP R> ENDIF ;P -- The loop is essential. You will notice a few seconds (!) startup delay. : read-chan ( c-addr u socket -- ) -ROT #19 0 DO 3DUP 3 #224 SYSCALL DUP 0= IF 2DROP 3DROP UNLOOP EXIT ENDIF 2DROP LOOP 3DUP 3 #224 SYSCALL ?DUP IF ?SOCKET DROP CR ." read-chan error, socket " ROT H. ." where: " TYPE ExitThread ELSE DROP 3DROP ENDIF ;P : ->ID ;P IMMEDIATE : ->NAME EVAL" CELL+ " ;P IMMEDIATE : ->LISTEN EVAL" 2 CELL[] " ;P IMMEDIATE : ->READ EVAL" 3 CELL[] " ;P IMMEDIATE : ->WRITE EVAL" 4 CELL[] " ;P IMMEDIATE : ->LINK EVAL" 5 CELL[] " ;P IMMEDIATE : ->CHNAME EVAL" 6 CELL[] " ;P IMMEDIATE 0 VALUE chlink PRIVATE -- link all allocated channels together for .NETWORK : CHANNEL CREATE HERE LOCAL ch \ ( "name" ) chan# , 1 +TO chan# \ handle $hostname , \ for reading (default is THIS machine) 0 , \ server listens through this socket (if local!) 0 , \ initialized to read 0 , \ initialized to write chlink , ch TO chlink \ link to CHANNEL-chain @LATEST , \ name of this channel FORGET> @+ TO chan# CELL+ \ skip host name @+ disconnect @+ ?DUP IF close-chan ENDIF @+ ?DUP IF close-chan ENDIF @ TO chlink \ unlink from CHANNEL-chain DOES> ; \ ( -- address ) : .CHANNEL ( 'chan -- ) LOCAL ch CR ch ->CHNAME @ ID$ DUP 0= IF 3DROP #10 S" [hidden]" ENDIF TYPE SPACES ." |" ch ->NAME @ COUNT 2DUP $hostname COUNT COMPARE 0= IF 2DROP S" [local]" ENDIF #16 OVER - 0 MAX SPACES TYPE ." | " ( name ) ch ->ID @ 7 .R ." |" ( id# ) ch ->LISTEN @ 7 .R ." |" ( listen socket ) ch ->READ @ 7 .R ." |" ( read socket ) ch ->WRITE @ 7 .R 3 SPACES ( write socket ) ; : CHANNEL-RESET ( 'chan -- ) LOCAL ch ch ->LISTEN DUP @ disconnect 0! ch ->READ DUP @ ?DUP IF close-chan ENDIF 0! ch ->WRITE DUP @ ?DUP IF close-chan ENDIF 0! ; -- Visit all linked channels : RUN-CHLINK ( xt -- ) >S chlink BEGIN DUP WHILE DUP S EXECUTE ->LINK @ REPEAT S> 2DROP ;P : RESET-NETWORK ( -- ) ['] CHANNEL-RESET RUN-CHLINK ; : .NETWORK ( -- ) CR ." local channel | connected to | log. id# | lsocket | rsocket | wsocket " CR ." ------------------+-----------------+----------+---------+---------+---------" ['] .channel RUN-CHLINK ; -- Note that a channel connects between TWO and only TWO threads. Multi inputs and outputs -- are programming errors. : CHANNEL-RECEIVE ( c-addr u chan -- ) LOCAL ch ch ->READ @ DUP 0= IF DROP ch ->NAME @ COUNT ch ->ID @ open-chan DUP ch ->READ ! ENDIF read-chan ; : CHANNEL-SEND ( c-addr u chan -- ) LOCAL ch ch ->WRITE @ DUP 0= IF DROP ch ->ID @ create-chan ch ->LISTEN ! ch ->LISTEN @ connect-chan DUP ch ->WRITE ! ENDIF write-chan ; : CHANNEL-C! ( n channel -- ) >R SP@ 1 R> CHANNEL-SEND DROP ; : CHANNEL-! ( n channel -- ) >R SP@ =CELL R> CHANNEL-SEND DROP ; : CHANNEL-2! ( d channel -- ) >R SP@ 2 CELLS R> CHANNEL-SEND 2DROP ; : CHANNEL-3! ( d n chan -- ) >R SP@ 3 CELLS R> CHANNEL-SEND 3DROP ; : CHANNEL-C@ ( channel -- n ) >R 0 SP@ 1 R> CHANNEL-RECEIVE ; : CHANNEL-@ ( channel -- n ) >R 0 SP@ =CELL R> CHANNEL-RECEIVE ; : CHANNEL-2@ ( channel -- d ) >R 0. SP@ 2 CELLS R> CHANNEL-RECEIVE ; : CHANNEL-3@ ( chann -- d n ) >R 0. 0 SP@ 3 CELLS R> CHANNEL-RECEIVE ; -- We NEVER close a channel again (FORGET takes care of it). : SELECT-CHANNEL ( addr count timeout -- index | -1 ) 0 LOCAL ch >R 2DUP 0 ?DO @+ TO ch ch 0> IF \ when not a timer or default ch ->READ @ \ when not already open 0= IF ch ->NAME @ COUNT ch ->ID @ open-chan ch ->READ ! ENDIF ENDIF LOOP DROP R> 3 #196 SYSCALL ?CHAN" select error" ; DOC (* Design choice: :I and :F are too difficult. It would be necessary to allocate a block of memory when STARTP allocates the thread. In this block the :I and :F cells go. The block is deallocated by ENDP . Because STARTP does not guarantee a thread starts immediately, it is not possible to use a statically allocated block (a second thread might start before that and overwrite the parameters, besides, we don't know beforehand how many parameters there will be). If parameters are *absolutely a must*, you can experiment with arg being a pointer to a "threadblock" which contains, at the least, the exec address. *) ENDDOC VARIABLE 'ThreadID PRIVATE :NONAME ( arg -- f ) EXECUTE ( return ) 1 ; 1 CALLBACK 'ThreadFunc PRIVATE : ALLOC-THREAD ( xt index addr -- ) >R >R >R 0 \ security attributes: 0 == default 0 \ thread's stack size: 0 == default 'ThreadFunc \ address of ThreadFunc callback R> \ arg for ThreadFunc 0 \ 0 == CREATE_SUSPENDED 'ThreadID \ address of DWORD to receive ID# CreateThread R> R> []CELL ! ;P DOC Synchronized concurrent processing (* We will now describe a construct to allow synchronized concurrent processing. Occam calls this a "PAR". In the following, read "process" as "thread." In iForth's PAR construct all started concurrent processes are forced to wait until each and every process has finished and the main line of sequential processing can continue. The "waiting to be finished" bit, the synchronization, is the only feature discerning them from a set of asynchronous concurrent processes. Inside a colon definition a standard PAR looks as follows: VARIABLE gorilla 1 gorilla ! VARIABLE bananas 111 bananas ! : ZOO PAR STARTP -24 bananas +! ENDP STARTP 1 gorilla +! ENDP ENDPAR CR bananas ? gorilla ? ; PAR marks the start of a list of sub-processes. The routine definition for each sub-process is enclosed by STARTP and ENDP. These two words generate code that takes care of workspace allocation and de-allocation. ENDPAR marks the end of a list of processes. It compiles code that waits until all listed processes have terminated. *) ENDDOC : (ALLOC-THREADS) ( addr -- ) @+ ( cnt ) >R ( addr+1 ) DUP R@ CELLS + >S >S R@ 0 ?DO S I CELL[] @ ( get xt ) I T ( thread# 'table ) ALLOC-THREAD LOOP -S S R@ MultiWaitFor S> R> REMOVE-ALL ;P : PAR ( -- cnt sys ) POSTPONE AHEAD 0 $12344321 ; IMMEDIATE -- The SECURE OFF is needed because we can't SAVE/RESTORE loops? : STARTP ( -- sys3 ) $12355321 SECURE @ >S SECURE OFF :NONAME ; IMMEDIATE : ENDP ( cnt sys sys3 -- xt cnt+1 sys ) POSTPONE ; S> SECURE ! SWAP $12355321 <> ABORT" illegal ENDP" ROT 1+ ROT ; IMMEDIATE : ENDPAR ( sysx xt1 xt2 ... xtn n sys -- addr ) $12344321 <> ABORT" illegal PAR" ALIGN HERE >R DUP , DUP >R 0 ?DO , LOOP R> 0 ?DO 0 , LOOP POSTPONE THEN R> POSTPONE LITERAL POSTPONE (ALLOC-THREADS) ; IMMEDIATE DOC (* The SELECT statement allows a process to make a choice over its future behavior dependent on the readiness of other concurrent processes to communicate with it over a channel. SELECT [channel] GUARD [code] ENDGUARD ... [channel] [boolean] ?GUARD [code] ENDGUARD ... [timeout] TIMEOUT [code] ENDGUARD ... [timeout] [boolean] ?TIMEOUT [code] ENDGUARD ... DEFAULT [code] ENDGUARD ... [boolean] ?DEFAULT [code] ENDGUARD ENDSELECT Here "[channel]" is used to describe an arbitrary series of iForth words that should result in a channel address put on the data stack, for use by GUARD. Likewise for "[timeout]" which should produce a timeout value in milliseconds for use by TIMEOUT . The word "[code]" describes any iForth code. This [code] is executed on the condition that something can be read from the channel GUARDed. Again, the "[boolean]" can be generated by any sequence of iForth words. ?GUARD needs a boolean true and a ready channel to activate its code. The DEFAULT clause is executed after the channels and timeouts have been tested. It is ALWAYS ready, so it executes unless a channel or timer is also ready. Notes: DEFAULT is implemented as 0 TIMEOUT . When a channel is negative it is actually a TIMEOUT . When a channel is zero it is a DEFAULT . The textually *last* DEFAULT or lowest-valued TIMEOUT wins. When NO guard is active (either no guards defined, or all booleans are false) an _infinite_ timeout results and the code of the first GUARD ENDGUARD is executed. iForth could check for this, but it doesn't. *) ENDDOC : (ALLOC-GUARDS) ( S: chan1 chan2 ... chann -- ) ( addr -- ) 0 0 0 _infinite_ LOCALS| #ms timer-ix 'xt 'ch | ( 100 seconds max ?? ) @+ ( cnt ) >R ( addr+1 ) DUP TO 'xt R@ CELLS + TO 'ch R@ 0 ?DO ( first select smallest TIMEOUT or DEFAULT ) S> DUP 0<= IF DUP ABS ( -- -chan +time ) DUP #ms U< IF TO #ms I TO timer-ix ELSE DROP ENDIF ENDIF 'ch I ( chan# 'table index ) CELL[] ! LOOP 'ch R> #ms SELECT-CHANNEL ( -1 | ix ) DUP -1 = IF DROP timer-ix ENDIF 'xt []CELL @ EXECUTE ;P : _Tmassage_ ( timeout bool -- ) 0= IF DROP _infinite_ ENDIF ;P : _Cmassage_ ( channel bool -- ) 0= IF DROP [ _infinite_ NEGATE ] LITERAL ENDIF ;P : SELECT ( -- cnt sys ) 0 $12344329 ; IMMEDIATE : GUARD ( -- sys3 ) $12355329 SECURE @ >S SECURE OFF POSTPONE >S POSTPONE AHEAD :NONAME ; IMMEDIATE -- Trick: if bool is false, convert GUARD to TIMEOUT : ?GUARD ( -- sys3 ) POSTPONE _Cmassage_ POSTPONE GUARD ; IMMEDIATE : TIMEOUT ( -- sys3 ) POSTPONE NEGATE ( non-positive channels are timeouts ) POSTPONE GUARD ; IMMEDIATE -- Trick: if bool is false, convert