Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

MODULE ERRLOG (
		IDENT = '1',
		%IF
		    %BLISS(BLISS32)
		%THEN
		    LANGUAGE(BLISS32),
		    ADDRESSING_MODE(EXTERNAL=LONG_RELATIVE,
				    NONEXTERNAL=LONG_RELATIVE)
		%ELSE
		    LANGUAGE(BLISS36)
		%FI
		) =

BEGIN
!
!			COPYRIGHT (c) 1982 BY
!	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! 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:	CMS Library Processor
!
! ABSTRACT:
!
!	This module contains the ERRLOG function to allow a CMS utility
!	function to place entries in a specified error log file.
!
! Environment: DECsystem-20 ,VAX/VMS
!
! Author: D. Knight , Creation Date: 5-Mar-80
!
!--

!
! Table of Contents:
!

FORWARD ROUTINE
	ERRLOG;					!Append an entry to the error log file

!
! Include Files
!

%if %bliss(bliss32) %then

library 'sys$library:starlet';
undeclare %quote $descriptor;

%fi

%if %bliss(bliss36) %then

require 'jsys:';

%fi

LIBRARY 'XPORT:';

REQUIRE 'SCONFG:';

REQUIRE 'BLISSX:';

!
! Macros:
!

!
! Equated Symbols:
!

LITERAL
	WRK_BUF_SIZE=30;		!Space for storing date, time, etc.

!
! OWN storage
!

!
! Externals
!

EXTERNAL ROUTINE
	DATTIM,				!Pick up the current date and time
	GETACT;				!Get account name

GLOBAL ROUTINE ERRLOG (REMRK,REM_CHARS) =

!++
! Functional Description:
!
!	Append a record to the error log file.
!
! Formal Parameters:
!
!	REMRK - pointer to remark text
!	REM_CHARS - length of remark text
!
! Implicit Inputs:
!
!	NONE
!
! Implicit Outputs:
!
!	NONE
!
! Routine Value:
! COMPLETION CODES
!
!	FALSE - no entry made
!	TRUE  - entry made
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    BEGIN

    LOCAL
	APND_IOB : $XPO_IOB(),		!Log file IOB
	DBUF: VECTOR[CH$ALLOCATION(WRK_BUF_SIZE)],
	DLGT,
	LINE_BUF,			!Pointer to line buffer
	LINEPTR;

    !Initialize IOB
    $XPO_IOB_INIT(IOB=APND_IOB);

    !Silently check if the error logging file exists.  If it does not,
    !do not attempt to create it.
    IF
	NOT $XPO_OPEN(IOB=APND_IOB,FILE_SPEC=(%STRING(LIB,ERLG)),OPTIONS=INPUT,FAILURE=0)
    THEN
	RETURN FALSE;

    $XPO_close(IOB=APND_IOB);

    !Open the file for appending.
    IF
	NOT $XPO_OPEN(IOB=APND_IOB,FILE_SPEC=(%STRING(LIB,ERLG)),OPTIONS=APPEND,FAILURE=0)
    THEN
	!Cannot write the entry
	RETURN FALSE;

    !Allocate room to assemble line
    $XPO_GET_MEM(CHARACTERS=.REM_CHARS+2+WRK_BUF_SIZE*2,RESULT=LINE_BUF);
    LINEPTR=.LINE_BUF;

    !Put date and time in record
    DLGT=DATTIM(DBUF);
    LINEPTR=CH$MOVE(.DLGT,CH$PTR(DBUF),.LINEPTR);

    !Now pick up the account identifier
    CH$WCHAR_A(%C' ',LINEPTR);
    DLGT=GETACT(DBUF);
    LINEPTR=CH$MOVE(.DLGT,CH$PTR(DBUF),.LINEPTR);

    !Put out the remark
    CH$WCHAR_A(%C' ',LINEPTR);
    LINEPTR=CH$MOVE(.REM_CHARS,.REMRK,.LINEPTR);

    !Output the line, ignore errors that occur while logging an error.
    $XPO_put(IOB=APND_IOB,
	     STRING=(CH$DIFF(.LINEPTR,.LINE_BUF),.LINE_BUF),
	     FAILURE=0);
    !And terminate everything
    $XPO_close(IOB=APND_IOB,
	       FAILURE=0);
    !Free the memory
    $XPO_FREE_MEM(STRING=(.REM_CHARS+2+WRK_BUF_SIZE*2,.LINE_BUF));

    TRUE

    END;				!End of ERRLOG

END					!End of Module ERRLOG
ELUDOM