/*
 *****************************************************************************
 *                                                                           *
 * Copyright 1978 Compaq Computer Corporation                                *
 *                                                                           *
 * Compaq and the Compaq logo Registered in U.S. Patent and Trademark Office.*
 *                                                                           *
 * Confidential computer software. Valid license from Compaq required for    *
 * possession, use or copying. Consistent with FAR 12.211 and 12.212,        *
 * Commercial Computer Software, Computer Software Documentation, and        *
 * Technical Data for Commercial Items are licensed to the U.S. Government   *
 * under vendors standard commercial license.                                *
 *                                                                           *
 *****************************************************************************

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
     8-Dec-2000	|  LJK	| EV1-65  Change copyright notice to Compaq format.
*/
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;