SUBROUTINE EXTENDED_DATA_SYMTBL C IMPLICIT NONE C INCLUDE 'DISMSYMTBL.INC' C BYTE BLV_TYP, BLV_FLAGS, BLV_FLAGS2, + BLV_FORTFLAGS(0:53) INTEGER*2 NLV_PTR INTEGER*4 I, ILV_PNTR, ADDR, J, K, K2, + ILV_SYSVECARGS(0:12,0:233) LOGICAL*1 LLV_IMPLICITSTATE DATA BLV_FORTFLAGS/0,0,8,9*0,4,4,4,20,0,0,4,4,0,5*12,3*14,0, + 4*14,15,15,5*0,5*8,4*0,4*8/ DATA (ILV_SYSVECARGS(I,0),I=0,5)/12,0,0,0,SYM_D_QUD,SYM_PROC/ !$QIOW DATA (ILV_SYSVECARGS(I,'04'X),I=0,3)/3,0,0,SYM_D_LNG/ !$ADJSTK DATA (ILV_SYSVECARGS(I,'05'X),I=0,2)/2,0,SYM_D_LNG/ !$ADJWSL DATA (ILV_SYSVECARGS(I,'07'X),I=0,5)/5,SYM_D_QUD,SYM_D_WRD, + SYM_D_QUD,2*0/ !$ALLOC DATA (ILV_SYSVECARGS(I,'09'X),I=0,4)/4,SYM_D_WRD,2*SYM_D_QUD,0/ !$ASCTIM DATA (ILV_SYSVECARGS(I,'0A'X),I=0,4)/4,SYM_D_QUD,SYM_D_WRD,0, + SYM_D_QUD/ !$ASSIGN DATA (ILV_SYSVECARGS(I,'0B'X),I=0,2)/2,2*SYM_D_QUD/ !$BINTIM DATA (ILV_SYSVECARGS(I,'0E'X),I=0,2)/2,SYM_D_LNG,SYM_D_QUD/ !$CANWAK DATA (ILV_SYSVECARGS(I,'0F'X),I=0,12)/12,2*SYM_D_LNG,2*0, + SYM_D_QUD,SYM_D_LNG,6*0/!$CRPMSC DATA (ILV_SYSVECARGS(I,'12'X),I=0,2)/2,SYM_PROC,-SYM_T_ARGLST/ !$CMKRNL DATA (ILV_SYSVECARGS(I,'14'X),I=0,4)/4,0,SYM_D_LNG,2*0/ !$CNTREG DATA (ILV_SYSVECARGS(I,'17'X),I=0,7)/7,0,SYM_D_WRD,4*0,SYM_D_QUD/ !$CREMBX DATA (ILV_SYSVECARGS(I,'18'X),I=0,12)/12,SYM_D_LNG,4*SYM_D_QUD, + SYM_D_LNG,-SYM_T_QUOLST, + SYM_D_QUD,4*0/ !$CREPRC DATA (ILV_SYSVECARGS(I,'19'X),I=0,3)/3,2*SYM_D_LNG,0/ !$CRETVA DATA (ILV_SYSVECARGS(I,'1B'X),I=0,2)/2,SYM_D_QUD,0/ !$DALLOC DATA (ILV_SYSVECARGS(I,'1D'X),I=0,3)/3,SYM_PROC,2*0/ !$DCLAST DATA (ILV_SYSVECARGS(I,'1E'X),I=0,1)/1,SYM_D_LNG/ !$DCLEXH DATA (ILV_SYSVECARGS(I,'21'X),I=0,2)/2,SYM_D_LNG,SYM_D_QUD/ !$DELPRC DATA (ILV_SYSVECARGS(I,'22'X),I=0,3)/3,2*SYM_D_LNG,0/ !$DELTVA DATA (ILV_SYSVECARGS(I,'29'X),I=0,4)/4,0,SYM_D_LNG,2*0/ !$EXPREG DATA (ILV_SYSVECARGS(I,'2A'X),I=0,3)/-3,SYM_D_QUD,SYM_D_WRD, + SYM_D_QUD/ !$FAO DATA (ILV_SYSVECARGS(I,'2B'X),I=0,4)/4,SYM_D_QUD,SYM_D_WRD, + SYM_D_QUD,SYM_D_LNG/ !$FAOL DATA (ILV_SYSVECARGS(I,'2C'X),I=0,3)/3,SYM_D_LNG,SYM_D_QUD,0/ !$FORCEX DATA (ILV_SYSVECARGS(I,'2F'X),I=0,1)/1,SYM_D_QUD/ !$GETTIM DATA (ILV_SYSVECARGS(I,'34'X),I=0,3)/3,2*SYM_D_LNG,0/ !$LKWSET DATA (ILV_SYSVECARGS(I,'35'X),I=0,7)/7,2*SYM_D_LNG,2*0,SYM_D_QUD, + SYM_D_LNG,0/ !$MGBLSC DATA (ILV_SYSVECARGS(I,'37'X),I=0,2)/2,SYM_D_WRD,SYM_D_LNG/ !$NUMTIM DATA (ILV_SYSVECARGS(I,'39'X),I=0,5)/12,0,0,0,SYM_D_QUD,SYM_PROC/ !$QIO DATA (ILV_SYSVECARGS(I,'3A'X),I=0,2)/2,0,SYM_D_LNG/ !$READEF DATA (ILV_SYSVECARGS(I,'41'X),I=0,4)/4,0,SYM_PROC,0,SYM_D_LNG/ !$SETEXV DATA (ILV_SYSVECARGS(I,'44'X),I=0,4)/4,0,SYM_D_QUD,SYM_PROC,0/ !$SETIMR DATA (ILV_SYSVECARGS(I,'45'X),I=0,4)/4,SYM_D_LNG,SYM_D_QUD,0, + SYM_D_LNG/ !$SETPRI DATA (ILV_SYSVECARGS(I,'46'X),I=0,5)/5,2*SYM_D_LNG,2*0,SYM_D_BYT/ !$SETPRT DATA (ILV_SYSVECARGS(I,'4B'X),I=0,6)/6,SYM_D_QUD,SYM_D_WRD, + SYM_D_QUD,2*SYM_D_BYT,0/!$TRNLOG DATA (ILV_SYSVECARGS(I,'4C'X),I=0,3)/3,2*SYM_D_LNG,0/ !$ULKPAG DATA (ILV_SYSVECARGS(I,'4D'X),I=0,3)/3,2*SYM_D_LNG,0/ !$ULWSET DATA (ILV_SYSVECARGS(I,'4E'X),I=0,2)/2,SYM_D_LNG,SYM_JMPE/ !$UNWIND DATA (ILV_SYSVECARGS(I,'50'X),I=0,2)/2,SYM_D_LNG,SYM_D_QUD/ !$WAKE DATA (ILV_SYSVECARGS(I,'56'X),I=0,5)/5,0,SYM_D_WRD,SYM_D_QUD,0, + SYM_D_BYT/ !$GETMSG DATA (ILV_SYSVECARGS(I,'59'X),I=0,5)/5,0,SYM_D_WRD,SYM_D_QUD, + SYM_D_WRD,SYM_D_QUD/ !$GETCHN DATA (ILV_SYSVECARGS(I,'5B'X),I=0,7)/7,0,SYM_D_LNG,SYM_D_QUD, + -SYM_T_ITMLSTJPI, + SYM_D_QUD,SYM_PROC,0/ !$GETJPI DATA (ILV_SYSVECARGS(I,'5C'X),I=0,4)/4,SYM_D_LNG,SYM_PROC, + SYM_D_QUD,0/ !$PUTMSG DATA (ILV_SYSVECARGS(I,'60'X),I=0,4)/4,0,SYM_D_LNG,0,SYM_D_LNG/ !$SETPRV DATA (ILV_SYSVECARGS(I,'70'X),I=0,3)/-1,SYM_D_RMS,2*SYM_PROC/ !$GET DATA (ILV_SYSVECARGS(I,'71'X),I=0,3)/-1,SYM_D_RMS,2*SYM_PROC/ !$PUT DATA (ILV_SYSVECARGS(I,'72'X),I=0,3)/-1,SYM_D_RMS,2*SYM_PROC/ !$READ DATA (ILV_SYSVECARGS(I,'75'X),I=0,1)/1,SYM_D_RMS/ !$WAIT DATA (ILV_SYSVECARGS(I,'77'X),I=0,3)/-1,SYM_D_RMS,2*SYM_PROC/ !$CLOSE DATA (ILV_SYSVECARGS(I,'78'X),I=0,3)/-1,SYM_D_RMS,2*SYM_PROC/ !$CONNECT DATA (ILV_SYSVECARGS(I,'79'X),I=0,3)/-1,SYM_D_RMS,2*SYM_PROC/ !$CREATE DATA (ILV_SYSVECARGS(I,'7A'X),I=0,3)/-1,SYM_D_RMS,2*SYM_PROC/ !$DISCONNECT DATA (ILV_SYSVECARGS(I,'81'X),I=0,3)/-1,SYM_D_RMS,2*SYM_PROC/ !$OPEN DATA (ILV_SYSVECARGS(I,'86'X),I=0,3)/-1,SYM_D_RMS,2*SYM_PROC/ !$PARSE DATA (ILV_SYSVECARGS(I,'89'X),I=0,3)/-1,SYM_D_RMS,2*SYM_PROC/ !$SEARCH DATA (ILV_SYSVECARGS(I,'B8'X),I=0,11)/11,2*0,SYM_D_LNG,0, + SYM_D_QUD,0,SYM_PROC,0, + SYM_PROC,2*0/ !$ENQ DATA (ILV_SYSVECARGS(I,'B9'X),I=0,4)/4,0,SYM_D_LNG,2*0/ !$DEQ DATA (ILV_SYSVECARGS(I,'BA'X),I=0,11)/11,2*0,SYM_D_LNG,0, + SYM_D_QUD,0,SYM_PROC,0, + SYM_PROC,2*0/ !$ENQW DATA (ILV_SYSVECARGS(I,'C3'X),I=0,8)/8,2*0,SYM_D_QUD, + -SYM_T_ITMLSTDVI, + SYM_D_QUD,SYM_PROC,2*0/ !$GETDVIW DATA (ILV_SYSVECARGS(I,'C8'X),I=0,2)/2,0,SYM_D_QUD/ !$SYNCH DATA (ILV_SYSVECARGS(I,'D0'X),I=0,5)/5,SYM_D_LNG,2*SYM_D_QUD, + SYM_D_BYT,-SYM_T_ITMLSTLNM/ !$CRELNM DATA (ILV_SYSVECARGS(I,'D1'X),I=0,3)/3,2*SYM_D_QUD,SYM_D_BYT/ !$DELLNM DATA (ILV_SYSVECARGS(I,'D2'X),I=0,5)/5,SYM_D_LNG,2*SYM_D_QUD, + SYM_D_BYT,-SYM_T_ITMLSTLNM/ !$TRNLNM DATA (ILV_SYSVECARGS(I,'D4'X),I=0,7)/7,0,SYM_D_LNG, + -SYM_T_ITMLSTLKI, + SYM_D_QUD,SYM_PROC,2*0/ !$GETLKIW DATA (ILV_SYSVECARGS(I,'D6'X),I=0,3)/3,SYM_D_QUD,2*SYM_D_LNG/ !$ASCTOID DATA (ILV_SYSVECARGS(I,'D8'X),I=0,6)/6,0,SYM_D_WRD,SYM_D_QUD, + 3*SYM_D_LNG/ !$IDTOASC DATA (ILV_SYSVECARGS(I,'DD'X),I=0,11)/11,0,2*SYM_D_QUD,0, + SYM_D_QUD,4*0,SYM_PROC, + 0/ !$BRKTHRUW C EXTERNAL FIX_BUFR_OVRFL, SYS$QIOW EXTERNAL DISM__UNSPDATYP, DISM__INVSTATBL C C pre-scan the symbol table for RMS and FORTRAN format entries, and expand C each of those C CALL LIB$ESTABLISH(FIX_BUFR_OVRFL) I=1 DO WHILE (I.LE.SYM_TBL_PTR) IF((SYM_TYP(I).AND.SYM_D_RMS).NE.0)THEN CALL COPY_BYTE(SYM_VAL(I),BLV_TYP) IF(BLV_TYP.EQ.'1'X)THEN ! RAB$C_BID CALL COPY_LONG(SYM_VAL(I)+36,ILV_PNTR) ! RAB$L_UBF IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_LNG),,) ENDIF CALL COPY_LONG(SYM_VAL(I)+40,ILV_PNTR) ! RAB$L_RBF IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_LNG),,) ENDIF CALL COPY_LONG(SYM_VAL(I)+44,ILV_PNTR) ! RAB$L_RHB IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_LNG),,) ENDIF CALL COPY_LONG(SYM_VAL(I)+48,ILV_PNTR) ! RAB$L_KBF/PBF IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_LNG),,) ENDIF CALL COPY_LONG(SYM_VAL(I)+60,ILV_PNTR) ! RAB$L_FAB IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_RMS),,) ENDIF CALL COPY_LONG(SYM_VAL(I)+64,ILV_PNTR) ! RAB$L_XAB IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_RMS),,) ENDIF ELSEIF(BLV_TYP.EQ.'2'X)THEN ! NAM$C_BID CALL COPY_LONG(SYM_VAL(I)+4,ILV_PNTR) ! NAM$L_RSA IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_BYT),,) ENDIF CALL COPY_LONG(SYM_VAL(I)+12,ILV_PNTR) ! NAM$L_ESA IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_BYT),,) ENDIF CALL COPY_LONG(SYM_VAL(I)+16,ILV_PNTR) ! NAM$L_RLF IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_RMS),,) ENDIF ELSEIF(BLV_TYP.EQ.'3'X)THEN ! FAB$C_BID CALL COPY_LONG(SYM_VAL(I)+36,ILV_PNTR) ! FAB$L_XAB IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_RMS),,) ENDIF CALL COPY_LONG(SYM_VAL(I)+40,ILV_PNTR) ! FAB$L_NAM IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_RMS),,) ENDIF CALL COPY_LONG(SYM_VAL(I)+44,ILV_PNTR) ! FAB$L_FNA IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_CHR),,) ENDIF CALL COPY_LONG(SYM_VAL(I)+48,ILV_PNTR) ! FAB$L_DNA IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_CHR),,) ENDIF ELSEIF(BLV_TYP.EQ.'12'X)THEN ! XAB$C_DAT CALL COPY_LONG(SYM_VAL(I)+4,ILV_PNTR) ! XAB$L_NXT IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_RMS),,) ENDIF ELSEIF(BLV_TYP.EQ.'13'X)THEN ! XAB$C_PRO CALL COPY_LONG(SYM_VAL(I)+4,ILV_PNTR) ! XAB$L_NXT IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_RMS),,) ENDIF CALL COPY_LONG(SYM_VAL(I)+24,ILV_PNTR) ! XAB$L_ACLBUF IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_BYT),,) ENDIF ELSEIF(BLV_TYP.EQ.'14'X)THEN ! XAB$C_ALL CALL COPY_LONG(SYM_VAL(I)+4,ILV_PNTR) ! XAB$L_NXT IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_RMS),,) ENDIF ELSEIF(BLV_TYP.EQ.'15'X)THEN ! XAB$C_KEY CALL COPY_LONG(SYM_VAL(I)+4,ILV_PNTR) ! XAB$L_NXT IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_RMS),,) ENDIF CALL COPY_LONG(SYM_VAL(I)+56,ILV_PNTR) ! XAB$L_KNM IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_CHR),,) ENDIF ELSEIF(BLV_TYP.EQ.'16'X)THEN ! XAB$C_SUM CALL COPY_LONG(SYM_VAL(I)+4,ILV_PNTR) ! XAB$L_NXT IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_RMS),,) ENDIF ELSEIF(BLV_TYP.EQ.'1D'X)THEN ! XAB$C_FHC CALL COPY_LONG(SYM_VAL(I)+4,ILV_PNTR) ! XAB$L_NXT IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_RMS),,) ENDIF ELSEIF(BLV_TYP.EQ.'1E'X)THEN ! XAB$C_RDT CALL COPY_LONG(SYM_VAL(I)+4,ILV_PNTR) ! XAB$L_NXT IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_RMS),,) ENDIF ELSEIF(BLV_TYP.EQ.'1F'X)THEN ! XAB$C_TRM CALL COPY_LONG(SYM_VAL(I)+4,ILV_PNTR) ! XAB$L_NXT IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_RMS),,) ENDIF CALL COPY_LONG(SYM_VAL(I)+8,ILV_PNTR) ! XAB$L_ITMLST IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_LNG),,) ENDIF ELSEIF(BLV_TYP.EQ.'20'X)THEN ! XAB$C_CXF CALL COPY_LONG(SYM_VAL(I)+4,ILV_PNTR) ! XAB$L_NXT IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_RMS),,) ENDIF ELSEIF(BLV_TYP.EQ.'21'X)THEN ! XAB$C_CXR CALL COPY_LONG(SYM_VAL(I)+4,ILV_PNTR) ! XAB$L_NXT IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_RMS),,) ENDIF ELSEIF(BLV_TYP.EQ.'22'X)THEN ! XAB$C_JNL CALL COPY_LONG(SYM_VAL(I)+4,ILV_PNTR) ! XAB$L_NXT IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_RMS),,) ENDIF CALL COPY_LONG(SYM_VAL(I)+12,ILV_PNTR) ! XAB$L_JNL_FAB IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_RMS),,) ENDIF CALL COPY_LONG(SYM_VAL(I)+16,ILV_PNTR) ! XAB$L_VOLNAM_BUF IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_CHR),,) ENDIF ELSEIF(BLV_TYP.EQ.'23'X)THEN ! XAB$C_RU CALL COPY_LONG(SYM_VAL(I)+4,ILV_PNTR) ! XAB$L_NXT IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_RMS),,) ENDIF ENDIF ELSEIF((SYM_TYP(I).AND.SYM_D_FORMAT).NE.0)THEN ADDR=SYM_VAL(I) BLV_FLAGS2=0 DO WHILE (BLV_FLAGS2.NE.4) ! not end-of-format CALL COPY_BYTE(ADDR,BLV_FLAGS2) ADDR=ADDR+1 IF(BLV_FORTFLAGS(BLV_FLAGS2.AND.'7F'X).NE.0)THEN BLV_FLAGS=0 IF((BLV_FLAGS2.AND.'80'X).NE.0)THEN CALL COPY_BYTE(ADDR,BLV_FLAGS) ADDR=ADDR+1 ENDIF IF((BLV_FORTFLAGS(BLV_FLAGS2.AND.'7F'X).AND.8).NE.0)THEN IF((BLV_FLAGS.AND.'80'X).NE.0)THEN CALL COPY_LONG(ADDR,ILV_PNTR) ADDR=ADDR+4 ILV_PNTR=ILV_PNTR+ADDR CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_PROC),,) ELSE ADDR=ADDR+(BLV_FLAGS.AND.3) ENDIF ENDIF IF((BLV_FORTFLAGS(BLV_FLAGS2.AND.'7F'X).AND.4).NE.0)THEN IF((BLV_FLAGS.AND.'40'X).NE.0)THEN CALL COPY_LONG(ADDR,ILV_PNTR) ADDR=ADDR+4 ILV_PNTR=ILV_PNTR+ADDR CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_PROC),,) ELSE ILV_PNTR=0 IF((BLV_FLAGS.AND.4).EQ.0)THEN CALL COPY_BYTE(ADDR,ILV_PNTR) ADDR=ADDR+1 ELSE CALL COPY_WORD(ADDR,ILV_PNTR) ADDR=ADDR+2 ENDIF IF((BLV_FORTFLAGS(BLV_FLAGS2.AND.'7F'X).AND.16).NE.0)THEN ADDR=ADDR+ILV_PNTR ENDIF ENDIF ENDIF IF((BLV_FORTFLAGS(BLV_FLAGS2.AND.'7F'X).AND.2).NE.0)THEN IF((BLV_FLAGS.AND.'20'X).NE.0)THEN CALL COPY_LONG(ADDR,ILV_PNTR) ADDR=ADDR+4 ILV_PNTR=ILV_PNTR+ADDR CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_PROC),,) ELSE ADDR=ADDR+1 ENDIF ENDIF IF((BLV_FORTFLAGS(BLV_FLAGS2.AND.'7F'X).AND.1).NE.0)THEN IF((BLV_FLAGS.AND.'10'X).NE.0)THEN CALL COPY_LONG(ADDR,ILV_PNTR) ADDR=ADDR+4 ILV_PNTR=ILV_PNTR+ADDR CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_PROC),,) ELSE ADDR=ADDR+1 ENDIF ENDIF ENDIF ENDDO ENDIF I=I+1 ENDDO C C scan for LIB$TPARSE data structures and system service item lists C I=1 DO WHILE (I.LE.SYM_TBL_PTR) IF((SYM_TYP(I).AND.SYM_D_EXTENDED).NE.0)THEN GOTO (100,200,100,400,500,400,400,400,400,400,500,9999,9999, + 400,400,400,9999,1800), SYM_EXT_ATTR(I) C C handler for undefined extended data structures C CALL LIB$SIGNAL(DISM__UNSPDATYP,%VAL(3),%VAL(SYM_VAL(I)), + %VAL(SYM_TYP(I)),%VAL(SYM_EXT_ATTR(I))) GOTO 9999 C C handler for LIB$TPARSE state table entries C 100 ADDR=SYM_VAL(I) SYM_TYP(I)=SYM_TYP(I).OR.SYM_NOTDEF BLV_FLAGS=0 LLV_IMPLICITSTATE=.FALSE. DO WHILE ((BLV_FLAGS.AND.4).EQ.0) ADDR=ADDR+1 CALL COPY_BYTE(ADDR,BLV_FLAGS) ADDR=ADDR+1 BLV_FLAGS2=0 IF((BLV_FLAGS.AND.1).NE.0)THEN CALL COPY_BYTE(ADDR-2,BLV_TYP) NLV_PTR=ZEXT(BLV_TYP) IF(NLV_PTR.LE.219)THEN ILV_PNTR=1 DO WHILE (ILV_PNTR.LE.SYM_TBL_PTR.AND. + SYM_VAL(ILV_PNTR).NE.SYM_EXT_VAL(I)) ILV_PNTR=ILV_PNTR+1 ENDDO IF((SYM_TYP(ILV_PNTR).AND.SYM_D_EXTENDED).NE.0.AND. + SYM_EXT_ATTR(ILV_PNTR).EQ.SYM_T_KEYWRDTBL)THEN IF(NLV_PTR.GT.SYM_EXT_VAL(ILV_PNTR))THEN SYM_EXT_VAL(ILV_PNTR)=NLV_PTR ENDIF ELSE CALL LIB$SIGNAL(DISM__INVSTATBL,%VAL(4),%VAL(SYM_VAL(I)), + %VAL(SYM_VAL(ILV_PNTR)), + %VAL(SYM_TYP(ILV_PNTR)), + %VAL(SYM_EXT_ATTR(ILV_PNTR))) ENDIF ENDIF ENDIF IF((BLV_FLAGS.AND.2).NE.0)THEN CALL COPY_BYTE(ADDR,BLV_FLAGS2) ADDR=ADDR+1 ENDIF IF((BLV_FLAGS.AND.8).NE.0)THEN CALL COPY_WORD(ADDR,NLV_PTR) ADDR=ADDR+2 ILV_PNTR=ADDR+NLV_PTR CALL WRITE_SYM_TBL(%VAL(ILV_PNTR), + %VAL(SYM_D_EXTENDED+SYM_NOTDEF), + %VAL(SYM_T_STATE),%VAL(SYM_EXT_VAL(I))) ENDIF IF((BLV_FLAGS2.AND.1).NE.0) ADDR=ADDR+4 IF((BLV_FLAGS.AND.'80'X).NE.0)THEN CALL COPY_LONG(ADDR,ILV_PNTR) ADDR=ADDR+4 ILV_PNTR=ILV_PNTR+ADDR CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_PROC),,) ENDIF IF((BLV_FLAGS.AND.'40'X).NE.0)THEN CALL COPY_LONG(ADDR,ILV_PNTR) ADDR=ADDR+4 ILV_PNTR=ILV_PNTR+ADDR CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_LNG),,) ENDIF IF((BLV_FLAGS.AND.'20'X).NE.0) ADDR=ADDR+4 IF((BLV_FLAGS.AND.'10'X).EQ.0)THEN LLV_IMPLICITSTATE=.TRUE. ELSE CALL COPY_WORD(ADDR,NLV_PTR) ADDR=ADDR+2 IF(NLV_PTR.NE.-1.AND. ! TPA$_EXIT + NLV_PTR.NE.-2)THEN ! TPA$_FAIL ILV_PNTR=ADDR+NLV_PTR CALL WRITE_SYM_TBL(%VAL(ILV_PNTR), + %VAL(SYM_D_EXTENDED+SYM_NOTDEF), + %VAL(SYM_T_STATE),%VAL(SYM_EXT_VAL(I))) ENDIF ENDIF ENDDO IF(LLV_IMPLICITSTATE)THEN CALL WRITE_SYM_TBL(%VAL(ADDR),%VAL(SYM_D_EXTENDED+SYM_NOTDEF), + %VAL(SYM_T_STATE),%VAL(SYM_EXT_VAL(I))) ENDIF GOTO 9999 C C handler for LIB$TPARSE keyword table entries C 200 SYM_TYP(I)=SYM_TYP(I).OR.SYM_NOTDEF GOTO 9999 C C handler for SYS$GETDVI, SYS$GETQUI, SYS$GETSYI, SYS$SNDJBC, C SYS$CHANGE_ACL, SYS$CHECK_ACCESS/SYS$CHKPRO, SYS$GETLKI, C SYS$GETUAI/SYS$SETUAI, SYS$MOUNT item lists C 400 ADDR=SYM_VAL(I) CALL COPY_LONG(ADDR,ILV_PNTR) ADDR=ADDR+4 DO WHILE (ILV_PNTR.NE.0) CALL COPY_LONG(ADDR,ILV_PNTR) ! buffer pointer ADDR=ADDR+4 IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_BYT),,) ENDIF CALL COPY_LONG(ADDR,ILV_PNTR) ! buffer length word ADDR=ADDR+4 IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_WRD),,) ENDIF CALL COPY_LONG(ADDR,ILV_PNTR) ! next item code and buffer len ADDR=ADDR+4 ENDDO GOTO 9999 C C handler for SYS$GETJPI, SYS$CRELNM/SYS$TRNLNM item lists C 500 ADDR=SYM_VAL(I) CALL COPY_LONG(ADDR,ILV_PNTR) ADDR=ADDR+4 DO WHILE (ILV_PNTR.NE.0) IF((ILV_PNTR.AND.'FFFF'X).NE.'FFFF'X)THEN CALL COPY_LONG(ADDR,ILV_PNTR) ! buffer pointer ADDR=ADDR+4 IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_BYT),,) ENDIF CALL COPY_LONG(ADDR,ILV_PNTR) ! buffer length word ADDR=ADDR+4 IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR),%VAL(SYM_D_WRD),,) ENDIF CALL COPY_LONG(ADDR,ILV_PNTR) ! next item code and buffer len ADDR=ADDR+4 ELSE CALL COPY_LONG(ADDR,ILV_PNTR) ! buffer pointer (next itmlst) ADDR=ADDR+4 IF(ILV_PNTR.NE.0)THEN CALL WRITE_SYM_TBL(%VAL(ILV_PNTR), + %VAL(SYM_D_EXTENDED), + %VAL(SYM_EXT_ATTR(I)),) ENDIF ILV_PNTR=0 ENDIF ENDDO C C handler for CALLG argument list C 1800 IF(SYM_EXT_VAL(I).GE.%LOC(SYS$QIOW).AND. + SYM_EXT_VAL(I).LE.%LOC(SYS$QIOW)+'748'X)THEN ILV_PNTR=(SYM_EXT_VAL(I)-%LOC(SYS$QIOW))/8 ADDR=SYM_VAL(I) CALL COPY_LONG(ADDR,J) IF((ILV_SYSVECARGS(0,ILV_PNTR).LT.0.AND. + J.GE.-ILV_SYSVECARGS(0,ILV_PNTR)).OR. + (ILV_SYSVECARGS(0,ILV_PNTR).GT.0.AND. + J.EQ.ILV_SYSVECARGS(0,ILV_PNTR)))THEN DO K=1,MIN(IABS(ILV_SYSVECARGS(0,ILV_PNTR)),J) ADDR=ADDR+4 CALL COPY_LONG(ADDR,K2) IF(K2.NE.0)THEN IF(ILV_SYSVECARGS(K,ILV_PNTR).GT.0)THEN CALL WRITE_SYM_TBL(%VAL(K2), + %VAL(ILV_SYSVECARGS(K,ILV_PNTR)), + ,) ELSEIF(ILV_SYSVECARGS(K,ILV_PNTR).LT.0)THEN CALL WRITE_SYM_TBL(%VAL(K2), + %VAL(SYM_D_EXTENDED), + %VAL(-ILV_SYSVECARGS(K,ILV_PNTR)),) ENDIF ENDIF ENDDO ENDIF ENDIF 9999 CONTINUE ENDIF I=I+1 ENDDO CALL LIB$REVERT C C return to caller C RETURN C END SUBROUTINE EXTENDED_DATA_SYMNAM(IND,S_ADDR) C IMPLICIT NONE C CHARACTER*8 S_ADDR INTEGER*4 IND C INCLUDE 'DISMSYMTBL.INC' C EXTERNAL DISM__UNSPDATYP C IF(SYM_EXT_ATTR(IND).EQ.SYM_T_STATETBL)THEN SYM_NAM(IND)='STATETBL_'//S_ADDR ELSEIF(SYM_EXT_ATTR(IND).EQ.SYM_T_KEYWRDTBL)THEN SYM_NAM(IND)='KEYWRDTBL_'//S_ADDR ELSEIF(SYM_EXT_ATTR(IND).EQ.SYM_T_STATE)THEN SYM_NAM(IND)='STATE_'//S_ADDR ELSEIF(SYM_EXT_ATTR(IND).EQ.SYM_T_ITMLSTDVI)THEN SYM_NAM(IND)='ITMLST_DVI_'//S_ADDR ELSEIF(SYM_EXT_ATTR(IND).EQ.SYM_T_ITMLSTJPI)THEN SYM_NAM(IND)='ITMLST_JPI_'//S_ADDR ELSEIF(SYM_EXT_ATTR(IND).EQ.SYM_T_ITMLSTQUI)THEN SYM_NAM(IND)='ITMLST_QUI_'//S_ADDR ELSEIF(SYM_EXT_ATTR(IND).EQ.SYM_T_ITMLSTSYI)THEN SYM_NAM(IND)='ITMLST_SYI_'//S_ADDR ELSEIF(SYM_EXT_ATTR(IND).EQ.SYM_T_ITMLSTSJC)THEN SYM_NAM(IND)='ITMLST_SJC_'//S_ADDR ELSEIF(SYM_EXT_ATTR(IND).EQ.SYM_T_ITMLSTCACL)THEN SYM_NAM(IND)='ITMLST_ACL_'//S_ADDR ELSEIF(SYM_EXT_ATTR(IND).EQ.SYM_T_ITMLSTCHKA)THEN SYM_NAM(IND)='ITMLST_CHP_'//S_ADDR ELSEIF(SYM_EXT_ATTR(IND).EQ.SYM_T_ITMLSTLNM)THEN SYM_NAM(IND)='ITMLST_LNM_'//S_ADDR ELSEIF(SYM_EXT_ATTR(IND).EQ.SYM_T_QUOLST)THEN SYM_NAM(IND)='QUOLST_'//S_ADDR ELSEIF(SYM_EXT_ATTR(IND).EQ.SYM_T_ITMLSTFLSCN)THEN SYM_NAM(IND)='ITMLST_FLSCN_'//S_ADDR ELSEIF(SYM_EXT_ATTR(IND).EQ.SYM_T_ITMLSTLKI)THEN SYM_NAM(IND)='ITMLST_LKI_'//S_ADDR ELSEIF(SYM_EXT_ATTR(IND).EQ.SYM_T_ITMLSTUAI)THEN SYM_NAM(IND)='ITMLST_UAI_'//S_ADDR ELSEIF(SYM_EXT_ATTR(IND).EQ.SYM_T_ITMLSTMNT)THEN SYM_NAM(IND)='ITMLST_MNT_'//S_ADDR ELSEIF(SYM_EXT_ATTR(IND).EQ.SYM_T_BASARGLST)THEN SYM_NAM(IND)='barg_'//S_ADDR ELSEIF(SYM_EXT_ATTR(IND).EQ.SYM_T_ARGLST)THEN SYM_NAM(IND)='ARGLST_'//S_ADDR ELSE CALL LIB$SIGNAL(DISM__UNSPDATYP,%VAL(3),%VAL(SYM_VAL(IND)), + %VAL(SYM_TYP(IND)),%VAL(SYM_EXT_ATTR(IND))) ENDIF C RETURN C END SUBROUTINE EXTENDED_DATA_PASS2(ADDR,IND) C IMPLICIT NONE C INTEGER*4 ADDR, IND C INCLUDE 'DISMSYMTBL.INC' C BYTE TAB/9/, BLV_FLAGS, BLV_FLAGS2, BLV_TYP, + BLV_SCRATCH CHARACTER*8 TPA_TYPE(234:247), SYI3_TYPE(1) CHARACTER*9 PQL_TYPE(15), FSCN_TYPE(8), LKI_TYPE(0:9,2) CHARACTER*10 ACL_TYPE(1:12), CHP_TYPE(0:19), LNM_TYPE(-1:9) CHARACTER*12 JPI_TYPE(0:37,6) CHARACTER*13 MNT_TYPE(29) CHARACTER*15 SYI1_TYPE(0:'102'X) CHARACTER*16 UAI_TYPE(71) CHARACTER*18 SYI2_TYPE(0:'2A'X) CHARACTER*20 DVI_TYPE(147) CHARACTER*21 QUI_TYPE(94) CHARACTER*24 SJC_TYPE(171) CHARACTER*128 CLV_LINE INTEGER*2 LN, LN2, NLV_PTR INTEGER*4 I, ILV_PNTR, ILV_ARG, ILV_ACTION, ILV_MASK, ILV_MSKADR DATA TPA_TYPE/'FILESPEC','UIC','IDENT','ANY','ALPHA','DIGIT', + 'STRING','SYMBOL','BLANK','DECIMAL','OCTAL','HEX', + 'LAMBDA','EOS'/ DATA DVI_TYPE/'DEVCHAR','DEVCLASS','DEVTYPE','DEVBUFSIZ', + 'DEVDEPEND','UNIT','PID','OWNUIC','VPROT','ERRCNT','OPCNT', + 'RECSIZ','MAXBLOCK','DEVDEPEND2','REFCNT','DEVNAM','VOLNAM', + 'SECTORS','TRACKS','CYLINDERS','FREEBLOCKS','LOGVOLNAM', + 'VOLNUMBER','VOLCOUNT','ROOTDEVNAM','NEXTDEVNAM', + 'TRANSCNT','MOUNTCNT','CLUSTER','MAXFILES','SERIALNUM', + 'ACPPID','ACPTYPE','CONCEALED','REC','CCL','TRM','DIR', + 'SDI','SQD','SPL','OPR','RCT','NET','FOD','DUA','SHR', + 'GEN','AVL','MNT','MBX','DMT','ELG','ALL','FOR','SWL', + 'IDV','ODV','RND','RTM','RCK','WCK','TT_PASSALL', + 'TT_NOECHO','TT_NOTYPEAHD','TT_ESCAPE','TT_HOSTSYNC', + 'TT_TTSYNC','TT_SCRIPT','TT_LOWER','TT_MECHTAB', + 'TT_WRAP','TT_CRFILL','TT_LFFILL','TT_SCOPE', + 'TT_REMOTE','TT_EIGHTBIT','TT_MBXDSABL','TT_NOBRDCST', + 'TT_READSYNC','TT_MECHFORM','TT_HALFDUP','TT_MODEM', + 'TT_OPER','TT_PAGE','TT_LOCALECHO','TT_AUTOBAUD', + 'TT_HANGUP','TT_MODHANGUP','TT_BRDCSTMBX','TT_DMA', + 'TT_ALTYPEAHD','TT_SETSPEED','TT_DCL_MAILBX', + 'TT_EDITING','TT_INSERT','TT_FALLBACK','TT_DIALUP', + 'TT_SECURE','TT_DISCONNECT','TT_PASTHRU','TT_SIXEL', + 'TT_DRCS','TT_PRINTER','TT_APP_KEYPAD','TT_SYSPWD', + 'TT_ANSICRT','TT_REGIS','TT_BLOCK','TT_AVO','TT_EDIT', + 'TT_DECCRT','STS','DEVSTS','DEVCHAR2','FULLDEVNAM', + 'LOCKID','ALLDEVNAM','VOLSETNAM','DEVLOCKNAM', + 'ALLOCLASS','ALT_HOST_AVAIL','ALT_HOST_NAME', + 'ALT_HOST_TYPE','HOST_AVAIL','HOST_COUNT','HOST_NAME', + 'HOST_TYPE','REMOTE_DEVICE','SERVED_DEVICE', + 'SHDW_CATCHUP_COPYING','SHDW_MASTER', + 'SHDW_MASTER_NAME','SHDW_MEMBER','SHDW_MERGE_COPYING', + 'SHDW_NEXT_MBR_NAME','TT_PHYDEVNAM','TT_DECCRT2', + 'MEDIA_NAME','MEDIA_TYPE','MEDIA_ID', + 'SHDW_FAILED_MEMBER','SHDW_spare_bit_2', + 'SHDW_spare_string_1','SHDW_spare_string_2', + 'SHDW_spare_integer_1','SHDW_spare_integer_2'/ DATA (JPI_TYPE(I,1),I=0,1)/'EXCVEC','FINALEXC'/, + (JPI_TYPE(I,2),I=0,16)/'VIRTPEAK','WSPEAK','USERNAME', + 'ACCOUNT','PROCPRIV','VOLUMES','LOGINTIM','IMAGNAME', + 'SITESPEC','MSGMASK','CLINAME','TABLENAME', + 'CREPRC_FLAGS','UAF_FLAGS','MAXDETACH','MAXJOBS', + 'SHRFILLM'/, + (JPI_TYPE(I,3),I=0,37)/'ASTACT','ASTEN','PRI','OWNER','UIC', + 'STS','STATE','MEM','GRP','PRIB','APTCNT','TMBU', + 'GPGCNT','PPGCNT','ASTCNT','BIOCNT','BIOLM', + 'BYTCNT','DIOCNT','DIOLM','FILCNT','TQCNT','EFWM', + 'EFCS','EFCU','PID','BYTLM','PRCCNT','PRCNAM', + 'TERMINAL','JOBPRCCNT','ENQCNT','ENQLM','SWPFILLOC', + 'MODE','JOBTYPE','PROC_INDEX','MASTER_PID'/, + (JPI_TYPE(I,4),I=0,27)/'CURPRIV','WSAUTH','WSQUOTA','DFWSCNT', + 'FREP0VA','FREP1VA','DFPFC','CPUTIM','PRCLM', + 'ASTLM','PAGEFLTS','DIRIO','BUFIO','CPULIM', + 'PGFLQUOTA','FILLM','TQLM','WSSIZE','AUTHPRIV', + 'IMAGPRIV','PAGFILCNT','FREPTECNT','WSEXTENT', + 'WSAUTHEXT','AUTHPRI','PAGFILLOC','IMAGECOUNT', + 'PHDFLAGS'/ DATA QUI_TYPE/'ACCOUNT_NAME','AFTER_TIME','ASSIGNED_QUEUE_NAME', + 'BASE_PRIORITY','CHARACTERISTIC_NAME', + 'CHARACTERISTIC_NUMBER','CHARACTERISTICS', + 'CHECKPOINT_DATA','CLI','COMPLETED_BLOCKS', + 'CONDITION_VECTOR','CPU_DEFAULT','CPU_LIMIT', + 'DEVICE_NAME','ENTRY_NUMBER','FILE_COPIES', + 'FILE_COPIES_CHKPT','FILE_COPIES_DONE','FILE_FLAGS', + 'FILE_SETUP_MODULES','FILE_SPECIFICATION', + 'FILE_STATUS','FIRST_PAGE','FORM_DESCRIPTION', + 'FORM_FLAGS','FORM_LENGTH','FORM_MARGIN_BOTTOM', + 'FORM_MARGIN_LEFT','FORM_MARGIN_RIGHT', + 'FORM_MARGIN_TOP','FORM_NAME','FORM_NUMBER', + 'FORM_SETUP_MODULES','FORM_STOCK','FORM_WIDTH', + 'GENERIC_TARGET','INTERVENING_BLOCKS', + 'INTERVENING_JOBS','JOB_COPIES','JOB_COPIES_CHKPT', + 'JOB_COPIES_DONE','JOB_FLAGS','JOB_LIMIT','JOB_NAME', + 'JOB_RESET_MODULES','JOB_SIZE','JOB_SIZE_MAXIMUM', + 'JOB_SIZE_MINIMUM','JOB_STATUS','LAST_PAGE', + 'LIBRARY_SPECIFICATION','LOG_QUEUE','LOG_SPECIFICATION', + 'NOTE','OPERATOR_REQUEST','OWNER_UIC', + 'PAGE_SETUP_MODULES','PARAMETER_1','PARAMETER_2', + 'PARAMETER_3','PARAMETER_4','PARAMETER_5', + 'PARAMETER_6','PARAMETER_7','PARAMETER_8','PRIORITY', + 'PROCESSOR','PROTECTION','QUEUE_FLAGS','QUEUE_NAME', + 'QUEUE_STATUS','REFUSAL_REASON','REQUEUE_PRIORITY', + 'REQUEUE_QUEUE_NAME','SCSNODE_NAME','SEARCH_FLAGS', + 'SEARCH_NAME','SEARCH_NUMBER','SUBMISSION_TIME','UIC', + 'USERNAME','WSDEFAULT','WSEXTENT','WSQUOTA', + 'RESERVED_BOOLEAN_1','RESERVED_BOOLEAN_2', + 'RESERVED_INPUT_1','RESERVED_INPUT_2', + 'DEFAULT_FORM_NAME','DEFAULT_FORM_NUMBER', + 'DEFAULT_FORM_STOCK','JOB_PID','RESERVED_OUTPUT_5', + 'RESERVED_OUTPUT_6'/ DATA SYI1_TYPE/'VERSION','SID','PFCDEFAULT','PAGTBLPFC','SYSPFC', + 'KFILSTCNT','GBLSECTIONS','GBLPAGES','GBLPAGFIL','MAXPROCESSCNT', + 'PIXSCAN','PROCSECTCNT','MINWSCNT','PAGFILCNT','SWPFILCNT', + 'SYSMWCNT','INTSTKPAGES','DLCKEXTRASTK','BALSETCNT','IRPCOUNT', + 'IRPCOUNTV','WSMAX','NPAGEDYN','NPAGEVIR','PAGEDYN', + 'VIRTUALPAGECNT','SPTREQ','EXUSRSTK','LRPCOUNT','LRPCOUNTV', + 'LRPSIZE','LRPMIN','SRPCOUNT','SRPCOUNTV','SRPSIZE', + 'SRPMIN','CHANNELCNT','PIOPAGES','CTLPAGES','CTLIMGLIM', + 'IMGIOCNT','QUANTUM','MPW_WRTCLUSTER','MPW_HILIMIT', + 'MPW_LOLIMIT', + 'MPW_PRIO','SWP_PRIO','MPW_THRESH','MPW_WAITLIMIT','TBSKIPWSL', + 'PHYSICALPAGES','PFRATL','PFRATH','PFRATS','WSINC', + 'WSDEC','AWSMIN','AWSTIME','SWPRATE','SWPOUTPGCNT', + 'SWPALLOCINC','IOTA','LONGWAIT','SWPFAIL','VMSD1', + 'VMSD2','VMSD3','VMSD4','VMS5','VMS6', + 'VMS7','VMS8','USERD1','USERD2','USER3', + 'USER4','EXTRACPU','MAXSYSGROUP','MVTIMEOUT','MAXBUF', + 'DEFMBXBUFQUO','DEFMBXMXMSG','DEFMBXNUMMSG','FREELIM','FREEGOAL', + 'GROWLIM','BORROWLIM','LOCKRETRY','XFMAXRATE','LAMAPREGS', + 'REALTIME_SPTS','CLISYMTBL','LOCKIDTBL','RESHASHTBL', + 'DEADLOCK_WAIT', + 'SCSBUFFCNT','SCSCONNCNT','SCSRESPCNT','SCSMAXDG','SCSMAXMSG', + 'SCSFLOWCUSH','SCSSYSTEMID','SCSSYSTEMIDH','SCSNODE','SCSNODEH', + 'PRCPOLINTERVAL','PASTIMOUT','PASTDGBUF','PANUMPOLL', + 'PAPOLLINTERVAL', + 'PAPOOLINTERVAL','TIMEPROMPTWAIT','UDABURSTRATE','LNMSHASHTBL', + 'LNMPHASHTBL', + 'TTY_SCANDELTA','TTY_DIALTYPE','TTY_SPEED','TTY_RSPEED', + 'TTY_PARITY', + 'TTY_BUF','TTY_DEFCHAR','TTY_DEFCHAR2','TTY_TYPAHDSZ', + 'TTY_ALTYPAHD','TTY_ALTALARM','TTY_DMASIZE','TTY_PROT', + 'TTY_OWNER','TTY_CLASSNAME', + 'TTY_SILOTIME','TTY_DEFPORT','RMS_DFMBC','RMS_DFMBFSDK', + 'RMS_DFMBFSMT', + 'RMS_DFMBFSUR','RMS_DFMBFREL','RMS_DFMBFIDX','RMS_DFMBFHSH', + 'RMS_PROLOGUE','RMS_EXTEND_SIZE','RMS_FILEPROT','PQL_DASTLM', + 'PQL_MASTLM','PQL_DBIOLM','PQL_MBIOLM','PQL_DBYTLM', + 'PQL_MBYTLM','PQL_DCPULM','PQL_MCPULM','PQL_DDIOLM', + 'PQL_MDIOLM','PQL_DFILLM','PQL_MFILLM','PQL_DPGFLQUOTA', + 'PQL_MPGFLQUOTA','PQL_DPRCLM','PQL_MPRCLM','PQL_DTQELM', + 'PQL_MTQELM','PQL_DWSDEFAULT','PQL_MWSDEFAULT', + 'PQL_DWSQUOTA','PQL_MWSQUOTA','PQL_DWSEXTENT','PQL_MWSEXTENT', + 'PQL_DENQLM','PQL_MENQLM','ACP_MAPCACHE','ACP_HDRCACHE', + 'ACP_DIRCACHE','ACP_WORKSET','ACP_FIDCACHE','ACP_EXTCACHE', + 'ACP_EXTLIMIT','ACP_QUOCACHE','ACP_SYSACC','ACP_MAXREAD', + 'ACP_WINDOW','ACP_WRITEBACK', + 'ACP_DATACHECK','ACP_BASEPRIO','ACP_SWAPFLGS','DEFPRI','IJOBLIM', + 'BJOBLIM','NJOBLIM','RJOBLIM','QUORUM','VOTES','RECNXINTERVAL', + 'BOOTTIME','LOCKIDTBL_MAX','TAILORED','STARTUP_P1', + 'STARTUP_P2','STARTUP_P3','STARTUP_P4','STARTUP_P5','STARTUP_P6', + 'STARTUP_P7','STARTUP_P8','CLUSTER_NODES','CLUSTER_VOTES', + 'CLUSTER_QUORUM','CLUSTER_FSYSID','CLUSTER_FTIME', + 'CLUSTER_MEMBER','NODE_CSID','NODE_VOTES','NODE_QUORUM', + 'NODE_SYSTEMID','NODE_SWINCARN','NODE_SWTYPE','NODE_SWVERS', + 'NODE_HWTYPE','NODE_HWVERS','NODENAME','ARCHFLAG','SCS_EXISTS', + 'DISK_QUORUM','XSID','DISK_QUORUM2','DISK_QUORUM3','PAMAXPORT', + 'PASANITY','DEFQUEPRI','MAXQUEPRI','QDSKINTERVAL','ALLOCLASS', + 'LGI_RETRY_LIM','LGI_RETRY_TMO','LGI_BRK_LIM','LGI_BRK_TMO', + 'LGI_HID_TIM','LGI_PWD_TMO','PQL_DJTQUOTA','PQL_MJTQUOTA', + 'VAXCLUSTER','LOCKDIRWT', + 'QDSKVOTES','DORMANTWAIT','PAGEFILE_PAGE','SWAPFILE_PAGE', + 'PAGEFILE_FREE', + 'SWAPFILE_FREE','TTY_TIMEOUT','TTY_AUTOCHAR','PANOPOLL','PE1', + 'PE2','PE3','PE4','PE5','PE6','RMS_GBLBUFQUO','RMS_DFNBC', + 'ACP_DINDXCACHE','MAXATTACHPRI'/ DATA SYI2_TYPE/'CPU','BUGREBOOT','CRDENABLE','DUMPBUG', + 'BUGCHECKFATAL', + 'ACP_MULTIPLE','NOAUTOCONFIG','NOCLOCK','NOCLUSTER','POOLPAGING', + 'SBIERRENABLE','SETTIME','ACP_SHARE','SYSPAGING','UAFALTERNATE', + 'WRITABLESYS','RESALLOC','SSINHIBIT','CONCEAL_DEVICES', + 'SAVEDUMP', + 'MOUNTMSG','DISMOUMSG','LOADERAPT','LOADCHKPRT','XCPU', + 'CJFLOAD','CJFSYSRUJ','NODE_AREA','NODE_NUMBER','CLASS_PROT', + 'CHARACTER_EMULATED','DECIMAL_EMULATED','D_FLOAT_EMULATED', + 'F_FLOAT_EMULATED','G_FLOAT_EMULATED', + 'H_FLOAT_EMULATED','LOADMTACCESS','ACP_XQP_RES','WRITESYSPARAMS', + 'LGI_BRK_TERM', + 'LGI_BRK_DISUSER','ACP_REBLDSYSD','WS_OPA0'/ DATA SJC_TYPE/'ACCOUNTING_MESSAGE','ACCOUNTING_TYPES', + 'AFTER_TIME','NO_AFTER_TIME', + 'ALIGNMENT_MASK','ALIGNMENT_PAGES','BASE_PRIORITY','BATCH', + 'NO_BATCH','BATCH_INPUT','BATCH_OUTPUT','CHARACTERISTIC_NAME', + 'CHARACTERISTIC_NUMBER','NO_CHARACTERISTICS','CHECKPOINT_DATA', + 'NO_CHECKPOINT_DATA', + 'CLI','NO_CLI','CPU_DEFAULT','NO_CPU_DEFAULT','CPU_LIMIT', + 'NO_CPU_LIMIT','CREATE_START','DELETE_FILE','NO_DELETE_FILE', + 'DESTINATION_QUEUE','DEVICE_NAME','DOUBLE_SPACE', + 'NO_DOUBLE_SPACE','ENTRY_NUMBER','ENTRY_NUMBER_OUTPUT', + 'FILE_BURST', + 'FILE_BURST_ONE','NO_FILE_BURST','FILE_COPIES','FILE_FLAG', + 'FILE_FLAG_ONE','NO_FILE_FLAG','FILE_IDENTIFICATION', + 'FILE_SETUP_MODULES', + 'NO_FILE_SETUP_MODULES','FILE_SPECIFICATION','FILE_TRAILER', + 'FILE_TRAILER_ONE','NO_FILE_TRAILER','FIRST_PAGE', + 'NO_FIRST_PAGE','FORM_DESCRIPTION','FORM_LENGTH', + 'FORM_MARGIN_BOTTOM','FORM_MARGIN_LEFT','FORM_MARGIN_RIGHT', + 'FORM_MARGIN_TOP','FORM_NAME','FORM_NUMBER','FORM_SETUP_MODULES', + 'NO_FORM_SETUP_MODULES','FORM_SHEET_FEED','NO_FORM_SHEET_FEED', + 'FORM_STOCK','FORM_TRUNCATE','NO_FORM_TRUNCATE', + 'FORM_WIDTH','FORM_WRAP','NO_FORM_WRAP','GENERIC_QUEUE', + 'NO_GENERIC_QUEUE','GENERIC_SELECTION', + 'NO_GENERIC_SELECTION','GENERIC_TARGET','HOLD','NO_HOLD', + 'JOB_BURST','NO_JOB_BURST','JOB_COPIES','JOB_FLAG', + 'NO_JOB_FLAG','JOB_LIMIT','JOB_NAME','JOB_RESET_MODULES', + 'NO_JOB_RESET_MODULES','JOB_SIZE_MAXIMUM','NO_JOB_SIZE_MAXIMUM', + 'JOB_SIZE_MINIMUM', + 'NO_JOB_SIZE_MINIMUM','JOB_SIZE_SCHEDULING', + 'NO_JOB_SIZE_SCHEDULING','JOB_STATUS_OUTPUT', + 'JOB_TRAILER','NO_JOB_TRAILER','LAST_PAGE','NO_LAST_PAGE', + 'LIBRARY_SPECIFICATION','NO_LIBRARY_SPECIFICATION','LOG_DELETE', + 'NO_LOG_DELETE','LOG_QUEUE', + 'LOG_SPECIFICATION','NO_LOG_SPECIFICATION','LOG_SPOOL', + 'NO_LOG_SPOOL','LOWERCASE','NO_LOWERCASE','NEW_VERSION', + 'NEXT_JOB','NOTE','NO_NOTE','NOTIFY','NO_NOTIFY', + 'OPERATOR_REQUEST','NO_OPERATOR_REQUEST','OWNER_UIC', + 'PAGE_HEADER','NO_PAGE_HEADER','PAGE_SETUP_MODULES', + 'NO_PAGE_SETUP_MODULES', + 'PAGINATE','NO_PAGINATE','PARAMETER_1','PARAMETER_2', + 'PARAMETER_3','PARAMETER_4','PARAMETER_5','PARAMETER_6', + 'PARAMETER_7','PARAMETER_8','NO_PARAMETERS','PASSALL', + 'NO_PASSALL','PRIORITY','PROCESSOR','NO_PROCESSOR', + 'PROTECTION','QUEUE','QUEUE_FILE_SPECIFICATION','RELATIVE_PAGE', + 'REQUEUE','RESTART','NO_RESTART','RETAIN_ALL_JOBS', + 'RETAIN_ERROR_JOBS','NO_RETAIN_JOBS','SCSNODE_NAME', + 'SEARCH_STRING','SWAP','NO_SWAP','TERMINAL','NO_TERMINAL', + 'TOP_OF_FILE','USER_IDENTIFICATION','WSDEFAULT','NO_WSDEFAULT', + 'WSEXTENT','NO_WSEXTENT','WSQUOTA','NO_WSQUOTA', + 'ACCOUNT_NAME','UIC','USERNAME','BUFFER_COUNT', + 'EXTEND_QUANTITY','RECORD_BLOCKING','NO_RECORD_BLOCKING', + 'QUEMAN_RESTART', + 'NO_QUEMAN_RESTART','DEFAULT_FORM_NAME','DEFAULT_FORM_NUMBER', + 'RESERVED_INPUT_3', + 'RESERVED_INPUT_4','RESERVED_OUTPUT_1','RESERVED_OUTPUT_2'/ DATA ACL_TYPE/'ADDACLENT','DELACLENT','MODACLENT','FNDACLENT', + 'FNDACETYP','DELETEACL','READACL','ACLLENGTH', + 'READACE','RLOCK_ACL','WLOCK_ACL','UNLOCK_ACL'/ DATA CHP_TYPE/'END','ACCESS','FLAGS','PRIV','ACMODE','ACCLASS', + 'RIGHTS','ADDRIGHTS','MODE','MODES','MINCLASS', + 'MAXCLASS','OWNER','PROT','ACL','AUDITNAME', + 'ALARMNAME','MATCHEDACE','PRIVUSED','MAX_CODE'/ DATA LNM_TYPE/'CHAIN','END','INDEX','STRING','ATTRIBUTES','TABLE', + 'LENGTH','ACMODE','MAX_INDEX','PARENT','LNMB_ADDR'/ DATA PQL_TYPE/'ASTLM','BIOLM','BYTLM','CPULM','DIOLM','FILLM', + 'PGFLQUOTA','PRCLM','TQELM','WSQUOTA','WSDEFAULT', + 'ENQLM','WSEXTENT','JTQUOTA','LENGTH'/ DATA FSCN_TYPE/'FILESPEC','NODE','DEVICE','ROOT','DIRECTORY', + 'NAME','TYPE','VERSION'/ DATA (LKI_TYPE(I,1),I=0,6)/'PID','STATE','PARENT','LCKREFCNT', + 'LOCKID','REMLKID','LASTLKB'/ DATA (LKI_TYPE(I,2),I=0,9)/'NAMSPACE','RESNAM','RSBREFCNT', + 'VALBLK','SYSTEM','LCKCOUNT','BLOCKEDBY','BLOCKING', + 'LOCKS','LASTRSB'/ DATA UAI_TYPE/'RTYPE','VERSION','USRDATOFF','USERNAME', + 'USERNAME_TAG','UIC','MEM','GRP','SUB_ID','PARENT_ID','ACCOUNT', + 'OWNER','DEFDEV','DEFDIR','LGICMD','DEFCLI','CLITABLES','PWD', + 'PWD2','LOGFAILS','SALT','ENCRYPT','ENCRYPT2','PWD_LENGTH', + 'EXPIRATION','PWD_LIFETIME','PWD_DATE','PWD2_DATE', + 'LASTLOGIN_I','LASTLOGIN_N','PRIV','DEFPRIV','MIN_CLASS', + 'MAX_CLASS','FLAGS','NETWORK_ACCESS_P','NETWORK_ACCESS_S', + 'BATCH_ACCESS_P','BATCH_ACCESS_S','LOCAL_ACCESS_P', + 'LOCAL_ACCESS_S','DIALUP_ACCESS_P','DIALUP_ACCESS_S', + 'REMOTE_ACCESS_P','REMOTE_ACCESS_S','PRIMEDAYS','PRI','QUEPRI', + 'MAXJOBS','MAXACCTJOBS','MAXDETACH','PRCCNT','BIOLM','DIOLM', + 'TQCNT','ASTLM','ENQLM','FILLM','SHRFILLM','WSQUOTA','DFWSCNT', + 'WSEXTENT','PGFLQUOTA','CPUTIM','BYTLM','PBYTLM','JTQUOTA', + 'PROXY_LIM','PROXIES','ACCOUNT_LIM','ACCOUNTS'/ DATA MNT_TYPE/'DEVNAM','VOLNAM','LOGNAM','FLAGS','ACCESSED', + 'PROCESSOR','VOLSET','BLOCKSIZE','DENSITY','EXTENT','FILEID', + 'LIMIT','OWNER','VPROT','QUOTA','RECORDSIZ','WINDOW', + 'EXTENSION','VISUAL_ID','COMMENT','unused1','unused2','unused3', + 'SHACOPY_BUF','SHANAM','SHAMEM','SHAMEM_MGCOPY','SHAMEM_COPY', + 'PRFD_PATH'/ CHARACTER*12 PROC_TYP(7) DATA PROC_TYP/'main program','subprogram','ext. function', + 'DEF function','GOSUB frame','cond handler','IOL frame'/ C STRUCTURE /BASIC/ UNION MAP BYTE ARGLIST(0:71) END MAP MAP INTEGER*4 LEN BYTE VERSION BYTE PROC_TYP INTEGER*2 FLAGS INTEGER*4 OFS_NAME BYTE PACKED_SCALEF BYTE DFL_SCALEF BYTE UNK_14 BYTE UNK_15 INTEGER*4 NUM_NSCALARS INTEGER*4 NUM_FARG INTEGER*4 NUM_BYT_DESCR ! +24 INTEGER*4 OFS_BYT_DESCR INTEGER*4 NUM_MOD_DESCR INTEGER*4 OFS_MOD_DESCR INTEGER*2 NUM_DYN_DESCR INTEGER*2 NUM_FIX_STRTMP INTEGER*4 NUM_BYT_ARRAY INTEGER*4 NUM_STMP_DESCR INTEGER*4 NUM_BYT_NTMP INTEGER*4 PTR_BGN_DATA ! +56 INTEGER*4 PTR_END_DATA INTEGER*4 LEN_RTA_DESCR INTEGER*4 V1_FILL END MAP END UNION END STRUCTURE RECORD /BASIC/ BASIC C INTEGER*4 FIND_P2_SYMBOL EXTERNAL FIND_P2_SYMBOL EXTERNAL DISM__UNSPDATYP, DISM__INVSTATBL, + DISM__INCITMLST C C dispatch to the appropriate handler C GOTO (1000,2000,3000,4000,5000,6000,7000,8000,9000,10000,11000, + 12000,13000,14000,15000,16000,17000,18000), SYM_EXT_ATTR(IND) C C invalid extended data type handler C CALL LIB$SIGNAL(DISM__UNSPDATYP,%VAL(3),%VAL(SYM_VAL(IND)), + %VAL(SYM_TYP(IND)),%VAL(SYM_EXT_ATTR(IND))) GOTO 9999 C C LIB$TPARSE state table handler C 1000 I=FIND_P2_SYMBOL(%VAL(SYM_EXT_VAL(IND))) IF(I.LE.0)THEN CALL LIB$SIGNAL(DISM__INVSTATBL,%VAL(4),%VAL(SYM_VAL(IND)), + %VAL(SYM_VAL(IABS(I))), + %VAL(SYM_TYP(IABS(I))), + %VAL(SYM_EXT_ATTR(IABS(I)))) ENDIF CALL STR$TRIM(SYM_NAM(IND),SYM_NAM(IND),LN) CALL STR$TRIM(SYM_NAM(I),SYM_NAM(I),LN2) WRITE(2,91000) TAB, TAB, SYM_NAM(IND)(1:LN), SYM_NAM(I)(1:LN2), TAB 91000 FORMAT(';'/ + A1,'$INIT_STATE',A1,A,',',A// + A1,'$STATE') GOTO 3010 C C LIB$TPARSE keyword table handler C 2000 CALL STR$TRIM(SYM_NAM(IND),SYM_NAM(IND),LN) ADDR=SYM_VAL(IND)+2*SYM_EXT_VAL(IND) CALL COPY_WORD(ADDR,NLV_PTR) ADDR=SYM_VAL(IND)+NLV_PTR BLV_TYP=0 DO WHILE (BLV_TYP.NE.'FF'X) CALL COPY_BYTE(ADDR,BLV_TYP) ADDR=ADDR+1 ENDDO CALL COPY_BYTE(ADDR,BLV_TYP) IF(BLV_TYP.EQ.'FF'X)THEN ADDR=ADDR+1 ENDIF WRITE(2,92000) SYM_NAM(IND)(1:LN), SYM_EXT_VAL(IND), SYM_VAL(IND), + ADDR 92000 FORMAT(';'/ + '; keyword table ''',A,''', contains',I4,' keywords'/ + '; spans address range ^X',Z8.8,' to ^X',Z8.8) GOTO 9999 C C LIB$TPARSE state table entry handler C 3000 CALL STR$TRIM(SYM_NAM(IND),SYM_NAM(IND),LN) WRITE(2,93000) TAB, TAB, SYM_NAM(IND)(1:LN) 93000 FORMAT(/A1,'$STATE',A1,A) 3010 BLV_FLAGS=0 DO WHILE ((BLV_FLAGS.AND.4).EQ.0) CLV_LINE=CHAR(9)//'$TRAN'//CHAR(9) LN=7 CALL COPY_BYTE(ADDR,BLV_TYP) ADDR=ADDR+1 CALL COPY_BYTE(ADDR,BLV_FLAGS) ADDR=ADDR+1 BLV_FLAGS2=0 IF((BLV_FLAGS.AND.2).NE.0)THEN CALL COPY_BYTE(ADDR,BLV_FLAGS2) ADDR=ADDR+1 ENDIF NLV_PTR=ZEXT(BLV_TYP) IF((BLV_FLAGS.AND.1).NE.0)THEN IF(NLV_PTR.LE.219)THEN I=FIND_P2_SYMBOL(%VAL(SYM_EXT_VAL(IND))) IF(I.LE.0)THEN CALL LIB$SIGNAL(DISM__INVSTATBL,%VAL(4),%VAL(SYM_VAL(IND)), + %VAL(SYM_VAL(IABS(I))),%VAL(SYM_TYP(IABS(I))), + %VAL(SYM_EXT_ATTR(IABS(I)))) ENDIF IF((SYM_TYP(I).AND.SYM_D_EXTENDED).NE.0.AND. + SYM_EXT_ATTR(I).EQ.SYM_T_KEYWRDTBL)THEN ILV_PNTR=SYM_VAL(I)+2*NLV_PTR CALL COPY_WORD(ILV_PNTR,NLV_PTR) ILV_PNTR=SYM_VAL(I)+NLV_PTR LN2=0 CLV_LINE(8:8)='''' LN=8 BLV_SCRATCH=0 DO WHILE (BLV_SCRATCH.NE.'FF'X) CALL COPY_BYTE(ILV_PNTR,BLV_SCRATCH) ILV_PNTR=ILV_PNTR+1 IF(BLV_SCRATCH.NE.'FF'X)THEN LN=LN+1 LN2=LN2+1 CLV_LINE(LN:LN)=CHAR(BLV_SCRATCH) ENDIF ENDDO IF(LN2.EQ.1)THEN LN=LN+1 CLV_LINE(LN:LN)='*' ENDIF LN=LN+1 CLV_LINE(LN:LN)='''' ELSE CALL LIB$SIGNAL(DISM__INVSTATBL,%VAL(4),%VAL(SYM_VAL(IND)), + %VAL(SYM_VAL(IABS(I))), + %VAL(SYM_TYP(IABS(I))), + %VAL(SYM_EXT_ATTR(IABS(I)))) ENDIF ELSEIF(NLV_PTR.GE.234.AND. + NLV_PTR.LE.247)THEN CLV_LINE(8:)='TPA$_'//TPA_TYPE(NLV_PTR) CALL STR$TRIM(CLV_LINE,CLV_LINE,LN) ELSEIF(NLV_PTR.EQ.248)THEN IF((BLV_FLAGS.AND.8).NE.0)THEN CALL COPY_WORD(ADDR,NLV_PTR) ADDR=ADDR+2 ILV_PNTR=ADDR+NLV_PTR I=FIND_P2_SYMBOL(%VAL(ILV_PNTR)) IF(I.LE.0)THEN CALL LIB$SIGNAL(DISM__INVSTATBL,%VAL(4),%VAL(SYM_VAL(IND)), + %VAL(SYM_VAL(IABS(I))), + %VAL(SYM_TYP(IABS(I))), + %VAL(SYM_EXT_ATTR(IABS(I)))) ELSE CLV_LINE(8:)='!'//SYM_NAM(I) CALL STR$TRIM(CLV_LINE,CLV_LINE,LN) ENDIF ENDIF ENDIF ELSE IF(NLV_PTR.GE.'20'X.AND. + NLV_PTR.LT.'7F'X)THEN CLV_LINE(8:)=''''//CHAR(NLV_PTR)//'''' LN=10 ELSE CALL SYS$FAO('^X!XB',,CLV_LINE(8:),%VAL(NLV_PTR)) LN=11 ENDIF ENDIF IF((BLV_FLAGS2.AND.1).NE.0)THEN CALL COPY_LONG(ADDR,ILV_ARG) ADDR=ADDR+4 ENDIF IF((BLV_FLAGS.AND.'80'X).NE.0)THEN CALL COPY_LONG(ADDR,ILV_ACTION) ADDR=ADDR+4 ILV_ACTION=ILV_ACTION+ADDR ENDIF IF((BLV_FLAGS.AND.'40'X).NE.0)THEN CALL COPY_LONG(ADDR,ILV_MSKADR) ADDR=ADDR+4 ILV_MSKADR=ILV_MSKADR+ADDR ENDIF IF((BLV_FLAGS.AND.'20'X).NE.0)THEN CALL COPY_LONG(ADDR,ILV_MASK) ADDR=ADDR+4 ENDIF IF((BLV_FLAGS.AND.'10'X).NE.0)THEN CALL COPY_WORD(ADDR,NLV_PTR) ADDR=ADDR+2 IF(NLV_PTR.EQ.-1)THEN CLV_LINE(LN+1:)=',TPA$_EXIT' LN=LN+10 ELSEIF(NLV_PTR.EQ.-2)THEN CLV_LINE(LN+1:)=',TPA$_FAIL' LN=LN+10 ELSE ILV_PNTR=ADDR+NLV_PTR I=FIND_P2_SYMBOL(%VAL(ILV_PNTR)) IF(I.LE.0)THEN CALL LIB$SIGNAL(DISM__INVSTATBL,%VAL(4),%VAL(SYM_VAL(IND)), + %VAL(SYM_VAL(IABS(I))), + %VAL(SYM_TYP(IABS(I))), + %VAL(SYM_EXT_ATTR(IABS(I)))) ELSE CLV_LINE(LN+1:)=','//SYM_NAM(I) CALL STR$TRIM(CLV_LINE,CLV_LINE,LN) ENDIF ENDIF ELSEIF(BLV_FLAGS2.NE.0.OR. + (BLV_FLAGS.AND.'E0'X).NE.0)THEN LN=LN+1 CLV_LINE(LN:LN)=',' ENDIF IF((BLV_FLAGS.AND.'80'X).NE.0)THEN I=FIND_P2_SYMBOL(%VAL(ILV_ACTION)) IF(I.LE.0)THEN CALL LIB$SIGNAL(DISM__INVSTATBL,%VAL(4),%VAL(SYM_VAL(IND)), + %VAL(SYM_VAL(IABS(I))), + %VAL(SYM_TYP(IABS(I))), + %VAL(SYM_EXT_ATTR(IABS(I)))) ELSE CLV_LINE(LN+1:)=','//SYM_NAM(I) CALL STR$TRIM(CLV_LINE,CLV_LINE,LN) ENDIF ELSEIF(BLV_FLAGS2.NE.0.OR. + (BLV_FLAGS.AND.'60'X).NE.0)THEN LN=LN+1 CLV_LINE(LN:LN)=',' ENDIF IF((BLV_FLAGS.AND.'20'X).NE.0)THEN CALL SYS$FAO(',^X!XL',LN2,CLV_LINE(LN+1:),%VAL(ILV_MASK)) LN=LN+LN2 ELSEIF(BLV_FLAGS2.NE.0.OR. + (BLV_FLAGS.AND.'40'X).NE.0)THEN LN=LN+1 CLV_LINE(LN:LN)=',' ENDIF IF((BLV_FLAGS.AND.'40'X).NE.0)THEN I=FIND_P2_SYMBOL(%VAL(ILV_MSKADR)) IF(I.LE.0)THEN CALL LIB$SIGNAL(DISM__INVSTATBL,%VAL(4),%VAL(SYM_VAL(IND)), + %VAL(ILV_MSKADR), + %VAL(SYM_TYP(IABS(I))), + %VAL(SYM_EXT_ATTR(IABS(I)))) ELSE CLV_LINE(LN+1:)=','//SYM_NAM(I) CALL STR$TRIM(CLV_LINE,CLV_LINE,LN) ENDIF ELSEIF(BLV_FLAGS2.NE.0)THEN LN=LN+1 CLV_LINE(LN:LN)=',' ENDIF IF((BLV_FLAGS2.AND.1).NE.0)THEN CALL SYS$FAO(',^X!XL',LN2,CLV_LINE(LN+1:),%VAL(ILV_ARG)) LN=LN+LN2 ENDIF WRITE(2,'(A)') CLV_LINE(1:LN) ENDDO I=FIND_P2_SYMBOL(%VAL(ADDR)) IF(I.LE.0.OR. + (SYM_TYP(I).AND.SYM_D_EXTENDED).EQ.0.OR. + SYM_EXT_ATTR(I).NE.SYM_T_STATE)THEN WRITE(2,93001) TAB 93001 FORMAT(/A1,'$END_STATE') ENDIF GOTO 9999 C C SYS$GETDVI item list handler C 4000 ILV_MASK=-1 DO WHILE (ILV_MASK.NE.0) CALL COPY_LONG(ADDR,ILV_MASK) ADDR=ADDR+4 IF(ILV_MASK.EQ.0)THEN WRITE(2,94000) TAB, TAB 94000 FORMAT(A1,'.LONG',A1,'0') ELSE WRITE(2,94001) TAB, TAB, (ILV_MASK.AND.'FFFF'X) 94001 FORMAT(A1,'.WORD',A1,I5) NLV_PTR=(ILV_MASK/65536).AND.'7FFF'X CLV_LINE=DVI_TYPE(NLV_PTR/2) CALL STR$TRIM(CLV_LINE,CLV_LINE,LN) IF(NLV_PTR)THEN CLV_LINE(LN+1:)='+DVI$M_SECONDARY' LN=LN+16 ENDIF IF(ILV_MASK.LT.0)THEN CLV_LINE(LN+1:)='+DVI$M_NOREDIRECT' LN=LN+17 ENDIF WRITE(2,94002) TAB, TAB, CLV_LINE(1:LN) 94002 FORMAT(A1,'.WORD',A1,'DVI$_',A) CALL COPY_LONG(ADDR,ILV_MSKADR) ADDR=ADDR+4 IF(ILV_MSKADR.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE I=FIND_P2_SYMBOL(%VAL(ILV_MSKADR)) IF(I.LE.0)THEN CALL LIB$SIGNAL(DISM__INVSTATBL,%VAL(4),%VAL(SYM_VAL(IND)), + %VAL(ILV_MSKADR), + %VAL(SYM_TYP(IABS(I))), + %VAL(SYM_EXT_ATTR(IABS(I)))) ELSE CALL STR$TRIM(SYM_NAM(I),SYM_NAM(I),LN) WRITE(2,94003) TAB, TAB, SYM_NAM(I)(1:LN) 94003 FORMAT(A1,'.ADDRESS',A1,A) ENDIF ENDIF CALL COPY_LONG(ADDR,ILV_MSKADR) ADDR=ADDR+4 IF(ILV_MSKADR.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE I=FIND_P2_SYMBOL(%VAL(ILV_MSKADR)) IF(I.LE.0)THEN CALL LIB$SIGNAL(DISM__INVSTATBL,%VAL(4),%VAL(SYM_VAL(IND)), + %VAL(ILV_MSKADR), + %VAL(SYM_TYP(IABS(I))), + %VAL(SYM_EXT_ATTR(IABS(I)))) ELSE CALL STR$TRIM(SYM_NAM(I),SYM_NAM(I),LN) WRITE(2,94003) TAB, TAB, SYM_NAM(I)(1:LN) ENDIF ENDIF ENDIF ENDDO GOTO 9999 C C SYS$GETJPI item list handler C 5000 ILV_MASK=-1 DO WHILE (ILV_MASK.NE.0) CALL COPY_LONG(ADDR,ILV_MASK) ADDR=ADDR+4 IF(ILV_MASK.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE WRITE(2,94001) TAB, TAB, (ILV_MASK.AND.'FFFF'X) NLV_PTR=ILV_MASK/65536 BLV_TYP=NLV_PTR/256 NLV_PTR=NLV_PTR.AND.'FF'X GOTO (5010,5020,5030,5040,5050,5060), BLV_TYP IF(ILV_MASK.EQ.'FFFFFFFF'X)THEN CLV_LINE='CHAIN' LN=5 GOTO 5105 ENDIF 5009 CALL LIB$SIGNAL(DISM__INCITMLST,%VAL(3),'GETJPI', + %VAL(ADDR-4),%VAL(ILV_MASK)) GOTO 9999 5010 IF(NLV_PTR.LE.1)THEN CLV_LINE=JPI_TYPE(NLV_PTR,1) GOTO 5100 ENDIF GOTO 5009 5020 IF(NLV_PTR.LE.16)THEN CLV_LINE=JPI_TYPE(NLV_PTR,2) GOTO 5100 ENDIF GOTO 5009 5030 IF(NLV_PTR.LE.37)THEN CLV_LINE=JPI_TYPE(NLV_PTR,3) GOTO 5100 ENDIF GOTO 5009 5040 IF(NLV_PTR.LE.27)THEN CLV_LINE=JPI_TYPE(NLV_PTR,4) GOTO 5100 ENDIF GOTO 5009 5050 IF(NLV_PTR.LE.-1)THEN CLV_LINE=JPI_TYPE(NLV_PTR,5) GOTO 5100 ENDIF GOTO 5009 5060 IF(NLV_PTR.LE.-1)THEN CLV_LINE=JPI_TYPE(NLV_PTR,6) GOTO 5100 ENDIF GOTO 5009 5100 CALL STR$TRIM(CLV_LINE,CLV_LINE,LN) 5105 WRITE(2,95002) TAB, TAB, CLV_LINE(1:LN) 95002 FORMAT(A1,'.WORD',A1,'JPI$_',A) CALL COPY_LONG(ADDR,ILV_MSKADR) ADDR=ADDR+4 IF(ILV_MSKADR.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE I=FIND_P2_SYMBOL(%VAL(ILV_MSKADR)) IF(I.LE.0)THEN CALL LIB$SIGNAL(DISM__INVSTATBL,%VAL(4),%VAL(SYM_VAL(IND)), + %VAL(ILV_MSKADR), + %VAL(SYM_TYP(IABS(I))), + %VAL(SYM_EXT_ATTR(IABS(I)))) ELSE CALL STR$TRIM(SYM_NAM(I),SYM_NAM(I),LN) WRITE(2,94003) TAB, TAB, SYM_NAM(I)(1:LN) ENDIF ENDIF CALL COPY_LONG(ADDR,ILV_MSKADR) ADDR=ADDR+4 IF(ILV_MSKADR.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE I=FIND_P2_SYMBOL(%VAL(ILV_MSKADR)) IF(I.LE.0)THEN CALL LIB$SIGNAL(DISM__INVSTATBL,%VAL(4),%VAL(SYM_VAL(IND)), + %VAL(ILV_MSKADR), + %VAL(SYM_TYP(IABS(I))), + %VAL(SYM_EXT_ATTR(IABS(I)))) ELSE CALL STR$TRIM(SYM_NAM(I),SYM_NAM(I),LN) WRITE(2,94003) TAB, TAB, SYM_NAM(I)(1:LN) ENDIF ENDIF ENDIF ENDDO GOTO 9999 C C SYS$GETQUI item list handler C 6000 ILV_MASK=-1 DO WHILE (ILV_MASK.NE.0) CALL COPY_LONG(ADDR,ILV_MASK) ADDR=ADDR+4 IF(ILV_MASK.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE WRITE(2,94001) TAB, TAB, (ILV_MASK.AND.'FFFF'X) NLV_PTR=(ILV_MASK/65536).AND.'7FFF'X IF(NLV_PTR.LE.0.OR. + NLV_PTR.GT.'5E'X)THEN CALL LIB$SIGNAL(DISM__INCITMLST,%VAL(3),'GETQUI', + %VAL(ADDR-4),%VAL(ILV_MASK)) GOTO 9999 ENDIF CLV_LINE=QUI_TYPE(NLV_PTR) CALL STR$TRIM(CLV_LINE,CLV_LINE,LN) WRITE(2,96002) TAB, TAB, CLV_LINE(1:LN) 96002 FORMAT(A1,'.WORD',A1,'QUI$_',A) CALL COPY_LONG(ADDR,ILV_MSKADR) ADDR=ADDR+4 IF(ILV_MSKADR.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE I=FIND_P2_SYMBOL(%VAL(ILV_MSKADR)) IF(I.LE.0)THEN CALL LIB$SIGNAL(DISM__INVSTATBL,%VAL(4),%VAL(SYM_VAL(IND)), + %VAL(ILV_MSKADR), + %VAL(SYM_TYP(IABS(I))), + %VAL(SYM_EXT_ATTR(IABS(I)))) ELSE CALL STR$TRIM(SYM_NAM(I),SYM_NAM(I),LN) WRITE(2,94003) TAB, TAB, SYM_NAM(I)(1:LN) ENDIF ENDIF CALL COPY_LONG(ADDR,ILV_MSKADR) ADDR=ADDR+4 IF(ILV_MSKADR.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE I=FIND_P2_SYMBOL(%VAL(ILV_MSKADR)) IF(I.LE.0)THEN CALL LIB$SIGNAL(DISM__INVSTATBL,%VAL(4),%VAL(SYM_VAL(IND)), + %VAL(ILV_MSKADR), + %VAL(SYM_TYP(IABS(I))), + %VAL(SYM_EXT_ATTR(IABS(I)))) ELSE CALL STR$TRIM(SYM_NAM(I),SYM_NAM(I),LN) WRITE(2,94003) TAB, TAB, SYM_NAM(I)(1:LN) ENDIF ENDIF ENDIF ENDDO GOTO 9999 C C SYS$GETSYI item list handler C 7000 ILV_MASK=-1 DO WHILE (ILV_MASK.NE.0) CALL COPY_LONG(ADDR,ILV_MASK) ADDR=ADDR+4 IF(ILV_MASK.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE WRITE(2,94001) TAB, TAB, (ILV_MASK.AND.'FFFF'X) NLV_PTR=ILV_MASK/65536 BLV_TYP=NLV_PTR/4096 NLV_PTR=NLV_PTR.AND.'FFF'X GOTO (7001,7010,7020,7030), BLV_TYP+1 7009 CALL LIB$SIGNAL(DISM__INCITMLST,%VAL(3),'GETSYI', + %VAL(ADDR-4),%VAL(ILV_MASK)) GOTO 9999 7001 IF(NLV_PTR.EQ.'100'X)THEN CLV_LINE='OLDVERSION' LN=10 GOTO 7105 ELSEIF(NLV_PTR.EQ.'200'X)THEN CLV_LINE='OLDCPU' LN=6 GOTO 7105 ELSEIF(NLV_PTR.EQ.'201'X)THEN CLV_LINE='OLDSID' LN=6 GOTO 7105 ENDIF GOTO 7009 7010 IF(NLV_PTR.LE.'102'X)THEN CLV_LINE=SYI1_TYPE(NLV_PTR) GOTO 7100 ENDIF GOTO 7009 7020 IF(NLV_PTR.LE.'2A'X)THEN CLV_LINE=SYI2_TYPE(NLV_PTR) GOTO 7100 ENDIF GOTO 7009 7030 IF(NLV_PTR.LE.-1)THEN CLV_LINE=SYI3_TYPE(NLV_PTR) GOTO 7100 ENDIF GOTO 7009 7100 CALL STR$TRIM(CLV_LINE,CLV_LINE,LN) 7105 WRITE(2,97002) TAB, TAB, CLV_LINE(1:LN) 97002 FORMAT(A1,'.WORD',A1,'SYI$_',A) CALL COPY_LONG(ADDR,ILV_MSKADR) ADDR=ADDR+4 IF(ILV_MSKADR.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE I=FIND_P2_SYMBOL(%VAL(ILV_MSKADR)) IF(I.LE.0)THEN CALL LIB$SIGNAL(DISM__INVSTATBL,%VAL(4),%VAL(SYM_VAL(IND)), + %VAL(ILV_MSKADR), + %VAL(SYM_TYP(IABS(I))), + %VAL(SYM_EXT_ATTR(IABS(I)))) ELSE CALL STR$TRIM(SYM_NAM(I),SYM_NAM(I),LN) WRITE(2,94003) TAB, TAB, SYM_NAM(I)(1:LN) ENDIF ENDIF CALL COPY_LONG(ADDR,ILV_MSKADR) ADDR=ADDR+4 IF(ILV_MSKADR.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE I=FIND_P2_SYMBOL(%VAL(ILV_MSKADR)) IF(I.LE.0)THEN CALL LIB$SIGNAL(DISM__INVSTATBL,%VAL(4),%VAL(SYM_VAL(IND)), + %VAL(ILV_MSKADR), + %VAL(SYM_TYP(IABS(I))), + %VAL(SYM_EXT_ATTR(IABS(I)))) ELSE CALL STR$TRIM(SYM_NAM(I),SYM_NAM(I),LN) WRITE(2,94003) TAB, TAB, SYM_NAM(I)(1:LN) ENDIF ENDIF ENDIF ENDDO GOTO 9999 C C SYS$SNDJBC item list handler C 8000 ILV_MASK=-1 DO WHILE (ILV_MASK.NE.0) CALL COPY_LONG(ADDR,ILV_MASK) ADDR=ADDR+4 IF(ILV_MASK.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE WRITE(2,94001) TAB, TAB, (ILV_MASK.AND.'FFFF'X) NLV_PTR=(ILV_MASK/65536).AND.'7FFF'X IF(NLV_PTR.LE.0.OR. + NLV_PTR.GT.171)THEN CALL LIB$SIGNAL(DISM__INCITMLST,%VAL(3),'SNDJBC', + %VAL(ADDR-4),%VAL(ILV_MASK)) GOTO 9999 ENDIF CLV_LINE=SJC_TYPE(NLV_PTR) CALL STR$TRIM(CLV_LINE,CLV_LINE,LN) WRITE(2,98002) TAB, TAB, CLV_LINE(1:LN) 98002 FORMAT(A1,'.WORD',A1,'SJC$_',A) CALL COPY_LONG(ADDR,ILV_MSKADR) ADDR=ADDR+4 IF(ILV_MSKADR.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE I=FIND_P2_SYMBOL(%VAL(ILV_MSKADR)) IF(I.LE.0)THEN CALL LIB$SIGNAL(DISM__INVSTATBL,%VAL(4),%VAL(SYM_VAL(IND)), + %VAL(ILV_MSKADR), + %VAL(SYM_TYP(IABS(I))), + %VAL(SYM_EXT_ATTR(IABS(I)))) ELSE CALL STR$TRIM(SYM_NAM(I),SYM_NAM(I),LN) WRITE(2,94003) TAB, TAB, SYM_NAM(I)(1:LN) ENDIF ENDIF CALL COPY_LONG(ADDR,ILV_MSKADR) ADDR=ADDR+4 IF(ILV_MSKADR.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE I=FIND_P2_SYMBOL(%VAL(ILV_MSKADR)) IF(I.LE.0)THEN CALL LIB$SIGNAL(DISM__INVSTATBL,%VAL(4),%VAL(SYM_VAL(IND)), + %VAL(ILV_MSKADR), + %VAL(SYM_TYP(IABS(I))), + %VAL(SYM_EXT_ATTR(IABS(I)))) ELSE CALL STR$TRIM(SYM_NAM(I),SYM_NAM(I),LN) WRITE(2,94003) TAB, TAB, SYM_NAM(I)(1:LN) ENDIF ENDIF ENDIF ENDDO GOTO 9999 C C SYS$CHANGE_ACL item list handler C 9000 ILV_MASK=-1 DO WHILE (ILV_MASK.NE.0) CALL COPY_LONG(ADDR,ILV_MASK) ADDR=ADDR+4 IF(ILV_MASK.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE WRITE(2,94001) TAB, TAB, (ILV_MASK.AND.'FFFF'X) NLV_PTR=(ILV_MASK/65536).AND.'7FFF'X IF(NLV_PTR.LE.0.OR. + NLV_PTR.GT.12)THEN CALL LIB$SIGNAL(DISM__INCITMLST,%VAL(3),'CHANGE_ACL', + %VAL(ADDR-4),%VAL(ILV_MASK)) GOTO 9999 ENDIF CLV_LINE=ACL_TYPE(NLV_PTR) CALL STR$TRIM(CLV_LINE,CLV_LINE,LN) WRITE(2,99002) TAB, TAB, CLV_LINE(1:LN) 99002 FORMAT(A1,'.WORD',A1,'ACL$C_',A) CALL COPY_LONG(ADDR,ILV_MSKADR) ADDR=ADDR+4 IF(ILV_MSKADR.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE I=FIND_P2_SYMBOL(%VAL(ILV_MSKADR)) IF(I.LE.0)THEN CALL LIB$SIGNAL(DISM__INVSTATBL,%VAL(4),%VAL(SYM_VAL(IND)), + %VAL(ILV_MSKADR), + %VAL(SYM_TYP(IABS(I))), + %VAL(SYM_EXT_ATTR(IABS(I)))) ELSE CALL STR$TRIM(SYM_NAM(I),SYM_NAM(I),LN) WRITE(2,94003) TAB, TAB, SYM_NAM(I)(1:LN) ENDIF ENDIF CALL COPY_LONG(ADDR,ILV_MSKADR) ADDR=ADDR+4 IF(ILV_MSKADR.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE I=FIND_P2_SYMBOL(%VAL(ILV_MSKADR)) IF(I.LE.0)THEN CALL LIB$SIGNAL(DISM__INVSTATBL,%VAL(4),%VAL(SYM_VAL(IND)), + %VAL(ILV_MSKADR), + %VAL(SYM_TYP(IABS(I))), + %VAL(SYM_EXT_ATTR(IABS(I)))) ELSE CALL STR$TRIM(SYM_NAM(I),SYM_NAM(I),LN) WRITE(2,94003) TAB, TAB, SYM_NAM(I)(1:LN) ENDIF ENDIF ENDIF ENDDO GOTO 9999 C C SYS$CHECK_ACCESS, SYS$CHKPRO item list handler C 10000 ILV_MASK=-1 DO WHILE (ILV_MASK.NE.0) CALL COPY_LONG(ADDR,ILV_MASK) ADDR=ADDR+4 IF(ILV_MASK.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE WRITE(2,94001) TAB, TAB, (ILV_MASK.AND.'FFFF'X) NLV_PTR=(ILV_MASK/65536).AND.'7FFF'X IF(NLV_PTR.LE.0.OR. + NLV_PTR.GT.19)THEN CALL LIB$SIGNAL(DISM__INCITMLST,%VAL(3),'CHKACC/CHKPRO', + %VAL(ADDR-4),%VAL(ILV_MASK)) GOTO 9999 ENDIF CLV_LINE=CHP_TYPE(NLV_PTR) CALL STR$TRIM(CLV_LINE,CLV_LINE,LN) WRITE(2,91002) TAB, TAB, CLV_LINE(1:LN) 91002 FORMAT(A1,'.WORD',A1,'CHP$_',A) CALL COPY_LONG(ADDR,ILV_MSKADR) ADDR=ADDR+4 IF(ILV_MSKADR.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE I=FIND_P2_SYMBOL(%VAL(ILV_MSKADR)) IF(I.LE.0)THEN CALL LIB$SIGNAL(DISM__INVSTATBL,%VAL(4),%VAL(SYM_VAL(IND)), + %VAL(ILV_MSKADR), + %VAL(SYM_TYP(IABS(I))), + %VAL(SYM_EXT_ATTR(IABS(I)))) ELSE CALL STR$TRIM(SYM_NAM(I),SYM_NAM(I),LN) WRITE(2,94003) TAB, TAB, SYM_NAM(I)(1:LN) ENDIF ENDIF CALL COPY_LONG(ADDR,ILV_MSKADR) ADDR=ADDR+4 IF(ILV_MSKADR.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE I=FIND_P2_SYMBOL(%VAL(ILV_MSKADR)) IF(I.LE.0)THEN CALL LIB$SIGNAL(DISM__INVSTATBL,%VAL(4),%VAL(SYM_VAL(IND)), + %VAL(ILV_MSKADR), + %VAL(SYM_TYP(IABS(I))), + %VAL(SYM_EXT_ATTR(IABS(I)))) ELSE CALL STR$TRIM(SYM_NAM(I),SYM_NAM(I),LN) WRITE(2,94003) TAB, TAB, SYM_NAM(I)(1:LN) ENDIF ENDIF ENDIF ENDDO GOTO 9999 C C SYS$CRELNM, SYS$TRNLNM item list handler C 11000 ILV_MASK=-1 DO WHILE (ILV_MASK.NE.0) CALL COPY_LONG(ADDR,ILV_MASK) ADDR=ADDR+4 IF(ILV_MASK.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE WRITE(2,94001) TAB, TAB, (ILV_MASK.AND.'FFFF'X) NLV_PTR=(ILV_MASK/65536).AND.'7FFF'X IF(NLV_PTR.LT.-1.OR. + NLV_PTR.GT.9)THEN CALL LIB$SIGNAL(DISM__INCITMLST,%VAL(3),'CRELNM/TRNLNM', + %VAL(ADDR-4),%VAL(ILV_MASK)) GOTO 9999 ENDIF CLV_LINE=LNM_TYPE(NLV_PTR) CALL STR$TRIM(CLV_LINE,CLV_LINE,LN) WRITE(2,91102) TAB, TAB, CLV_LINE(1:LN) 91102 FORMAT(A1,'.WORD',A1,'LNM$_',A) CALL COPY_LONG(ADDR,ILV_MSKADR) ADDR=ADDR+4 IF(ILV_MSKADR.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE I=FIND_P2_SYMBOL(%VAL(ILV_MSKADR)) IF(I.LE.0)THEN CALL LIB$SIGNAL(DISM__INVSTATBL,%VAL(4),%VAL(SYM_VAL(IND)), + %VAL(ILV_MSKADR), + %VAL(SYM_TYP(IABS(I))), + %VAL(SYM_EXT_ATTR(IABS(I)))) ELSE CALL STR$TRIM(SYM_NAM(I),SYM_NAM(I),LN) WRITE(2,94003) TAB, TAB, SYM_NAM(I)(1:LN) ENDIF ENDIF CALL COPY_LONG(ADDR,ILV_MSKADR) ADDR=ADDR+4 IF(ILV_MSKADR.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE I=FIND_P2_SYMBOL(%VAL(ILV_MSKADR)) IF(I.LE.0)THEN CALL LIB$SIGNAL(DISM__INVSTATBL,%VAL(4),%VAL(SYM_VAL(IND)), + %VAL(ILV_MSKADR), + %VAL(SYM_TYP(IABS(I))), + %VAL(SYM_EXT_ATTR(IABS(I)))) ELSE CALL STR$TRIM(SYM_NAM(I),SYM_NAM(I),LN) WRITE(2,94003) TAB, TAB, SYM_NAM(I)(1:LN) ENDIF ENDIF ENDIF ENDDO GOTO 9999 C C SYS$CREPRC quota list handler C 12000 BLV_TYP=-1 DO WHILE (BLV_TYP.NE.0) CALL COPY_BYTE(ADDR,BLV_TYP) ADDR=ADDR+1 IF(BLV_TYP.EQ.0)THEN WRITE(2,91200) TAB, TAB 91200 FORMAT(A1,'.BYTE',A1,'PQL$_LISTEND') ELSE IF(NLV_PTR.LE.0.OR. + NLV_PTR.GT.15)THEN CALL LIB$SIGNAL(DISM__INCITMLST,%VAL(3),'CREPRC', + %VAL(ADDR-4),%VAL(BLV_TYP)) GOTO 9999 ENDIF CLV_LINE=PQL_TYPE(NLV_PTR) CALL STR$TRIM(CLV_LINE,CLV_LINE,LN) WRITE(2,91202) TAB, TAB, CLV_LINE(1:LN) 91202 FORMAT(A1,'.BYTE',A1,'PQL$_',A) CALL COPY_LONG(ADDR,ILV_MSKADR) ADDR=ADDR+4 WRITE(2,91203) TAB, TAB, ILV_MSKADR 91203 FORMAT(A1,'.LONG',A1,I6) ENDIF ENDDO GOTO 9999 C C SYS$FILESCAN item list handler C 13000 ILV_MASK=-1 DO WHILE (ILV_MASK.NE.0) CALL COPY_LONG(ADDR,ILV_MASK) ADDR=ADDR+4 IF(ILV_MASK.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE WRITE(2,94001) TAB, TAB, (ILV_MASK.AND.'FFFF'X) NLV_PTR=(ILV_MASK/65536).AND.'7FFF'X IF(NLV_PTR.LE.0.OR. + NLV_PTR.GT.8)THEN CALL LIB$SIGNAL(DISM__INCITMLST,%VAL(3),'FILESCAN', + %VAL(ADDR-4),%VAL(ILV_MASK)) GOTO 9999 ENDIF CLV_LINE=FSCN_TYPE(NLV_PTR) CALL STR$TRIM(CLV_LINE,CLV_LINE,LN) WRITE(2,91302) TAB, TAB, CLV_LINE(1:LN) 91302 FORMAT(A1,'.WORD',A1,'FSCN$_',A) CALL COPY_LONG(ADDR,ILV_MSKADR) ADDR=ADDR+4 IF(ILV_MSKADR.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE I=FIND_P2_SYMBOL(%VAL(ILV_MSKADR)) IF(I.LE.0)THEN WRITE(2,91303) TAB, TAB, ILV_MSKADR 91303 FORMAT(A1,'.LONG',A1,'^X',Z8.8) ELSE CALL STR$TRIM(SYM_NAM(I),SYM_NAM(I),LN) WRITE(2,94003) TAB, TAB, SYM_NAM(I)(1:LN) ENDIF ENDIF ENDIF ENDDO GOTO 9999 C C SYS$GETLKI item list handler C 14000 ILV_MASK=-1 DO WHILE (ILV_MASK.NE.0) CALL COPY_LONG(ADDR,ILV_MASK) ADDR=ADDR+4 IF(ILV_MASK.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE WRITE(2,94001) TAB, TAB, (ILV_MASK.AND.'FFFF'X) NLV_PTR=ILV_MASK/65536 BLV_TYP=NLV_PTR/256 NLV_PTR=NLV_PTR.AND.'FF'X GOTO (14010,14020), BLV_TYP 14009 CALL LIB$SIGNAL(DISM__INCITMLST,%VAL(3),'GETLKI', + %VAL(ADDR-4),%VAL(ILV_MASK)) GOTO 9999 14010 IF(NLV_PTR.LE.6)THEN CLV_LINE=LKI_TYPE(NLV_PTR,1) GOTO 14100 ENDIF GOTO 14009 14020 IF(NLV_PTR.LE.9)THEN CLV_LINE=LKI_TYPE(NLV_PTR,2) GOTO 14100 ENDIF GOTO 14009 14100 CALL STR$TRIM(CLV_LINE,CLV_LINE,LN) WRITE(2,91402) TAB, TAB, CLV_LINE(1:LN) 91402 FORMAT(A1,'.WORD',A1,'LKI$_',A) CALL COPY_LONG(ADDR,ILV_MSKADR) ADDR=ADDR+4 IF(ILV_MSKADR.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE I=FIND_P2_SYMBOL(%VAL(ILV_MSKADR)) IF(I.LE.0)THEN CALL LIB$SIGNAL(DISM__INVSTATBL,%VAL(4),%VAL(SYM_VAL(IND)), + %VAL(ILV_MSKADR), + %VAL(SYM_TYP(IABS(I))), + %VAL(SYM_EXT_ATTR(IABS(I)))) ELSE CALL STR$TRIM(SYM_NAM(I),SYM_NAM(I),LN) WRITE(2,94003) TAB, TAB, SYM_NAM(I)(1:LN) ENDIF ENDIF CALL COPY_LONG(ADDR,ILV_MSKADR) ADDR=ADDR+4 IF(ILV_MSKADR.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE I=FIND_P2_SYMBOL(%VAL(ILV_MSKADR)) IF(I.LE.0)THEN CALL LIB$SIGNAL(DISM__INVSTATBL,%VAL(4),%VAL(SYM_VAL(IND)), + %VAL(ILV_MSKADR), + %VAL(SYM_TYP(IABS(I))), + %VAL(SYM_EXT_ATTR(IABS(I)))) ELSE CALL STR$TRIM(SYM_NAM(I),SYM_NAM(I),LN) WRITE(2,94003) TAB, TAB, SYM_NAM(I)(1:LN) ENDIF ENDIF ENDIF ENDDO GOTO 9999 C C SYS$GETUAI, SYS$SETUAI item list handler C 15000 ILV_MASK=-1 DO WHILE (ILV_MASK.NE.0) CALL COPY_LONG(ADDR,ILV_MASK) ADDR=ADDR+4 IF(ILV_MASK.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE WRITE(2,94001) TAB, TAB, (ILV_MASK.AND.'FFFF'X) NLV_PTR=(ILV_MASK/65536).AND.'7FFF'X IF(NLV_PTR.LE.0.OR. + NLV_PTR.GT.'47'X)THEN CALL LIB$SIGNAL(DISM__INCITMLST,%VAL(3),'GETUAI/SETUAI', + %VAL(ADDR-4),%VAL(ILV_MASK)) GOTO 9999 ENDIF CLV_LINE=UAI_TYPE(NLV_PTR) CALL STR$TRIM(CLV_LINE,CLV_LINE,LN) WRITE(2,91502) TAB, TAB, CLV_LINE(1:LN) 91502 FORMAT(A1,'.WORD',A1,'UAI$_',A) CALL COPY_LONG(ADDR,ILV_MSKADR) ADDR=ADDR+4 IF(ILV_MSKADR.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE I=FIND_P2_SYMBOL(%VAL(ILV_MSKADR)) IF(I.LE.0)THEN CALL LIB$SIGNAL(DISM__INVSTATBL,%VAL(4),%VAL(SYM_VAL(IND)), + %VAL(ILV_MSKADR), + %VAL(SYM_TYP(IABS(I))), + %VAL(SYM_EXT_ATTR(IABS(I)))) ELSE CALL STR$TRIM(SYM_NAM(I),SYM_NAM(I),LN) WRITE(2,94003) TAB, TAB, SYM_NAM(I)(1:LN) ENDIF ENDIF CALL COPY_LONG(ADDR,ILV_MSKADR) ADDR=ADDR+4 IF(ILV_MSKADR.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE I=FIND_P2_SYMBOL(%VAL(ILV_MSKADR)) IF(I.LE.0)THEN CALL LIB$SIGNAL(DISM__INVSTATBL,%VAL(4),%VAL(SYM_VAL(IND)), + %VAL(ILV_MSKADR), + %VAL(SYM_TYP(IABS(I))), + %VAL(SYM_EXT_ATTR(IABS(I)))) ELSE CALL STR$TRIM(SYM_NAM(I),SYM_NAM(I),LN) WRITE(2,94003) TAB, TAB, SYM_NAM(I)(1:LN) ENDIF ENDIF ENDIF ENDDO GOTO 9999 C C SYS$MOUNT item list handler C 16000 ILV_MASK=-1 DO WHILE (ILV_MASK.NE.0) CALL COPY_LONG(ADDR,ILV_MASK) ADDR=ADDR+4 IF(ILV_MASK.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE WRITE(2,94001) TAB, TAB, (ILV_MASK.AND.'FFFF'X) NLV_PTR=(ILV_MASK/65536).AND.'7FFF'X IF(NLV_PTR.LE.0.OR. + NLV_PTR.GT.29)THEN CALL LIB$SIGNAL(DISM__INCITMLST,%VAL(3),'MOUNT', + %VAL(ADDR-4),%VAL(ILV_MASK)) GOTO 9999 ENDIF CLV_LINE=MNT_TYPE(NLV_PTR) CALL STR$TRIM(CLV_LINE,CLV_LINE,LN) WRITE(2,91602) TAB, TAB, CLV_LINE(1:LN) 91602 FORMAT(A1,'.WORD',A1,'MNT$_',A) CALL COPY_LONG(ADDR,ILV_MSKADR) ADDR=ADDR+4 IF(ILV_MSKADR.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE I=FIND_P2_SYMBOL(%VAL(ILV_MSKADR)) IF(I.LE.0)THEN CALL LIB$SIGNAL(DISM__INVSTATBL,%VAL(4),%VAL(SYM_VAL(IND)), + %VAL(ILV_MSKADR), + %VAL(SYM_TYP(IABS(I))), + %VAL(SYM_EXT_ATTR(IABS(I)))) ELSE CALL STR$TRIM(SYM_NAM(I),SYM_NAM(I),LN) WRITE(2,94003) TAB, TAB, SYM_NAM(I)(1:LN) ENDIF ENDIF CALL COPY_LONG(ADDR,ILV_MSKADR) ADDR=ADDR+4 IF(ILV_MSKADR.EQ.0)THEN WRITE(2,94000) TAB, TAB ELSE I=FIND_P2_SYMBOL(%VAL(ILV_MSKADR)) IF(I.LE.0)THEN CALL LIB$SIGNAL(DISM__INVSTATBL,%VAL(4),%VAL(SYM_VAL(IND)), + %VAL(ILV_MSKADR), + %VAL(SYM_TYP(IABS(I))), + %VAL(SYM_EXT_ATTR(IABS(I)))) ELSE CALL STR$TRIM(SYM_NAM(I),SYM_NAM(I),LN) WRITE(2,94003) TAB, TAB, SYM_NAM(I)(1:LN) ENDIF ENDIF ENDIF ENDDO GOTO 9999 C C BASIC-PLUS-2/VAX subprogram arglist C 17000 DO I=0,71 CALL COPY_BYTE(ADDR+I,BASIC.ARGLIST(I)) ENDDO WRITE(2,91700) TAB, TAB, BASIC.LEN, TAB, + TAB, TAB, BASIC.VERSION, TAB, + TAB, TAB, BASIC.PROC_TYP, TAB, + PROC_TYP(BASIC.PROC_TYP), + TAB, TAB, BASIC.FLAGS, TAB, + TAB, TAB, BASIC.OFS_NAME, TAB, + TAB, TAB, BASIC.PACKED_SCALEF, TAB, + TAB, TAB, BASIC.DFL_SCALEF, TAB, + TAB, TAB, BASIC.UNK_15, BASIC.UNK_14, + TAB, TAB, BASIC.NUM_NSCALARS, TAB, + TAB, TAB, BASIC.NUM_FARG, TAB, + TAB, TAB, BASIC.NUM_BYT_DESCR, TAB, + TAB, TAB, BASIC.OFS_BYT_DESCR, TAB, + TAB, TAB, BASIC.NUM_MOD_DESCR, TAB, + TAB, TAB, BASIC.OFS_MOD_DESCR, TAB, + TAB, TAB, BASIC.NUM_DYN_DESCR, TAB, + TAB, TAB, BASIC.NUM_FIX_STRTMP, TAB, + TAB, TAB, BASIC.NUM_BYT_ARRAY, TAB, + TAB, TAB, BASIC.NUM_STMP_DESCR, TAB, + TAB, TAB, BASIC.NUM_BYT_NTMP, TAB 91700 FORMAT(A1,'.LONG',A1,I2,A1,'; length'/ + A1,'.BYTE',A1,I2,A1,'; BASIC version #'/ + A1,'.BYTE',A1,I2,A1,'; for ',A,' module'/ + A1,'.WORD',A1,'^X',Z4.4,A1,'; flags'/ + A1,'.LONG',A1,'^X',Z8.8,A1,'; offset to name'/ + A1,'.BYTE',A1,I2,A1,'; packed decimal scale factor'/ + A1,'.BYTE',A1,I2,A1,'; D_floating scale factor'/ + A1,'.WORD',A1,'^X',2Z2.2/ + A1,'.LONG',A1,I3,A1,'; # of numeric scalars to allocate'/ + A1,'.LONG',A1,I3,A1,'; # of formal arguments'/ + A1,'.LONG',A1,I4,A1,'; reserved bytes for descriptors'/ + A1,'.LONG',A1,'^X',Z8.8,A1,'; offset to template data'/ + A1,'.LONG',A1,I3,A1,'; # of descriptors to modify'/ + A1,'.LONG',A1,'^X',Z8.8,A1,'; offset to mod data'/ + A1,'.WORD',A1,I3,A1,'; # of dynamic string descriptors'/ + A1,'.WORD',A1,I3,A1,'; # of fixed string templates'/ + A1,'.LONG',A1,I4,A1,'; reserved bytes for arrays'/ + A1,'.LONG',A1,I3,A1,'; # of temporary string descriptors'/ + A1,'.LONG',A1,I3,A1,'; reserved bytes for temporary #''s') IF(BASIC.LEN .GE.60)THEN WRITE(2,91701) TAB, TAB, BASIC.PTR_BGN_DATA, TAB 91701 FORMAT(A1,'.LONG',A1,'^X',Z8.8,A1,'; offset to data start') ENDIF IF(BASIC.LEN .GE.64)THEN WRITE(2,91702) TAB, TAB, BASIC.PTR_END_DATA, TAB 91702 FORMAT(A1,'.LONG',A1,'^X',Z8.8,A1,'; offset to data end') ENDIF IF(BASIC.LEN .GE.68)THEN WRITE(2,91703) TAB, TAB, BASIC.V1_FILL 91703 FORMAT(A1,'.LONG',A1,'^X',Z8.8) ENDIF ADDR=ADDR+BASIC.LEN IF(BASIC.LEN .EQ. BASIC.OFS_NAME)THEN CALL COPY_STR(ADDR,CLV_LINE,LN) WRITE(2,91704) TAB, TAB, CLV_LINE(1:LN) 91704 FORMAT(A1,'.ASCIC',A1,'"',A,'"') ADDR=ADDR+LN+1 CALL COPY_LONG(ADDR,ILV_PNTR) ADDR=ADDR+4 WRITE(2,91705) TAB, TAB, ILV_PNTR, TAB 91705 FORMAT(A1,'.LONG',A1,I3,A1,'; # of line numbers') DO I=1,ILV_PNTR CALL COPY_WORD(ADDR,LN) ADDR=ADDR+2 CALL COPY_WORD(ADDR,NLV_PTR) ADDR=ADDR+2 WRITE(2,91706) TAB, TAB, LN, NLV_PTR, TAB 91706 FORMAT(A1,'.WORD',A1,I5,',',I4,A1,'; line #, offset to line') ENDDO ELSE ENDIF GOTO 9999 C C CALLG procedure argument list C 18000 CALL COPY_LONG(ADDR,ILV_MSKADR) ADDR=ADDR+4 WRITE(2,91801) TAB, TAB, ILV_MSKADR 91801 FORMAT(A1,'.LONG',A1,I3) DO I=1,ILV_MSKADR CALL COPY_LONG(ADDR,ILV_PNTR) ADDR=ADDR+4 IF(ILV_PNTR.NE.0)THEN ILV_ARG=FIND_P2_SYMBOL(%VAL(ILV_PNTR)) IF(ILV_ARG.LE.0)THEN WRITE(2,91703) TAB, TAB, ILV_PNTR ELSE CALL STR$TRIM(SYM_NAM(ILV_ARG),SYM_NAM(ILV_ARG),LN) WRITE(2,94003) TAB, TAB, SYM_NAM(ILV_ARG)(1:LN) ENDIF ELSE WRITE(2,94000) TAB, TAB ENDIF ENDDO GOTO 9999 C 9999 CONTINUE RETURN C END