include	<evexpr.h>
include <error.h>
include "hcheck.h"

# DOCHECK -- Perform a consistency check on the image header
#
# B.Simon	30-Apr-90	Original

procedure docheck (im, igroup, command, hasgroup, title)

pointer	im		#  i: Image descriptor
int	igroup		#  i: Group number
char	command[ARB]	# io: Consistency check command
bool	hasgroup	# io: Group parameters in the command file?
bool	title		# io: Print title line?
#--
include	"hcheck.com"

bool	isgroup
int	keystart, cmdstart, show
pointer	sp, op, errmsg

string	badexpr  "Syntax error: %s"
string	badtype  "Not a boolean expression: %s"

int	errcode(), strlen()
pointer	evexpr(), locpr()

extern	vheader, fheader

begin
	call smark (sp)
	call salloc (errmsg, SZ_LINE, TY_CHAR)

	call cmdsplit (im, igroup, command, keystart, cmdstart, show, isgroup)
	hasgroup = hasgroup || isgroup

	switch (show) {
	case NEVER:
	    ;

	case ALWAYS:
	    call chk_print (im, command[keystart], "", title)

	case IF_MISSING:
	    call chk_missing (im, command[keystart], title)

	case IF_TRUE:
	    imc = im
	    keyc[1] = EOS
	    iferr {
		op = evexpr (command[cmdstart], locpr(vheader), locpr(fheader))

	    } then {
		switch (errcode())  {

		case SYNTAX: # Generate a more meaningful syntax error message
		    call xer_reset
		    if (strlen (command[cmdstart]) > 60)
			call strcat (" ...", command[cmdstart+60], SZ_COMMAND)

		    call sprintf (Memc[errmsg], SZ_LINE, badexpr)
		    call pargstr (command[cmdstart])
		    call error (SYNTAX, Memc[errmsg])

		case MISSING: # missing header keyword
		    call xer_reset
		    call chk_missing (im, keyc ,title)

		case LOCAL: # other errors generated by this task
		    call erract (EA_ERROR)

		default:
		    call erract (EA_ERROR)
		}

	    } else if (O_TYPE(op) != TY_BOOL) {
		command[cmdstart+SZ_FNAME] = EOS
		call sprintf (Memc[errmsg], SZ_LINE, badtype)
		    call pargstr (command[cmdstart])
		call error (LOCAL, Memc[errmsg])

	    } else if (O_VALB(op)) {
		call chk_print (im, command[keystart], 
				command[cmdstart], title)
	    }
	}

	call sfree (sp)
end