PROGRAM SETOPS C C BOB FRAZER, 7523, 4-7863 C C 15-FEB-83 C C MODIFIED TO ADD PARSE INPUT FILESPEC PROCESSOR C (DEFAULTS ARE SY:XX.SYS - ONLY THE XX NEED BE ENTERED) C C R W BARNARD, 2565, 4-5115 C C 2-MAR-83 C C DISPLAY CURRENT SET OPTIONS FOR --.SYS HANDLER C INTEGER LP(512) INTEGER*2 UNIT,SBLOK(4),STAT(8),ASW,STRING(41),PROMPT(8) INTEGER BIT0,BIT1,BIT2,BIT3,BIT4,BIT5,BIT6,BIT7 INTEGER BIT8,BIT9,BIT10,BIT11,BIT12,BIT13,BIT14,BIT15 BYTE READNM(14), FILNAM(15) BYTE LPB(1024),IN(40),OPTN(6),NUM,OCT,NO BYTE X1,X2,X3 BYTE TAB,CRLF,FORM,FB,WAIT,XON,SPCL,SCO,RPA,WPA REAL*8 XOPT,TERM,XMANY EQUIVALENCE (LPB(1),LP(1)) DATA DEV, EXT /3RSY , 3RSYS / DATA NUM/"100/,OCT/"140/,NO/"200/ DATA BIT0 /"000001/, BIT1 /"000002/, BIT2 /"000004/, 1 BIT3 /"000010/, BIT4 /"000020/, BIT5 /"000040/, 2 BIT6 /"000100/, BIT7 /"000200/, BIT8 /"000400/, 3 BIT9 /"001000/, BIT10/"002000/, BIT11/"004000/, 4 BIT12/"010000/, BIT13/"020000/, BIT14/"040000/, 5 BIT15/"100000/ C 89 FORMAT (1X,' THERE ARE ',I3,' UNITS ON SYSTEM') 90 FORMAT (1X,' UNIT',I3,' STATUS = ',4(1X,O8)) 91 FORMAT (1X,' TCB NO. ',I3,//,35(1X,O6,/),2X,2I5) 100 FORMAT (1X,' SET OPTIONS for FILE NAME ? to exit ',$) 101 FORMAT (40(A1)) 102 FORMAT (1X,' NO SUCH FILE FOUND') 103 FORMAT (A1) 104 FORMAT (1X,' SET XX ',6A1,' = ',2X, I6,' , INTEGER') 105 FORMAT (1X,' SET XX ',6A1,' = ',2X, O6,' , OCTAL') 106 FORMAT (1X,' SET XX ',6A1,' = ',A2,6A1,' , (NO)') 107 FORMAT (1X,' SET XX ',6A1,' = ',5X,3A1,' , OCTAL') 108 FORMAT (1X,O6,8(2X,O6)) 109 FORMAT (1X,40(A1)) 110 FORMAT (1X,' TT ',A8,O6) 111 FORMAT (1X,' SET TT ',A8) 112 FORMAT (/) 113 FORMAT (//,1X,' SYSTEM IS ',A4,A2,2X,A8,A8,/) 120 FORMAT (4X,'TCB CSR VEC JOB TAB CR FORM', 1 ' FB WAIT XON SPCL SCOPE PASSALL WIDTH',/, 2 3X,'ADDRESSES (OCTAL)',16X,'LF',14X,'OFF',13X, 3 'R W',/) 121 FORMAT (/,3X,'( * = CONSOLE )',10X,'(',14X,'X = ON,YES', 5 18X,')',//) 122 FORMAT (2X,O6,A1,O6,2X,O3,1X,I3,1X,3A2,2X,A1, 1 5(3X,A1),3(4X,A1),3X,A1,2X,I5) 123 FORMAT (4X,' CSR VEC TAB CR FORM', 1 ' FB WAIT XON SPCL SCOPE PASSALL WIDTH',/, 2 3X,'ADDRESSES (OCTAL)',16X,'LF',14X,'OFF',13X, 3 'INPUT',/) 124 FORMAT (8X,A1,O6,2X,O3,10X,6(3X,A1),2(4X,A1),6X,A1,4X,I5) C IRMON =IPEEK("54) ! RMON J =IRMON+"372 IMTT =IPEEK(J) TERM ='TERMINAL' XMANY =' SINGLE ' ISYJOB =IMTT.AND.BIT14 IMTT =IMTT.AND.BIT13 IF (IMTT.NE.0) XMANY=' MULTI ' SYS ='RT11' ISYS ='SJ' J =IRMON+"300 ICON =IPEEK(J) !configuration word IF ((ICON.AND.BIT0 ).EQ.0) GO TO 150 ISYS ='FB' IF ((ICON.AND.BIT12).EQ.0) GO TO 150 ISYS ='XM' 150 WRITE (7,113) SYS,ISYS,XMANY,TERM TAB ='-' CRLF ='-' FORM ='-' FB ='-' WAIT ='-' XON ='-' SPCL ='-' SCO ='-' RPA ='-' WPA ='-' X1 ='*' ITCB =0 IPUN =0 IJOB =0 IF (IMTT.NE.0) GO TO 160 WRITE (7,123) J =IPEEK("44) IF ((J.AND.BIT12).NE.0) RPA='X' J =IRMON+"304 ICSR =IPEEK(J) !console CSR IVEC ="60 IF (ICSR.EQ."177560) GO TO 154 IVEC ="270 152 IVEC =IVEC+8 IF (IVEC.GT."376) GO TO 153 J =IPEEK(IVEC) IF (J.GE.0) GO TO 152 IF (J.LT.IRMON) GO TO 152 I =IVEC+4 K =IPEEK(I) IF (K.GE.0) GO TO 152 IF (K.GT.J) GO TO 154 GO TO 152 153 IVEC =0 154 IEMT =IPEEK("30) I =IEMT-2 ISTAT =IPEEK(I) !console status I =IEMT-8 IWIDE =(IPEEK(I).AND."377) !console width IF ((ISTAT.AND.BIT15).NE.0) SCO='X' IF (ISYS.EQ.'SJ') GO TO 155 IF ((ISTAT.AND.BIT3 ).NE.0) FB='X' 155 WRITE (7,124) X1,ICSR,IVEC,TAB,CRLF,FORM, 1 FB,WAIT,XON,SPCL,SCO,RPA,IWIDE GO TO 195 C 160 IF (MTSTAT(STAT).NE.0) GO TO 200 C STAT (1)=OFFSET RMON TO FIRST TCB C (2)=OFFSET RMON TO CONSOLE TCB C (3)=NUMBER OF TCB'S C (4)=BYTE SIZE OF TCB ITC1 =("00/2)+1 ITC2 =("02/2)+1 ITW =("06/2)+1 ITS =("14/2)+1 ITC =("16/2)+1 ITV =("20/2)+1 ITJ ="24+1 WRITE (7,120) ITCBS =STAT(3) ITCB =IRMON+STAT(1) ICON =IRMON+STAT(2) ISIZ =STAT(4) ITCB =ITCB-ISIZ DO 170 UNIT=1,ITCBS ITCB =ITCB+ISIZ J =ITCB DO 165 I=1,16 K=I+16 LP(I) =IPEEK(J) LP(K) ='**' LP(K+16)=0 J =J+2 165 CONTINUE ICSR =LP(ITC) IVEC =LP(ITV) IWIDE =LP(ITW) X1 =' ' IM=0 IG=0 IF (ITCB.EQ.ICON) X1='*' IF (LP(ITS).GE.0) GO TO 169 IM =MTATCH(UNIT,,K) !ATTACHED BY SOMEBODY IG =IGTJB(LP(17),K) !LP(30-32) = NAME OF JOB DO 166 I=51,56 IF (LPB(I).EQ.0) LPB(I)=' ' 166 CONTINUE IF (IG.LT.0) GO TO 169 LPB(ITJ)=K !K = JOB NO. IMP =LP(21)+9 ITID =IPEEK(IMP)+4 IF (ISYJOB.NE.0) ITID=ITID+2 DO 167 I=29,35 LP(I)=IPEEK(ITID) ITID=ITID+2 167 CONTINUE 169 IJOB =LPB(ITJ) WRITE (6,91) UNIT,(LP(K),K=1,35),IM,IG TAB ='-' CRLF ='-' FORM ='-' FB ='-' WAIT ='-' XON ='-' SPCL ='-' SCO ='-' RPA ='-' WPA ='-' ISTAT =LP(ITC1) IF ((ISTAT.AND.BIT0 ).NE.0) TAB ='X' IF ((ISTAT.AND.BIT1 ).NE.0) CRLF='X' IF ((ISTAT.AND.BIT2 ).NE.0) FORM='X' IF ((ISTAT.AND.BIT6 ).NE.0) WAIT='X' IF ((ISTAT.AND.BIT7 ).NE.0) XON ='X' IF ((ISTAT.AND.BIT12).NE.0) SPCL='X' IF ((ISTAT.AND.BIT15).NE.0) SCO ='X' ISTAT =LP(ITC2) IF ((ISTAT.AND.BIT7 ).NE.0) RPA ='X' IF ((ISTAT.AND.BIT15).NE.0) WPA ='X' WRITE (7,122) ITCB,X1,ICSR,IVEC,IJOB,LP(26),LP(27),LP(28), 1 TAB,CRLF,FORM,FB,WAIT,XON,SPCL,SCO,RPA,WPA,IWIDE 170 CONTINUE 195 WRITE (7,121) 200 WRITE (7,112) DO 210 I=1,40 IN(I) =' ' 210 CONTINUE LASCHR= 0 WRITE (7,100) READ (5,101) READNM IF (READNM(1).EQ.' ') GO TO 900 C CALL PARSE (READNM, FILNAM, DEV, EXT, LASCHR) OPEN (UNIT=11, 1 NAME=FILNAM, 2 TYPE='OLD', 3 READONLY, 4 ERR=215, 5 ACCESS='DIRECT', 6 RECORDSIZE=128) GO TO 220 215 WRITE (7,102) GO TO 200 C 220 REWIND 11 IREC=1 READ (11'IREC) (LP(I),I=1,256) IREC=2 READ (11'IREC) (LP(I),I=257,512) CLOSE (UNIT=11) C WRITE (7,112) IPNT=129 IPNTB=257 C 230 ICNST=LP(IPNT) DO 231 I=1,6 OPTN(I)=' ' 231 CONTINUE INME=IPNT+1 CALL R50ASC (6,LP(INME),OPTN) ITYPE=LPB(IPNTB+7) IJMP =LPB(IPNTB+6)+129 IF (ITYPE.EQ.NUM) GO TO 300 IF (ITYPE.EQ.OCT) GO TO 400 IF (ITYPE.EQ.NO ) GO TO 500 I=-1 WRITE (7,105) OPTN,I C 240 IPNT=IPNT+4 IPNTB=IPNTB+8 IF (IPNT.GE.192) GO TO 900 IF (LP(IPNT).NE.0) GO TO 230 GO TO 200 C 300 CONTINUE ! NUMBER IGET=0 IF (LP(IJMP).EQ."060703) IGET=(IJMP+1)+(ICNST/2) IF (LP(IJMP).EQ."010067) IGET=(LP(IJMP+1)/2)+IJMP+2 IF (IGET.NE.0) GO TO 310 IJMP=IJMP+1 GO TO 300 310 I=LP(IGET) WRITE (7,104) OPTN,I GO TO 240 C 400 CONTINUE ! OCTAL IF (ICNST.GT.0) GO TO 450 IF ((ICNST.AND."000077).EQ.0) GO TO 450 IF (LP(IJMP).EQ."006300) IJMP=IJMP+1 IF (LP(IJMP).EQ."006300) IJMP=IJMP+1 IJMP=IJMP+3 IGET=(LP(IJMP+1)/2)+IJMP+2 IGET=LP(IGET).AND.(.NOT.ICNST) X1=' ' IF ((.NOT.ICNST.AND."700).NE.0) X1='1' X2='1' X3='1' IF ((IGET.AND."700).NE.0) X1='0' IF ((IGET.AND."070).NE.0) X2='0' IF ((IGET.AND."007).NE.0) X3='0' WRITE (7,107) OPTN,X1,X2,X3 GO TO 240 C 450 IF (LP(IJMP).EQ."010067) GO TO 460 IJMP=IJMP+1 GO TO 450 460 IGET=(LP(IJMP+1)/2)+IJMP+2 I=LP(IGET) WRITE (7,105) OPTN,I GO TO 240 C 500 CONTINUE ! NO IJMP=IJMP+2 IGET=(LP(IJMP+1)/2)+IJMP+2 I=' ' IF (LP(IGET).EQ.ICNST) I='NO' WRITE (7,106) OPTN,I,OPTN GO TO 240 C 900 STOP 'bye-bye' END