Trailing-Edge
-
PDP-10 Archives
-
BB-H138E-BM
-
6-1-sources/setcomman.bli
There are 10 other files named setcomman.bli in the archive. Click here to see a list.
%TITLE 'SETCOMMAN - set command file name'
MODULE SETCOMMAN ( ! Set command file name
IDENT = '3-006' ! File: SETCOMMAN.BLI Edit: CJG3006
) =
BEGIN
!
! COPYRIGHT (c) 1982, 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:
!
! Set help file name.
!
! ENVIRONMENT: Runs at any access mode - AST reentrant
!
! AUTHOR: John Sauter, CREATION DATE: June 3, 1982
!
! MODIFIED BY:
!
! 1-001 - Original. JBS 07-Jun-1982
! 1-002 - Don't open the file on the INCLUDE channel if the COMMAND channel
! is not already open. This is because the initial opens from
! EDT$EDIT must have a default name which is only supplied on
! the COMMAND channel. JBS 08-Jun-1982
! 1-003 - Close the correct file. JBS 11-Jun-1982
! 1-004 - Set CMD_OPN when the command file is open. JBS 11-Jun-1982
! 1-005 - Pass the default file name in the RHB parameter. JBS 15-Jun-1982
! 1-006 - Accept the default name as a parameter. JBS 23-Aug-1982
! 3-001 - Modify for TOPS10/20. CJG 23-Mar-1983
! 3-002 - Add updates from V3 sources. GB 03-may-1983
! 3-003 - Remove default name from argument list - its already been
! done by the parser. CJG 10-Jun-1983
! 3-004 - Remove call to EDT$$CALLFIO. CJG 10-Jun-1983
! 3-005 - Change the way that filespecs are handled. CJG 23-Jun-1983
! 3-006 - Modify ASSERT macro to include error code. CJG 30-Jan-1984
!--
%SBTTL 'Declarations'
!
! TABLE OF CONTENTS:
!
REQUIRE 'EDTSRC:TRAROUNAM';
FORWARD ROUTINE
EDT$$SET_COMFNAM;
!
! INCLUDE FILES:
!
REQUIRE 'EDTSRC:EDTREQ';
!
! MACROS:
!
! NONE
!
! EQUATED SYMBOLS:
!
! NONE
!
! OWN STORAGE:
!
! NONE
!
! EXTERNAL REFERENCES:
!
! In the routine
%SBTTL 'EDT$$SET_COMFNAM - set command file name'
GLOBAL ROUTINE EDT$$SET_COMFNAM ( ! Set command file name
NADDR ! Address of new command file name
) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Set a new command file name. If the file does not exist there is no
! effect. Otherwise the current command file is abandoned and the new
! command file is read instead.
!
! FORMAL PARAMETERS:
!
! NADDR Address of new command file name, or 0 if none.
!
!
! IMPLICIT INPUTS:
!
! CMD_NAM
! CMD_OPN
!
! IMPLICIT OUTPUTS:
!
! CMD_NAM
! CMD_OPN
!
! ROUTINE VALUE:
!
! 0 = File not present, CMD_NAM unchanged (or error, accompanied by message)
! 1 = file present, CMD_NAM changed, or no file named.
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
EXTERNAL ROUTINE
EDT$FILEIO, ! Do file I/O
EDT$$DEA_HEAP : NOVALUE, ! Deallocate heap storage
EDT$$ALO_HEAP, ! Allocate heap storage
EDT$$FMT_MSG : NOVALUE, ! Put the text for a message in the format buffer
EDT$$FIOPN_ERR : NOVALUE; ! Print a message if a file operation files
EXTERNAL
CMD_NAM : BLOCK [], ! Name of the command file
CMD_OPN, ! 1 = command file is open
INC_NAM : BLOCK [],
IOFI_NFND; ! 1 = last open failed because of file not found
EXTERNAL LITERAL
EDT$K_INCLUDE_FILE, ! Channel for testing for presence of command file
EDT$K_COMMAND_FILE, ! Command file channel
EDT$K_OPEN_INPUT, ! Code for opening for input
EDT$K_CLOSE; ! Code for closing a file
LOCAL
PTR,
LEN,
STATUS;
MESSAGES ((INSMEM, COMFILCLO, COMFILNOP, COMFILNEX));
MAP
NADDR : REF BLOCK;
!+
! If the descriptor came from the initial command parser and a file is
! already open - then die.
!-
IF ((.NADDR EQL CMD_NAM) AND (.CMD_OPN NEQ 0)) THEN ASSERT (24, 0);
!+
! Switch to the new command file, if it exists.
!-
IF ((.NADDR NEQ 0) AND .CMD_OPN)
THEN
BEGIN
INC_NAM [DSC$L_DESC] = .NADDR; ! Copy the descriptor
INC_NAM [DSC$W_JFN] = 0;
STATUS = EDT$FILEIO (EDT$K_OPEN_INPUT, EDT$K_INCLUDE_FILE, INC_NAM);
IF ( NOT .STATUS)
THEN
BEGIN
IF ( NOT .IOFI_NFND) THEN EDT$$FIOPN_ERR (EDT$_COMFILNOP, INC_NAM);
RETURN (0)
END;
!+
! Now that we know that the file exists we can close it on the INCLUDE channel.
!-
STATUS = EDT$FILEIO (EDT$K_CLOSE, EDT$K_INCLUDE_FILE, 0);
IF ( NOT .STATUS)
THEN
BEGIN
EDT$$FIOPN_ERR (EDT$_COMFILCLO, INC_NAM);
RETURN (0);
END;
END;
!+
! Either the file exists, or no command file is currently open, or no file name is specified.
! If the command file is currently open, close it.
!-
IF .CMD_OPN
THEN
BEGIN
STATUS = EDT$FILEIO (EDT$K_CLOSE, EDT$K_COMMAND_FILE, 0);
IF ( NOT .STATUS)
THEN
BEGIN
EDT$$FIOPN_ERR (EDT$_COMFILCLO, CMD_NAM);
RETURN (0);
END;
CMD_OPN = 0;
!+
! Deallocate the previous string, if any. Note that if CMD_OPN is zero
! the old space is not deallocated. EDT$EDIT takes advantage of this.
!-
IF (.CMD_NAM [DSC$W_LENGTH] NEQ 0) THEN
BEGIN
LEN = .CMD_NAM [DSC$W_LENGTH];
PTR = .CMD_NAM [DSC$A_POINTER];
EDT$$DEA_HEAP (LEN, PTR);
END;
END;
!+
! If no new file has been specified, clean up and exit.
!-
IF (.NADDR EQL 0)
THEN
BEGIN
CMD_NAM [DSC$L_DESC] = 0;
CMD_NAM [DSC$W_JFN] = 0;
END
ELSE
BEGIN
!+
! The command file is not open and a file has been specified. The file may
! not be present. Open errors return an error code but print no message.
! There should be an open error only if this is the initial open.
!-
IF (.NADDR NEQ CMD_NAM) THEN CMD_NAM [DSC$L_DESC] = .NADDR [DSC$L_DESC];
STATUS = EDT$FILEIO (EDT$K_OPEN_INPUT, EDT$K_COMMAND_FILE, CMD_NAM);
IF ( NOT .STATUS) THEN RETURN (0);
CMD_OPN = 1;
END;
RETURN (1);
END; ! of routine EDT$SET_COMFNAM
END
ELUDOM