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
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-17 01:08:50 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								io.servers.connection io.encodings.binary
							 | 
						
					
						
							
								
									
										
										
										
											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
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-03-11 22:01:39 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								SYMBOL: local-node
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-18 10:08:59 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: handle-node-client ( -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-03-11 23:42:32 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    deserialize
							 | 
						
					
						
							
								
									
										
										
										
											2008-10-02 09:30:38 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [ first2 get-process 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 )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    <threaded-server>
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        swap >>insecure
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        binary >>encoding
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        "concurrency.distributed" >>name
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        [ handle-node-client ] >>handler ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-17 01:08:50 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: (start-node) ( addrspec addrspec -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-25 17:58:19 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    local-node set-global <node-server> start-server* ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-18 06:07:40 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: start-node ( port -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-17 01:08:50 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    host-name over <inet> (start-node) ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-18 10:08:59 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								TUPLE: remote-process id node ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-18 10:08:59 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								C: <remote-process> remote-process
							 | 
						
					
						
							
								
									
										
										
										
											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
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-18 10:08:59 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: remote-process 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 -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-02 13:36:57 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    id>> local-node get-global <remote-process>
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-18 06:07:40 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    (serialize) ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-03-11 23:42:32 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: stop-node ( node -- )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    f swap send-remote-message ;
							 |