4.3BSD/usr/contrib/B/src/bint/b3err.c

/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */

/*
  $Header: b3err.c,v 1.4 85/08/22 16:57:50 timo Exp $
*/

/* B error message handling */

/* There are two kinds of errors:
	1) parsing, when the line in error is in a buffer
	2) execution, when the line in error is a parse-tree, and must
	   therefore be reconstructed.
*/

/* All error messages are collected in a file, both to save data space
   and to ease translation to other languages.	The English version
   of the database can be recreated from the program sources by scanning
   for the pattern "MESS(".  This is a macro whose first argument is
   the message number and whose second number is the message string;
   this macro expands to only the message number which is passed to
   the error routines.	The error routines then dig the message from
   the error message file, or just print the number if the file can't be
   opened.  There is also a way to pass a message that is determined
   at runtime.
*/

#include "b.h"
#include "b0fea.h"
#include "b0fil.h"
#include "b1obj.h"
#include "b2syn.h"
#include "b3env.h"
#include "b3fil.h"
#include "b3err.h"
#include "b3scr.h"
#include "b3sig.h"
#include "b3sou.h"

Visible bool still_ok, interrupted;

Visible parsetree curline= Vnil;
Visible value curlino;
Visible context how_context, act_context;

FILE *errfile;	/* The first thing a visible routine must do is set this */
		/* usually by calling line()				 */

#define Interactive (errfile == stderr)

/*********************************************************************/

/* While we are reading the Messages file, we build an index.
   probe[k] contains the first message number found in block k.
   blocks are BUFSIZ in size. */

#define FILESIZE 12916 /* Approximated current size of Messages file */
#define MAXPROBE (10 + FILESIZE/BUFSIZ) /* Allow some growth */

Hidden short probe[MAXPROBE];
Hidden int nprobes= 1;

Hidden FILE *messfp;
Hidden string savedmess;

Visible int MESSMAKE(mess) string mess; {
	savedmess= mess;
	return -1;
}

Visible string getmess(nr) int nr; {
	int last, c; char *cp= NULL;
	static char buf[80]; bool new; int block; long ftell();
	char *filename;
	if (nr == 0) return "";
	if (nr < 0) { return savedmess; }
	if (messfp == NULL)
		messfp= fopen(messfile, "r");
	if (messfp) {
		for (block= nprobes-1; block > 0; --block) {
			if (probe[block] <= nr)
				break;
		}
		new= block == nprobes-1;
		fseek(messfp, (long)block*BUFSIZ, 0);
		last= 0;
		while (last < nr) {
			if (new) block= ftell(messfp) / BUFSIZ;
			if (fgets(buf, sizeof buf, messfp) == NULL) break;
			last= atoi(buf);
			if (last <= 0)
				continue;
			if (new && block >= nprobes && nprobes < MAXPROBE) {
				probe[block]= last;
				nprobes= block+1;
			}
		}
		if (last == nr) {
			cp= index(buf, '\n');
			if (cp != NULL) *cp = '\0'; /* strip terminating \n */
			cp= buf;
			cp= index(buf, '\t');
			if (cp != NULL) return cp+1;
		}
	}
	sprintf(buf, " (error %d) ", nr);
	return buf;
}

Hidden Procedure prmess(nr) int nr; {
	errmess(getmess(nr));
}

/*********************************************************************/

Hidden Procedure putch(c) char c; {
	putc(c, errfile);
}

Hidden Procedure line() {
#ifdef EXT_COMMAND
	e_done();
#endif
	fflush(stdout);
	if (cntxt == In_read) {
		if (rd_interactive) {
			errfile= stderr; at_nwl= Yes;
		} else errfile= stdout;
	} else if (interactive) errfile= stderr;
	       else errfile= stdout;
	if (!at_nwl) putch('\n');
	at_nwl= Yes;
}

Hidden Procedure errmess(m) string m; {
	fputs(m, errfile);
}

#ifdef NOT_USED
Hidden Procedure core_dump() {
	errmess("*** Core-dump for inspection purposes: ");
	fflush(stdout);
	dump();
}
#endif

Hidden Procedure prname(name) value name; {
	if (Is_text(name)) {
		still_ok= Yes;
		writ(name);
		still_ok= No;
	}
}

Visible value erruname= Vnil;
Visible intlet errlino= 0;

Hidden intlet pr_line(at) bool at; {
	/*prints the line that tx is in, with an arrow pointing to the column
	  that tx is at.
	*/
	txptr lx= fcol(); intlet ap= -1, p= 0; char c; txptr ax= tx;
	if (!at) do ax--; while (Space(Char(ax)));
	while (!Eol(lx) && Char(lx) != Eotc) {
		if (lx == ax) ap= p;
		c= *lx++;
		if (c == '\t') {
			do { putch(' '); } while (((++p)%4)!=0);
		} else { putch(c); p++; }
	}
	putch('\n');
	if (ap < 0) ap= p;
	for (p= 0; p < ap+4; p++) putch(' ');
	errmess("^\n");
}

Hidden bool sh_lino(lino) intlet lino; {
	switch (cntxt) {
		case In_command:
		case In_read:
		case In_edval:
		case In_tarval:
		case In_prmnv:	return No;
		case In_unit:	return lino != 1;
		default:	return Yes;
	}
}


Hidden Procedure show_line(in_node, at, node, line_no)
 bool in_node, at; parsetree node; int line_no;
 {
	if (sh_lino(line_no))
		fprintf(errfile, " in line %d of your ", line_no);
	else
		errmess(" in your ");
	switch (cntxt) {
		case In_command:	errmess("command"); break;
		case In_read:		errmess("expression to be read"); break;
		case In_edval:		errmess("edited value"); break;
		case In_tarval: 	errmess("target value"); break;
		case In_unit:		errmess("unit ");
					release(erruname);
					if (Is_text(uname)) {
						value name; literal type;
						p_name_type(uname, &name, &type);
						prname(name); release(name);
						erruname= copy(uname);
						errlino= line_no;
					} else erruname= Vnil;
					break;
		case In_prmnv:		errmess("permanent environment"); break;
		default:		errmess("???\n"); return;
	}
	errmess("\n");
	if (!in_node || node != Vnil) errmess("    ");
	if (in_node) display(errfile, node, Yes);
	else pr_line(at);
}

Hidden bool unit_file() {
	value *aa;
	return cntxt == In_unit && Is_text(uname) && p_exists(uname, &aa);
}

Hidden Procedure show_where(in_node, at, node)
	bool in_node, at; parsetree node; {

	int line_no= in_node ? intval(curlino) : lino;
	if (cntxt == In_formal) { /*can only happen when in_node*/
		context cc;
		sv_context(&cc);
		set_context(&how_context);
		copy(uname);
		show_line(Yes, Yes, curline, intval(curlino));
		errmess("*** originating");
		set_context(&act_context);
		copy(uname);
		show_line(Yes, Yes, curline, intval(curlino));
		set_context(&cc);
	} else
		show_line(in_node, at, node, line_no);
	if (!Interactive && !unit_file()) {
		fprintf(errfile,
		  "*** (detected after reading %d input line%s of your input file ",
		    f_lino, f_lino == 1 ? "" : "s");
		if (iname == Vnil) errmess("standard input");
		else prname(iname);
		errmess(")\n");
	}
}

Hidden Procedure fatal(m, in_node) int m; bool in_node; {
	line();
	errmess("*** Sorry, B system malfunction");
	show_where(in_node, Yes, curline);
	errmess("*** The problem is: ");
	prmess(m); errmess("\n");
	errmess("*** Please save pertinent data for inspection by B guru\n");
	bye(-1);
}

Visible Procedure syserr(m) int m; {
	fatal(m, Yes);
}

#ifdef EXT_COMMAND
Visible Procedure psyserr(m) int m; {
	fatal(m, No);
}
#endif

Visible Procedure memexh() {
	line();
	errmess("*** Sorry, memory exhausted");
/* show_where(Yes, Yes); don't know if in node or not; to fix */ errmess("\n");
	errmess("*** Get your boss to buy a larger computer\n");
	bye(-1);
}

Hidden Procedure fix_files() {
	if (ifile != stdin) fclose(ifile);
	if (f_interactive(stdin) || filtered) {
		interactive= Yes;
		release(iname);
		iname = Vnil;
		ifile = stdin;
		sv_ifile= ifile;
		Eof= No;
	}
}

Hidden Procedure message(m1, m2, v, m3, in_node, at)
 string m1; int m2, m3; value v; bool in_node, at; {
	still_ok= No;
	line();
	errmess(m1);
	show_where(in_node, at, curline);
	errmess("*** The problem is: ");
	prmess(m2);
	if (v != Vnil) errmess(strval(v));
	prmess(m3);
	errmess("\n");
	at_nwl=Yes;
}

Visible Procedure pprerr(m) int m; {
	if (still_ok)
	message("*** There's something I don't understand", m, Vnil, 0, No, No);
}

Visible Procedure pprerr2(tag, m) value tag; int m; {
	if (still_ok)
	message("*** There's something I don't understand", 0, tag, m, No, No);
}

Visible Procedure parerr2(m, ss) int m, ss; {
	if (still_ok)
	message("*** There's something I don't understand", m, Vnil, ss, No, Yes);
}

Visible Procedure parerr(m) int m; {
	parerr2(m, 0);
}

Visible Procedure fixerr3(m1, v, m2) value v; int m1, m2; {
	if (still_ok)
	message("*** There's something I can't resolve", m1, v, m2, Yes, Yes);
}

Visible Procedure fixerr2(v, m) value v; int m; {
	fixerr3(0, v, m);
}

Visible Procedure fixerr(m) int m; {
	fixerr3(0, Vnil, m);
}

Visible Procedure error3(m1, v, m2) value v; int m1, m2; {
	message("*** Can't cope with problem", m1, v, m2, Yes, No);
}

Visible Procedure error2(m, v) int m; value v; {
	error3(m, v, 0);
}

Visible Procedure error(m) int m; {
	error3(m, Vnil, 0);
}

Visible Procedure checkerr() {
	still_ok= No;
	line();
	errmess("*** Your check failed");
	show_where(Yes, No, curline);
	at_nwl= Yes;
}

#ifdef SIGNAL

Visible Procedure int_signal() {
	interrupted= Yes; still_ok= No;
	if (cntxt == In_prmnv) exit(-1);
	if (!interactive) fix_files();
	if (!interactive) bye(1);
	line(); fflush(stdout);
	errmess("*** interrupted\n");
#ifndef INTEGRATION
	if (filtered) errmess("\177");
#endif
	if (cntxt == In_read) {
		set_context(&read_context);
		copy(uname);
	}
	at_nwl= Yes;
}

#endif SIGNAL

Visible bool bugs= No, testing= No, tracing= No;

#ifdef NOT_USED
Visible Procedure debug(m) string m; {
	if (bugs) {
		line();
		errmess("*** Debugging ");
		show_where(Yes, Yes, curline);
		fprintf(errfile, "*** %s\n", m);
		at_nwl= Yes;
	}
}
#endif

#ifdef EXT_COMMAND

/* User-callable error message */
Visible Procedure e_error(mesg) value mesg; {
	value v= convert(mesg, Yes, Yes);
	message("*** Halted", 0, v, 0, Yes, No);
	release(v);
}

#endif

Visible Procedure bye(ex) int ex; {
#ifdef EXT_COMMAND
	e_done();
#endif
	at_nwl= Yes;
	putprmnv();
	endall();
	if (ex == 0) {
		term_mem();
		endmem();
	}
#ifdef IBMPC
	memstat("at end");
#endif IBMPC
	exit(ex);
}

Visible Procedure initerr() {
	still_ok= Yes; interrupted= No; curline= Vnil; curlino= zero;
}


#define HZ 60 /* 4.2BSD: not line frequency but historical constant */

showtime(whence)
	string whence;
{
#ifdef TIMING
	static long total[2];
	long buf[4];
	extern bool timing; /* Set in b3mai.c by -T option */

	if (!timing) return;
	times(buf);
	line();
	fprintf(errfile, "*** Times %s: user %.2f sys %.2f (total %.2f %.2f)\n",
		whence,
		(float)(buf[0]-total[0])/HZ, (float)(buf[1]-total[1])/HZ,
		(float)total[0]/HZ, (float)total[1]/HZ
	);
	total[0]= buf[0]; total[1]= buf[1];
#endif TIMING
}