	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 ? <cr> 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
