Google
 

Trailing-Edge - PDP-10 Archives - bb-r775c-bm_tops20_ks_upd_3 - sources/prfile.bli
There are 10 other files named prfile.bli in the archive. Click here to see a list.
 %TITLE 'PRFILE - parse a file specification'
MODULE PRFILE (				! Parse a command
		IDENT = '3-006'			! File: PRFILE.BLI Edit:GB3006
		) =
BEGIN
!
!			  COPYRIGHT (c) 1983, 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 -- 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] = CH$PTR (.FILE_DESC [DSC$A_POINTER]);
	    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