%TITLE 'LIB$FID_TO_NAME - convert device and file ID to file specification'
MODULE LIB$FID_TO_NAME (IDENT = '1-005')=
BEGIN
!
! ABSTRACT:
!
!	This routine converts a device and file identification to a file
!	specification.
!
! ENVIRONMENT:	Runs at any access mode - AST reentrant
!
! AUTHOR: Martin L. Jack, CREATED 23-Dec-1981
! modified to version 1-004
!
! ENTERED BY: Michael Sternberg 08-Aug-1982
!
! modified 13-Jun-1986 by John Osudar (Argonne National Laboratory)
!	VMS V4.x extensions (rooted directory syntax, long names)
!
%SBTTL 'Declarations'

SWITCHES ADDRESSING_MODE (EXTERNAL = GENERAL, NONEXTERNAL = WORD_RELATIVE);
!
LINKAGE
	LINKAGE_JSB_3_6 =JSB(REGISTER=0,REGISTER=1,REGISTER=2):
			 NOPRESERVE(3,4,5,6),

	LINKAGE_JSB_2_2 = JSB(REGISTER=0;REGISTER=1,REGISTER=2);

FORWARD ROUTINE
	LIB$FID_TO_NAME;

LIBRARY 'SYS$LIBRARY:LIB';		! SYSTEM SYMBOLS

    PSECT
		CODE = _LIB$CODE (READ,NOWRITE,EXECUTE,SHARE,PIC,
					ADDRESSING_MODE (WORD_RELATIVE)),
		PLIT = _LIB$CODE (READ,NOWRITE,EXECUTE,SHARE,PIC,
					ADDRESSING_MODE (WORD_RELATIVE)),
		OWN  = _LIB$DATA (READ,WRITE,NOEXECUTE,NOSHARE,PIC,
					ADDRESSING_MODE (LONG_RELATIVE)),
		GLOBAL=_LIB$DATA (READ,WRITE,NOEXECUTE,NOSHARE,PIC,
					ADDRESSING_MODE (LONG_RELATIVE));

EXTERNAL ROUTINE
	LIB$ANALYZE_SDESC_R2:	LINKAGE_JSB_2_2,
	LIB$FREE_EF,
	LIB$GET_EF,
	LIB$SCOPY_R_DX6:	LINKAGE_JSB_3_6;

EXTERNAL LITERAL
	LIB$_INVARG,
	LIB$_STRTRU,
	LIB$_INVFILSPE;

%SBTTL 'LIB$FID_TO_NAME - Convert device and file ID to file specification'
GLOBAL ROUTINE LIB$FID_TO_NAME (
	DEVICE_NAME,				!Deice name string
	FILE_ID:	REF BLOCK[,BYTE],	!File identification
	FILE_SPEC,				!File specification string
	FILE_SPEC_LENGTH,			!True length of FILE_SPEC
	DIRECTORY_ID:	REF BLOCK[,BYTE],	!Directory identification
	ACP_STATUS				!ACP status return
    )=
!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine converts a disk device name and file identification to a
!	file specificatio by using the file name and directory back link
!	pointers recorded in the file headers. Since directory back link
!	pointers do not exist in Structure Level 1, the routine will not
!	operate well in this case, unless the DIRECTORY_ID parameter is used.
!
! CALLING SEQUENCE:
!
!	ret_status.wl.v = LIB$FID_TO_NAME (
!		device-name.rt.dx, file-id.rwu.r,
!		file-spec.wt.dx, [file-spec-length.wwu.r],
!		[directory-id.rwu.r],[acp-status.wlu.r])
!
! FORMAL PARAMETERS:
!
!	DEVICE_NAME		Address of a descriptor for a device name.
!				Typically this string is obtained from the
!				NAM$T_DVI field of a VAX-11 RMS name block.
!				The device name must reference a disk device.
!				The string must contain no more them 64
!				characters.
!
!	FILE_ID			Address of an array of three words that
!				specifies a file identification. Typically
!				this array is obtained from the NAM$W_FID field
!				of a VAX-11 RMS name block. The $FIDDEF macro
!				defines the structure of this parameter.
!
!	FILE_SPEC		Address of a descriptor for a string that
!				receives the file specification. This is an
!				output parameter.
!
!	FILE_SPEC_LENGTH	Address of a word to receive the number of
!				characters written into FILE_SPEC, not
!				counting padding in the case of a fixed-length
!				string. If the output string is truncated to
!				the size specified in the FILE_SPEC
!				string, FILE_SPEC_LENGTH is set to this
!				size. Therefore, FILE_SPEC_LENGTH can
!				always be used by the calling program to access
!				a valid substring of FILE_SPEC. This is
!				an optional output parameter, passed by
!				reference.
!
!	DIRECTORY_ID		Address of an array of three words that
!				specifies a directory file identification.
!				Typically this array is obtained from the
!				NAM$W_DID field of a VAX-11 RMS name block.
!				The $FIDDEF macro defines the structure of this
!				parameter. Thos is an optional parameter.
!
!	ACP_STATUS		Address of a long word that receives the status
!				resulting from traversing the back links. This
!				is an optional output parameter.
!
!	The output parameters are guaranteed to be stored only if the routine
!	value is true.
!
!--

BEGIN
LOCAL
	DEV_DESC:	BLOCK[DSC$K_S_BLN,BYTE],
	ITM:		BLOCK[28,BYTE],
	FIB:		BLOCK[FIB$C_LENGTH,BYTE],
	FIB_DESC:	VECTOR[2],
	ASCNAME:	BLOCK[ATR$S_ASCNAME,BYTE] VOLATILE,
	BACKLINK:	BLOCK[ATR$S_BACKLINK,BYTE] VOLATILE,
	ATR:		BLOCKVECTOR[3,8,BYTE],
	IOSB:		VECTOR[4,WORD],
	CHANNEL:	WORD,
	EFN,
	FILE_NAME_LEN,
	FILE_NAME:	BLOCK[ATR$S_ASCNAME,BYTE] VOLATILE,
	DIR_LEVELS,
	DIR_NAME_LEN:	VECTOR[17,BYTE],
	DIR_NAME:	BLOCKVECTOR[17,39,BYTE],
	ACPTYPE,
	BUFFER:		BLOCK[256,BYTE],
	BUF_PTR:	REF VECTOR[,BYTE],
	BUF_LENGTH,
	STATUS_1,
	STATUS_2,
	STATUS_3,
	STATUS_4,
	STATUS_5,
	STATUS_6,
	FINAL_STATUS,
	ACP_STATUS_VALUE;
MACRO
	ITM_W_SIZE=	0,0,16,0 %,
	ITM_W_TYPE=	2,0,16,0 %,
	ITM_L_ADDR=	4,0,32,0 %,
	ITM_L_LEN=	8,0,32,0 %,
	ITM_W_SIZE_2=	12,0,16,0 %,
	ITM_W_TYPE_2=	14,0,16,0 %,
	ITM_L_ADDR_2=	16,0,32,0 %,
	ITM_L_LEN_2=	20,0,32,0 %,
	ITM_L_END=	24,0,32,0 %;
LABEL
	PROCESS;
BUILTIN
	ACTUALCOUNT,
	LOCC,
	NULLPARAMETER;

IF ACTUALCOUNT() LSSU 3 THEN RETURN LIB$_INVARG;

BEGIN
REGISTER
	R1=1,
	R2=2;
STATUS_1=LIB$ANALYZE_SDESC_R2(.DEVICE_NAME;R1,R2);
IF NOT .STATUS_1 THEN RETURN .STATUS_1;
IF .R1 GTRU LOG$C_NAMLENGTH THEN RETURN LIB$_INVARG;
DEV_DESC[DSC$B_DTYPE]=DSC$K_CLASS_Z;
DEV_DESC[DSC$B_CLASS]=DSC$K_DTYPE_Z;
DEV_DESC[DSC$W_LENGTH]=.R1;
DEV_DESC[DSC$A_POINTER]=.R2;
END;

STATUS_2= $ASSIGN(DEVNAM=DEV_DESC,CHAN=CHANNEL);
IF NOT .STATUS_2 THEN RETURN .STATUS_2;

STATUS_3=LIB$GET_EF(EFN);
IF NOT .STATUS_3
THEN
	BEGIN
	$DASSGN(CHAN=.CHANNEL);
	RETURN .STATUS_3;
	END;

PROCESS:	BEGIN

ITM[ITM_W_SIZE]=LOG$C_NAMLENGTH;
ITM[ITM_W_TYPE]=DVI$_LOGVOLNAM;
ITM[ITM_L_ADDR]=BUFFER;
ITM[ITM_L_LEN]=ITM[ITM_W_SIZE];
ITM[ITM_W_SIZE_2]=4;
ITM[ITM_W_TYPE_2]=DVI$_ACPTYPE;
ITM[ITM_L_ADDR_2]=ACPTYPE;
ITM[ITM_L_LEN_2]=0;
ITM[ITM_L_END]=0;
ACPTYPE=0;
FINAL_STATUS=$GETDVI(CHAN=.CHANNEL,EFN=.EFN,ITMLST=ITM);
IF NOT .FINAL_STATUS THEN LEAVE PROCESS;
FINAL_STATUS=$WAITFR(EFN=.EFN);
IF NOT .FINAL_STATUS THEN LEAVE PROCESS;

IF
	.ACPTYPE NEQ DVI$C_ACP_F11V1 AND
	.ACPTYPE NEQ DVI$C_ACP_F11V2
THEN
	BEGIN
	FINAL_STATUS=LIB$_INVFILSPE;
	LEAVE PROCESS;
	END;

IF .ITM[ITM_W_SIZE] EQL 0
THEN
	BEGIN

	ITM[ITM_W_SIZE]=LOG$C_NAMLENGTH;
	ITM[ITM_W_TYPE]=DVI$_DEVNAM;
	FINAL_STATUS=$GETDVI(CHAN=.CHANNEL,EFN=.EFN,ITMLST=ITM);
	IF NOT .FINAL_STATUS THEN LEAVE PROCESS;
	FINAL_STATUS=$WAITFR(EFN=.EFN);
	IF NOT .FINAL_STATUS THEN LEAVE PROCESS;
	IF .ITM[ITM_W_SIZE] EQL 0
	THEN
		BEGIN
		FINAL_STATUS=LIB$_INVFILSPE;
		LEAVE PROCESS;
		END;
	END;

CH$FILL(0,FIB$C_LENGTH,FIB);
FIB[FIB$W_FID_NUM]=.FILE_ID[FID$W_NUM];
FIB[FIB$W_FID_SEQ]=.FILE_ID[FID$W_SEQ];
FIB[FIB$W_FID_RVN]=.FILE_ID[FID$W_RVN];

FIB_DESC[0]=FIB$C_LENGTH;
FIB_DESC[1]=FIB;

ATR[0,ATR$W_TYPE]=ATR$C_BACKLINK;
ATR[0,ATR$W_SIZE]=ATR$S_BACKLINK;
ATR[0,ATR$L_ADDR]=BACKLINK;
ATR[1,ATR$W_TYPE]=ATR$C_ASCNAME;
ATR[1,ATR$W_SIZE]=ATR$S_ASCNAME;
ATR[1,ATR$L_ADDR]=FILE_NAME;
ATR[2,0,0,32,0]=0;
ACP_STATUS_VALUE=SS$_NORMAL;

FINAL_STATUS=$QIOW(
	FUNC=IO$_ACCESS,
	CHAN=.CHANNEL,
	EFN=.EFN,
	IOSB=IOSB,
	P1=FIB_DESC,
	P5=ATR);
IF .FINAL_STATUS THEN FINAL_STATUS=.IOSB[0];
IF NOT .FINAL_STATUS THEN LEAVE PROCESS;

BEGIN
REGISTER
	R0=0;
LOCC(%REF(%C' '), %REF(ATR$S_ASCNAME),FILE_NAME;R0);
FILE_NAME_LEN=ATR$S_ASCNAME-.R0;
END;

IF NOT NULLPARAMETER(5)
THEN
	BEGIN
 	BACKLINK[FID$W_NUM]=.DIRECTORY_ID[FID$W_NUM];
	BACKLINK[FID$W_SEQ]=.DIRECTORY_ID[FID$W_SEQ];
	BACKLINK[FID$W_RVN]=.DIRECTORY_ID[FID$W_RVN];
	END;

DIR_LEVELS=0;
ATR[1,ATR$L_ADDR]=ASCNAME;
UNTIL
	(.BACKLINK[FID$W_NUM] EQL FID$C_MFD AND .BACKLINK[FID$B_NMX] EQL 0) OR
	.DIR_LEVELS GEQU 15
DO
	BEGIN

	IF .BACKLINK[FID$W_NUM] EQL 0
	THEN
	    BEGIN
	    IF .DIR_LEVELS NEQ 0 THEN ACP_STATUS_VALUE = SS$_NOSUCHFILE;
	    EXITLOOP;
	    END;

	FIB[FIB$W_FID_NUM] = .BACKLINK[FID$W_NUM];
	FIB[FIB$W_FID_SEQ] = .BACKLINK[FID$W_SEQ];
	FIB[FIB$B_FID_NMX] = .BACKLINK[FID$B_NMX];
	IF .BACKLINK[FID$B_RVN] NEQ 0
	    THEN FIB[FIB$B_FID_RVN] = .BACKLINK[FID$B_RVN];

	ACP_STATUS_VALUE = $QIOW(
	    FUNC=IO$_ACCESS,
	    CHAN=.CHANNEL,
	    EFN=.EFN,
	    IOSB=IOSB,
	    P1=FIB_DESC,
	    P5=ATR);
	IF .ACP_STATUS_VALUE THEN ACP_STATUS_VALUE=.IOSB[0];
	IF NOT .ACP_STATUS_VALUE THEN EXITLOOP;

	BEGIN
	REGISTER
	    R0 = 0;
	LOCC(%REF(%C'.'),%REF(ATR$S_ASCNAME),ASCNAME;R0);
	DIR_NAME_LEN[.DIR_LEVELS] = R0 =ATR$S_ASCNAME - .R0;
	IF .R0 GTRU 39 THEN EXITLOOP;
	CH$MOVE(.R0,ASCNAME,DIR_NAME[.DIR_LEVELS,0,0,0,0]);
	END;

	DIR_LEVELS=.DIR_LEVELS + 1;

	IF .ACPTYPE EQL DVI$C_ACP_F11V1 THEN EXITLOOP;
	END;

END;

STATUS_5=$DASSGN(CHAN=.CHANNEL);
STATUS_6=LIB$FREE_EF(EFN);
IF NOT .STATUS_6 THEN RETURN .STATUS_6;
IF NOT .STATUS_5 THEN RETURN .STATUS_5;

IF NOT .FINAL_STATUS THEN RETURN .FINAL_STATUS;
IF
	.DIR_LEVELS EQL 0 AND
	.BACKLINK[FID$W_NUM] EQL FID$C_MFD AND .BACKLINK[FID$B_NMX] EQL 0
THEN
	BEGIN
	DIR_NAME_LEN[0]=6;
	DIR_NAME[0,0,0,32,0]='0000';
	DIR_NAME[0,4,0,16,0]='00';
	DIR_LEVELS=1;
	END;

IF
	NOT .ACP_STATUS_VALUE AND
	.BACKLINK[FID$W_NUM] NEQ 0 AND
	.DIR_LEVELS NEQ 0
THEN
	BEGIN
	DIR_NAME_LEN[.DIR_LEVELS]=1;
	DIR_NAME[.DIR_LEVELS,0,0,8,0] = '?';
	DIR_LEVELS=.DIR_LEVELS+1;
	END;

BUF_PTR = .ITM[ITM_L_ADDR] + .ITM[ITM_W_SIZE];

IF .BUF_PTR[-1] NEQ %C':'
THEN
	BEGIN
	BUF_PTR[0]=%C':';
	BUF_PTR = .BUF_PTR+1;
	END;
BUF_PTR[0]=%C'[';
BUF_PTR = .BUF_PTR+1;

DECR I FROM .DIR_LEVELS-1 TO 0 DO
	BEGIN

	BUF_PTR=CH$MOVE(.DIR_NAME_LEN[.I],DIR_NAME[.I,0,0,0,0],.BUF_PTR);
	IF .I NEQ 0
	THEN
		BEGIN
		BUF_PTR[0] = %C'.';
		BUF_PTR=.BUF_PTR+1;
		END;
	IF .I EQL .DIR_LEVELS-8 AND .I NEQ 0
	THEN
		BEGIN
		BUF_PTR[0] = %C']';
		BUF_PTR=.BUF_PTR+1;
		BUF_PTR[0] = %C'[';
		BUF_PTR=.BUF_PTR+1;
		END;
	END;
BUF_PTR[0]=%C']';
BUF_PTR=.BUF_PTR+1;

BUF_PTR=CH$MOVE(.FILE_NAME_LEN,FILE_NAME,.BUF_PTR);

BEGIN
REGISTER
	R1=1;
FINAL_STATUS=SS$_NORMAL;
BUF_LENGTH=.BUF_PTR-.ITM[ITM_L_ADDR];
STATUS_4=LIB$SCOPY_R_DX6(.BUF_LENGTH,.ITM[ITM_L_ADDR],.FILE_SPEC);
IF NOT .STATUS_4 THEN RETURN .STATUS_4;
LIB$ANALYZE_SDESC_R2(.FILE_SPEC;R1);
IF .R1 LSSU .BUF_LENGTH
THEN
	BEGIN
	BUF_LENGTH=.R1;
	FINAL_STATUS=LIB$_STRTRU;
	END;
END;

IF NOT NULLPARAMETER(4)
THEN
	(.FILE_SPEC_LENGTH)<0,16>=.BUF_LENGTH;

IF NOT NULLPARAMETER(6)
THEN
	.ACP_STATUS=.ACP_STATUS_VALUE;

RETURN .FINAL_STATUS;
END;
END
ELUDOM