/*
*****************************************************************************
*									    *
*  Copyright (c) 1978, 1979, 1980	                                    *
*  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:

	SDL (Structure Definition Language)

abstract:

	Output error messages to sys$error and the listing
	arguments:
		sdl$_shr_data   the data structure containing all the data that
				is shared with the backends.  It contains the
				file variables that were opened by the driver.
		msgno		a message code, generated by the MSG utility
		line		the source line locator where the error occured.
		text		ascii text to be supplied as an fao argument.

	All SDL messages are formatted so that if one fao argument is
	present it is a a line number.
	if two are present the first is a line number and the next is text.

author:
	C.T. Pacy
date:
	revised 22-DEC-1980	ctp
	revised  3-Oct-1983	kd
*/
errmsg:	proc (sdl$_shr_data, msgno, line, text);
	dcl msgno fixed bin(31);

	dcl 1 line,
	  2 lineno fixed bin(15),
	  2 colno  fixed bin(15);

	dcl text char(132) var;

	dcl dummy_lineno ptr;
	dcl dummy_text ptr;
	dcl writelist entry variable;

	%include 'sdl$library:sdlshr.in';

/* Put Message system service */
declare sys$putmsg external entry (
	any,			/* addr of message vector */
	entry value,		/* external action procedure */
	char(*),		/* facility name string */
	any)			/* argument for the action procedure */

	options (variable) returns(fixed bin(31));


	dcl 1 msgvec ,
		2 arg_count fixed bin(15),
		2 flags bit(16) init ('0'b),
		2 msg_id fixed bin(31),
		2 FAO_count fixed bin(15) init (0),
		2 newflags bit(16) init ('0'b),
		2 FAO_args (2) fixed bin(31) init (0,0);
	dcl i fixed bin;
	dcl 1 desc,
		2 len fixed bin(31) init(0),
		2 address pointer init (null());
	dcl ptrbin pointer based (addr(binptr));
	dcl binptr fixed bin(31);
	dcl status_bits bit(3) based;
	dcl success_bit bit(1) based;
	dcl int fixed bin(31) based;
 

	dummy_lineno=addr(lineno);
	dummy_text=addr(text);
	writelist=sdl$writelist;
	listline=0;	/* this prevents sdl$writelist from outputting a line
			   number when writing this to the listing */

/* if not a warning message, increment the error count */
	if ^(addr(msgno)->success_bit) then
		if addr(msgno)->status_bits ^= '000'b then
			errorcount=errorcount+1;

/* set the main return status bits, so it will reflect any warning messages */
	addr(main_return)->status_bits = addr(msgno)->status_bits;
	msg_id=msgno;

/* if text present, add to fao args */
	if dummy_text ^= null() then do;
		fao_count=fao_count+1;
		desc.len=length(text);
		ptrbin=addr(text);
		binptr=binptr+2;
		desc.address=ptrbin;
		ptrbin=addr(desc);
		fao_args(fao_count)=binptr;
		end;
/* if lineno present, add to fao args */
	if dummy_lineno ^= null() then do;
		fao_count=fao_count+1;
		fao_args(fao_count)=lineno;
		end;

/* put out the message */
	arg_count=2+fao_count;
	i=sys$putmsg(msgvec,writelist,,sdl$_shr_data);
end;