.TITLE	WILDJPI - DEC Wildcard $GETJPI example program
	.IDENT	/V1.20/

; Taken from a DEC manual, but with a significant number of
; changes.

; B. Z. Lederman

	$JPIDEF				; Define $GETJPI item codes

OUTLEN = 78				; width of terminal
UNAMSIZ = 32				; size allocated for username
IMAGSIZ = 255				; buffer for image

	.PSECT	DATA	RD, WRT, NOEXE

IOSB:	.WORD	0			; Completion status
	.WORD	0			; remainder of IOSB isn't used
	.LONG	0			; but must be allocated

PID:	.LONG	-1			; Wildcard PID initialized to -1

ITEMS:	.WORD	UNAMSIZ			; size of username buffer
	.WORD	JPI$_USERNAME		; user name item code
	.ADDRESS UNAME			; address of user name buffer
	.ADDRESS UNAMESIZ		; address to return user name size

	.WORD	IMAGSIZ			; size of image name buffer
	.WORD	JPI$_IMAGNAME		; image name item code
	.ADDRESS IMAGE			; address of image name buffer
	.ADDRESS IMAGESIZ		; address to return image name size

	.LONG	0			; end of list

IMAGEDSC:				; length and address form a string
IMAGESIZ:				; descriptor for LIB$PUT_OUTPUT
	.WORD	0			; Buffer for size of user name
	.BYTE	DSC$K_DTYPE_T
	.BYTE	DSC$K_CLASS_S
	.ADDRESS IMAGE			; Address of image name buffer
IMAGE:	.BLKB	IMAGSIZ			; Image name buffer

FOURTYSIX:				; size of buffer remaining for
	.WORD	<OUTLEN - UNAMSIZ - 1>	; image name

UNAMEDSC:				; length and address form a string
UNAMESIZ:				; descriptor for LIB$PUT_OUTPUT
	.WORD	0			; Buffer for size of user name
	.BYTE	DSC$K_DTYPE_T
	.BYTE	DSC$K_CLASS_S
	.ADDRESS UNAME			; Address of user name buffer
UNAME:	.BLKB	UNAMSIZ			; user name buffer

FAOLEN:	.BLKW	1			; FAO buffer length
	.BLKW	1			; buffer, just in case

FAODESC:				; FAO output descriptor
	.WORD	OUTLEN
	.BYTE	DSC$K_DTYPE_T
	.BYTE	DSC$K_CLASS_S
	.ADDRESS FAOBUF

FAOBUF:	.BLKB	OUTLEN			; FAO buffer

STR2:	.ASCID	/!AS !AS/		; FAO control string

	.PSECT	CODE	EXE, NOWRT

	.ENTRY	START, ^M<>

LOOP:	$GETJPIW_S	-		; Get information and wait
		EFN = #1, -		; event flag 1
		PIDADR = PID, -		; wildcared PID
		ITMLST = ITEMS, -	; address of item list
		IOSB = IOSB		; always use IOSB for status check

	BLBC	R0, 10$			; if failure in R0, check that status
	MOVZWL	IOSB, R0		; If success, then test IOSB

10$:	BLBS	R0, DISPLAY		; if success, then display
	CMPW	R0, #SS$_NOPRIV		; no priv. for this process?
	BEQL	LOOP			; if not, just try next process
	CMPW	R0, #SS$_SUSPENDED	; process suspended?
	BEQL	LOOP			; if yes, try next
	CMPW	R0, #SS$_NOMOREPROC	; no more processes?
	BEQL	DONE			; if yes, finished
	BRB	ERROR			; otherwise, exit with error code

DISPLAY:
	PUSHAW	FOURTYSIX		; maximum size to fit terminal
	PUSHAQ	IMAGEDSC
	PUSHAQ	IMAGEDSC
	CALLS	#3, G^LIB$TRIM_FILESPEC	; take off trailing spaces

	$FAO_S	CTRSTR = STR2, -	; Format the output string
		OUTLEN = FAOLEN, -
		OUTBUF = FAODESC, -
		P1 = #UNAMEDSC, -
		P2 = #IMAGEDSC

	PUSHAQ	FAODESC			; output the formatted string
	CALLS	#1, G^LIB$PUT_OUTPUT

	MOVC5	#0, FAOBUF, #^A' ' , #OUTLEN, FAOBUF	; blank fill buffer

	BRW	LOOP			; get the next process

DONE:	MOVL	#SS$_NORMAL, R0		; put success in R0
ERROR:	$EXIT_S	R0			; exit with status

	.END	START