Trailing-Edge
-
PDP-10 Archives
-
BB-D480F-SB_FORTRAN10_V10
-
error0.bli
There are 12 other files named error0.bli in the archive. Click here to see a list.
!COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1976, 1985
!ALL RIGHTS RESERVED.
!
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
!ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
!INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
!COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
!OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
!TRANSFERRED.
!
!THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
!AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
!CORPORATION.
!
!DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
!SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
! Author: *
MODULE ERR0=
BEGIN
GLOBAL BIND ERR0V = #10^24 + 0^18 + 0; ! Version Date: 11-Jun-81
%(
***** Begin Revision History *****
***** End Revision History *****
)%
%(
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