! NOTE NEW VERSION OF THIS GLOBAL ARRY
!
%CONSTSTRING(10)%ARRAY LT(0:7)=" !???! "," IMP "," FORTRAN ",
                              " IMPS "," ASMBLR "," ALGOL(E) ",
                              " OPTCODE "," PASCAL "
!*

! 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.

%SYSTEMROUTINE INDIAG(%INTEGER OLDLNB, LANG, PCOUNT,MODE,DIAG,ASIZE,  %C
                                        %INTEGERNAME FIRST,NEWLNB)
!***********************************************************************
!*       THE DIAGNOSTIC ROUTINE FOR IMP %AND ALGOL(LANG=5)             *
!*       THE ALGOL SYMBOL TABLES ARE SET UP AS FOR IMP                 *
!*       MODE = 0 FOR JOBBER&EMAS2900, =1 FOR OPEH IN VMEB&VMEK        *
!*       DIAG = DIAGNOSTIC LEVEL                                       *
!*       1 = ROUTE SUMMARY ONLY (ASIZE)=ADDR MODULE NAME FROM OPEH     *
!*       2 = DIAGNOSTICS AS TRADITIONALLY PERFORMED                    *
!*       ASIZE IS NO OF ELEMENTS OF EACH ARRAY TO BE PRINTED(DIAG>1)   *
!***********************************************************************
%ROUTINESPEC PRINT LOCALS(%INTEGER ADATA,%STRING(15)LOC)
%ROUTINESPEC PRINT SCALAR(%RECORDNAME VAR)
%ROUTINESPEC PRINT ARR(%RECORDNAME VAR,%INTEGER ASIZE)
%ROUTINESPEC PRINT VAR(%INTEGER TYPE,PREC,NAM,LANG,FORM,VADDR)
%INTEGER GLAAD, FLINE, NAM, TYPE, PREC, TSTART, PREV BLK, %C
      WORD0, WORD1, WORD2, WORD3, I
%RECORDFORMAT F(%INTEGER VAL,%STRING(11)VNAME)
%OWNINTEGERARRAY GLOBAD(0:20)
%OWNINTEGER GLOBPTR
%STRING (10) STMNT
%STRING (20) PROC
%STRING (50) NAME
%CONSTINTEGER ALGOL=5;! LANGUAGE CODE
      %IF FIRST=1 %THEN GLOBPTR=0
      %IF LANG#ALGOL %THEN STMNT=" LINE" %C
         %AND PROC=" ROUTINE/FN/MAP " %C
         %ELSE STMNT=" STATEMENT" %AND PROC=" PROCEDURE "
      GLAAD=INTEGER(OLDLNB+16);         ! ADDR OF GLA/PLT
      TSTART=INTEGER(OLDLNB+12)&X'FFFFFF'
      %IF TSTART=0 %THEN %START
         PRINTSTRING("
".PROC."COMPILED WITHOUT DIAGNOSTICS
")
         ASSDUMP(PCOUNT,OLDLNB)
         NEWLNB=INTEGER(OLDLNB)
         %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)
         %IF WORD1&X'C0000000'=X'40000000' %AND COMREG(25)#0 %C
            %THEN NEWLNB=INTEGER(OLDLNB) %AND %RETURN
! SYSTEM ROUTINE
         NAME=STRING(TSTART+12)
         I=WORD0&X'FFFF';               ! LINE NO DISP
         %IF I=0 %THEN FLINE=-1 %ELSE FLINE=INTEGER(OLDLNB+I)
         NEWLINE
         %IF MODE=1 %THEN PRINTSTRING(LT(LANG)) %ELSE %START
            %IF FIRST=1 %THEN FIRST=0 %AND PRINTSTRING("DIAGNOSTICS ")
            PRINTSTRING("ENTERED FROM")
         %FINISH
         %IF WORD0>>16=0 %THENSTART
            %IF MODE=0 %THEN PRINTSTRING(LT(LANG))
            PRINTSTRING("ENVIRONMENTAL BLOCK
")
         %FINISHELSESTART
            %IF FLINE>=0 %AND FLINE#WORD0>>16 %THEN %START
               PRINTSTRING(STMNT)
               WRITE(FLINE,4)
               PRINTSTRING(" OF")
            %FINISH
            %IF WORD3=0 %THEN PRINTSTRING(" BLOCK") %C
               %ELSE PRINT STRING(PROC.NAME)
            PRINTSTRING(" STARTING AT".STMNT)
            WRITE(WORD0>>16,2)
            %IF MODE=1 %AND DIAG=1 %THENSTART
               PRINTSTRING("(MODULE ".STRING(ASIZE).")")
            %FINISH
            NEWLINE
            %IF LANG#ALGOL %THEN I=20 %ELSE I=16
            %IF MODE=0 %OR DIAG>1 %THEN  %START
               PRINT LOCALS(TSTART+I+(WORD3>>26)<<2,"LOCAL")
               %IF WORD1&X'C0000000'#0 %THEN %START;! EXTERNAL(ETC) ROUTINE                   
                  I=WORD1&X'3FFFF'+INTEGER(GLAAD+12)+I
                  PRINT LOCALS(I,"GLOBAL")
               %FINISH
            %FINISH
            %IF WORD3#0 %START
               NEWLNB=INTEGER(OLDLNB)
               %UNLESS DIAG=1 %THEN NEWLINE
               %RETURN
            %FINISH
         %FINISH
         PREV BLK=WORD1&X'FFFF'
         TSTART=PREV BLK
      %REPEAT
      NEWLNB=0
      NEWLINE;  %RETURN

%ROUTINE QSORT(%RECORDARRAYNAME A,%INTEGER I,J)
%RECORDSPEC A(F)
%RECORD D(F)
%INTEGER L,U
         %IF I>=J %THEN %RETURN
         L=I; U=J; D=A(J); ->FIND
UP:
         L=L+1
         %IF L=U %THEN ->FOUND
FIND:
         %UNLESS A(L)_VNAME>D_VNAME %THEN ->UP
         A(U)=A(L)
DOWN:
         U=U-1
         %IF L=U %THEN ->FOUND
         %UNLESS A(U)_VNAME<D_VNAME %THEN ->DOWN
         A(L)=A(U); ->UP
FOUND:
         A(U)=D
         QSORT(A,I,L-1)
         QSORT(A,U+1,J)
%END
%ROUTINE PRINT LOCALS(%INTEGER ADATA,%STRING(15)LOC)
!***********************************************************************
!*      ADATA POINTS TO THE FIRST ENTRY FOR LOCALS IN THE SYMBOL TABLES*
!***********************************************************************
%INTEGER I,NRECS,SADATA
      %IF LOC="GLOBAL" %THEN %START
         I=0
         %WHILE I<GLOBPTR %CYCLE
            %IF GLOBAD(I)=ADATA %THEN %RETURN
            I=I+1
         %REPEAT
         %IF GLOBPTR<=20 %THEN  %START
            GLOBAD(GLOBPTR)=ADATA
            GLOBPTR=GLOBPTR+1
         %FINISH
      %FINISH
      NEWLINE
      %IF INTEGER(ADATA)<0 %THEN PRINTSTRING("NO ")
      PRINTSTRING(LOC." VARIABLES
")
      NRECS=0; SADATA=ADATA
      %WHILE INTEGER(ADATA)>0 %CYCLE
         NRECS=NRECS+1
         ADATA=ADATA+8+BYTE INTEGER(ADATA+4)&(-4)
      %REPEAT
      %RETURN %IF NRECS=0
      %BEGIN
      %RECORDARRAY VARS(1:NRECS)(F)
      %INTEGER I
      ADATA=SADATA
      %CYCLE I=1,1,NRECS
         VARS(I)<-RECORD(ADATA)
         ADATA=ADATA+8+BYTEINTEGER(ADATA+4)&(-4)
      %REPEAT
      QSORT(VARS,1,NRECS)
      %CYCLE I=1,1,NRECS
         %IF VARS(I)_VAL>>28&3=0 %THEN PRINT SCALAR(VARS(I))
      %REPEAT
      %IF ASIZE>0 %THEN %START
         %CYCLE I=1,1,NRECS
            %IF VARS(I)_VAL>>28&3#0 %THEN PRINT ARR(VARS(I),ASIZE)
         %REPEAT
      %FINISH
      %END
%END
%ROUTINE PRINT SCALAR(%RECORDNAME VAR)
!***********************************************************************
!*       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                               *
!***********************************************************************
%RECORDSPEC VAR(F)
%INTEGER I, K, VADDR
%STRING(11)LNAME
      I=VAR_VAL
      K=I>>20
      TYPE=K&7
      PREC=K>>4&7
      NAM=K>>10&1
      LNAME<-VAR_VNAME."          "
      PRINT STRING(LNAME."=")
      %IF I&X'40000'=0 %THEN VADDR=OLDLNB %ELSE VADDR=GLAAD
      VADDR=VADDR+I&X'3FFFF'
      PRINT VAR(TYPE,PREC,NAM,LANG,0,VADDR)
      NEWLINE
%END
%ROUTINE PRINT VAR(%INTEGER TYPE,PREC,NAM,LANG,FORM,VADDR)
!***********************************************************************
!*    OUTPUT A VARIABLE. FIXED FORMAT(FORM#0) TAKE 14 PLACES FOR       *
!*    VARIABLES UP TO 32 BITS AND 21 PLACES THEREAFTER                 *
!***********************************************************************
%INTEGER K,I,J
%CONSTINTEGER UNASSI=X'81818181'
%SWITCH INTV,REALV(3:7)
! USE VALIDATE ADDRESS HERE TO CHECK ACR LEVELS ETC

      *LDTB_X'18000010'
      *LDA_VADDR
      *VAL_(%LNB+1)
      *JCC_3,<INVALID>
      %IF NAM#0 %OR (TYPE=5 %AND FORM=0) %THEN %START
         %IF INTEGER(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,<INVALID>
      %FINISH
      ->ILL ENT %IF PREC<3;             ! BITS NOT IMPLEMENTED
      %IF TYPE=1 %THEN ->INTV(PREC)
      %IF TYPE=2 %THEN ->REALV(PREC)
      %IF TYPE=3 %AND PREC=5 %THEN ->BOOL
      %IF TYPE=5 %THEN ->STR
INTV(4):                                ! 16 BIT INTEGER
      K=BYTEINTEGER(VADDR)<<8!BYTEINTEGER(VADDR+1)
      ->NOT ASS %IF K=UNASSI>>16
      WRITE(K,12*FORM+1)
      %RETURN
INTV(7):                                ! 128 BIT INTEGER
REALV(3):                               ! 8 BIT REAL
REALV(4):                               ! 16 BIT REAL
ILL ENT:                                ! SHOULD NOT OCCURR
      PRINTSTRING("UNKNOWN TYPE OF VARIABLE")
      %RETURN
INTV(5):                                ! 32 BIT INTEGER
      ->NOT ASS %IF INTEGER(VADDR)=UN ASSI
      WRITE(INTEGER(VADDR),1+12*FORM)
      %UNLESS LANG=ALGOL %OR FORM=1 %OR -255<=INTEGER(VADDR)<=255 %START
         PRINTSTRING(" (X'")
         PRHEX(INTEGER(VADDR),8);  PRINTSTRING("')")
      %FINISH
      %RETURN
INTV(3):                                ! 8 BIT INTEGER
      WRITE(BYTEINTEGER(VADDR),1+12*FORM);  %RETURN
REALV(5):                               ! 32 BIT REAL
      ->NOT ASS %IF INTEGER(VADDR)=UN ASSI
      PRINT FL(REAL(VADDR), 7)
      %RETURN
INTV(6):                                ! 64 BIT INTEGER
      ->NOT ASS %IF UN ASSI=INTEGER(VADDR)=INTEGER(VADDR+4)
      PRINTSTRING("X'")
      PRHEX(INTEGER(VADDR),8);  SPACES(2)
      PRHEX(INTEGER(VADDR+4),8)
      PRINTSYMBOL('''')
      %RETURN
REALV(6):                               ! 64 BIT REAL
      ->NOT ASS %IF UNASSI=INTEGER(VADDR)=INTEGER(VADDR+4)
      PRINT FL(LONG REAL(VADDR), 14)
      %RETURN
REALV(7):                               ! 128 BIT REAL
      ->NOT ASS %IF UNASSI=INTEGER(VADDR)=INTEGER(VADDR+4)
      PRINT FL(LONGREAL(VADDR),14)
      %IF FORM=0 %THEN %START
         PRINTSTRING(" (R'"); PRHEX(INTEGER(VADDR),8)
         PRHEX(INTEGER(VADDR+4),8)
         SPACE; PRHEX(INTEGER(VADDR+8),8)
         PRHEX(INTEGER(VADDR+12),8)
         PRINTSTRING("')")
      %FINISH
      %RETURN
BOOL:                                   ! BOOLEAN
      ->NOT ASS %IF INTEGER(VADDR)=UNASSI
      %IF INTEGER(VADDR)=0 %THEN PRINTSTRING("  'FALSE'     ") %C
         %ELSE PRINTSTRING("   'TRUE'      ")
      %RETURN
STR:  I=BYTEINTEGER(VADDR)
      ->NOT ASS %IF BYTE INTEGER(VADDR+1)=UNASSI&255=I
      K=1
      %WHILE K<=I %CYCLE
         J=BYTE INTEGER(VADDR+K)
         ->NPRINT %UNLESS 32<=J<=126 %OR J=10
         K=K+1
      %REPEAT
      PRINTSTRING("""")
      PRINTSTRING(STRING(VADDR));  PRINTSTRING("""")
      %RETURN
ESC:                                    ! ESCAPE DESCRIPTOR
      PRINTSTRING("ESCAPE ROUTINE")
      ->AIGN
INVALID:
      PRINTSTRING("INVALID ADDRSS")
      ->AIGN
NPRINT:
      PRINT STRING(" CONTAINS UNPRINTABLE CHARS")
      %RETURN
NOT ASS:
      PRINTSTRING("  NOT ASSIGNED")
AIGN:
      %IF PREC>=6 %AND FORM=1 %THEN SPACES(7)
%END;                                   ! PRINT VAR
%INTEGERFN CHECK DUPS(%INTEGER REFADDR,VADDR,ELSIZE)
!***********************************************************************
!*    CHECK IF VAR THE SAME AS PRINTED LAST TIME                       *
!***********************************************************************
      ELSIZE=ELSIZE!X'18000000'
      *LDTB_ELSIZE; *LDA_REFADDR
      *CYD_0; *LDA_VADDR
      *CPS_%L=%DR
      *JCC_8,<A DUP>
      %RESULT=0
ADUP: %RESULT=1
%END
%ROUTINE DCODEDV(%LONGINTEGER DV,%INTEGERARRAYNAME LB,UB)
!***********************************************************************
!*    WORK DOWN A DOPE VECTOR DESCRIBED BY WORD DESCRIPTOR DV AND      *
!*    RETURN SIZE,DIMENIONALITY AND SUBSCRIPT RANGES IN DATA           *
!***********************************************************************
%INTEGER I,ND,AD,U,T
      ND=(DV>>32)&255; ND=ND//3
      LB(0)=ND; UB(0)=ND
      AD=INTEGER(ADDR(DV)+4)+12*(ND-1)
      T=1
      %CYCLE I=1,1,ND
         U=INTEGER(AD+8)//INTEGER(AD+4)
         UB(I)=U
         LB(I)=INTEGER(AD)
         T=T*(UB(I)-LB(I)+1)
         AD=AD-12
      %REPEAT
      UB(ND+1)=0
      LB(ND+1)=0
%END
%ROUTINE PRINT ARR(%RECORDNAME VAR,%INTEGER ASIZE)
!***********************************************************************
!*    PRINT THE FIRST ASIZE ELEMENTS OF THE ARRAY DEFINED BY VAR       *
!*    ARRAYNAMES PRINTED ALSO AT PRESENT. UP TO COMPILERS TO AVOID THIS*
!***********************************************************************
%RECORDSPEC VAR(F)
%INTEGER I,J,K,TYPE,PREC,ELSIZE,ND,VADDR,HDADDR,BASEADDR,ELSPERLINE,%C
         M1,REFADDR,ELSONLINE,DUPSEEN
%LONGINTEGER ARRD,DOPED
%INTEGERARRAY LBS,UBS,SUBS(0:13)
      I=VAR_VAL
      K=I>>20
      PREC=K>>4&7
      TYPE=K&7
      PRINTSTRING("

ARRAY ".VAR_VNAME)
      %IF I&X'40000'#0 %THEN VADDR=GLAAD %ELSE VADDR=OLDLNB
      HDADDR=VADDR+I&X'3FFFF'
!
!     VALIDATE HEADER ADDRESS AND THE 2 DESCRIPTORS
!
      *LDTB_X'18000010'
      *LDA_HDADDR
      *VAL_(%LNB+1)
      *JCC_3,<HINV>
      ARRD=LONG INTEGER(HDADDR)
      DOPED=LONG INTEGER(HDADDR+8)
      *LD_ARRD
      *VAL_(%LNB+1)
      *JCC_3,<HINV>
      *LD_DOPED
      *VAL_(%LNB+1)
      *JCC_3,<HINV>
      BASEADDR=INTEGER(ADDR(ARRD)+4)
      DCODEDV(DOPED,LBS,UBS)
      ND=LBS(0)
      %IF TYPE#5 %THEN ELSIZE=1<<(PREC-3) %ELSE %START
         I=INTEGER(ADDR(DOPED)+4)
         ELSIZE=INTEGER(I+12*(ND-1)+4)
      %FINISH
!
! PRINT OUT AND CHECK ARRAYS BOUND PAIR LIST
!
      PRINT SYMBOL('('); J=0
      %CYCLE I=1,1,ND
         SUBS(I)=LBS(I);                ! SET UP SUBS TO FIRST EL
         WRITE(LBS(I),1)
         PRINT SYMBOL(':')
         WRITE(UBS(I),1)
         PRINT SYMBOL(',') %UNLESS I=ND
         J=1 %IF LBS(I)>UBS(I)
      %REPEAT
      PRINT SYMBOL(')')
      NEWLINE
      %IF J#0 %THEN PRINTSTRING("BOUND PAIRS INVALID") %AND %RETURN
!
! WORK OUT HOW MANY ELEMENTS TO PRINT ON A LINE
!
      %IF TYPE=5 %THEN ELSPERLINE=1 %ELSE %START
         %IF ELSIZE<=4 %THEN ELSPERLINE=6 %ELSE ELSPERLINE=4
      %FINISH
      %CYCLE;                           ! THROUGH ALL THE COLUMNS
!
! PRINT COLUMN HEADER EXCEPT FOR ONE DIMENSION ARRAYS
!
         %IF ND>1 %THEN %START
            PRINT STRING("
COLUMN (*,")
            %CYCLE I=2,1,ND
               WRITE(SUBS(I),1)
               PRINT SYMBOL(',') %UNLESS I=ND
            %REPEAT
            PRINT SYMBOL(')')
         %FINISH
!
! COMPUTE THE ADDRESS OF FIRST ELEMENT OF THE COLUMN
!
         K=0; M1=1; I=1
         %WHILE I<=ND %CYCLE
            K=K+M1*(SUBS(I)-LBS(I))
            M1=M1*(UBS(I)-LBS(I)+1)
            I=I+1
         %REPEAT
         VADDR=BASEADDR+K*ELSIZE
         REFADDR=0;                     ! ADDR OF LAST ACTUALLY PRINTED
         DUPSEEN=0; ELSONLINE=99;       ! FORCE FIRST EL ONTO NEW LINE
!
! CYCLE DOWN THE COLUMN AND PRINT THE ELEMENTS. SEQUENCES OF REPEATED
! ELEMENTS ARE REPLACED BY "(RPT)". AT THE START OF EACH LINE THE
! CURRENT VALUE OF THE FIRST SUBSCRIPTED IS PRINTED FOLLOWED BY A APAREN
!
         %CYCLE I=LBS(1),1,UBS(1)
            %IF REFADDR#0 %THEN %START; ! CHK LAST PRINTED IN THIS COL
               K=CHECK DUPS(REFADDR,VADDR,ELSIZE)
               %IF K#0 %THEN %START
                  PRINT STRING("(RPT)") %IF DUPSEEN=0
                  DUPSEEN=DUPSEEN+1
                  ->SKIP
               %FINISH
            %FINISH
!
! START A NEW LINE AND PRINT SUBSCRIPT VALUE IF NEEDED
!
            %IF DUPSEEN#0 %OR ELS ON LINE>=ELS PER LINE %START
               NEWLINE; WRITE(I,3); PRINT STRING(")")
               DUPSEEN=0; ELS ON LINE=0
            %FINISH
            PRINT VAR(TYPE,PREC,0,LANG,1,VADDR);                       
            ELSONLINE=ELSONLINE+1
            REFADDR=VADDR
SKIP:
            VADDR=VADDR+ELSIZE
            ASIZE=ASIZE-1
            %EXIT %IF ASIZE<0
         %REPEAT;                       ! UNTIL COLUMN FINISHED
         NEWLINE
         %EXIT %IF ASIZE<=0 %OR ND=1
!
! UPDATE SECOND SUBSCRIPT TO NEXT COLUMN. CHECK FOR AND DEAL WITH
! OVERFLOW INTO NEXT OR FURTHER CLOUMNS
!
         I=2; SUBS(1)=LBS(1)
         %CYCLE
            SUBS(I)=SUBS(I)+1
            %EXIT %UNLESS SUBS(I)>UBS(I)
            SUBS(I)=LBS(I);             ! RESET TO LOWER BOUND
            I=I+1
         %REPEAT
         %EXIT %IF I>ND;                ! ALL DONE
      %REPEAT;                          ! FOR FURTHER CLOMUNS
      %RETURN
HINV: PRINTSTRING(" HAS INVALID HEADER
")
%END;                                  ! OF RT PRINT ARR
%END;                                   ! OF RT IDIAGS
%ENDOFFILE