| 
									
										
										
										
											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 |