/* --- Copyright University of Sussex 1990. All rights reserved. ----------
 > File:            C.vms/src/sysspawn.p
 > Purpose:
 > Author:          John Gibson (see revisions)
 > Documentation:	REF *SYSUTIL
 */


;;; ----------------- SPAWNING VMS PROCESSES --------------------------------

#_INCLUDE 'declare.ph'
#_INCLUDE 'vmsdefs.ph'

weak global constant
		procedure sys_async_input
	;

section $-Sys;

constant
		procedure Vms_set_Ctrl_C,
		_vmsproc_tab, _vmsproc_tab_lim
	;

endsection;


;;; ----------------------------------------------------------------------

section $-Sys => pop_status, pop_spawn_flags, sysspawn;

vars
	pop_status		= 0,		;;; status return from sub-process
	pop_spawn_flags	= 0,		;;; flags for lib$spawn
	;

define sysspawn(command, input, output, wait);
	lvars command, input, output, wait, async, _entry, _res;
	dlvars _flags = _int(pop_spawn_flags), _pid, _status;
	lconstant macro DEVIN = [weakref popdevin];

	define lconstant Spawn_arg(arg);
		lvars arg;
		if arg then arg@DSC_SPEC else _0 endif
	enddefine;

	dlocal 0 % false -> async,
			   if async then async -> weakref sys_async_input(DEVIN) endif
			 %;

	if not(input) and testdef popdevin and testdef sys_async_input
	and (weakref sys_async_input(DEVIN) ->> async) then
		false -> weakref sys_async_input(DEVIN)
	endif;

	if command then consdescriptor(command) -> command endif;
	if input then consdescriptor(input) -> input endif;
	if output then consdescriptor(output) -> output endif;

	if wait then
		;;; waiting
		_flags _biclear _1 -> _flags;	;;; set wait mode (bit 0 = 0)

		if testdef popdevin then
			;;; disable Ctrl-C first
			Vms_set_Ctrl_C(DEVIN, false)
		endif;

		_extern lib\$spawn(
						/* command */	Spawn_arg(command),
						/* input   */	Spawn_arg(input),
						/* output  */	Spawn_arg(output),
						/* flags   */	ident _flags,
						/* prcnam  */	,
						/* pidadr  */	ident _pid,
						/* statadr */	ident _status) -> _res;

		if testdef popdevin then
			;;; re-enable Ctrl-C before returning
			Vms_set_Ctrl_C(DEVIN, true)
		endif;
		if _res _bitst _1 then
			;;; succeeded
			Uint_->_bigint(_status) -> pop_status;
			Uint_->_bigint(_pid)		;;; return pid
		else
			;;; failed
			false
		 endif
	else
		;;; not waiting
		_flags _biset _1 -> _flags;		;;; set nowait mode (bit 0 = 1)

		;;; find free entry in proc table
		_vmsproc_tab -> _entry;
		repeat
			if _entry >=@(struct PROC_ENTRY) _vmsproc_tab_lim then
				mishap(0, 'sysspawn: NO SPACE LEFT IN PROCESS TABLE')
			endif;
			quitif(_zero(_entry!PROC_COND));
			_entry@(struct PROC_ENTRY)++ -> _entry
		endrepeat;

		_extern lib\$spawn(
						/* command */	Spawn_arg(command),
						/* input   */	Spawn_arg(input),
						/* output  */	Spawn_arg(output),
						/* flags   */	ident _flags,
						/* prcnam  */	,
						/* pidadr  */	_entry@PROC_PID,
						/* statadr */	_entry@PROC_STATUS,
						/* efn     */	,
						/* astadr  */	_extern _pop_spawn_ast,
						/* astpar  */	_entry@PROC_COND)
			-> _res;
		if _res _bitst _1 then
			;;; succeeded -- set live process in table (_spawn_ast will
			;;; set PROC_COND to -1 when the process dies)
			_1 -> _entry!PROC_COND;
			Uint_->_bigint(_entry!PROC_PID)		;;; return pid
		else
			;;; failed
			false
		endif
	endif
enddefine;


endsection;		/* $-Sys */



/* --- Revision History ---------------------------------------------------
--- John Gibson, Nov 22 1990
		Now uses _extern _pop_spawn_ast
--- John Gibson, Oct 10 1990
		VMS _extern changed to return proper system call result (thus test
		for success is now result _bitst _1).
--- John Gibson, Jul 23 1989
		Added variable -pop_spawn_flags- to enable flag bit args to be passed
		to lib$spawn.
--- Roger Evans, Sep 26 1988
		Fixed bug in proc table scan loop - _entry was not being incremented!!
--- John Gibson, Mar 16 1988
		Moved out of sysutil.p
 */
