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) 1981, 1985 BY
!	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!		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 WHICH 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