Google
 

Trailing-Edge - PDP-10 Archives - tops20-v7-ft-dist1-clock - 7-sources/prfile.bli
There are 10 other files named prfile.bli in the archive. Click here to see a list.
!GREEN:<ZBRAD.20790>PRFILE.BLI.3  4-Nov-85 13:51:34, Edit by MERRILL
!Edit 35, Copy file pointer correctly
 %TITLE 'PRFILE - parse a file specification'
MODULE PRFILE (				! Parse a command
		IDENT = '3-006'			! File: PRFILE.BLI Edit:GB3006
		) =
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 -- The DEC Standard Editor
!
! ABSTRACT:
!
!	Parse a filespec and a buffer name.
!
! ENVIRONMENT:	Runs on TOPS-20 only
!
! AUTHOR: Chris Gill, CREATION DATE: March 15, 1983
!
! MODIFIED BY:
!
! 3-001 - Original
! 3-002 - Change the filespec handling. CJG 28-Jun-1983
! 3-003 - Fix some bugs in defaulting and EXIT handling. CJG 12-Dec-1983
! 3-004 - Make sure a meaningfull message is returned for file errors. CJG 23-Dec-1983
! 3-005 - Check for control-C being typed. CJG 5-Jan-1984
! 3-006 - Fix problem with EXIT when we already had an output JFN. GB 20-Jun-1984
!--

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

REQUIRE 'EDTSRC:TRAROUNAM';

FORWARD ROUTINE
    EDT$$PA_FILE,				! Parse a filespec
    EDT$$PA_BUFFER;				! Parse a buffer name

!
! INCLUDE FILES:
!

REQUIRE 'EDTSRC:EDTREQ';

REQUIRE 'EDTSRC:PARLITS';

REQUIRE 'SYS:JSYS';

!
! EXTERNAL REFERENCES:
!
!	In the routines
!
!
! MACROS:
!
!	NONE
!
!
! OWN STORAGE
!
OWN	TEMP_DESC : BLOCK [6];	!Holds new filespec for compare	


%SBTTL 'EDT$$PA_FILE - parse a filespec'

GLOBAL ROUTINE EDT$$PA_FILE (				! Parse a filespec
		FILE_DESC : REF BLOCK,			! Descriptor to use
		FLAGS,					! I/O and required flags
		DFLT : REF VECTOR) =			! Defaults

BEGIN

!+
! FUNCTIONAL DESCRIPTION
!
!	This subroutine parses a filespec and saves it in the parse stack.
!	If a filespec was required then an error is returned if a filespec
!	could not be parsed. All the commands which require a filespec do
!	not take defaults, so the GTJFN block is cleared for them. If the
!	command is EXIT then any JFN we have for the output file is released
!	and a new one obtained.
!
! FORMAL PARAMETERS:
!
!	FILE_DESC	The file descriptor to be returned
!	FLAGS		Flags affecting parsing
!	DFLT		Default values for the filespec
!
! IMPLICIT INPUTS:
!
!	ATOM_BUFFER
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	1 - All OK
!	0 - Reparse required
!      -1 - Error in parsing
!
! SIDE EFFECTS:
!
!	May assign a JFN to a file.
!
! EXTERNAL DATA
!-

    EXTERNAL ROUTINE
	EDT$$GET_FILESPEC : NOVALUE;		! Convert filespec

    EXTERNAL
	GETJFN_BLOCK : VECTOR [16],		! GTJFN argument block
	ATOM_BUFFER,				! Command buffer
	CSB,
	FD_FIL,
	CC,					! Control-C flag
	PA_ERRNO,
	PA_CURCMD : REF NODE_BLOCK;		! Current node

    LOCAL
	LEN,
	C_FLAG,					! COMND flags
	C_DATA,					! COMND data or pointer
	C_FDB;					! FDB used in parse

    LITERAL
	F_REQD   = 1,				! Filespec is required
	F_EXIT   = 2,				! EXIT command
	F_OUTPUT = 4,				! Parse an output filespec
	F_RELEAS = 8;				! Release JFN when done

    BEGIN

!+
! Preset the GTJFN block with the defaults, if given.
!-

	IF ((.FLAGS AND F_OUTPUT) NEQ 0)
	THEN
	    GETJFN_BLOCK [$GJGEN] = GJ_MSG + GJ_FOU + GJ_XTN	! Output
	ELSE
	    GETJFN_BLOCK [$GJGEN] = GJ_OLD + GJ_XTN;		! Input

	IF (.DFLT EQL 0)
	THEN
	    BEGIN
	    IF ((.FLAGS AND F_REQD) NEQ 0)
	    THEN
		BEGIN
		GETJFN_BLOCK [$GJDEV] = 0;
		GETJFN_BLOCK [$GJDIR] = 0;
		GETJFN_BLOCK [$GJNAM] = 0;
		GETJFN_BLOCK [$GJEXT] = 0;
		END
	    ELSE
		BEGIN
		GETJFN_BLOCK [$GJDEV] = .FILE_DESC [DSC$A_DEVICE];
		GETJFN_BLOCK [$GJDIR] = .FILE_DESC [DSC$A_DIRECT];
		GETJFN_BLOCK [$GJNAM] = .FILE_DESC [DSC$A_FNAME];
		GETJFN_BLOCK [$GJEXT] = .FILE_DESC [DSC$A_FEXTN];
		END;
	    END
	ELSE
	    BEGIN
	    GETJFN_BLOCK [$GJDEV] = .DFLT [0];
	    GETJFN_BLOCK [$GJDIR] = .DFLT [1];
	    GETJFN_BLOCK [$GJNAM] = .DFLT [2];
	    GETJFN_BLOCK [$GJEXT] = .DFLT [3];
	    END;

!+
! Now try to parse a filespec. If it fails and either a control-C was
! pressed or we required a filespec, then return an error.
!-

	IF (NOT COMMAND (FD_FIL)) THEN RETURN (-1);
	IF (.CC NEQ 0) THEN RETURN (-1);
	IF ((.C_FLAG AND CM_NOP) NEQ 0) THEN
	    IF ((.FLAGS AND F_REQD) EQL 0)
		THEN
		    RETURN (1)
		ELSE
		    BEGIN
		    PA_ERRNO = .C_DATA;
		    RETURN (-1);
		    END;

	IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN RETURN (0);

!+
! If this is an EXIT command and we already have a JFN for the output filespec
! from the initial command line, then release that JFN. If a filespec was
! given with the EXIT command then it overrides the original.
! Finally release the newly obtained JFN (we get new ones when we do the rename)!-
	IF ((.FLAGS AND F_EXIT) NEQ 0)
	THEN
	    BEGIN
	    IF (.FILE_DESC [DSC$W_JFN] NEQ 0)
	    THEN
		BEGIN
		_RLJFN (.FILE_DESC [DSC$W_JFN]);
		FILE_DESC [DSC$W_JFN] = 0;
		END;
	    IF (CH$RCHAR (CH$PTR (ATOM_BUFFER)) NEQ 0)
	    THEN
		EDT$$GET_FILESPEC (.C_DATA, .FILE_DESC);
	    _RLJFN (.C_DATA);
	    FILE_DESC [DSC$W_JFN] = 0;
	    END
	ELSE
!+
! Not EXIT command - convert the JFN to a full filespec and save the result pointer.
!-
	    EDT$$GET_FILESPEC (.C_DATA, .FILE_DESC);

	IF (.FILE_DESC [DSC$W_LENGTH] NEQ 0) THEN
	    BEGIN
	    PA_CURCMD [FSPCLEN] = .FILE_DESC [DSC$W_LENGTH];
	    PA_CURCMD [FILSPEC] = .FILE_DESC [DSC$A_POINTER]; ![35]
	    END;

!+
! Release the JFN if required. This is done for the SET commands because
! the files are handled later.
!-

	IF ((.FLAGS AND F_RELEAS) NEQ 0)
	THEN
	    BEGIN
	    _RLJFN (.FILE_DESC [DSC$W_JFN]);
	    FILE_DESC [DSC$W_JFN] = 0;
	    END;

	RETURN (1);
    END;
END;


%SBTTL 'EDT$$PA_BUFFER - Parse a buffer name'

GLOBAL ROUTINE EDT$$PA_BUFFER =			! Parse a buffer name


BEGIN

!+
 ! This routine parses a buffer name and stores a pointer and length
! in a new range node.
!
! ROUTINE VALUE
!
!	-1 - JSYS error, unable to create range node, zero length buffer name
!	 0 - Reparse required
!	+1 - All OK
!-

!
! EXTERNAL DATA
!

    EXTERNAL
	CSB,
	FD_RNF,
	PA_ERRNO,			! Error code from parse
	PA_CURRNG : REF NODE_BLOCK,	! Current node
	PA_BUFRNG : REF NODE_BLOCK,	! Buffer node
	PA_CURTOK,			! Current token pointer
	PA_CURTOKLEN;			! Current token length

!
! EXTERNAL ROUTINES
!

    EXTERNAL ROUTINE
	EDT$$PA_NEW_NOD,		! Create a new node
	EDT$$PA_SCANTOK : NOVALUE;	! Get length and pointer

    LOCAL
	C_FLAG,					! COMND flags
	C_DATA,					! COMND data or pointer
	C_FDB;					! FDB used in parse

    MESSAGES (INVBUFNAM);
!
!

    BEGIN
	PA_ERRNO = EDT$_INVBUFNAM;
	IF (NOT COMMAND (FD_RNF)) THEN RETURN (-1);
	IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN RETURN (0);
	IF ((.C_FLAG AND CM_NOP) NEQ 0) THEN RETURN (-1);

!+
! Create a new node and set the pointers. If the node cannot be created
! or the buffer name is zero length, then return an error.
!-

	IF ((PA_CURRNG = EDT$$PA_NEW_NOD (RANGE_NODE, RAN_BUFFER))
		EQL 0) THEN RETURN (-1);

	EDT$$PA_SCANTOK (0,1);
	IF (.PA_CURTOKLEN EQL 0) THEN RETURN (-1);
	PA_CURRNG [BUF_NAME] = .PA_CURTOK;
	PA_CURRNG [BUF_LEN] = .PA_CURTOKLEN;
	PA_BUFRNG = .PA_CURRNG;
	RETURN (1);
    END;
END;

END
ELUDOM