;;
;	LOGICAL FUNCTION ARG_EXIST( n )
;
;
;	Returns, as the function result, an indication of whether the  Nth
;	argument passed to the routine which called ARG_EXIST actually ex-
;	ists.   The Nth argument will not exist if N > the total number of
;	arguments passed or if the Nth argument was  omitted  [as  is  the
;	second  argument  in  'CALL X(A,,B)' ].   'N' is an integer in the
;	range (1,255).
;
;	NOTE--Character string arguments  to  FORTRAN  subprograms  cannot
;	      ever  be  omitted unless the corresponding dummy argument is
;	      either non-existent or not of  character  data  type.   This
;	      means  that  such  arguments can only be 'passed through' to
;	      another subprogram, as described  in  routine  'ARG_ADDRESS'
;	      below.
;
;	.INDEX ARGUMENTS>>
;
;	Alan L. Zirkle     Naval Surface Weapons Center
;			   Code K53
;	28 Jun 1982	   Dahlgren, Virginia  22448
;

	.ENTRY	ARG_EXIST, ^M<>

	MOVZBL	@4(AP),R0	; VALUE OF N IS NOW IN R0

	BEQL	FALSE		; ZERO IS NOT LEGAL VALUE FOR N

	CMPB	R0,@8(FP)	; 8(FP) IS CALLER'S AP

	BGTRU	FALSE		; BRANCH IF N > TOTAL NUMBER OF ACTUAL ARGS

	TSTL	@8(FP)[R0]	; TEST Nth ACTUAL ARGUMENT ADDRESS--IT WILL
				;  BE ZERO IF THE ARGUMENT DOESN'T EXIST
	BEQL	FALSE

	MOVL	#1,R0		; THE ARGUMENT DOES EXIST--RETURN .TRUE.

	RET

FALSE:	CLRL	R0		; THE ARGUMENT DOESN'T EXIST--RETURN .FALSE.

	RET

;	.END

	.TITLE	ITEM_LIST

;;
;	SUBROUTINE ITEM_LIST( array , code1 , buf1 [, rlen1] , ... ,
;
;+						   coden , bufn [, rlenn])
;
;
;	Builds a list of 'item descriptors' as required by several VAX/VMS
;	System Services as their 'ITMLST' argument.   The list is built in
;	the ARRAY argument,  which must be an INTEGER*4 array large enough
;	to hold the list (three elements for each item code, plus one ele-
;	ment as a terminator).
;
;	The CODEi arguments are the item codes for the items to be return-
;	ed by the System Service. For each item code, a BUFi argument must
;	be supplied.  If the corresponding item code will cause an address
;	or a 'value' (integer)  to be returned,  BUFi must be an INTEGER*4
;	variable and the corresponding RLENi  argument must not be present
;	(not even as  a null argument).   If the item code  will  return a
;	'string', BUFi must be a CHARACTER variable, and RLENi must either
;	be a null argument or an INTEGER*4 variable.  If present, the act-
;	ual length of the string will be returned in RLENi.  For example:
;
;	  CALL ITEM_LIST(ITMLST,JPI$_PRI,PRIORITY,JPI$_USERNAME,USERN,,
;	1					   JPI$_PRCNAM,PRCNAM,LEN)
;
;	The JPI$_PRI item code returns an integer value,  so PRIORITY must
;	be an INTEGER*4 variable.   JPI$_USERNAME and JPI$_PRCNAM both re-
;	turn strings, so USERN and PRCNAM must be CHARACTER variables, and
;	the RLENi arguments must be used  (a null argument is used for the
;	USERNAME item and INTEGER*4 variable LEN for the PRCNAM item).
;
;	ITEM_LIST will signal  SS$_INSFARG  if it determines that you have
;	not passed a correct argument list.   It cannot,  however, do this
;	in all cases,  so a bad argument list may not  be discovered until
;	you call the System Service and get an abort or incorrect results.
;	
;	ITEM_LIST will not work correctly if any of the BUFi arguments are
;	integers which, at the time ITEM_LIST is called, contain  hex val-
;	ues '010Ennnn' (where n is any digit).
;
;	.INDEX ARGUMENTS>>
;
;	Alan L. Zirkle     Naval Surface Weapons Center
;			   Code K53
;	14 May 1985	   Dahlgren, Virginia  22448
;

	$SSDEF

	.PSECT	$CODE, LONG,PIC,SHR,EXE,RD,NOWRT

	.ENTRY	ITEM_LIST, ^M<R2,R3,R4>

	MOVZBL	(AP), R0	; R0 = Count of arguments
	DECL	R0		; R0 = Count of arguments, minus one
	MOVAL	8(AP), R1	; R1 = Address of second argument's address
	MOVL	4(AP), R4	; R4 = Address of array to be filled

LOOP:
	SUBL	#2, R0		; Decrement argument count by 2
	BLSS	ERROR		; Branch if argument(s) missing
	MOVAW	@(R1)+, R3	; Get address of item code
	BEQL	ERROR		; Branch if argument is null
	MOVW	(R3), R3	; Get item code
	MOVAL	@(R1)+, R2	; R2 = Address of buffer (or buffer descriptor)
	BEQL	ERROR		; Branch if argument is null
	CMPW	2(R2), #^X010E	; Is this a string descriptor?
	BEQL	DESCR		; Branch if it is
	MOVW	#4, (R4)+	; Store length of 4
	MOVW	R3, (R4)+	; Store item code
	MOVL	R2, (R4)+	; Store longword's address
	CLRL	(R4)+		; Store null length return value address
	BRB	LOOPEND

DESCR:
	DECL	R0		; Decrement argument count by another 1
	BLSS	ERROR		; Branch if RLENi argument missing
	MOVW	0(R2), (R4)+	; Store length of string
	MOVW	R3, (R4)+	; Store item code
	MOVL	4(R2), (R4)+	; Store string's address
	MOVAL	@(R1)+, (R4)+	; Store return value address (may be null)

LOOPEND:
	TSTL	R0		; Are all arguments processed?
	BGTR	LOOP		; Loop if not
	CLRL	(R4)		; Insert zero item code as a terminator
	RET			; Return

ERROR:
	PUSHL	#SS$_INSFARG	; Signal SS$_INSFARG if the argument list
	CALLS	#1, G^LIB$SIGNAL ; is not correct.

;	.END

;;
;	INTEGER*4 FUNCTION LBYTE( integer )
;
;
;	Extracts the low-order byte  from the INTEGER*4 or INTEGER*2 argu-
;	ment INTEGER,  and sign extends the value.   This allows the value
;	to be assigned to a BYTE variable  without danger of integer over-
;	flow.  Examples:
;
;	  Incorrect:  INTEGER*4 I	Correct:  INTEGER*4 I,LBYTE
;		      BYTE B			  BYTE B
;		      I = 255			  I = 255
;		      B = I			  B = LBYTE(I)
;
;	.INDEX ARITHMETIC CONVERSIONS>>
;
;	Alan L. Zirkle     Naval Surface Weapons Center
;			   Code K53
;	19 Jan 1986	   Dahlgren, Virginia  22448
;

	.ENTRY	LBYTE,^M<>

	CVTBL	@4(AP),R0

	RET

	.END