.TITLE Lib_Return_LNMs

	.IDENT /Ver X01/

;++
;
; Author:	George Watson
;
; Modified by:	Jonathan Welch		Modification Date: 24-Jun-1987 14:45
;
; Functional Description:
;
;	All the logical names in the specified logical name
;	table are returned as a byte array of counted strings.
;
;	The list of tables in LNM$PROCESS_DIRECTORY is scanned first in
;	the access mode of the caller.  If the specified table is not
;	found, the list of tables in LNM$SYSTEM_DIRECTORY is scanned
;	in Executive Mode.  CMEXEC privilege is required for to scan
;	this area, hence either the user must have it or the program calling
;	this subroutine must be install with it.
;
;	No indication of lack of privilege is returned - you must be
;	aware of this restriction yourself.
;
; Calling Sequence:
;
;	Sts = Lib_Return_Process_LNMs(Table, Array)
;
; Formal Arguments:
;
;	Byte array which will contain the logical names from the specified
;	table as a stream of counted strings.
;
;	Table
;	  VMS Usage  : char_string
;	  type       : character string
;	  access     : read only
;	  mechanism  : by descriptor
;
;	Array
;	  VMS Usage  : byte_unsigned
;	  type       : byte (unsigned)
;	  access     : write only
;	  mechanism  : by reference, array reference
;
; 	String indicating which logical name table to extract logical
;	names from.
;
; Implicit Inputs:
;
;	none
;
; Implicit Outputs:
;
;	none
;
; Completion status:
;
;	SS$_NORMAL	Routine completed successfully.
;
;	SS$_INSFARG	Insufficient arguments were passed to this routine.
;
;	SS$_NOLOGTAB	The specified logical name table does not exist.
;
;	Any return value from STR$UPCASE.
;
;--

	.LIBRARY 'SYS$LIBRARY:LIB'

	.link	\sys$system:sys.stb\

	$DSCDEF
	$LNMSTRDEF
	$SSDEF

	.PSECT	_Lib_Return_LNMs_Data, WRT, NOEXE, PAGE

Array_Location:
	.BLKL	1

Name_Table:
	.BLKL	1

Table_Found:
	.BLKB	1

Tmp_String:
	.BLKW	1
	.BYTE	DSC$K_DTYPE_T
	.BYTE	DSC$K_CLASS_S
	.ADDRESS Text
Text:	.BLKB	255

; Main routine entrypoint
	.PSECT	_Lib_Return_LNMs, PAGE,NOWRT,EXE
	.entry	Lib_Return_LNMs, ^M<>

Table = 4
Array = 8

	CMPB	(AP),#2			; Were the correct number of arguments
	BGEQ	10$			; passed?
	MOVL	#SS$_INSFARG, R0	; No, return an error.
	BRB	30$

10$:	MOVL	Array(AP), Array_Location ; Where to put counted strings.
	MOVL	#1, Name_Table		; Search in process area first.
	MOVL	#0, Table_Found		; Table name not found yet.

	MOVW	@Table(AP), Tmp_String	; Put length of input string in
	PUSHL	Table(AP)		; Tmp_String.
	PUSHAL	Tmp_String
	CALLS	#2, G^STR$UPCASE	; Up-case passed string to local storage
	BLBC	R0, 30$			; Continue if no error.

; Scan the process table area first.
	CALLS	#0, Actually_Return_LNMs ; Scan the process table area.
	BLBC	R0, 30$			; Was there an error?

	CMPB	#1, Table_Found		; Exit if the specified table was
	BNEQ	20$			; found in the process table area.
	MOVL	#SS$_NORMAL, R0
	BRB	30$

20$:	MOVL	#0, Name_Table		; Now look in the system table area.
	$CMEXEC_S ROUTIN=Actually_Return_LNMs

	CMPL	R0, #SS$_NOPRIV		; Re-vector SS$_NOPRIV to SS$_NORMAL
	BNEQ	25$
	MOVL	#SS$_NORMAL, R0
	BRB	30$

25$:	BLBC	R0, 30$			; Was there an error from CHME?

	CMPB	#1, Table_Found		; Was the table found at all?
	BEQL	30$			; Yes.

	MOVL	#SS$_NOLOGTAB, R0	; No, signal an error.

30$:	RET

; This routine really does all the work.
	.PSECT	_Actually_Return_LNMs,LONG,NOWRT,EXE
	.ENTRY	Actually_Return_LNMs, ^M<R2,R3,R4,R5,R6,R7,R8,R9>

; R6 <- starting location of where to begin putting counted strings
; of logical names.
10$:	MOVL	Array_Location, R6

; Index into system/process tables.
	MOVL	Name_Table, R9

; pointer to hash table
Again:	MOVL	G^LNM$AL_HASHTBL[R9], R4
	MOVL	(R4), R4

	mcoml	LNMHSH$L_MASK(r4),r4	; get size of hash table
	incl	r4

HASH_LOOP:
	MOVL	G^LNM$AL_HASHTBL[R9],r5	; again, pointer to hash table
	MOVL	(R5), R5
	moval	LNMHSH$C_BUCKET-4(r5)[r4],r5	; addr of bucket
	sobgeq	r4,SCAN_COLLISION_BUCKETS

; -done-
	MOVL	R6, R1
	movl	#SS$_NORMAL,R0
	ret

SCAN_COLLISION_BUCKETS:
	movl	(r5),r5			; get next link in chain (LNMB$)
	beql	HASH_LOOP		; next chain if NIL
	movl	LNMB$L_TABLE(r5),r1	; get address of table header (LNMTH$)
	movl	LNMTH$L_NAME(r1),r1	; get name block for table (LNMB$)
	moval	LNMB$T_NAME(r5),R7	; address of logical name
	moval	LNMB$T_NAME(r1),R8	; address of table logical name

	PUSHR	#^M<R0,R1,R2,R3,R4,R5>
	MOVZBL	(R8)+, R0
	CMPC3	R0, (R8), Text
	TSTL	R0			; Are the strings equal?
	BNEQ	20$			; No, continue scanning.

	MOVB	#1, Table_Found		; Yes.  Set a success flag.

	MOVZBL	(R7), R0
	INCL	R0
	MOVC3	R0, (R7), (R6)		; Yes, copy logical name into array.
	MOVL	#0, (R3)		; Put a null at the end of the array.
	MOVL	R3, R6			; Update pointer.
20$:	POPR	#^M<R0,R1,R2,R3,R4,R5>

	BRB	SCAN_COLLISION_BUCKETS

	.END