Module GET_PID =
begin

!	Cracks the command line for a PID, either as a parameter, or in
!	the qualifier /ID=pid.  If neither is present, then a read with
!	prompt is done for the PID.
!
!	R.J. FitzPatrick		July 1979
!	Smithsonian Astrophysical Observatory, Cambridge MA
!
LIBRARY 'SYS$LIBRARY:STARLET.L32';
LIBRARY 'SYS$LIBRARY:CLIMAC.L32';
LIBRARY 'SYS$LIBRARY:TPAMAC.L32';

STRUCTURE
	BBLOCK [O, P, S, E; N] =
		[N]
		(BBLOCK+O)<P,S,E>;
!
! Macro to declare parameter list for TPARSE action routines.
!
MACRO
	TPARSE_ARGS (NAME) =
		BUILTIN AP;
		BIND NAME = AP : REF BBLOCK;
		%;

OWN
	PID_ADDR	: LONG,
	GET_CMD		: $CLIREQDESC (RQTYPE = GETCMD
			),
	TPARSE_BLOCK	: BBLOCK [TPA$K_LENGTH0]
			  INITIAL (TPA$K_COUNT0, 2^24);

EXTERNAL ROUTINE
	LIB$TPARSE,
	FOR$CNV_IN_Z;

FORWARD ROUTINE
	ASK_PID;

GLOBAL ROUTINE GET_PID (CLI_CALLBACK, PID) =
BEGIN

EXTERNAL
	TPID_STB	: VECTOR [0],
	TPID_KTB	: VECTOR [0];

PID_ADDR = .PID;
(.CLI_CALLBACK) (GET_CMD);
IF .GET_CMD[CLI$W_RQSIZE] GTR 0 THEN
    BEGIN
	TPARSE_BLOCK[TPA$L_STRINGCNT] = .GET_CMD[CLI$W_RQSIZE];
	TPARSE_BLOCK[TPA$L_STRINGPTR] = .GET_CMD[CLI$A_RQADDR];
	LIB$TPARSE (TPARSE_BLOCK, TPID_STB, TPID_KTB)
    END
    ELSE
	ASK_PID ()
END;						! end of routine GET_PID

! Store process id found by TPARSE.

ROUTINE STO_PID =
BEGIN

TPARSE_ARGS (CONTEXT);

.PID_ADDR = .CONTEXT[TPA$L_NUMBER];
RETURN 1;

END;

ROUTINE ASK_PID =
BEGIN
!
! Macro to generate a string and descriptor.
!

MACRO
	DESCRIPTOR (STRING) =
	    UPLIT (%CHARCOUNT (STRING), UPLIT BYTE (STRING))%;

OWN
	INFAB:		$FAB(
		FAC = (GET,PUT),
		RAT=CR,
		FNA=UPLIT BYTE('SYS$INPUT'),
		FNS=%CHARCOUNT('SYS$INPUT')
		),
	INRAB:		$RAB(
		RAC=SEQ,
		ROP=(PMT,CVT),
		FAB=INFAB
		),
	LINEBUF	: VECTOR[3],
	LINE_DESC : VECTOR[2]
			INITIAL ( 0, LINEBUF );

LITERAL
	LINELEN = 12;

BIND
	PROMPT_STR = UPLIT BYTE (%ASCIC'$_Who	' );

$OPEN( FAB=INFAB ) ;
$CONNECT( RAB=INRAB ) ;

DO
BEGIN
    INRAB[RAB$L_PBF] = PROMPT_STR + 1 ;
    INRAB[RAB$B_PSZ] = (.PROMPT_STR)<0,8> ;
    INRAB[RAB$L_UBF] = LINEBUF;
    INRAB[RAB$W_USZ] = LINELEN;
    IF $GET( RAB=INRAB ) EQL RMS$_EOF THEN $EXIT();
    LINE_DESC[0] = .INRAB[RAB$W_RSZ];
END
UNTIL
    .LINE_DESC[0] NEQ 0;

FOR$CNV_IN_Z (LINE_DESC, .PID_ADDR)
END;

$INIT_STATE	(TPID_STB, TPID_KTB);

$STATE	(,
	('/'),
	(TPA$_LAMBDA,PARAM)
	);
$STATE	(,
	('IDENTIFICATION')
	);
$STATE	(,
	('=')
	);
$STATE	(PARAM,
	(TPA$_HEX,,STO_PID)
	);
$STATE	(,
	(TPA$_EOS, TPA$_EXIT)
	);
END
ELUDOM