Trailing-Edge
-
PDP-10 Archives
-
bb-r775e-bm_tops20_ks_upd_5
-
sources/edt/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