Trailing-Edge
-
PDP-10 Archives
-
DEC_CMS-20_V1.0_SRC
-
cms/sources/sysmsg.bli
There are no other files named sysmsg.bli in the archive.
MODULE sysmsg (
IDENT = '1',
%IF
%BLISS(BLISS32)
%THEN
LANGUAGE(BLISS32),
ADDRESSING_MODE(EXTERNAL=GENERAL,
NONEXTERNAL=LONG_RELATIVE)
%ELSE
LANGUAGE(BLISS36)
%FI
) =
BEGIN
!
! COPYRIGHT (C) 1982, 1983 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:
!
! Generate correct system message
!
! ENVIRONMENT: VAX/VMS, DS-20
!
! AUTHOR: D. Knight
!
!--
!
! INCLUDE FILES:
!
%if %bliss(bliss32) %then
library 'sys$library:starlet' ;
%fi
%if %bliss(bliss36) %then
%if %switches(tops20) %then
require 'jsys:';
%else
%error('DS-10 support not implemented')
%fi
%fi
LIBRARY 'XPORT:';
require 'blissx:';
REQUIRE 'SCONFG:';
require 'condit:';
!
! TABLE OF CONTENTS
!
FORWARD ROUTINE
syslp : novalue, !generate system message
%if vaxvms %then
rmsmsg : novalue, !generate system message
%fi
sysmsg : novalue; !generate system message
!
! MACROS:
!
%if %bliss(bliss32) %then
macro
l_=0,32,0 %,
w0_=0,16,0 %,
w1_=16,16,0 %;
%fi
!
! EQUATED SYMBOLS:
!
literal
k_cr = %o'15',
k_lf = %o'12';
!
! OWN STORAGE:
!
!
! EXTERNAL REFERENCES:
!
external
f_log_set ; ! Determine if /LOG or /NOLOG is on
%if %bliss(bliss36) %then
external literal
msg_erro,
msg_fata,
msg_info,
msg_seve,
msg_succ,
msg_warn;
external routine
lib$put_output;
%fi
GLOBAL ROUTINE syslp (msgcode,num_chars,p_string,action) : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! Output system message in proper format
!
! FORMAL PARAMETERS:
!
! msgcode - type of message to be output
! NUM_CHARS - character count
! P_STRING - pointer to string
! ACTION - optional action routine to handle text string
!
! IMPLICIT INPUTS:
!
! NONE.
!
! IMPLICIT OUTPUTS:
!
! NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
BEGIN
local
string : desc_block;
$str_desc_init(descriptor=string,string=(.num_chars,.p_string));
sysmsg(.msgcode,string,.action)
end;
GLOBAL ROUTINE sysmsg (msgcode,a_message,action) : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! Output system message in proper format
!
! FORMAL PARAMETERS:
!
! msgcode - type of message to be output
! A_MESSAGE - address of a descriptor to the message text to write
! ACTION - optional action routine to handle text string
!
! IMPLICIT INPUTS:
!
! NONE.
!
! IMPLICIT OUTPUTS:
!
! NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
BEGIN
%if %bliss(bliss32) %then
local
msgblk: $sts_fullword, ! defined in CONDIT
msv: block[4];
! Check for success and /NOLOG
msgblk = .msgcode;
if .msgblk[sts$v_severity] eql sts$k_success and
not .f_log_set
then
return ;
!now print the message
msv[0,w0_]=3;
msv[0,w1_]=0;
msv[1,l_]=.msgcode;
msv[2,w1_]=0;
msv[2,w0_]=1;
msv[3,l_]=.a_message;
if
.action eql 0
then
$putmsg(msgvec=msv)
else
$putmsg(msgvec=msv,actrtn=.action)
%fi
%if %bliss(bliss36) %then
%if %switches(tops20) %then
map
a_message :ref desc_block;
local
wrk_buf : vector[ch$allocation(250)],
wrk_ptr,
sev_lev;
! break msgcode into its components of 4 character message id and
! the severity level
sev_lev = .msgcode<1,7>;
! Return if this is a success message and /NOLOG is set
if .sev_lev eql msg_succ and
not .f_log_set
then
return ;
!point to working buffer
wrk_ptr=ch$ptr(wrk_buf);
! if message is an informational, enclose in brackets
if .sev_lev eql msg_info
then
wrk_ptr=ch$move(len_comma_ptr('['),.wrk_ptr);
!put message id into buffer
wrk_ptr = ch$move(len_comma_ptr(fac_name),.wrk_ptr);
wrk_ptr = ch$move(4,ch$ptr(msgcode),.wrk_ptr);
ch$wchar_a(%c' ',wrk_ptr);
!put message string in buffer
wrk_ptr=ch$move(.a_message[desc_len],.a_message[desc_ptr],.wrk_ptr);
if .sev_lev eql msg_info ! close brackets for info
then
wrk_ptr=ch$move(len_comma_ptr(']'),.wrk_ptr);
if
.sev_lev eql msg_succ or
.sev_lev eql msg_info or
.sev_lev eql msg_warn
then
begin
!+
! Write message to terminal WITHOUT going through XPORT (ROLBCK
! may have already closed OUT_IOB).
!-
local
temp_desc : $str_descriptor();
$str_desc_init (descriptor = temp_desc,
string = (ch$diff(.wrk_ptr,ch$ptr(wrk_buf)),
ch$ptr(wrk_buf)));
lib$put_output(temp_desc);
end
else
!let the system do it
begin
!add <CR><LF> to end of message
ch$wchar_a (k_cr, wrk_ptr);
ch$wchar_a (k_lf, wrk_ptr);
!the -20 needs a null to tell when things are done
ch$wchar_a(0,wrk_ptr);
!now output the error; start with <cr><lf> if not already at beginning
! of a line, followed by ?, then text
esout(ch$ptr(wrk_buf);wrk_ptr)
end
%else
%error('ds-10 support not implemented')
%fi
%fi
END; !End of SYSMSG
%if vaxvms %then
GLOBAL ROUTINE rmsmsg (msgcode,msgcode2) : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! Output rms system message in proper format. Since rms status
! codes are handled differently by $putmsg this routine is necessary.
!
! FORMAL PARAMETERS:
!
! msgcode - primary code
! msgcode2 - 2nd code
!
! IMPLICIT INPUTS:
!
! NONE.
!
! IMPLICIT OUTPUTS:
!
! NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
BEGIN
local
msgblk: $sts_fullword, ! defined in CONDIT
msv: block[3];
! Check for success and /NOLOG
msgblk = .msgcode;
if .msgblk[sts$v_severity] eql sts$k_success and
not .f_log_set
then
return ;
!now print the message
msv[0,w0_]=3;
msv[0,w1_]=0;
msv[1,l_]=.msgcode;
msv[2,l_]=.msgcode2;
$putmsg(msgvec=msv);
END; !End of SYSMSG
%fi
END !End of Module SYSMSG
ELUDOM