#ifdef public_domain_notice

Copyright (c) 1996 David P. Murphy for Datametrics Systems Corporation ---
please send all comments and bug reports to murphy@connor.datametrics.com

Permission is granted to any individual or institution to use, copy, or
redistribute this software so long as all of the original files are included,
that it is not sold for profit, and that this copyright notice is retained.
Use at your own risk.  Neither Murphy nor Datametrics assumes responsibility.
Do not taunt Happy Fun Ball.

#endif

	/* add an entry to the Hardware Exceptions Report */

#include "dscstd.h"
#include <descrip.h>
#include <stdio.h>
#include <errno.h>
#include <signal.h>
#include <ssdef.h>
#include <libdef.h>
#include <chfdef.h>
#include <stsdef.h>
#ifdef __VAX
#include <sfdef.h>
#endif
#ifdef __ALPHA
#include <ints.h>
#include <pdscdef.h>
#include <psigdef.h>
#include <libicb.h>
#endif

	/* macros specific to this module */

#undef MAYBE
#define MAYBE  2

#define HER$_USERABORT   0x00060001

#define MAX_ARGS            250
#define MAX_SIGNALS         250

#ifdef __VAX
#define REG_AP                        12
#define REG_FP                        13
#define REG_SP                        14
#define REG_PC                        15
#define NUMBER_OF_REGISTERS           16
#define NUMBER_OF_SPECIAL_REGISTERS    4
#endif
#ifdef __ALPHA
#define NUMBER_OF_INT_REGISTERS       32
#define NUMBER_OF_FLOAT_REGISTERS     32
#define NUMBER_OF_REGISTERS           64
#define NUMBER_OF_SPECIAL_REGISTERS    0
#endif

#ifdef __VAX
#define SPECIAL_PC   ((char *) 0x80000014)
#endif

	/* internal data structures */

typedef union VMS_REGISTER {
#ifdef __VAX
	long lval;
	float fval;
#endif
#ifdef __ALPHA
	__int64 qval;
	unsigned long ulvals[2];
	double dval;
#endif
	void *pval;
} VMSRegister;

typedef struct VMS_PROC_STATUS_WORD {
	unsigned cBit            :  1;
	unsigned vBit            :  1;
	unsigned zBit            :  1;
	unsigned nBit            :  1;
	unsigned traceBit        :  1;
	unsigned intOverflow     :  1;
	unsigned floatUnderflow  :  1;
	unsigned decimalOverflow :  1;
	unsigned                 :  8;
} PSW;

typedef struct VMS_PROC_STATUS_LONGWORD {
	PSW thepsw;
	unsigned iplValue       : 5;
	unsigned                : 1;
	unsigned prevMode       : 2;
	unsigned currentMode    : 2;
	unsigned interruptStack : 1;
	unsigned firstPartDone  : 1;
	unsigned                : 2;
	unsigned tracePending   : 1;
	unsigned pdp11mode      : 1;
} PSL;

#ifdef __VAX
typedef struct VMS_ARGUMENT_STACK {
	unsigned char argCount;
	unsigned : 24;
	void *args[MAX_ARGS];
} ArgStack;

typedef struct VMS_CALL_FRAME {
	struct VMS_CALL_FRAME *conditionHandler;
	unsigned           :  5;
	unsigned miniPSW   : 11;
	unsigned entryMask : 12;
	unsigned           :  1;
	unsigned isCALLS   :  1;
	unsigned spa       :  2;
	ArgStack *savedAP;
	struct VMS_CALL_FRAME *savedFP;
	char *savedPC;
	VMSRegister savedRegs[NUMBER_OF_REGISTERS - NUMBER_OF_SPECIAL_REGISTERS];
} CallFrame;
typedef CallFrame FrameData;
#endif
#ifdef __ALPHA
typedef void ArgStack;
typedef struct pdscdef CallFrame;
typedef struct invo_context_blk FrameData;
#endif

typedef struct VMS_CONDITION_STACK {
	CONDVAL condValue;
	unsigned char argCount;
	unsigned : 24;
	void *args[MAX_ARGS];
} CondStack;

typedef struct VMS_SIGNAL_ARRAY {
	long totalArgCount;
	CondStack signals[MAX_SIGNALS];
} SignalArray;

typedef struct VMS_MECH_ARRAY {
#ifdef __VAX
	long totalArgCount;		/* always four longwords following */
	CallFrame *frame;
	long depth;
	long savedR0;
	long savedR1;
#endif
#ifdef __ALPHA
	long totalArgCount;	/* always eighty-seven longwords following */
	long mch_flags;
	CallFrame *frame;
	long mch_xxx;
	long depth;
	long mch_resvd1;
	uint64 mch_daddr;
	uint64 mch_esf_addr;
	uint64 mch_sig_addr;
	uint64 savedR0;
	uint64 savedR1;
	uint64 savedR16;
	uint64 savedR17;
	uint64 savedR18;
	uint64 savedR19;
	uint64 savedR20;
	uint64 savedR21;
	uint64 savedR22;
	uint64 savedR23;
	uint64 savedR24;
	uint64 savedR25;
	uint64 savedR26;
	uint64 savedR27;
	uint64 savedR28;
	uint64 savedF0;
	uint64 savedF1;
	uint64 savedF10;
	uint64 savedF11;
	uint64 savedF12;
	uint64 savedF13;
	uint64 savedF14;
	uint64 savedF15;
	uint64 savedF16;
	uint64 savedF17;
	uint64 savedF18;
	uint64 savedF19;
	uint64 savedF20;
	uint64 savedF21;
	uint64 savedF22;
	uint64 savedF23;
	uint64 savedF24;
	uint64 savedF25;
	uint64 savedF26;
	uint64 savedF27;
	uint64 savedF28;
	uint64 savedF29;
	uint64 savedF30;
#endif
} MechArray;

	/* operating-system function declarations */

#ifdef __VAX
#  define sys$asctim                SYS$ASCTIM
#  define sys$assign                SYS$ASSIGN
#  define sys$dassgn                SYS$DASSGN
#  define sys$putmsg                SYS$PUTMSG
#  define lib$establish             LIB$ESTABLISH
#  define lib$find_image_symbol     LIB$FIND_IMAGE_SYMBOL
#  define lib$get_curr_invo_context LIB$GET_CURR_INVO_CONTEXT
#  define lib$get_prev_invo_context LIB$GET_PREV_INVO_CONTEXT
#  define lib$signal                LIB$SIGNAL
#endif
#include <starlet.h>		/* prototypes for the SYS$xxxxx() functions */
#include <lib$routines.h>	/*     "       "   "  LIB$xxxxx()     "     */

extern void lib$get_curr_invo_context(struct invo_context_blk *);
extern unsigned int lib$get_prev_invo_context(struct invo_context_blk *);

	/* external function declarations */

extern int DSC_CanReadMemory(int, void *);
extern void DSC_ShowSystemData(void *, FILE *, void *);
extern void DSC_ShowProcessData(void *, FILE *, void *);
extern CallFrame *DSC_GetMyFrame(void);
#ifdef __VAX
extern void DSC_GetMyRegisters(VMSRegister *);
#endif

	/* internal function declarations */

void HER_SetUserMessage(char *);
void HER_SetUserFunction(int (*fncptr)());
void HER_TrackDummyError(CONDVAL);
int HER_CheckForException(CONDVAL, SignalArray *);
CONDVAL HER_Init(void);
CONDVAL HER_HandleException(SignalArray *, MechArray *);
CONDVAL HER_ReportException(SignalArray *, MechArray *);

	/* external data declarations */

	/* internal data declarations */

LOCALDATA $DESCRIPTOR(NullDevice, "NL:");

LOCALDATA $DESCRIPTOR(SherlockImage, "SHERLOCK_HOLMES");
LOCALDATA $DESCRIPTOR(SherlockName,  "SH_SHOW");
LOCALDATA CONDVAL (*SherlockPtr)() = NULL;

LOCALDATA FILE *ReportFP = NULL;
LOCALDATA long TrackChannel = 0;
LOCALDATA long FrameCount   = 0;
LOCALDATA VMSRegister TrueRegs[NUMBER_OF_REGISTERS];

LOCALDATA BOOL Reporting = FALSE;

#define MAX_IMAGES  32
LOCALDATA int nImageCount = 0;
LOCALDATA struct {
	char imgname[39 + 1];
	void *vastart;
	void *vaend;
} ImageInfo[MAX_IMAGES];

LOCALDATA char *UserMessage = NULL;
LOCALDATA int (*UserFunction)() = NULL;

#ifdef __VAX
LOCALDATA char *RegLabels[] = {
	"R0", "R1", "R2", "R3", "R4", "R5", "R6", "R7",
	"R8 ", "R9 ", "R10", "R11", "AP", "FP", "SP", "PC"
};
#endif


MEP__ PRIVATE void HER_I_SaveChan(
	void
)
{
	/* try to keep a channel reserved for error-tracking purposes,
	 * so that the calling program does not consume all channels
	 * (ignore any error)
	 */
	if (TrackChannel == 0) {
		sys$assign(&NullDevice, &TrackChannel, 0, 0);
	}

	return;
}


MEP__ UNIVERSAL CONDVAL HER_Init(
	void
)
{
	HER_I_SaveChan();

	return(SS$_NORMAL);
}


MEP__ PRIVATE void HER_I_CauseDump(
	long exitargs[]
)
{
	CONDVAL cv0;

	IFBAD(exitargs[0]) {
		lib$establish(HER_HandleException);
		lib$signal(HER$_USERABORT, 0);
	}

	return;
}


MEP__ PRIVATE CONDVAL HER_I_HandleDummyError(
	SignalArray *sigargs,
	MechArray *mechargs
)
{
	HER_ReportException(sigargs, mechargs);

	return(SS$_CONTINUE);
}


MEP__ UNIVERSAL void HER_TrackDummyError(
	CONDVAL cv0
)
{
	if (cv0 == 0) cv0 = HER$_USERABORT;
	lib$establish(HER_I_HandleDummyError);
	lib$signal(cv0, 0);

	return;
}


MEP__ UNIVERSAL void HER_SetUserMessage(
	char *msgptr
)
{
	UserMessage = msgptr;

	return;
}


MEP__ UNIVERSAL void HER_SetUserFunction(
	int (*fncptr)()
)
{
	UserFunction = fncptr;

	return;
}


MEP__ UNIVERSAL CONDVAL HER_HandleException(
	SignalArray *sigargs,
	MechArray *mechargs
)
{
	CONDVAL cv0;

	if (HER_CheckForException(0, sigargs)) {
		IFBAD(HER_ReportException(sigargs, mechargs)) {
			fprintf(stderr, "\nunable to report the exception!\n");
			if (cv0 == SS$_RESIGNAL) {
				fprintf(stderr, "\n\tcoding error within HER.C\n");
			}
			else {
				fprintf(stderr, "\n\tcan't open the logfile, ");
				fprintf(stderr, "status is (hex) %x\n", cv0);
			}
			fflush(stderr);
			fsync(fileno(stderr));
			sleep(10);
		}
	}

	return(SS$_RESIGNAL);
}


MEP__ UNIVERSAL int HER_CheckForException(
	CONDVAL cv0,
	SignalArray *sigargs
)
{
	if (sigargs != NULL) {
		cv0 = sigargs->signals[0].condValue;
	}

	switch (cv0) {

	case SS$_ACCVIO:
	case SS$_ASTFLT:
	case SS$_BREAK:
	case SS$_CMODSUPR:
	case SS$_CMODUSER:
	case SS$_DECOVF:
	case SS$_FLTDIV:
	case SS$_FLTOVF:
	case SS$_FLTUND:
	case SS$_FLTDIV_F:
	case SS$_FLTOVF_F:
	case SS$_FLTUND_F:
	case SS$_INTDIV:
	case SS$_INTOVF:
	case SS$_OPCDEC:
	case SS$_PAGRDERR:
	case SS$_ROPRAND:
	case SS$_SSFAIL:
#ifdef __VAX
	case SS$_ARTRES:
	case SS$_COMPAT:
	case SS$_OPCCUS:
	case SS$_RADRMOD:
	case SS$_SUBRNG:
	case SS$_TBIT:
#endif
#ifdef __ALPHA
	case SS$_ALIGN:
	case SS$_HPARITH:
#endif
#ifdef HER$_USERABORT
	case HER$_USERABORT:
#endif
		return(TRUE);

	case SS$_EXQUOTA:
	case SS$_EXASTLM:
	case SS$_EXBIOLM:
	case SS$_EXBYTLM:
	case SS$_EXDIOLM:
	case SS$_EXENQLM:
	case SS$_EXFILLM:
	case SS$_EXPRCLM:
	case SS$_EXTQELM:
	case SS$_EXPGFLQUOTA:
		return(MAYBE);

	default:
		return(FALSE);
	}
}


MEP__ PRIVATE CONDVAL HER_I_ShowMessageText(
	struct dsc$descriptor_s *msdp,
	long unused
)
{
	int trimlen;
	char *endptr;

	endptr = msdp->dsc$a_pointer + msdp->dsc$w_length - 1;
	trimlen = msdp->dsc$w_length;
	while (endptr > msdp->dsc$a_pointer) {
		if (*endptr == '\0' || *endptr > ' ') break;
		--trimlen;
		--endptr;
	}
	fprintf(ReportFP, "\t\t%*.*s\n", trimlen, trimlen, msdp->dsc$a_pointer);

	/* must return an even value to prevent sys$putmsg()
	 * from echoing this string to SYS$ERROR:
	 */
	return(0);
}


MEP__ PRIVATE void HER_I_ShowExceptionHeader(
	SignalArray *sigargs
)
{
	struct dsc$descriptor_s tempsd;
	char timebuf[23 + 1];

	tempsd.dsc$a_pointer = timebuf;
	tempsd.dsc$w_length = sizeof(timebuf);
	tempsd.dsc$b_dtype = 0;
	tempsd.dsc$b_class = 0;
	sys$asctim(NULL, &tempsd, NULL, 0);
	timebuf[23] = '\0';
	fprintf(ReportFP, "\f\nEXCEPTION occurred at %s\n", timebuf);

	if (UserMessage != NULL) {
		fprintf(ReportFP, "\n\tApplication Message:\n\n\t\t%s\n", UserMessage);
	}
	if (UserFunction != NULL) {
		(*UserFunction)(ReportFP);
	}

	fprintf(ReportFP, "\n\tCondition:\n\n");

	sigargs->totalArgCount -= 2;
	sys$putmsg(sigargs, HER_I_ShowMessageText, NULL, 0);
	sigargs->totalArgCount += 2;

	return;
}


#ifdef __VAX

MEP__ PRIVATE int HER_I_CanProcess(
	CallFrame *fp
)
{
	if (DSC_CanReadMemory(sizeof(void *), fp)) {
		if (DSC_CanReadMemory(sizeof(void *), fp->savedPC)) {
			return(TRUE);
		}
	}

	return(FALSE);
}

#endif


MEP__ PRIVATE int HER_I_GetMaxArgs(
	MechArray *mechargs
)
{
	int largestArgCount;
#ifdef __VAX
	ArgStack *ap;
	CallFrame *fp;
#endif
#ifdef __ALPHA
	struct aidef *airptr;
	FrameData icbblock;
#endif

	largestArgCount = 0;
#ifdef __VAX
	for (fp = mechargs->frame; fp != NULL; fp = fp->savedFP) {
		if (HER_I_CanProcess(fp) == FALSE) {
			break;
		}
		if ((ap = fp->savedAP) == NULL) {
		}
		else if (! DSC_CanReadMemory(sizeof(long), ap)) {
		}
		else if (ap->argCount == 0 || ap->argCount > 32) {
		}
		else if (ap->argCount > largestArgCount) {
			largestArgCount = ap->argCount;
		}
	}
#endif
#ifdef __ALPHA
	lib$get_curr_invo_context(&icbblock);
	for (;;) {
		airptr = (struct aidef *) &icbblock.libicb$q_ireg[25];
		if (airptr->ai$b_arg_count > largestArgCount) {
			largestArgCount = airptr->ai$b_arg_count;
		}
		if (lib$get_prev_invo_context(&icbblock) == 0) break;
	}
#endif

	return(largestArgCount);
}


MEP__ PRIVATE int HER_I_CountFrames(
	MechArray *mechargs
)
{
	int j;
#ifdef __VAX
	CallFrame *fp;
#endif
#ifdef __ALPHA
	FrameData icbblock;
#endif

	j = 0;
#ifdef __VAX
	for (fp = mechargs->frame; fp != NULL; fp = fp->savedFP) {
		if (HER_I_CanProcess(fp) == FALSE) break;
		++j;
	}
#endif
#ifdef __ALPHA
	lib$get_curr_invo_context(&icbblock);
	for (;;) {
		if (lib$get_prev_invo_context(&icbblock) == 0) break;
		++j;
	}
#endif

	return(j);
}


MEP__ PRIVATE void HER_I_ShowCallStack(
	MechArray *mechargs
)
{
	int j;
	int depth;
	int maxargs;
	int argcnt;
	unsigned long curPC;
#ifdef __VAX
	ArgStack *ap;
	CallFrame *fp;
#endif
#ifdef __ALPHA
	unsigned long rim;	/* register info mask */
	unsigned long onearg;
	struct aidef *airptr;
	FrameData icbblock;
#endif

	/* we don't want to show the Program Counter per se at this time
	 * (that gets shown later in the per-frame data printout in ShowFrame below)
	 * but the address which can be compared to the "jacket" addresses in the .MAP ---
	 * for vax, it is the address of the entry point of the function (i.e., the two byte register save mask)
	 * for axp, it is the address of the procedure descriptor.
	 */
	maxargs = HER_I_GetMaxArgs(mechargs);
#ifdef __VAX
	fprintf(ReportFP, "\n\tCall Stack:\n\n\t\t       abs PC   ");
#endif
#ifdef __ALPHA
	fprintf(ReportFP, "\n\tCall Stack:\n\n\t\t      PD addr   ");
#endif
	for (j = 0; j < maxargs; j++) fprintf(ReportFP, "     arg %d", j + 1);
	fprintf(ReportFP, "\n\t\t      --------   ");
	for (j = 0; j < maxargs; j++) fprintf(ReportFP, "  --------");
	fprintf(ReportFP, "\n");

	depth = HER_I_CountFrames(mechargs);

#ifdef __VAX
	for (fp = mechargs->frame; fp != NULL; fp = fp->savedFP) {
		if (HER_I_CanProcess(fp) == FALSE) break;
		curPC = fp->savedPC;
#endif
#ifdef __ALPHA
	lib$get_curr_invo_context(&icbblock);
	for (;;) {
		curPC = (unsigned long) ((CallFrame *) icbblock.libicb$ph_procedure_descriptor);
#endif
		fprintf(ReportFP, "\t\t(%2d)  %08X  :", depth--, curPC);
#ifdef __VAX
		if ((ap = fp->savedAP) == NULL) {
			fprintf(ReportFP, "    <none>");
		}
		else if (! DSC_CanReadMemory(sizeof(long), ap)) {
			fprintf(ReportFP, "    <none>");
		}
		else if (ap->argCount == 0 || ap->argCount > 32) {
			fprintf(ReportFP, "    <none>");
		}
		else {
			for (j = 0; j < ap->argCount; j++) {
				fprintf(ReportFP, "  %8X", ap->args[j]);
			}
		}
#endif
#ifdef __ALPHA
		airptr = (struct aidef *) &icbblock.libicb$q_ireg[25];
		if ((argcnt = airptr->ai$b_arg_count) == 0) {
			fprintf(ReportFP, "    <none>");
		}
		else {
			rim = 0x03;
			for (j = 0; j < argcnt; j++) {
				int huh;
				huh = airptr->ai$v_arg_reg_info & rim;
				if (huh == AI$K_AR_I64) {
					onearg = icbblock.libicb$q_ireg[16 + j];
				}
				else if (huh == AI$K_AR_FF) {
					onearg = icbblock.libicb$q_freg[16 + j];
				}
				else {
					onearg = 0x0A11Beef;
				}
				fprintf(ReportFP, "  %8X", onearg);
				rim <<= 3;
			}
		}
#endif
		fprintf(ReportFP, "\n");
#ifdef __ALPHA
		if (lib$get_prev_invo_context(&icbblock) == 0) break;
#endif
	}

	return;
}


MEP__ PRIVATE void HER_I_ShowRegisters(
	FrameData *fdp
)
{
	int j;

#ifdef SAMPLE_VAX_OUTPUT

	Registers:

		R0 = 00000000   R4 = 00000000   R8  = 00000000   AP = 00000000
		R1 = 00000000   R5 = 00000000   R9  = 00000000   FP = 00000000
		R2 = 00000000   R6 = 00000000   R10 = 00000000   SP = 00000000
		R3 = 00000000   R7 = 00000000   R11 = 00000000   PC = 00000000
#endif

#ifdef SAMPLE_AXP_OUTPUT

	Registers:

		IR0  =       61        0      FR0  =     0.0000000000
		IR1  =        1        0      FR1  =     0.0000000000
		IR2  =        4        0      FR2  =     0.0000000000
		IR3  = 7FF34280        0      FR3  =     0.0000000000
		IR4  = 7FFBF80C        0      FR4  =     0.0000000000
		IR5  = 7FFBF91C        0      FR5  =     0.0000000000
		IR6  = 7FFA0944        0      FR6  =     0.0000000000
		IR7  = 7FFA0944        0      FR7  =     0.0000000000
		IR8  = 7FFA0208        0      FR8  =     0.0000000000
		IR9  = 7FFA0410        0      FR9  =     0.0000000000
		IR10 = 7FFA1190        0      FR10 =     0.0000000000
		IR11 = 7FFBE3E0        0      FR11 =     0.0000000000
		IR12 =       5D        0      FR12 =     0.0000000000
		IR13 = 7FEDBF70        0      FR13 =     0.0000000000
		IR14 =        0        0      FR14 =     0.0000000000
		IR15 =  2024061        0      FR15 =     0.0000000000
		IR16 =   2D2EF0        0      FR16 =     0.0000000000
		IR17 =        0        1      FR17 =     0.0000000000
		IR18 =   2D35D8  A00010A      FR18 =     0.0000000000
		IR19 =        0    80000      FR19 =     0.0000000000
		IR20 =        0        0      FR20 =     0.0000000000
		IR21 =   2D35D9        0      FR21 =     0.0000000000
		IR22 =        0        0      FR22 =     0.0000000000
		IR23 =        0        0      FR23 =     0.0000000000
		IR24 =        0   2D35F6      FR24 =     0.0000000000
		IR25 =        1        0      FR25 =     0.0000000000
		IR26 =    3024C        0      FR26 =     0.0000000000
		IR27 =   13FB20        0      FR27 =     0.0000000000
		IR28 = 80161188 FFFFFFFF      FR28 =     0.0000000000
		IR29 = 7FE4FBB0        0      FR29 =     0.0000000000
		IR30 = 7FE4FBA0        0      FR30 =     0.0000000000
		IR31 =        0 48000700      FR31 =     0.0000000000
#endif

	fprintf(ReportFP, "\n\tRegisters:\n\n");

#ifdef __VAX
	for (j = 0; j < 4; j++) {
		fprintf(ReportFP, "\t\t%s = %8X   %s = %8X   %s = %8X   %s = %8X\n",
			RegLabels[j],      TrueRegs[j].lval,
			RegLabels[j +  4], TrueRegs[j + 4].lval,
			RegLabels[j +  8], TrueRegs[j + 8].lval,
			RegLabels[j + 12], TrueRegs[j + 12].lval);
	}
#endif
#ifdef __ALPHA
	/* don't bother printing IR31 and FR31 --- they are both permanently zero
	 */
	for (j = 0; j < NUMBER_OF_INT_REGISTERS - 1; j++) {
		fprintf(ReportFP, "\t\tIR%-2d = %8X %8X      FR%-2d = %16.10lf\n",
			j, TrueRegs[j].ulvals[1], TrueRegs[j].ulvals[0],
			j, TrueRegs[j + NUMBER_OF_INT_REGISTERS].dval);
	}
#endif

	return;
}


MEP__ PRIVATE int HER_I_CheckAsciiArg(
	int thesize,
	char *theptr
)
{
	int worksize;

	if ((worksize = thesize) == 0) {
		worksize = 255;
	}
	else {
		if (! DSC_CanReadMemory(worksize, theptr)) {
			return(FALSE);
		}
	}
	while (worksize-- > 0) {
		if (thesize == 0) {
			if (! DSC_CanReadMemory(1, theptr)) {
				return(FALSE);
			}
			if (*theptr == '\0') {
				return(TRUE);
			}
		}
		if (*theptr != '\t' && *theptr < ' ') {
			return(FALSE);
		}
		++theptr;
	}

	return((thesize == 0) ? FALSE : TRUE);
}


MEP__ PRIVATE int HER_I_CheckDescriptorArg(
	struct dsc$descriptor_s *sdptr
)
{
	/* <sigh> at this time, we only support
	 * fixed-length character string descriptors
	 */

	if (sdptr->dsc$w_length == 0 || sdptr->dsc$w_length > 255) {
		return(FALSE);
	}
	if (sdptr->dsc$b_dtype != 0 && sdptr->dsc$b_dtype != DSC$K_DTYPE_T) {
		return(FALSE);
	}
	if (sdptr->dsc$b_class != 0 && sdptr->dsc$b_class != DSC$K_CLASS_S) {
		return(FALSE);
	}

	return(HER_I_CheckAsciiArg(sdptr->dsc$w_length, sdptr->dsc$a_pointer));
}


MEP__ PRIVATE void HER_I_ShowArguments(
	ArgStack *ap,
	int argc
)
{
	int j;
	int expandLimit;
	void *thisarg;
	struct dsc$descriptor_s *dscptr;

	fprintf(ReportFP, "\n\tArgument Stack: (count is %d)", argc);
#ifdef __ALPHA
	fprintf(ReportFP, " (probably bogus)");
#endif
	fprintf(ReportFP, "\n\n");

	if (argc == 0) {
		fprintf(ReportFP, "\t\t<none>\n");
		return;
	}

#ifdef SAMPLE_VAX_OUTPUT
		A0  =  00000000
		A1  =  00000000  :  00  0000  00000000
		A2  =  00000000  :  00  0000  00000000
		A3  =  00000000  :  00  0000  00000000  "hello world"
#endif

#ifdef SAMPLE_AXP_OUTPUT
#endif

#ifdef __VAX
	for (j = 0; j < argc; j++) {
		thisarg = ap->args[j];
		fprintf(ReportFP, "\t\tA%d  =  %8X", j + 1, thisarg);
		expandLimit = 8;
		while (DSC_CanReadMemory(sizeof(long), thisarg)) {
			if (--expandLimit <= 0) break;
			fprintf(ReportFP, "  -->  %2X  %4X  %8X",
				(unsigned long) *((unsigned char  *) thisarg),
				(unsigned long) *((unsigned short *) thisarg),
				(unsigned long) *((unsigned long  *) thisarg));
			dscptr = (struct dsc$descriptor_s *) thisarg;
			if (HER_I_CheckDescriptorArg(dscptr)) {
				fprintf(ReportFP, "  \"%-*.*s\"", dscptr->dsc$w_length,
					dscptr->dsc$w_length, dscptr->dsc$a_pointer);
				thisarg = NULL;
			}
			else if (HER_I_CheckAsciiArg(0, (char *) thisarg)) {
				fprintf(ReportFP, "  \"%s\"", (char *) thisarg);
				thisarg = NULL;
			}
			else {
				thisarg = (void *) *((long *) thisarg);
			}
		}
		fprintf(ReportFP, "\n");
	}
#endif
#ifdef __ALPHA
	fprintf(ReportFP, "\n");
#endif

	return;
}


MEP__ UNIVERSAL void HER_K_SaveImageInfo(
	char *pcImageName,
	void *pvStart,
	void *pvEnd
)
{
	if (nImageCount < MAX_IMAGES) {
		strcpy(ImageInfo[nImageCount].imgname, pcImageName);
		ImageInfo[nImageCount].vastart = pvStart;
		ImageInfo[nImageCount].vaend   = pvEnd;
		++nImageCount;
	}

	return;
}


MEP__ PRIVATE void HER_I_PrintImageOffset(
	char *pcLabel,
	void *pvPC
)
{
	int j;

	fprintf(ReportFP, "\n\t\t%s = %8X", pcLabel, (int) pvPC);
	for (j = 0; j < nImageCount; j++) {
		if (ImageInfo[j].vastart <= pvPC && pvPC <= ImageInfo[j].vaend) {
			fprintf(ReportFP, " (%s + %8X)", ImageInfo[j].imgname, (int) pvPC - (int) ImageInfo[j].vastart);
			break;
		}
	}

	return;
}


MEP__ PRIVATE void HER_I_ShowFrame(
	FrameData *fdp
)
{
	int j;
	int k;
	int numberOfArgs;
	unsigned long entrymask;
	long stackptr;
	ArgStack *ap;
	void *framepc;
#ifdef __ALPHA
	struct pdscdef *procdescptr;
#endif

	/* title and PC for this call frame.  notice that axp-vms has two possible PCs, so i show them both:
	 *
	 * (from _The OpenVMS Calling Standard_, chapter 3, section 6, table 3-3)
	 *
	 *         PDSC$Q_ENTRY
	 *         The absolute address of the first instruction of the entry code sequence for the procedure.
	 *
	 * (from table 3-10)
	 *
	 *         LIBICB$Q_PROGRAM_COUNTER
	 *         A quadword that contains the current value of the procedure's program counter.
	 *         For interrupted procedures, this is the same as the continuation program counter;
	 *         for active procedures, this is the return address back into that procedure.
	 */
#ifdef __VAX
	framepc = (void *) fdp->savedPC;
#endif
#ifdef __ALPHA
	framepc = (void *) fdp->libicb$q_program_counter[0];
#endif
	fprintf(ReportFP, "\n\tFrame #%d:\n", FrameCount--);
	HER_I_PrintImageOffset("Program Counter", framepc);
#ifdef __ALPHA
	procdescptr = (struct pdscdef *) fdp->libicb$ph_procedure_descriptor;
	HER_I_PrintImageOffset("Entry Point    ", (void *) procdescptr->pdsc$q_entry[0]);
	HER_I_PrintImageOffset("Procedure Desc ", procdescptr);
#endif
	fprintf(ReportFP, "\n");

	/* restore any saved registers
	 */
#ifdef __VAX
	entrymask = (unsigned long) fdp->entryMask;
	for (j = k = 0; j < REG_AP; j++) {
		if (entrymask & (1 << j)) {
			TrueRegs[j] = fdp->savedRegs[k++];
		}
	}
	TrueRegs[REG_AP].pval = fdp->savedAP;
	TrueRegs[REG_FP].pval = fdp->savedFP;
	TrueRegs[REG_PC].pval = fdp->savedPC;
#endif
#ifdef __ALPHA
	/* VAXman says:
	 *         You need to get the offset to the register save area from the procedure's PDSC at
	 *         PDSC$W_RSA_OFFSET then, apply that offset to the frame pointer.  The RA register (R26)
	 *         is saved first and then, the registers in accending order as specified by the register
	 *         save masks in PDSC->PDSC$L_IREG_MASK and PDSC->PDSC$L_FREG_MASK, repsectively.
	 *         As on the VAX, you can *only* obtain the register values which were masked (saved on
	 *         the stack) by the procedure's prologue.
	 *
	 * unfortunately, i've checked the source listings --- [Vxx.LIBRTL.LIS]LIB$CALLING_STANDARD.LIS ---
	 * only to verify that the lib$get_curr_invo_context() and lib$get_prev_invo_context() functions
	 * already do all of the register restoring vaxman describes above, yet the numbers are *still* wrong!
	 * i finally realized that the compiler plays fast & loose with not only the argument registers (R16-R21)
	 * but the argument-information register itself (R25), and is in fact allowed to do so by the standard;
	 * Table 3-1 of _The OpenVMS Calling Standard_ says:
	 *
	 *       AXP
	 *       Integer
	 *       Register  Usage
	 *
	 *         R0      Function value register. In a standard call that returns a nonfloating-point function result
	 *                 in a register, the result must be returned in this register. In a standard call, this register
	 *                 may be modified by the called procedure without being saved and restored. This register is
	 *                 not to be preserved by any called procedure.
	 *
	 *         R1      Conventional scratch register. In a standard call, this register may be modified by the called
	 *                 procedure without being saved and restored. This register is not to be preserved by any called
	 *                 procedure.
	 *
	 *         R2-15   Conventional saved registers. If a standard-conforming procedure modifies one of these
	 *                 registers, it must save and restore it.
	 *
	 *         R16-21  Argument registers. In a standard call, up to six nonfloating-point items of the argument
	 *                 list are passed in these registers. In a standard call, these registers may be modified by the
	 *                 called procedure without being saved and restored.
	 *
	 *         R22-24  Conventional scratch registers. In a standard call, these registers may be modified by the
	 *                 called procedure without being saved and restored.
	 *
	 *  ===>   R25     Argument information (AI) register. In a standard call, this register describes the argument    <===
	 *  ===>           list (see Section 3.7.1, for a detailed description). In a standard call, this register may be  <===
	 *  ===>           modified by the called procedure without being saved and restored.                              <===
	 *
	 *         R26     Return address (RA) register. In a standard call, the return address must be passed in this
	 *                 register. In a standard call, this register may be modified by the called procedure without
	 *                 being saved and restored.
	 *
	 *         R27     Procedure value (PV) register. In a standard call, the procedure value of the procedure being
	 *                 called is passed in this register. In a standard call, this register may be modified by the
	 *                 called procedure without being saved and restored.
	 *
	 *         R28     Volatile scratch register. The contents of this register are always unpredictable after any
	 *                 external transfer of control either to or from a procedure.  This applies to both standard and
	 *                 nonstandard calls.  This register may be used by the operating system for external call fixup,
	 *                 autoloading, and exit sequences.
	 *
	 *         R29     Frame pointer (FP). The contents of this register define, among other things, which procedure
	 *                 is considered current. Details of usage and alignment are defined in Section 3.6.
	 *
	 *         R30     Stack pointer (SP). This register contains a pointer to the top of the current operating stack.
	 *                 Aspects of its usage and alignment are defined by the hardware architecture. Various
	 *                 software aspects of its usage and alignment are defined in Section 3.7.1.
	 *
	 *         R31     ReadAsZero/Sink (RZ). Hardware defined: binary zero as a source operand, sink (no effect) as
	 *                 a result operand.
	 */
#endif

	/* calculate the number of arguments at this point
	 * and adjust the Stack Pointer, since it is not saved
	 */
	numberOfArgs = 0;
#ifdef __VAX
	if ((ap = fdp->savedAP) != NULL) {
		if (DSC_CanReadMemory(sizeof(long), ap)) {
			if (ap->argCount > 0 && ap->argCount <= 32) {
				numberOfArgs = ap->argCount;
			}
		}
	}
	stackptr  = (long) fdp + sizeof(long);
	stackptr += fdp->spa;
	stackptr += sizeof(CallFrame);
	stackptr += k * sizeof(long);
	if (fdp->isCALLS) stackptr += numberOfArgs * sizeof(long);
	TrueRegs[REG_SP].pval = (void *) stackptr;
#endif

	/* output the values in the registers at this point
	 */
	HER_I_ShowRegisters(fdp);

	/* output the values from the argument stack at this point
	 */
	HER_I_ShowArguments(ap, numberOfArgs);

	return;
}


MEP__ PRIVATE CONDVAL HER_I_LoadHandler(
	long sigargs[],
	long mechargs[]
)
{
#ifdef IGNORE_MISSING_SHERLOCK
#ifdef __ALPHA
	if ($VMS_STATUS_MSG_NO(sigargs[1]) == $VMS_STATUS_MSG_NO(LIB$_ACTIMAGE)) {
		if ($VMS_STATUS_FAC_NO(sigargs[1]) == $VMS_STATUS_FAC_NO(LIB$_ACTIMAGE)) {
			if ($VMS_STATUS_MSG_NO(sigargs[1]) == $VMS_STATUS_MSG_NO(RMS$_FNF)) {
				if ($VMS_STATUS_FAC_NO(sigargs[1]) == $VMS_STATUS_FAC_NO(RMS$_FNF)) {
					return(SS$_CONTINUE);
				}
			}
		}
	}
#endif
	if ($VMS_STATUS_MSG_NO(sigargs[1]) == $VMS_STATUS_MSG_NO(LIB$_KEYNOTFOU)) {
		if ($VMS_STATUS_FAC_NO(sigargs[1]) == $VMS_STATUS_FAC_NO(LIB$_KEYNOTFOU)) {
			return(SS$_CONTINUE);
		}
	}
#endif

	return(SS$_RESIGNAL);
}


MEP__ PRIVATE CONDVAL HER_I_LoadSherlock(
	void
)
{
	/* we must install our own error handler for temporary use,
	 * because (get this) the LIB routine actually signals from within
	 * if it can't find the function, ha ha.
	 */
	lib$establish(HER_I_LoadHandler);
	return(lib$find_image_symbol(&SherlockImage, &SherlockName, &SherlockPtr, NULL));
}


#ifdef __ALPHA

MEP__ PRIVATE void DSC_GetMyRegisters(
	VMSRegister *regptr	/* ignored */
)
{
	int j;
	int k;
	FrameData icbblock;

	/* IR31 and FR31 are not saved (since they are RAZ) so skip over them.
	 * and, yes, dec's floating-point registers are of the int64 type (sigh)
	 */
	lib$get_curr_invo_context(&icbblock);
	k = 0;
	for (j = 0; j < NUMBER_OF_INT_REGISTERS - 1; j++) {
		TrueRegs[k++].qval = icbblock.libicb$q_ireg[j];
	}
	TrueRegs[k++].qval = 0;
	for (j = 0; j < NUMBER_OF_FLOAT_REGISTERS - 1; j++) {
		TrueRegs[k++].qval = icbblock.libicb$q_freg[j];
	}
	TrueRegs[k++].qval = 0;

	return;
}

#endif


MEP__ UNIVERSAL CONDVAL HER_ReportException(
	SignalArray *sigargs,
	MechArray *mechargs
)
{
	char *reason;
	char *tmpptr;
	CONDVAL cv0;
	SignalArray *newsigs;
	char rptfs[132];
#ifdef __VAX
	CallFrame *fp, *saveFP;
	char **specialPCaddr;
#endif
#ifdef __ALPHA
	FrameData icbblock;
#endif

	if (Reporting) {
		return(SS$_RESIGNAL);
	}
	Reporting = TRUE;

	/* quick!  save the register values before our code overwrites them!
	 */
	DSC_GetMyRegisters(TrueRegs);

#ifdef __VAX
	specialPCaddr = NULL;
	saveFP = mechargs->frame;
	mechargs->frame = DSC_GetMyFrame();

	/* usually the call frame's PC will point at or close to the instruction
	 * dealing with whatever is going on.  however, exceptions seem to be
	 * (pardon me) an exception.  if my code look like this at PC 20000:
	 *
	 *        char *foo, bar;
	 *
	 *        foo = NULL;
	 *        bar = *foo;
	 *
	 * then the image seems to jump to some other region where it can
	 * prepare the SignalArray and MechanismArray so that it can call
	 * whatever handler is first in line, with the result that while the
	 * rest of the call frame contains valid information, the PC is left
	 * pointing to this intermediate area (typically 0x80000014) which is
	 * not useful at all.  in this case we will take advantage of the fact
	 * that the true PC (i.e., the one in which we are most interested)
	 * and PSL are passed along in the SignalArray, which does not look
	 * like a SignalArray, for all hardware exceptions:
	 *
	 *        +-------------------+
	 *        |    arg count      | : sigargs
	 *        +-------------------+
	 *        |    cond value     |
	 *        +-------------------+
	 *        |      arg 1        |
	 *        +-------------------+
	 *        |      arg 2        |
	 *        +-------------------+
	 *        |        .          |
	 *        +-------------------+
	 *        |        .          |
	 *        +-------------------+
	 *        |      arg n        |     (n = arg count - 3)
	 *        +-------------------+
	 *        |       PC          |
	 *        +-------------------+
	 *        |       PSL         |
	 *        +-------------------+
	 *
	 * instead of something more normal:
	 *
	 *        +-------------------+
	 *        | total arg count   | : sigargs
	 *        +-------------------+
	 *        | first cond value  |
	 *        +-------------------+
	 *        |    first arg 1    |
	 *        +-------------------+
	 *        |    first arg 2    |
	 *        +-------------------+
	 *        |        .          |
	 *        +-------------------+
	 *        |        .          |
	 *        +-------------------+
	 *        |    first arg n    |
	 *        +-------------------+
	 *        | second cond value |
	 *        +-------------------+
	 *        |    second arg 1   |
	 *        +-------------------+
	 *        |    second arg 2   |
	 *        +-------------------+
	 *        |        .          |
	 *        +-------------------+
	 *        |        .          |
	 *        +-------------------+
	 *        |    second arg n   |
	 *        +-------------------+
	 *        |        .          |
	 *        +-------------------+
	 *        |        .          |
	 *        +-------------------+
	 *        |    final arg n    |
	 *        +-------------------+
	 *
	 * unfortunately this is not explicitly documented anywhere, although
	 * details about the specific condition values and specific arguments
	 * thereof can be found on page 10-2 of the Introduction to System
	 * Services (Volume 4A of the P set).
	 *
	 * the question becomes, how can you tell a true SignalArray which
	 * develops from a user's call to lib$signal() from an exception?
	 * the first method i tried was to examine the PC from which the handler
	 * was called, and guess if it occurred in system space (typically
	 * 0x80000014).  this was too kludgy so now i just compare the condition
	 * value against the list of statuses Digital defines as Exception
	 * Conditions on the pages mentioned above.  this is why
	 * CheckForException() returns FALSE, TRUE, or MAYBE:  FALSE means the
	 * status is not one that we are interested in reporting at all, TRUE
	 * means it is an Official Digital Hardware Exception and should
	 * definitely be reported, and MAYBE means it is not an actual exception
	 * but we want to log it as if it was.
	 *
	 * an example of the most common exception follows:
	 *
	 *        +-------------------+
	 *        |        5          | : sigargs
	 *        +-------------------+
	 *        |    SS$_ACCVIO     |
	 *        +-------------------+
	 *        |    reason mask    |
	 *        +-------------------+
	 *        |  virtual address  |
	 *        +-------------------+
	 *        |       PC          |    (this is where the violation
	 *        +-------------------+         actually occurred)
	 *        |       PSL         |
	 *        +-------------------+
	 */

	/* check for an "uninteresting" PC.  if true, we need to replace it;
	 * however, since a call from a hardware exception does not conform
	 * to the normal signal array, we cast the "sigargs" value to be
	 * a <pointer to long> and then offset to where the true PC should be.
	 */
	if (HER_CheckForException(0, sigargs) == TRUE) {
		if (mechargs->frame->savedFP->savedPC == SPECIAL_PC) {
			long *longptr;
			specialPCaddr = &mechargs->frame->savedFP->savedPC;
			longptr  = (long *) sigargs;
			longptr += sigargs->totalArgCount - 1;
			mechargs->frame->savedFP->savedPC = (void *) (*longptr);
		}
	}
#endif

	/* drop the channel that we have reserved for our use,
	 * so that there will be one available
	 */
	if (TrackChannel != 0) {
		sys$dassgn(TrackChannel);
		TrackChannel = 0;
	}

	/* try to <open for appending>/<create> the exceptions report file.
	 * if we cannot do so for any reason, we want to create a new signal
	 * array which copies everything from the original and then adds
	 * some more condition values:  one to explain why we cannot open or
	 * create the file, and another one for each call frame to display
	 * the PC so that at least SOMEONE will see the function stack.
	 *
	 * note that detached processes do not necessarily have the SYS$LOGIN
	 * or SYS$SCRATCH logicals defined . . .
	 */
	rptfs[0] = '\0';
	if ((tmpptr = getenv("HER_PATH")) == NULL) {
		tmpptr = getenv("SYS$LOGIN");
	}
	if (tmpptr != NULL) {
		strcpy(rptfs, tmpptr);
	}
	strcat(rptfs, "HARDWARE_EXCEPTION.RPT");
	if ((ReportFP = fopen(rptfs, "a", "ctx=rec", "mrs=0", "rat=cr", "rfm=var")) == NULL) {
		cv0 = vaxc$errno;
	}
	else {
		newsigs = NULL;
		HER_I_ShowExceptionHeader(sigargs);
		HER_I_ShowCallStack(mechargs);
		DSC_ShowProcessData(NULL, ReportFP, NULL);
		DSC_ShowSystemData(NULL, ReportFP, NULL);
		if (SherlockPtr == NULL) {
			HER_I_LoadSherlock();
		}
		if (SherlockPtr != NULL) {
			nImageCount = 0;
			(*SherlockPtr)(0, ReportFP, NULL, NULL, HER_K_SaveImageInfo);
		}
#ifdef this_is_not_trustworthy
		FrameCount = mechargs->depth;
#else
		FrameCount = HER_I_CountFrames(mechargs);
#endif
#ifdef __VAX
		for (fp = mechargs->frame; fp != NULL; fp = fp->savedFP) {
			if (HER_I_CanProcess(fp) == FALSE) break;
			HER_I_ShowFrame(fp);
		}
#endif
#ifdef __ALPHA
		lib$get_curr_invo_context(&icbblock);
		for (;;) {
			HER_I_ShowFrame(&icbblock);
			if (lib$get_prev_invo_context(&icbblock) == 0) break;
		}
#endif
		fprintf(ReportFP, "\n\tFrame #0:\n\n\t\tshell\n");
		fprintf(ReportFP, "\nend of EXCEPTION report\n");
		fclose(ReportFP);
		cv0 = SS$_NORMAL;
	}

	/* try to keep a channel reserved for future reports
	 */
	HER_I_SaveChan();

	/* restore the frame pointer and program counter
	 */
#ifdef __VAX
	if (specialPCaddr != NULL) *specialPCaddr = SPECIAL_PC;
	mechargs->frame = saveFP;
#endif

	/* reset this module's static flags & pointers
	 */
	ReportFP = NULL;
	Reporting = FALSE;

	return(cv0);
}