!*_ DATED 11 NOV 76 1 ! ALTERATIONS BY K.YARWOOD ... ! PRINT FL AND NEXT SYMBOL LINES COMMENTED OUT ! PRINTTEXT'S TURNED TO PRINTSTRING'S ! ADDITION FOR LONGINTEGER IN RT PRINT VAR ! HEX EQUIVALENTS FOR INTS,LONGINTS ETC PRINTED ! INF PRINTED IN HEX IN RT ERRMESS %EXTERNALSTRINGFNSPEC STRHEX(%INTEGER I) %EXTERNALSTRING(8)%FNSPEC STRINT(%INTEGER I) %CONSTINTEGER STACKBASE=X'80100000'; ! START OF RESIDENT STACK ! %SYSTEMROUTINESPEC SIGNAL(%INTEGER I, J, K, %INTEGERNAME F) %ROUTINESPEC PRINTMESS(%INTEGER N) ! %SYSTEMROUTINESPEC TIDY EXIT !* %ROUTINESPEC INDIAG(%INTEGER OLDLNB, L, PC, %INTEGERNAME NEWLNB) ! %ROUTINESPEC FDIAG(%INTEGER OLDLNB,PC,%INTEGERNAME NEWLNB) %ROUTINESPEC ERMESS(%INTEGER N, INF) ! %ROUTINESPEC ICL9CELABELS %ROUTINE TRANS(%INTEGERNAME FAULT, EVENT, SUBEVENT) !*********************************************************************** !*_______TRANSLATE FAULT TO EVENT & VICE VERSA * !*********************************************************************** %CONSTBYTEINTEGERARRAY ETOF(0:54)=0,14,22,24,26,28,35,38,40,42,44,47, 0(3),3,1,5,54,56,53,19,0,23,0,28,0,26, 0,18,50,51,16,15,20,0,7,6,0,32,0,11,0, 25,0,54,0,72,73,71,74,75,70,0,30 %CONSTBYTEINTEGERARRAY FTOE(1:75)=X'12',0,X'11',0,X'13',X'62',X'61',0, 0(2),X'81',0(3),X'55',X'54', 0,X'51',X'17',X'56',0(4), X'91',X'41',0,X'31',0,X'B1',0,X'71', 0(17),X'52',X'53',X'53',X'16', X'14'(4),0(8),X'14'(2),0(2), X'A6',X'A3',X'A1',X'A2',X'A4',X'A5' %INTEGER K %IF FAULT=0 %THEN %START; ! EVENT-SUBEVENT GIVEN K=ETOF(EVENT) %IF K#0 %THEN FAULT=ETOF(K+SUBEVENT) %FINISH %ELSE %START %IF 1<=FAULT<=75 %START K=FTOE(FAULT) EVENT=K>>4; SUBEVENT=K&15 %FINISH %FINISH %END; ! TRANS %ROUTINE DUMP(%INTEGER START, FINISH) %INTEGER I, J I=START&(-4) %WHILE I<=FINISH %CYCLE PRINTSTRING(STRHEX(I)) %CYCLE J=0,4,12 SPACES(2) PRINTSTRING(STRHEX(INTEGER(I+J))) %REPEAT NEWLINE I=I+16 %REPEAT %END; ! DUMP %ROUTINE ASSDUMP(%INTEGER PCOUNT, OLDLNB) %INTEGER I PRINTSTRING(" PC =") PRINTSTRING(STRHEX(PCOUNT)) PRINTSTRING(" LNB =") PRINTSTRING(STRHEX(OLDLNB)) PRINTSTRING(" GLA ") I=INTEGER(OLDLNB+16) DUMP(I,I+128) PRINTSTRING(" STACK FRAME ") DUMP(OLDLNB,OLDLNB+256) %END; ! ASSDUMP !* %OWNINTEGER FIRST !* %SYSTEMROUTINE NDIAG(%INTEGER PCOUNT, LNB, FAULT, INF) !*********************************************************************** !*_______'MASTER DIAGNOSTIC ROUTINE'. DISCOVERS THE LANGUAGE OF THE * !*_______FAILED ROUTINE FROM WORD 4 OF THE GLA AND CALLS APPROPRIATE * !*_______DIAGNOSTIC ROUTINE. THIS IS REPEATED TILL ALL DIAGNOSTICS * !*_______GIVEN. * !*_______PCOUNT = PCOUNTER AT FAILURE * !*_______LNB = LOCAL NAME BASE AT FAILURE * !*_______FAULT = FAILURE (0=%MONITOR REQUESTED) * !*_______INF =ANY FURTHER INFORMATION * !*********************************************************************** %OWNINTEGER ACTIVE=0; ! CHECK FOR LOOPS %CONSTINTEGER RECURSE LIMIT=16; ! LIMIT OF STACK FRAME UNWOUND %INTEGER LANGFLAG, I, J, GLA, OLDLNB, NEWLNB, EVENT, SUBEVENT, RECURSE %SWITCH LANGUAGE(0:6) %STRING (20) FAILNO %CONSTSTRING(9)%ARRAY LT(0:6)=" !???! "," IMP "," FORTRAN ", " IMPS "," ASMBLR "," ALGOL60 ", " OPTCODE "; ! LAY DOWN A CONTINGENCY AGAINST ERRORS IN MDIAGS I=0; RECURSE=0 LNB=LNB&(-4) *STLN_OLDLNB ACTIVE=ACTIVE+1 FAILNO=" LOOPING" %IF ACTIVE>5 %THEN ->EOUT FAILNO=" CONT STACK FULL" %IF I>0 %THEN ->EOUT; ! CONTINGENCY DID NOT GO DOWN ! ! FIRST CHECK THE STACK FOR VALID DESCRIPTOR TO GLA. IF INVALID ASSUME ! A FAILURE DURING A CALL AND GO BACK ONE STACK FRAME ! INVGLA: %IF INTEGER(LNB+12)>>25<<1#X'B0' %THEN %C LNB=INTEGER(LNB)&(-4) %AND ->INVGLA GLA=INTEGER(LNB+16) *LDTB_X'18000020' *LDA_GLA *VAL_(%LNB+1) *JCC_12,; ! READ ACCESS AVAILABLE LNB=INTEGER(LNB)&(-4); ->INVGLA GLAOK: LANGFLAG=INTEGER(GLA+16)>>24 LANGFLAG=0 %IF LANGFLAG>6 SUBEVENT=0; EVENT=FAULT>>8 %IF FAULT>=256 %THEN SUBEVENT=FAULT&255 %AND FAULT=0 TRANS(FAULT,EVENT,SUBEVENT) ! ONCOND(EVENT,SUBEVENT,LNB) FIRST=1 %IF FAULT>=0 %THEN %START PRINT STRING(" MONITOR ENTERED FROM".LT(LANGFLAG)." !") %IF FAULT=0 %AND EVENT#0 %START PRINTSTRING(" MONITOR ENTERED ") PRINTSTRING("EVENT"); WRITE(EVENT,1) PRINTSYMBOL('/'); WRITE(SUBEVENT,1) %FINISH %ELSE ERMESS(FAULT,INF) NEWLINE %FINISH %ELSE EVENT=0 OLDLNB=LNB ->LANGUAGE(LANGFLAG) LANGUAGE(0): LANGUAGE(6): ! NO TRACE CODE LANGUAGE(4): ! UNKNOWN & ASSEMBLER ASSDUMP(PCOUNT,OLDLNB) NEWLNB=INTEGER(OLDLNB)&(-4) ->NEXTRT LANGUAGE(1): LANGUAGE(3): ! IMP & IMPS LANGUAGE(5): ! ALGOL 60 INDIAG(OLDLNB,LANGFLAG>>2,PCOUNT,NEWLNB); ! IMP DIAGS %IF NEWLNB=0 %THEN ->EXIT NEXTRT: ! CONTINUE TO UNWIND STACK PCOUNT=INTEGER(OLDLNB+8) OLDLNB=NEWLNB RECURSE=RECURSE+1 ->EXIT %IF OLDLNBRECURSE LIMIT ! FAR ENOUGH I=INTEGER(OLDLNB+16) LANGFLAG=INTEGER(I+16)>>24 LANGFLAG=0 %IF LANGFLAG>6 ->LANGUAGE(LANGFLAG) LANGUAGE(2): ! FORTRAN ! FDIAG(OLDLNB,PCOUNT,NEWLNB) %IF NEWLNB=0 %THEN ->EXIT ->NEXT RT EOUT: ! ERRROR EXIT PRINTSTRING(" MDIAG FAILS ".FAILNO." ") ACTIVE=0 ->QUIT EXIT: ! POP UP CONTINGENCY ACTIVE=0 %IF FAULT=0=EVENT %THEN ->END QUIT: %STOP *IDLE_X'DDDD' END: %END; ! OF NDIAG ! LAYOUT OF DIAGNOSIC TABLES !*********************** ! THE BOUND FIELD OF PLT DESCRIPTOR STORED AT (LNB+3 & LNB+4) IF ! USED TO CONTAIN A DISPLACEMENT RELATIVE TO THE START OF SST OF THE ! DIAGNOSTIC TABLES FOR THE BLOCK OR ROUTINE BEING EXECUTED. ! A ZERO BOUND MEANS NO DIAGNOSTIC REQUESTED.(NB THIS MAY MEAN A DUMMY ! FIRST WORD IN THE SST). ! THE ABSOLUTE ADDRESS OF THE SST FOR THE CURRENT CODE SEGMENT WILL ! ALWAYS BE FOUND IN THE STANDARD 10 WORDS OF THE GLA/PLT ! FORM OF THE TABLES:- ! WORD 0 = LINE OF RT IN SOURCE PROG <<16 ! LINE NO POSN(FROM LNB) ! WORD 1 = (12 LANG DEPENDENT BITS)<<20 ! ENVIRONMENT ! WORD 2 = DISPLAY POSN (FROM LNB)<<16 ! RT TYPE INFO ! WORD 3 = ZERO FOR BLKS OR STRING(<=11BYTES) BEING THE ! RT NAME. THIS WILL TAKE WORDS 4 AND 5 IF NEEDED ! WORD 6 = LANGUAGE DEPENDENT INFO . IMP ON CONDITIONS ETC ! THE REST IS MADE UP OF VARIABLE ENTRIES AND THE SECTION IS TERMINATED BY ! A WORD OF X'FFFFFFFF' ! EACH VARIABLE ENTRY CONSISTS OF THE VARIABLE WORD FOLLOWED BY ! THE VARIABLE NAME AS A STRING. THE WORD CONSISTS OF ! BITS 2**31 TO 2**20 TYPE INFORMATION (MAY BE LANGUAGE DEPENDENT ! BIT 2**19 =0 UNDER LNB =1 IN GLA ! BITS 2**18 TO 2**0 DISPLACEMENT FROM LNB(GLA) IN BYTES ! THE ENVIRONMENT IS A POINTER (RELATIVE TO SST) OF THE NEXT OUTERMOST ! BLOCK OR A POINTER TO GLOBAL OWNS, EXTERNAL OR COMMON AREAS ! A ZERO MEANS NO ENCLOSING BLOCK. WORD1=WORD3=0 IS AN ! IMP MAIN PROGRAM AND WILL TERMINATE THE DIAGNOSTICS. %ROUTINE INDIAG(%INTEGER OLDLNB, LANG, PCOUNT, %INTEGERNAME NEWLNB) !*********************************************************************** !*_______THE DIAGNOSTIC ROUTINE FOR IMP(LANG=0) %AND ALGOL * !*_______THE ALGOL SYMBOL TABLES ARE SET UP AS FOR IMP * !*********************************************************************** %ROUTINESPEC PRINT LOCALS(%INTEGER ADATA) %ROUTINESPEC PRINTVAR(%INTEGER ADATA) %INTEGER GLAAD, FLINE, ADATA, NAM, TYPE, PREC %INTEGER TSTART, PREV BLK, WORD0, WORD1, WORD2, WORD3, I %STRING (50) NAME GLAAD=INTEGER(OLDLNB+16); ! ADDR OF GLA/PLT TSTART=INTEGER(OLDLNB+12)&X'FFFFFF' %IF TSTART=0 %THEN %START PRINTSTRING(" RT/FN/MAP COMPILED WITHOUT DIAGNOSTICS ") ASSDUMP(PCOUNT,OLDLNB) NEWLNB=INTEGER(OLDLNB)&(-4) %RETURN %FINISH %UNTIL PREVBLK=0 %CYCLE TSTART=TSTART+INTEGER(GLAAD+12) WORD0=INTEGER(TSTART) WORD1=INTEGER(TSTART+4) WORD2=INTEGER(TSTART+8) WORD3=INTEGER(TSTART+12) NAME=STRING(TSTART+12) I=WORD0&X'FFFF'; ! LINE NO DISP %IF I=0 %THEN FLINE=-1 %ELSE FLINE=INTEGER(OLDLNB+I) NEWLINE %IF FIRST=1 %THEN %START PRINTSTRING("MONITOR ") FIRST=0 %FINISH PRINTSTRING("ENTERED FROM") %IF FLINE>=0 %THEN %START PRINTSTRING(" LINE") WRITE(FLINE,4) PRINTSTRING(" OF") %FINISH %IF WORD3=0 %THEN PRINTSTRING(" BLOCK") %C %ELSE PRINT STRING(" RT/FN/MAP ".NAME) PRINTSTRING(" STARTING AT LINE") WRITE(WORD0>>16,2) %IF LANG=0 %THEN I=20 %ELSE I=16 PRINT LOCALS(TSTART+I+(WORD3>>26)<<2) %IF WORD3#0 %START NEWLNB=INTEGER(OLDLNB)&(-4) NEWLINE %RETURN %FINISH PREV BLK=WORD1&X'FFFF' TSTART=PREV BLK %REPEAT NEWLNB=0 NEWLINE; %RETURN %ROUTINE PRINT LOCALS(%INTEGER ADATA) !*********************************************************************** !*______ADATA POINTS TO THE FIRST ENTRY FOR LOCALS IN THE SYMBOL TABLES* !*********************************************************************** NEWLINE %IF INTEGER(ADATA)<0 %THEN PRINTSTRING("NO ") PRINTSTRING("LOCAL VARIABLES ") %WHILE INTEGER(ADATA)>0 %CYCLE PRINT VAR(ADATA) ADATA=ADATA+8+BYTE INTEGER(ADATA+4)&(-4) %REPEAT %END; ! PRINT LOCALS %ROUTINE PRINT VAR(%INTEGER ADATA) !*********************************************************************** !*_______OUTPUT THE NEXT VARIABLE IN THE CURRENT BLOCK. * !*_______A VARIABLE ENTRY IN THE TABLES IS:- * !*_______FLAG<<20!VBREG<<18!DISP * !*_______WHERE:- * !*_________VBREG IS VARIABLE'S BASE REGISTER, DISP IS IT'S OFFSET * !*_________AND FLAGS=NAM<<6!PREC<<3!TYPE * !*********************************************************************** %INTEGER I, J, K, DISP, VBREG, VADDR, V, ARR %CONSTINTEGER UNASSI=X'81818181' %STRING(11)LNAME %STRING(63)MESS %SWITCH INTV,REALV(3:7) I=INTEGER(ADATA) DISP=I&X'3FFFF' VBREG=I&X'40000' K=I>>20 TYPE=K&7 PREC=K>>4&7 ARR=K>>8&3 NAM=K>>10&1 LNAME<-STRING(ADATA+4)." " PRINT STRING(LNAME."=") %IF VBREG=0 %THEN VADDR=OLDLNB %ELSE VADDR=GLAAD VADDR=VADDR+DISP ! USE VALIDATE ADDRESS HERE TO CHECK ACR LEVELS ETC *LDTB_X'18000010' *LDA_VADDR *VAL_(%LNB+1) *JCC_3, J=VADDR>>18 ->INVALID %UNLESS VADDR>24=X'E5' %THEN ->ESC VADDR=INTEGER(VADDR+4) ->NOT ASS %IF VADDR=UNASSI *LDTB_X'18000010' *LDA_VADDR *VAL_(%LNB+1) *JCC_3, J=VADDR>>18 ->INVALID %UNLESS VADDRILL ENT %IF PREC<3; ! BITS NOT IMPLEMENTED %IF PREC>=5 %OR ARR#0 %THEN V=INTEGER(VADDR) ->ARRAY %IF ARR#0 %IF TYPE=1 %THEN ->INTV(PREC) %IF TYPE=2 %THEN ->REALV(PREC) %IF TYPE=5 %THEN ->STR INTV(4): ! 16 BIT INTEGER V=HALFINTEGER(VADDR) MESS="X'".STRHEX(V)."' ".STRINT(V) ->OMESS INTV(7): ! 128 BIT INTEGER REALV(3): ! 8 BIT REAL REALV(4): ! 16 BIT REAL ILL ENT: ! SHOULD NOT OCCURR MESS="UNKNOWN TYPE OF VARIABLE" ->OMESS INTV(5): ! 32 BIT INTEGER ->NOT ASS %IF V=UN ASSI MESS="X'".STRHEX(V)."' ".STRINT(V) ->OMESS INTV(3): ! 8 BIT INTEGER WRITE(BYTEINTEGER(VADDR),1); ->NEWL REALV(5): ! 32 BIT REAL ->NOT ASS %IF V=UN ASSI MESS="X'".STRHEX(V)."'" ->OMESS INTV(6): ! 64 BIT INTEGER REALV(6): ! 64 BIT REAL REALV(7): ! 128 BIT REAL ARRAY: ! ARRAY PRINT 128 BIT HEADER ->NOT ASS %IF UN ASSI=V MESS="X'".STRHEX(V).STRHEX(INTEGER(VADDR+4)) %IF PREC=7 %OR ARR#0 %THEN %START MESS=MESS." ".STRHEX(INTEGER(VADDR+8)).STRHEX(INTEGER(VADDR+12)) %FINISH MESS=MESS."'"; ->OMESS STR: ->NOT ASS %IF BYTE INTEGER(VADDR+1)=UNASSI&255=BYTEINTEGER( %C VADDR) ->TOOLONG %IF BYTEINTEGER(VADDR)>50 MESS="""".STRING(VADDR)."""" ->OMESS ESC: ! ESCAPE DESCRIPTOR INVALID: MESS=" INVALID ADDRESS ".STRHEX(VADDR); ->OMESS TOO LONG: MESS=" TOO LONG "; ->OMESS; ! ASSUME SHORT STRINGS NOT ASS: MESS=" NOT ASSIGNED" OMESS:PRINTSTRING(MESS) NEWL: NEWLINE %END; ! PRINT VAR %END; ! OF RT IDIAGS !* %ROUTINE ERMESS(%INTEGER N, INF) !*********************************************************************** !*_______OUTPUTS AN ERROR MESSAGE STORED IN A COMPRESSED FORMAT * !*********************************************************************** %CONSTBYTEINTEGERARRAY TR(0:13)=1,2,3,4,5,6,7,3, 10,10,7,7,8,10 %RETURN %IF N<=0 %IF N=35 %THEN N=10 %IF N=10 %THEN %START; ! DEAL WITH INTERRUPT WT %IF INF=32 %THEN N=9 %IF INF<=13 %THEN N=TR(INF) %IF INF=140 %THEN N=25 %IF INF=144 %THEN N=28 ! MORE HELPFUL MESSAGE IF !POSSIBLE %FINISH !* PRINTMESS(N) !* ! (WE WOULD GET AN IOCP REF ON THIS NEXT LINE) ! %IF N=26 %THEN PRINT SYMBOL(NEXT SYMBOL) !*__________N=6(ARRAY BOUND FAULT) EXCLUDED FROM FOLLOWING - 19/3/76 %IF N=16 %OR N=17 %OR N=10 %THEN WRITE(INF,1) NEWLINE %END; ! ERMESS %ROUTINE PRINTMESS(%INTEGER N) PRINTSTRING("PROGRAM ERROR") WRITE(N,3) NEWLINE %END %ENDOFFILE