!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
!  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

!COPYRIGHT (C) 1976,1977 BY DIGITAL EQUIPMENT CORPORATION
MODULE IOERR=
BEGIN
%(
	THE CHANNEL TABLE
)%
	MACRO TABMAX=16$, TABSIZ=15$; % MAX CHANNELS AND SIZE %
	STRUCTURE CHTB[I,J]=[(I+1)*(J+1)]((.CHTB+.I*(J+1)+.J)<0,36>);
	EXTERNAL CHTB CHNLTAB[TABMAX,TABSIZ];
	MACRO BUFSIZ=100$;
	MACRO UNPACKIT(X,Y)=REPLACEI(X,SCANI(Y)+#40)$;
	STRUCTURE FUNNYBIT[I]=((.FUNNYBIT+(.I/36))<.I MOD 36,1>);
	EXTERNAL FUNNYBIT ZIGNORE;
%(
	C H A N N E L   T A B L E   M A C R O S
)%
MACRO	FMODE=CHAN[0]$,
	FDEV=CHAN[1]$,
	FBUF=CHAN[2]$,
	FBUFO=CHAN[2]<18,18>$,
	FBUFI=CHAN[2]<0,18>$,
	FOBUFH=CHAN[3]$,
	FOPTR=CHAN[4]$,
	FOCNT=CHAN[5]$,
	FIBUFH=CHAN[6]$,
	FIPTR=CHAN[7]$,
	FICNT=CHAN[8]$,
	FFILE=CHAN[9]$,
	FEXT=CHAN[10]$,
	FERR=CHAN[10]<0,12>$,
	FBLK=CHAN[10]<0,18>$,	% DEVICE BLK NO DSK=0 %
	FPROT=CHAN[11]<27,9>$,
	FDMODE=CHAN[11]<23,4>$,
	FTIME=CHAN[11]<13,10>$,
	FDATE=CHAN[11]<0,12>$,
	FPPN=CHAN[12]$,
	FPRJ=CHAN[12]<18,18>$,
	FPRG=CHAN[12]<0,18>$,
	FSIZ=CHAN[12]<18,18>$,
	FSTATUS=CHAN[13]$,
	FSWITCH=CHAN[14]$,
	FNEWPR=CHAN[15]<0,10>$,
%(
	STATUS WORD BITS
)%
	FYEND=0,1$,	% ENDFILE ALLOWED %
	FYREW=1,1$,	% REWIND ALLOWED  %
	FYREAD=2,1$,	% READING ALLOWED %
	FYWRITE=3,1$,	% WRITING ALLOWED %
	FYUPDAT=4,1$,	% UPDATING ALLOWED %
	FYDUMMY=5,1$,	% DUMMY CHANNEL   %
	FYERR=6,1$,	% WRITE ERRORS NOT TRAPPED %
	FPRIMARY=7,1$,	% PRIMARY DEFAULT VALUE %

% SYSTEM BITS OF STATUS WORD %
	FROPEN=18,1$,	% FILE OPEN FOR INPUT %
	FWOPEN=19,1$,	% FILE OPEN FOR OUTPUT %
	FEOF=20,1$,	% ENDFILE ENCOUNTERED %
	FIS35=21,1$,	% BIT 35 IS SET %
	FSET35=22,1$,	% SET BIT 35 ON NEXT WRITE %
	FSEQ=24,1$,	% PROCESSING SEQUENCE NO. %
	FPGMK=25,1$,	% PROCESSING PAGE MARK %
	FFISTAR=26,1$,	% FILE NAME IS "*" %
	FXSTAR=27,1$,	% EXTENSION NAME IS "*" %
	FUOPEN=28,1$,	% FILE IS OPEN FOR UPDATE %
	FDEVAS=29,1$,	% DEVICE ASSIGNED %
	FIOERR=30,1$,	% I/O ERROR OCCURRED %
	FNSET=35,1$;	% CHANNEL NOT SET %
MACRO
	XFYEND=1^0$,	% ENDFILE ALLOWED %
	XFYREW=1^1$,	% REWIND ALLOWED  %
	XFYREAD=1^2$,	% READING ALLOWED %
	XFYWRITE=1^3$,	% WRITING ALLOWED %
	XFYUPDAT=1^4$,	% UPDATE ALLOWED %
	XFYDUMMY=1^5$,	% DUMMY CHANNEL %
	XFYERR=1^6$,	% ALLOW WRITE ERROR TRAP %
	XFPRIMARY=1^7$;	% PRIMARY DEFAULT VALUE %
MACRO	OTHER=-1$;

EXTERNAL BINOUT, OCTOUT, DECOUT;
EXTERNAL WRITE, OUTMSG, TTYPUTS;


FORWARD
IOBUFH,		%( 6  )%
IODEC,		%( 6 )%
IOCTAL,		%(  6  )%
IOSPACE,	%( 6 )%
IOERR,		%(#2	PARAMETERS: THE ERROR NUMBER
		)%
IOERRDMP,		%( 3
		)%
IOERR2DMP,	%(
		)%
BYTEP,		%(
		)%
IOPCODE,		%(  7
		)%
IOPCHAN,		%(  9
		)%
IODCHAN,		%(#10
		)%
IOPANIC;		%(
		)%

EXTERNAL GETSTAT,PUTMSG;
EXTERNAL CRLF;
EXTERNAL CHNLMAX;
EXTERNAL GETSTS;
	GLOBAL  IOZERROR[10];


GLOBAL ROUTINE IOERR(N)=
    BEGIN
%(
	THIS IS THE FANTASTIC AMAZING ERROR-RECOVERY ROUTINE
	IT DOES EVERYTHING BUT REWRITE THE PROGRAM FOR THE
	IDIOT WHO GOT THE ERROR.

	WHEN CALLED, THIS ROUTINE INDEXES INTO ERRMSGS BY THE
	ERROR NUMBER.  IF THE ERROR NUMBER IS TOO LARGE IT
	PROVIDES A DEFAULT VALUE OF IOERR(0).

	THE ERROR TABLE CONTAINS SPECIFICATIONS OF WHAT TO DO
	WITH THE ERROR.  THE ENTRY IS TWO WORDS.  THE FIRST
	HALFWORD IS A RECOVERY OR DIAGNOSTIC ROUTINE (BUT NOT
	BOTH).  DIAGNOSTIC ROUTINES ARE EXECUTED BEFORE A SELECTED
	SOFT HALT (SEE BELOW); RECOVERY ROUTINES ARE EXECUTED 
	AFTER.  THIS IS SO THE SOFT HALT DISPLAYS THE ORIGINAL
	ERROR STATE.

	THE NEXT HALFWORD CONTAINS THE ACTION FLAGS.  THE 
	DEFAULT IS 0 WHICH @ROVIDES MAXIMUM INFORMATION AND
	MINIMUM RECOVERY.

	THE FIRST HALFWORD OF THE SEOND WORD POINTS TO THE
	SHORT MESSAGE AND THE SECOND HALFWORD TO THE LONG MSSAGE.
	IF .ZSHORT THEN WE GIVE THE SHORT MESSAGE.

	THE BIT ASSIGNMENTS ARE:
	D -> NO CHANNEL TABLE DUMP
	H -> NO HARD HALT
	S -> GIVE SOFT HALT
	I -> IGNORE THIS ERROR
	R -> THE ROUTINE IS A DIAGNOSTIC ROUTINE

	0<18,18> -> RECOVERY OR DIAGNOSTIC ROUTINE
	0<0,1>   -> 0 => GIVE CHANNEL TABLE DUMP
		    1 => NO CHANNEL TABLE DUMP (D-BIT)
	0<1,1>   -> 0 => GIVE HARD HALT
		    1 => NO HARD HALT (H-BIT)
	0<2,1>   -> 0 => NO SOFT HALT
		    1 => GIVE SOFT (DEBUG) HALT (S-BIT)
	0<3,1>   -> 0 => PROCESS THIS ERROR
		    1 => IGNORE THIS ERROR (I-BIT)
	0<4,1>   -> 0 => RECOVERY ROUTINE
		    1 => DIAGNOSTIC ROUTINE (R-BIT)

	AN ERROR CALL MAY PASS AND RECEIVE INFORMATION VIA
	"IOZERROR".  THE CONTENTS OF IOZERROR DEPEND UPON WHO ISSUES
	THE CALL.  WHAT IS RETURNED IN IOZERROR DEPENDS ON THE
	DIAGNOSTIC OR RECOVERY ROUTINE SELECTED.
)%
	STRUCTURE ERRTAB[I,J]=(((IF .I GTR ..ERRTAB THEN .ERRTAB+1
			     ELSE .ERRTAB+1+.I*2)+.J)<0,36>);
	EXTERNAL ZSHORT;
	EXTERNAL ERRTAB ERRMSGS;
	LOCAL T,OLDZ;
	MACHOP CALLI=#047,HLT=#254;
	BIND VECTOR MSGDESC=ERRMSGS[.N,0]<0,36>;
		MACRO HALT=HLT(4)$,
			D=0,1$,
			H=1,1$,
			S=2,1$,
			I=3,1$,
			R=4,1$,
			ROUTNAME=18,18$,
			MSG=MSGDESC[1]$;
	MACRO	DUMP=NOT .MSGDESC[0]<D>$,
		SOFT=.MSGDESC[0]<S>$,
		STOP= NOT .MSGDESC[0]<H>$,
		IGNORE=.MSGDESC[0]<I>$,
		DIAGNOSE=.MSGDESC[0]<R>$,
		RECOVER= NOT .MSGDESC[0]<R>$,
		RECRTN=.MSGDESC[0]<ROUTNAME>$,
		DIARTN=.MSGDESC[0]<ROUTNAME>$;
	MACRO	CRUNCH=CALLI(0,#12)$;

	IF .ZIGNORE[.N] THEN .N^18 ELSE 
	    IF IGNORE THEN .N^18 ELSE 
	    BEGIN
		CRLF(0);
		IF .ZSHORT THEN PUTMSG('ERR') ELSE PUTMSG('ERROR');
		IOSPACE();
		IODEC(.N);
		PUTMSG(':');
		IF .MSG NEQ 0 THEN TTYPUTS( .MSG<(IF .ZSHORT THEN 18 ELSE 0), 18>);
		CRLF(0);
%(
		HERE WE ACTUALLY DO SOMETHING ABOUT THE ERROR
)%
		IF DUMP THEN IOERRDMP(); % NO D-BIT: DUMP WHOLE WORLD %


		OLDZ_.IOZERROR[0];   % SAVE CONTENTS %

		IF DIAGNOSE THEN IF (T_DIARTN) NEQ 0 THEN (.T)();

		IF SOFT THEN HALT; % S-BIT: SOFT HALT %

% IF WE HAVE A RECOVERY ROUTINE THEN DO IT %

		IF RECOVER THEN IF (T_RECRTN) NEQ 0 THEN (.T)();

% IF WE WANT A HARD HALT, DO IT %
		IF STOP THEN CRUNCH;

% IF WE HAVE HACKED THRU TO THIS POINT WE CAN DO NO MORE. RETURN TO
  THE USER AND HOPE TO HELL HE KNOWS WHAT HE'S DOING %

% IF HE CHANGED IOZERROR[0] IN THE DIAGNOSTIC/RECOVERY ROUTINES
  THEN RETURN THE NEW VALUE ELSE RETURN THE ERROR CODE
%

		IF .OLDZ NEQ .IOZERROR[0] THEN .IOZERROR[0] ELSE .N^18
	    END
    END;


ROUTINE IOERRDMP=
    BEGIN
	LOCAL PTR, IND;
	INCR PTR TO .CHNLMAX DO IOERR2DMP(.PTR);
    END;


ROUTINE IOERR2DMP(N)=
    BEGIN
	BIND VECTOR CHAN=CHNLTAB[.N,0]<0,36>;
	LOCAL WORD[2],PTR1,PTR2,I;
	LOCAL T;
! PUT OUT THE CHANNEL
	STRUCTURE CHTB[I,J]=[(I+1)*(J+1)]((.CHTB+.I*(J+1)+.J)<0,36>);
	IODEC(.N);
	PUTMSG('=');
	IF .N EQL 0 THEN RETURN (PUTMSG('*TTY*',' ');
				CRLF(0));
	IF GETSTAT(.N) LSS 0 THEN RETURN (PUTMSG('*INVA','LID*');CRLF(0));
! PUT OUT THE MODE
	T_ ( SELECT .FMODE OF NSET
			0:  '(A)';
			1:  '(AL)';
			#10:  '(I)';
			#13:  '(IB)';
			#14:  '(B)';
			#15:  '(ID)';
			#16:  '(DR)';
			#17:  '(D)';
			OTHERWISE:  '*INV*';
			TESN);
	PUTMSG(.T);
	IOSPACE();
! PUT OUT THE DEVICE
	WORD[0]_WORD[1]_0;
	PTR1_WORD<36,7>;
	PTR2_FDEV<36,6>;
	DECR I FROM 5 TO 0 DO UNPACKIT(PTR1,PTR2);
	TTYPUTS(WORD);
	PUTMSG(':');
! PUT OUT THE FILE
	WORD[0]_WORD[1]_0;
	PTR1_WORD<36,7>;
	PTR2_FFILE<36,6>;
	DECR I FROM 5 TO 0 DO UNPACKIT(PTR1,PTR2);
	TTYPUTS(WORD);
! PUT OUT THE EXTENSION
	PUTMSG('.');
	WORD[0]_0;
	PTR1_WORD<36,7>;
	PTR2_FEXT<36,6>;
	DECR I FROM 2 TO 0 DO UNPACKIT(PTR1,PTR2);
	TTYPUTS(WORD);
	IF .FPPN NEQ 0 THEN 
	(
! PUT OUT THE PPN
		PUTMSG('[');
		IOCTAL(.FPRJ);
		PUTMSG(',');
		IOCTAL(.FPRG);
		PUTMSG('] ')
	) ELSE PUTMSG('   ');
! PUT OUT THE OUTPUT BUFFER HEADER INFO
	IOBUFH(.FBUFO,.FOBUFH,.FOPTR,.FOCNT);
! PUT OUT THE INPUT BUFFER HEADER INFO
	IOBUFH(.FBUFI,.FIBUFH,.FIPTR,.FICNT);
! PUT OUT THE STATUS INFO
	PUTMSG(' <(');
	BINOUT(0,0,.FSTATUS<18,18>);
	PUTMSG(',,');
	BINOUT(0,0,.FSTATUS<0,18>);
	PUTMSG(')');
	IF .FPROT NEQ 0 THEN ( PUTMSG(' OLD:'); IOCTAL(.FPROT));
	IF (PTR1_.FNEWPR) NEQ 0 THEN (PUTMSG(' NEW:'); IOCTAL(.PTR1<0,9>));
	PUTMSG('>');
! PUT OUT THE SWITCHES
	INCR I TO 35 DO
	    BEGIN
		IF .FSWITCH<.I,1> THEN
		    BEGIN
			PUTMSG('/');
			WRITE(0, IF .I GTR 25 THEN .I-26+"0" ELSE .I+"A");
		    END;
	    END;
! PUT OUT THE ERROR CODE
	IF .FERR NEQ 0 THEN
		(PUTMSG(' ERRO','R= #');
		 IOCTAL(.FERR));
! PUT OUT THE SYSTEM STATUS BITS
	IF .FSTATUS<FDEVAS> THEN
		BEGIN
		PUTMSG(' STS=');
		IOCTAL(GETSTS(.N));
		END;
! AND RETURN THE CARRIAGE (WHEW!)
	CRLF(0);
    END;


ROUTINE BYTEP(VAL)=
%( THE FUNCTION OF THIS ROUTINE IS TO PRINT OUT A BYTE POINTER
   IN THE FORMAT
		ADR<P,S,NDX,IND>
   WHERE @ AND (NDX) MAY BE OMITTED IF 0
)%
	BEGIN
	IOCTAL(.VAL<0,18>);
	PUTMSG('<');
	IODEC(.VAL<30,6>);
	PUTMSG(',');
	IODEC(.VAL<24,6>);
	IF (.VAL<18,4> NEQ 0) OR .VAL<22,1> THEN
	    BEGIN
		PUTMSG(',');
		IODEC(.VAL<18,4>);
		IF .VAL<22,1> THEN PUTMSG(',1');
	    END;
	PUTMSG('>');
	END;


ROUTINE IOCTAL(X)=OCTOUT(0,0,.X);

ROUTINE IODEC(X)=DECOUT(0,0,.X);

ROUTINE IOSPACE=PUTMSG(' ');


ROUTINE IOBUFH(BUF,HDR,PTR,CNT)=
BEGIN
	IOCTAL(.BUF);
	PUTMSG(':(');
	IOCTAL(.HDR<0,18>);
	IOSPACE();
	BYTEP(.PTR);
	IOSPACE();
	IODEC(.CNT);
	PUTMSG(') ');
END;


GLOBAL ROUTINE IOPCODE=
    BEGIN
	PUTMSG('CODE=');
	IODEC(.IOZERROR)
    END;


GLOBAL ROUTINE IOPCHAN=
	BEGIN
	PUTMSG('CHNL=');
	IODEC(.IOZERROR);
    END;


GLOBAL ROUTINE IODCHAN=
    BEGIN
	IOERR2DMP(.IOZERROR);
    END;


GLOBAL ROUTINE IOPANIC(N)=
    BEGIN
	MACHOP CALLI=#047;
	PUTMSG('PANIC',' STOP',' ON E','RROR ',' ');
	IODEC(.N);
	CRLF(0);
	CALLI(0,#12);
    END;


ROUTINE DIAGNOSE=
    BEGIN
%( 
	CALL FROM DDT BY PUSHJ DIAGNO$X
)%
	LOCAL T;
	MACHOP TTCALL=#051;
	TTCALL(#11);
	DO (PUTMSG('CHNL=');TTCALL(0,T)) UNTIL .T GTR "0" AND .T LEQ "9";
	IOERR2DMP(.T-"0");
    END;


GLOBAL ROUTINE SETREQ(CODE)=
    BEGIN
%%
%
	THIS ROUTINE RECEIVES A VARIABLE NUMBDR OF PARAMETERS OF  THE
       FORM (M1, M2, ... , MN, CODE) AND SETS THE VALUE "CODE" IN THE
       IGNORE REQUEST BITS FOR MESSAGES M1-MN.
%
%%
	LOCAL N;
	N_ IF .(@(CODE+1))<27,9> NEQ #274 THEN 0 ELSE .(@@(CODE+1))<0,18>;
	IF .N GTR 1 THEN 
	    BEGIN
		BIND VECTOR PLIST=CODE+1-.N;

%%
%
	PLIST NOW POINTS TO THE FIRST OF THE ARGUMENTS
%
%%
		DECR I FROM .N-2 TO 0 DO ZIGNORE[.PLIST[.I]]_.CODE;
	    END;
    END;


END ELUDOM