Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

 %TITLE 'GETFSPEC - Get a filespec'
MODULE GETFSPEC (				 ! Get filespec components
		IDENT = '3-002'			 ! File: GETFSPEC.BLI Edit:CJG3002
		) =
BEGIN
!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1988.  ALL RIGHTS RESERVED.
!
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED ONLY
!IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE INCLUSION OF 
!THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY OTHER COPIES THEREOF MAY 
!NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON.  NO TITLE
!TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
!
!THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE AND 
!SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION.
!
!DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS 
!SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
!
!
!++
! FACILITY:	EDT
!
! ABSTRACT:
!
!	Get filespec components for use in GTJFN
!
! ENVIRONMENT:	Runs on TOPS-20 only
!
! AUTHOR:	CHRIS GILL	CREATION DATE: 21-June-1983
!
! MODIFIED BY:
!
! 3-002 - Fix the case when a null filespec occurs. CJG 28-Jun-1983
!
!--

%SBTTL 'DECLARATIONS'
!
! TABLE OF CONTENTS:
!

REQUIRE 'EDTSRC:TRAROUNAM';

FORWARD ROUTINE
    EDT$$GET_FILESPEC : NOVALUE;

!
! INCLUDE FILES:
!

REQUIRE 'EDTSRC:EDTREQ';

REQUIRE 'SYS:JSYS';

!
! EXTERNAL REFERENCES:
!
!	NONE
!
! MACROS:
!
!	NONE
!
! OWN STORAGE:
!
!	NONE
!

%SBTTL 'EDT$$GET_FILESPEC - Get filespec components'

GLOBAL ROUTINE EDT$$GET_FILESPEC (
	JFN,					! JFN of file
	FILE_BLK				! Adrs of descriptor block
		) : NOVALUE =

BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine accepts a JFN and generates pointers to the full file
!	specification (discluding device and directory if they are the defaults),
!	and then creates pointers to device, directory, name, and extension.
!
! FORMAL PARAMETERS:
!
!	JFN	= JFN of file whose specification is required
!	FILE_BLK= Address of the 6-word descriptor block
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS:
!
!	CALLS EDT$$ALO_HEAP
!--

    EXTERNAL ROUTINE
	EDT$$DEA_HEAP,
	EDT$$ALO_HEAP;

    LOCAL
	NEW_PTR,
	ADRS;

    MAP
	FILE_BLK : REF BLOCK [];

    IF (.JFN EQL 0) THEN RETURN;

!+
! If we already have memory allocated, then get rid of it.
!-

    ADRS = .FILE_BLK [DSC$A_POINTER];
    IF (.ADRS NEQ 0) THEN EDT$$DEA_HEAP (%REF (130), ADRS);

!+
! Allocate some memory and set the full spec pointer.
!-

    FILE_BLK [DSC$W_JFN] = .JFN;
    EDT$$ALO_HEAP (%REF (130), ADRS);
    FILE_BLK [DSC$A_POINTER] = .ADRS;

    _JFNS (CH$PTR (.ADRS), .JFN, K_JFNS; ADRS);
    FILE_BLK [DSC$W_LENGTH] = CH$DIFF (.ADRS, CH$PTR (.FILE_BLK [DSC$A_POINTER]));

!+
! If the length is too small, then we have a null filespec (may have come from
! EDT$$PA_FILE). In this case, clear the full descriptor and return.
!-

    IF (.FILE_BLK [DSC$W_LENGTH] LEQ 3) THEN
	BEGIN
	ADRS = .FILE_BLK [DSC$A_POINTER];
	EDT$$DEA_HEAP (%REF (130), ADRS);
	FILE_BLK [DSC$L_DESC] = 0;
	RETURN;
	END;
!+
! Get individual components of the filespec. If the device or directory
! fields are the default, then make sure that the pointers are null in
! order to avoid opening the null directory.
!-

    EDT$$ALO_HEAP (%REF (130), ADRS);
    ADRS = CH$PTR (.ADRS);

!+
! Device field.
!-

    FILE_BLK [DSC$A_DEVICE] = .ADRS;
    _JFNS (.ADRS, .JFN, %O'200000000000'; NEW_PTR);
    IF (.NEW_PTR EQL .ADRS)
    THEN
	FILE_BLK [DSC$A_DEVICE] = 0
    ELSE
	BEGIN
	ADRS = .NEW_PTR;
	CH$A_WCHAR (0, ADRS);
	END;

!+
! Directory field.
!-

    FILE_BLK [DSC$A_DIRECT] = .ADRS;
    _JFNS (.ADRS, .JFN, %O'20000000000'; NEW_PTR);
    IF (.NEW_PTR EQL .ADRS)
    THEN
	FILE_BLK [DSC$A_DIRECT] = 0
    ELSE
	BEGIN
	ADRS = .NEW_PTR;
	CH$A_WCHAR (0, ADRS);
	END;

!+
! File name field - always want this.
!-

    FILE_BLK [DSC$A_FNAME] = .ADRS;
    _JFNS (.ADRS, .JFN, %O'1000000000'; ADRS);
    CH$A_WCHAR (0, ADRS);

!+
! File type field - always want this.
!-

    FILE_BLK [DSC$A_FEXTN] = .ADRS;
    _JFNS (.ADRS, .JFN, %O'100000000'; ADRS);
    CH$A_WCHAR (0, ADRS);

    RETURN;

    END;

END
ELUDOM