Google
 

Trailing-Edge - PDP-10 Archives - bb-h138f-bm - 7-sources/noopen.bli
There are 10 other files named noopen.bli in the archive. Click here to see a list.
 %TITLE 'NOOPEN - OPEN error message'
MODULE NOOPEN (				! OPEN error message
		IDENT = '3-005'			! File: NOOPEN.BLI Edit: GB3005
		) =
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:
!
!	OPEN error message
!
! ENVIRONMENT:	Runs at any access mode - AST reentrant
!
! AUTHOR: Bob Kushlis, CREATION DATE: 6-AUG-1979
!
! MODIFIED BY:
!
! 1-001	- Original.  DJS 18-FEB-1981.  This module was created by
!	extracting routine EDT$$FIOPN_ERR  from module EDTCTR.
! 1-002	- Regularize header and fix file name and module name.  JBS 04-Mar-1981
! 1-003	- Use the new message codes.  JBS 04-Aug-1981
! 1-004 - If VMS don't execute any code. STS 10-Feb-1982
! 1-005 - Put error messages back on VMS. STS 25-Feb-1982
! 1-006 - Add CRLF's for EXT messages.  SMB 02-Jul-1982
! 1-007	- Most CRLFs no longer needed.  JBS 05-Jul-1982
! 1-008 - Move setting of reverse video.  SMB 22-Jul-1982
! 3-001 - Fix EDT$$FMT_STR and modify for TOPS20. CJG 22-Mar-1983
! 3-002 - Fix call to EDT$$FMT_STR. CJG 15-Jun-1983
! 3-003 - In the case of a bad filespec - don't try to print it. CJG 28-Jun-1983
! 3-004 - Don't need EDT$$IO_ERRMSG in the TOPS-20 version. CJG 9-Dec-1983
! 3-005 - Output the TOPS20 Error code after the file name.  GB 2-Aug-1984
!--

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

REQUIRE 'EDTSRC:TRAROUNAM';

REQUIRE 'SYS:JSYS';

FORWARD ROUTINE
    EDT$$FIOPN_ERR : NOVALUE;

!
! INCLUDE FILES:
!

REQUIRE 'EDTSRC:EDTREQ';

!
! MACROS:
!
!	NONE
!
! EQUATED SYMBOLS:
!
!	NONE
!
! OWN STORAGE:
!
!	NONE
!
! EXTERNAL REFERENCES:
!
!	In the routine
%SBTTL 'EDT$$FIOPN_ERR  - OPEN error message'

GLOBAL ROUTINE EDT$$FIOPN_ERR (			! OPEN error message
    MESS, 					! Message to print first
    FILE_DESC					! address of file name
    ) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Print an error message about failure to open a file.
!	First a specified message is printed, then other messages
!	including the file name.
!
! FORMAL PARAMETERS:
!
!  MESS			Number of the message to print first.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS:
!
!	Prints a long message on the screen
!
!--

    BEGIN

    EXTERNAL ROUTINE
	EDT$$SC_REVID,
	EDT$$TI_WRSTR,
	EDT$$FMT_STR,
	EDT$$FMT_MSG,
	EDT$$MSG_TOSTR,
	EDT$$OUT_FMTBUF,
	EDT$$FMT_CRLF;			! Terminate a line in the format buffer

    EXTERNAL
	ERR_NUMBER,			! Last TOPS20 error
	FMT_WRRUT;			! Address of format output routine

    MAP
	FILE_DESC : REF BLOCK;

    MESSAGES ((FILNAM));
    IF (.FMT_WRRUT EQL EDT$$TI_WRSTR) THEN EDT$$SC_REVID ();

    EDT$$FMT_MSG (.MESS);

    IF (.FILE_DESC [DSC$W_LENGTH] NEQ 0) THEN
	BEGIN
	IF (.FMT_WRRUT EQL EDT$$TI_WRSTR) THEN EDT$$SC_REVID ();
	EDT$$MSG_TOSTR (EDT$_FILNAM);
	EDT$$FMT_STR (CH$PTR (.FILE_DESC [DSC$A_POINTER]), .FILE_DESC [DSC$W_LENGTH]);
	EDT$$FMT_CRLF ();
	END;
    IF (.FMT_WRRUT EQL EDT$$TI_WRSTR) THEN EDT$$OUT_FMTBUF ();
    _ERSTR ($PRIOU, FLD ($FHSLF, FLD_LHS) + (.ERR_NUMBER AND FLD_RHS), 0);
    EDT$$FMT_CRLF ();
    END;					! of routine EDT$$FIOPN_ERR


END
ELUDOM