.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 sent to
;	or returned from the System Service.  The item codes can be class-
;	ified into five types.  Examples are from the $SNDJBC System Serv-
;	ice:
;
;	  1. Integer ('value') or address items sent to the System Service.
;	     A BUFi argument, an INTEGER*4 variable, must be supplied, and
;	     the corresponding RLENi argument must NOT be present, even as
;	     a null argument.  Expressions and constants are not allowed.
;
;		CALL ITEM_LIST(ITMLST,SJC$_BASE_PRIORITY,PRI)
;
;	  2. Integer ('value')  or address items returned from the  System
;	     Service.   A BUFi argument,  an INTEGER*4  variable,  must be
;	     supplied, and the corresponding  RLENi  argument  must NOT be
;	     present, even as a null argument.   IMPORTANT -- The variable
;	     MUST be declared VOLATILE in FORTRAN programs.
;
;		CALL ITEM_LIST(ITMLST,SJC$_ENTRY_NUMBER_OUTPUT,ENTRY)
;
;	  3. Character string items sent to the System Service.  BUFi must
;	     be a CHARACTER variable or constant, and RLENi must be a null
;	     argument.   Constants, and expressions other than a substring
;	     specification, are not allowed.
;
;		CALL ITEM_LIST(ITMLST,SJC$_QUEUE,QUEUE(1:QLEN),)
;
;	  4. Character string items returned from the System Service. BUFi
;	     must be a CHARACTER variable,  and RLENi must be an INTEGER*4
;	     variable for the return of the string's actual length.   IMP-
;	     ORTANT -- both variables MUST be declared VOLATILE in FORTRAN
;	     programs
;
;		CALL ITEM_LIST(ITMLST,SJC$_,JOB_STATUS_OUTPUT,STAT,SLEN)
;
;	  5. Boolean items sent to the System Service.   The BUFi argument
;	     must be a null argument, and the  RLENi  argument must NOT be
;	     present, even as a null argument.
;
;		CALL ITEM_LIST(ITMLST,SJC$_DELETE_FILE,)
;
;	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.
;-	
;	A full example would be:
;
;		CALL ITEM_LIST(ITMLST,SJC$_BASE_PRIORITY,PRI,
;	    2			      SJC$_ENTRY_NUMBER_OUTPUT,ENTRY,
;	    3                         SJC$_QUEUE,QUEUE(1:QLEN),
;	    4                         SJC$_,JOB_STATUS_OUTPUT,STAT,SLEN,
;	    5                         SJC$_DELETE_FILE,)
;
;	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).   This is the pattern of a
;	VMS string descriptor's  first longword, so ITEM_LIST thinks  this
;	is a character string argument.
;
;	.INDEX ARGUMENTS>>
;
;	22 June 1986	Allow BOOLEAN items; rewrite description.
;
;
;	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	BOOLEAN		; Branch if argument is null
	CMPW	2(R2), #^X010E	; Is this a string descriptor?
	BEQL	STRING		; 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

BOOLEAN:
	CLRW	    (R4)+	; Store length of 0
	MOVW	R3, (R4)+	; Store item code
	CLRQ	    (R4)+	; Store zero address and null length return
	BRB	LOOPEND		;				value address

STRING:
	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