(*
 * LANGUAGE    : ANS Forth
 * PROJECT     : Forth Environments
 * DESCRIPTION : Example internetworking usage (based on idea by Skip Carter)
 * CATEGORY    : Named pipes / FIFOs
 * AUTHOR      : Marcel Hendrix
 * LAST CHANGE : October 19, 1997, mhx
 *)


	NEEDS -npipes

	REVISION -cliserv2 "ÄÄÄ Client - Server II  Version 1.01 ÄÄÄ"

     	PRIVATES


5 =: /queue	PRIVATE
7 =: /data	PRIVATE

#1000000 =: /bigsize PRIVATE



[DEFINED] _server_ [IF]

(* Example server code, accept some data and echo it back with the sign changed
 *
 *	example usage:  S" forthserver" server
 *
 *)

: server ( c-addr u -- )
	/queue CREATE&ACCEPT LOCAL handle
cr ." handle " H.
	S" Welcome to Internetworking with Forth!"
	DUP here !  here 1 cells handle write-named-pipe
			         handle write-named-pipe

	( read the number of points the remote end is going to send )
	here 1 cells handle read-named-pipex DROP @
	0 ?DO
		here 1 cells handle read-named-pipex DROP CR ." read "  @ DEC.
		here @ negate here !
		here 1 cells handle write-named-pipe ." -- wrote " here @ DEC.
	 LOOP

	handle close-named-pipe ;

: serverspeed ( c-addr u -- )
	/queue CREATE&ACCEPT 0 0 LOCALS| sz ^data handle |

	S" Welcome to the named pipe speed test with iForth!"
	DUP here !  here 1 cells handle write-named-pipe
			         handle write-named-pipe

	( read the number of bytes the remote end is going to send )
	here 1 cells handle read-named-pipex DROP @ TO sz
	sz ALLOCATE ?ALLOCATE TO ^data
	?MS >R
	  ^data sz handle read-named-pipex NIP DUP ( bytes)
	?MS R> - 1 MAX / CR .KB ." MB/sec, read " .MB ." Mbytes."
	^data FREE ?ALLOCATE

	handle close-named-pipe ;

LINUX? [IF]	:ABOUT	CR .~ Try: S" /dev/forthserver" server~
			CR .~      S" /dev/forthserver" serverspeed~ ;
     [ELSE]	:ABOUT	CR .~ Try: S" \\.\pipe\forthserver" server~
			CR .~      S" \\.\pipe\forthserver" serverspeed~ ;
     [THEN]

[ELSE]


[UNDEFINED] _client_ [IF] CR .( Neither client nor server defined) ABORT [THEN]

(* Example client code, get message from the server, then write some data to the server and
 *  get its response.
 *
 *  S" //./pipe/forthserver" client
 *
 *)

: client ( c-addr u -- )
	#5000 ( ms) OPEN-NAMED-PIPE LOCAL handle

	( read the welcome message from the server )
	here 1 cells handle read-named-pipex 2drop
	here DUP @   handle read-named-pipex CR TYPE

	( tell the server how much data we are going to send )
	/data here !  here 1 cells handle write-named-pipe

	( now send the data, one at a time, and print the returned data )
	/data  0 ?DO
			I 1+ here !
			here 1 cells handle write-named-pipe CR ." wrote " here @ DEC.
			here 1 cells handle read-named-pipex DROP ." -- read "  @ DEC.
		LOOP

	handle close-named-pipe ;

: clientspeed ( c-addr u -- )
	#5000 ( ms) OPEN-NAMED-PIPE 0 LOCALS| ^data handle |

	( read the welcome message from the server )
	here 1 cells handle read-named-pipex 2drop
	here DUP @   handle read-named-pipex CR TYPE

	( tell the server how much data we are going to send )
	/bigsize here !  here 1 cells handle write-named-pipe
	/bigsize ALLOCATE ?ALLOCATE TO ^data

	( now send the data)
	?MS >R
	  /bigsize DUP ^data over handle write-named-pipe
	?MS R> - 1 MAX /
	CR .KB ." MB/sec, wrote " .MB ." Mbytes."

	^data FREE ?ALLOCATE
	handle close-named-pipe ;

LINUX? [IF]	:ABOUT	CR .~ Try: S" /dev/forthserver" client~
			CR .~      S" /dev/forthserver" clientspeed~ ;
     [ELSE]	:ABOUT	CR .~ Try: S" \\.\pipe\forthserver" client~
			CR .~      S" \\.\pipe\forthserver" clientspeed~ ;
     [THEN]

[THEN]

	.ABOUT -cliserv2 CR
	DEPRIVE

				(* End of Source *)