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