[INHERIT('SYS$LIBRARY:STARLET')] PROGRAM LEAVE(INPUT,OUTPUT);
	TYPE 
		VARY = VARYING[80] OF CHAR;
                IPACK_20 = PACKED ARRAY(. 1..20 .) OF INTEGER ;
		SYS_TIME = RECORD
			  I,J : INTEGER;
			  END;		
	VAR
		S_SYMBOL : VARY;
		S_VALUE : VARY;
	 	COMMAND : VARY;
                SYSIN   : VARY;
		PROC_NAME : VARY;
		SPAWN_FLAGS : INTEGER;
		TBLFLG : INTEGER;
		ASCII_TIME : VARY;
		ALARM_TIME : VARY;
		ALARM_MSG :  VARY;
		ALARM_LOG : VARY;
		BINARY_TIME : SYS_TIME;

{									}
{	LIB$SPAWN definition - all arguments have been set to zero	}
{	except for							}
{									}
{			COMMAND - command to execute			}
{			SPAWN_FLAGS - type of spawn, this program	}
{				has set bit zero which spawns with	}
{				NOWAIT					}
{			PROC_NAME - Name of spawned process		}
{									}
	[EXTERNAL,ASYNCHRONOUS] FUNCTION LIB$SPAWN
		( %STDESCR COMMAND : PACKED ARRAY [$L1..$U1:INTEGER] OF CHAR;
		  %STDESCR SYSINPUT : PACKED ARRAY [$L2..$U2:INTEGER] OF CHAR := %IMMED 0;
		  %STDESCR SYSOUTPUT : PACKED ARRAY [$L3..$U3:INTEGER] OF CHAR := %IMMED 0;
		  VAR SPAWN_FLAGS : INTEGER;
		  %STDESCR PROC_NAME : PACKED ARRAY [$L4..$U4:INTEGER] OF CHAR ;
		  VAR PROC_PID : INTEGER := %IMMED 0;
		  VAR COMP_STAT : INTEGER := %IMMED 0;
		  VAR COMP_EFN  : INTEGER := %IMMED 0;
		  VAR COMP_ASTADR : INTEGER := %IMMED 0;
		  VAR COMP_ASTPRM : INTEGER := %IMMED 0
						) : INTEGER; EXTERNAL;

{									}
{	LIB$SET_SYMBOL definition. All arguments have been set to zero	}
{	except for :							}
{									}
{			S_SYMBOL - Symbol to define			}
{			S_VALUE  - Symbole definition			}
{									}
	[EXTERNAL,ASYNCHRONOUS] FUNCTION LIB$SET_SYMBOL
		( %STDESCR S_SYMBOL : PACKED ARRAY [$L1..$U1:INTEGER] OF CHAR;
		  %STDESCR S_VALUE : PACKED ARRAY [$L2..$U2:INTEGER] OF CHAR; 
		  VAR S_LOCGLO : INTEGER := %IMMED 0
						) : INTEGER; EXTERNAL;

{

 LIB$SET_LOGICAL - Set Logical Name.

	LIB$SET_LOGICAL requests the calling process's Command
	Language Interpreter (CLI) to define or redefine a supervisor-mode
	process logical name. It provides the same function as the DCL
	DEFINE command.

 ------------------------------------------------------------------------------
 FORMAT		LIB$SET_LOGICAL	log_name [,value] [,table_desc]
				[,attributes] [,item_list]

 ------------------------------------------------------------------------------
 RETURNS	type:      longword (unsigned)
		access:    write only
		mechanism: by value

 ------------------------------------------------------------------------------
 ARGUMENTS	LOG_NAM
		type:      character string
		access:    read only
		mechanism: by descriptor

		VALUE
		type:      character string
		access:    read only
		mechanism: by descriptor

		TABLE_DESC
		type:      character string
		access:    read only
		mechanism: by descriptor

		ATTRIBUTES
		type:      longword (unsigned)
		access:    read only
		mechanism: by reference

		ITEM_LIST
		type:      longword (unsigned)
		access:    read only
		mechanism: by reference, array reference

}
function lib$set_logical(
           %descr log_nam    : [readonly] varying(. upbnd_1 .) of char ;
           %descr value      : [readonly] varying(. upbnd_2 .) of char := %immed 0 ;
           %descr table_desc : [readonly] varying(. upbnd_3 .) of char := %immed 0 ;
           %ref   attributes : [readonly,long] unsigned := %immed 0 ;
           %ref   item_list  : [readonly] ipack_20 := %immed 0
           ) : integer ; extern ;


{									}
{	Procedures called by MAIN					}
{									}

	PROCEDURE GET_INPUTS;
		VAR
			I : INTEGER;
	BEGIN
		WRITE ('Enter time to ring alarm: ');
		READLN ( ASCII_TIME ) ;
		IF NOT ODD ( $BINTIM ( ASCII_TIME, BINARY_TIME ))
		THEN
			BEGIN
			WRITELN ( 'Illegal format for time string');
			HALT;
			END;{If}
		WRITE ( 'Enter alarm msg: ');
		READLN(ALARM_MSG);
		END;{Get_inputs}
	
	PROCEDURE DEFINE_LOGICALS;
        VAR
            ITEM_LIST : RECORD
                BUFFER_LENGTH : [WORD] 0..65535;
                ITEM_CODE     : [WORD] 0..65535;
                BUFFER_ADDRESS: INTEGER;
                RETURN_LENGTH : INTEGER;
                END_OF_LIST   : INTEGER;
                END;
	BEGIN
		ALARM_TIME := 'ALARM_TIME';
                WITH ITEM_LIST DO
                    BEGIN
                    BUFFER_LENGTH := SIZE(ASCII_TIME.BODY);
                    ITEM_CODE     := LNM$_STRING;
                    BUFFER_ADDRESS:= IADDRESS(ASCII_TIME.BODY);
                    RETURN_LENGTH := IADDRESS(ASCII_TIME.LENGTH);
                    END_OF_LIST   := 0;
                    END; {With}
{
		IF NOT ODD ( $CRELNM ( 
                                       TABNAM := 'LNM$PROCESS_TABLE',
                                       LOGNAM := ALARM_TIME,
                                       ITMLST := ITEM_LIST))
}
                IF NOT ODD (LIB$SET_LOGICAL(ALARM_TIME,ASCII_TIME))
		THEN
			BEGIN
			WRITELN ( 'Could not create time logical name.');
			HALT;
			END;{If}
		ALARM_LOG := 'ALARM_LOG';
                WITH ITEM_LIST DO
                    BEGIN
                    BUFFER_LENGTH := SIZE(ALARM_MSG.BODY);
                    ITEM_CODE     := LNM$_STRING;
                    BUFFER_ADDRESS:= IADDRESS(ALARM_MSG.BODY);
                    RETURN_LENGTH := IADDRESS(ALARM_MSG.LENGTH);
                    END_OF_LIST   := 0;
                    END; {With}
{
		IF NOT ODD ( $CRELNM ( 
                                       TABNAM := 'LNM$PROCESS_TABLE',
                                       LOGNAM := ALARM_LOG,
                                       ITMLST := ITEM_LIST))
}	
                IF NOT ODD (LIB$SET_LOGICAL(ALARM_LOG,ALARM_MSG))
	       THEN
			BEGIN
			WRITELN ( 'Could not create msg logical name.');
			HALT;
			END;{If}
		END;{Define_logicals}

	PROCEDURE DEFINE_SYMBOLS;
	BEGIN
		{ Define foreign command to execute program when spawned }
		S_SYMBOL := 'LEAVEEXE';	{ Symbol to define }
		S_VALUE  := '$bindir:LEAVEEXE'; { Symbol definition}
		IF NOT ODD (LIB$SET_SYMBOL(S_SYMBOL,S_VALUE,))
		THEN
			BEGIN
			WRITELN('Cannot define foreign command');
			HALT;
			END;{If}
		END;{Define_symbols}

	PROCEDURE SPAWN_PROCESS;
	BEGIN
		{ Define arguments for lib$spawn 			}
		SPAWN_FLAGS := 1; { Set nowait flag }
		COMMAND := '$LEAVEEXE'; { Execute foreign command LEAVEEXE }
		PROC_NAME := 'Leave'; { Set spawned process name to Leave }
                SYSIN := 'NL:';
		IF NOT ODD (LIB$SPAWN(COMMAND,SYSIN,,SPAWN_FLAGS,PROC_NAME))
		THEN
			BEGIN
			WRITELN('Cannot spawn process - Leave -');
			HALT;
			END;{If}

		END;{Spawn_process}

{									}
{	Begin MAIN procedure....					}
{									}
	BEGIN
		GET_INPUTS;
		DEFINE_LOGICALS;
		DEFINE_SYMBOLS;
		SPAWN_PROCESS;
	END.{Leave}
