2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! Copyright (C) 2005 Chris Double. All Rights Reserved.
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! See http://factorcode.org/license.txt for BSD license.
							 | 
						
					
						
							
								
									
										
										
										
											2008-03-29 00:00:20 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								USING: serialize sequences concurrency.messaging threads io
							 | 
						
					
						
							
								
									
										
										
										
											2010-09-27 20:12:33 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								io.servers io.encodings.binary assocs init
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-17 19:10:01 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								arrays namespaces kernel accessors ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-05-05 03:19:25 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								FROM: io.sockets => host-name <inet> with-client ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: concurrency.distributed
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-29 01:02:07 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								<PRIVATE
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-29 01:39:25 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: registered-remote-threads ( -- hash )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								   \ registered-remote-threads get-global ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-29 01:02:07 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								PRIVATE>
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-29 01:39:25 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: register-remote-thread ( thread name -- )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    registered-remote-threads set-at ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-29 01:02:07 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-29 01:39:25 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: unregister-remote-thread ( name -- )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    registered-remote-threads delete-at ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-29 01:02:07 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-29 01:39:25 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: get-remote-thread ( name -- thread )
							 | 
						
					
						
							
								
									
										
										
										
											2010-03-30 01:17:39 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    dup registered-remote-threads at [ ] [ threads at ] ?if ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-29 01:02:07 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: handle-node-client ( -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-03-11 23:42:32 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    deserialize
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-29 01:39:25 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [ first2 get-remote-thread send ] [ stop-this-server ] if* ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-25 17:58:19 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: <node-server> ( addrspec -- threaded-server )
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-30 20:15:53 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    binary <threaded-server>
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-25 17:58:19 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        swap >>insecure
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        "concurrency.distributed" >>name
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        [ handle-node-client ] >>handler ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-29 01:39:25 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								TUPLE: remote-thread node id ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-29 01:39:25 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								C: <remote-thread> remote-thread
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-03-11 23:42:32 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: send-remote-message ( message node -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-05-05 03:19:25 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    binary [ serialize ] with-client ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-03-11 23:42:32 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-29 01:39:25 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								M: remote-thread send ( message thread -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-03-11 23:42:32 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ id>> 2array ] [ node>> ] bi
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    send-remote-message ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-18 06:07:40 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: thread (serialize) ( obj -- )
							 | 
						
					
						
							
								
									
										
										
										
											2010-09-19 22:39:14 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    id>> [ insecure-addr ] dip <remote-thread> (serialize) ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-03-11 23:42:32 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: stop-node ( node -- )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    f swap send-remote-message ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-29 01:02:07 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-29 01:39:25 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    H{ } clone \ registered-remote-threads set-global
							 | 
						
					
						
							
								
									
										
										
										
											2009-11-30 18:36:03 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								] "remote-thread-registry" add-startup-hook
							 |