C SCAN - MCR TASK TO READ SYSTEM TABLES AND WRITE A SUMMARY C OF SYTEM ACTIVITY, ORDERED BY ADDRESS, TO TI OR LP. C C CALLING SEQUENCE C C MCR>SCA[N][/LP][/FU][PAR=XXX] C C SWITCH DEFINITIONS C /LP - SUMMARY WILL BE WRITTEN TO LINE PRINTER C /FU - SUMMARY WILL BE FOR ALL PARTITIONS. DEFAULT IS C ALL PARTITIONS, EXCEPT THOSE BEGINNING WITH SYS. C /PAR=XXX - SUMMARY WILL BE FOR PARTITION XXX ONLY. C C AUTHOR R. FRENCH APRIL 1975 THE BOEING COMPANY SEATTLE, WASH C MODIFIED APRIL 1975 R FRENCH CONVERTED TO VERSION 6A C MODIFIED MARCH 1977 R FRENCH CONVERTED FOR PDP 11/70 AND C VERSION 6.2 C C TASK BUILD FILE C C SCAN/PR/-CP/-FP=SCAN,SYSCAN,ORDERI,STRMOV,KOMSTR,LSTRNG C [1,1]EXEC.STB/SS C / C TASK=...SCA C PRI=60 C ASG=TI:1 C ASG=TI:2 C ACTFIL=1 C UNITS=1 C STACK=64 C LIBR=SYSRES:RO C / C BYTE INFO(58),IBUF(80),MSG(4) DIMENSION IACT(10,30),IOUT(12),IMRL(8,10),KOUT(9) DIMENSION IIPART(2),IPRM(2),ERRMSG(5) EQUIVALENCE (IBUF(1),IACT(1,1)),(ERRMSG(5),MSG) DIMENSION IGBL(2,3),IPNAME(2) DIMENSION ISTAT(24) DIMENSION KLOC(30),LOC(30) DIMENSION IPART(4,10),JPART(10),LPART(10),MPART(3) DATA IGBL/'CO','M ','LI','B ','PU','RE'/ DATA ISTAT/'LQ','LS','LF','RN','AQ','SU','W0','W1','W2','W3','W4', 1 'EX','IR','IP','ID','IF','TF','TR','TS','SC','RQ','RS', 2 'RF','PE'/ DATA LSTFLG,IIPFLG,IIPART/4*0/ DATA ERRMSG/'NO S','UCH ','PART','ITIO','N '/ DATA MSG(2)/"15/ DATA ISYS/3RSYS/ C C READ MCR LINE AND ASSIGN LUN CALL GETMCR(IBUF,I) IF (I.LT.4) GO TO 10 IF (LSTRNG(IBUF,1,I,'/LP',1,3).NE.0) CALL ASNLUN(1,'LP',0) C C READ SYSTEM TABLES AND SORT ACTIVE TASK AND PARTITION ARRAYS IF (LSTRNG(IBUF,1,I,'/FU',1,3).NE.0) LSTFLG=1 II=LSTRNG(IBUF,1,I,'/PAR',1,4) IF (II.GT.0) CALL IRAD50(6,IBUF(II+5),IIPART) 10 CALL SYSCAN(IACT,NACT,IMRL,NMRL,IPART,NPART) DO 20 I=1,NPART 20 JPART(I)=IPART(3,I) CALL ORDERI(JPART,NPART,LPART) KPART=1 IF (IIPART(1).EQ.0) GO TO 25 DO 21 KPART=1,NPART L=LPART(KPART) IF (KOMSTR(IPART(1,L),1,4,IIPART,1).EQ.0) GO TO 25 21 CONTINUE IPRM(1)=LOCF(ERRMSG) IPRM(2)=18 CALL WTQIO("400,2,1,,,IPRM) GO TO 140 25 LTASK=IPART(3,KPART) DO 30 I=1,NACT 30 KLOC(I)=IACT(5,I) CALL ORDERI(KLOC,NACT,LOC) IPARTX=IACT(8,LOC(1)) C C WRITE TITLE LINE WRITE(1,1000) 1000 FORMAT(6X,'TASK',3X,'TI',2X,'STAT',6X,'LOCATION',6X,'SIZE',4X, 1 'PART',3X,'PRI') C C WRITE SYSTEM PARTITION IF (IIPART(1).NE.0) GO TO 29 IF (LSTFLG.EQ.0) GO TO 33 JTASK=LTASK-1 WRITE(1,1100) JTASK,LTASK 1100 FORMAT(5X,'RSX11D',17X,'0 -',O5,'77',O6,'00',2X,'SYSTEM') 29 WRITE(1,1200) 1200 FORMAT(1X,58('-')) C C PROCESS ACTIVE TASK DATA 33 KTASK=1 DO 110 I=1,NACT J=LOC(I) IF (IIPART(1).EQ.0) GO TO 32 IF (KOMSTR(IACT(7,J),1,4,IIPART,1).NE.0) GO TO 110 IIPFLG=1 32 IF (LSTFLG.NE.0) GO TO 34 IF (IACT(7,J).NE.ISYS) GO TO 34 IF (IIPART(1).NE.0) GO TO 34 IF (IACT(8,J).EQ.IPARTX) GO TO 110 IPARTX=IACT(8,J) KPART=KPART+1 LTASK=IPART(4,KPART) GO TO 110 34 CALL R50ASC(6,IACT(1,J),IOUT(1)) IF (IACT(9,J).NE.0) GO TO 31 IOUT(4)=IACT(4,J) GO TO 35 31 IOUT(4)=IACT(3,J) KSTAT=IACT(4,J)/2 IOUT(5)=ISTAT(KSTAT) 35 IOUT(6)=IACT(5,J) IOUT(8)=IACT(6,J) IOUT(7)=IOUT(6)+IOUT(8) CALL R50ASC(6,IACT(7,J),IOUT(9)) IF (IACT(9,J).NE.0) IOUT(12)=IACT(9,J) C C NEW PARTITION 40 L=LPART(KPART) IF (KOMSTR(IPART(1,L),1,4,IACT(7,J),1).EQ.0) GO TO 80 IFLAG=0 IF (IOUT(6).EQ.LTASK) GO TO 50 IFLAG=1 ISIZE=IPART(4,L)-LTASK IF (ISIZE.EQ.0) GO TO 45 CALL R50ASC(6,IPART(1,L),MPART(1)) IEND=IPART(4,L)-1 WRITE(1,1500) LTASK,IEND,ISIZE,MPART 45 LTASK=IPART(4,L) C C MRL TASKS 50 IF (NMRL.EQ.0) GO TO 70 DO 60 II=1,NMRL IF (KOMSTR(IPART(1,L),1,4,IMRL(6,II),1).NE.0) GO TO 60 CALL R50ASC(6,IMRL(1,II),KOUT(1)) KOUT(4)=IMRL(3,II) KOUT(5)=IMRL(4,II) CALL R50ASC(6,IMRL(6,II),KOUT(6)) KOUT(9)=IMRL(8,II) ENCODE(58,3000,INFO) KTASK,KOUT 3000 FORMAT(I2,2X,3A2,O4,2X,'* WAITING FOR MEMORY *',O5,'00', 1 2X,3A2,I5) IF ((IMRL(5,II).AND.1).NE.0) 1 CALL STRMOV('**** CHECKPOINTED ****',1,22,INFO,17) KTASK=KTASK+1 WRITE(1,1400) INFO 1400 FORMAT(1X,58A1) 60 CONTINUE 70 WRITE(1,1200) KPART=KPART+1 IF (IFLAG.EQ.0) GO TO 90 GO TO 40 C C WRITE HOLE 80 IF (IOUT(6).EQ.LTASK) GO TO 90 ISIZE=IOUT(6)-LTASK IEND=IOUT(6)-1 WRITE(1,1500) LTASK,IEND,ISIZE,(IOUT(II),II=9,11) 1500 FORMAT(20X,O8,'00-',O5,'77',O6,'00',2X,3A2) C C WRITE ACTIVE TASK DATA 90 LTASK=IOUT(7) IF (IACT(9,J).EQ.0) GO TO 100 IOUT(7)=IOUT(7)-1 ENCODE(58,2000,INFO) KTASK,IOUT 2000 FORMAT(I2,2X,3A2,O4,3X,A2,O8,'00-',O5,'77',O6,'00',2X,3A2,I5) KTASK=KTASK+1 IF ((IACT(10,J).AND.1024).NE.0) CALL STRMOV('*',1,1,INFO,4) GO TO 105 C C WRITE GLOBAL COMMON DATA 100 IF (IACT(10,J).NE.3) GO TO 101 IF (KOMSTR(IPNAME(1),1,4,IACT(1,J),1).EQ.0) GO TO 110 IPNAME(1)=IACT(1,J) IPNAME(2)=IACT(2,J) 101 DO 102 II=5,10 102 IOUT(II)=IOUT(II+1) IOUT(6)=IOUT(6)-1 ENCODE(58,2500,INFO) (IOUT(II),II=1,10) 2500 FORMAT(4X,3A2,7X,I2,O8,'00-',O5,'77',O6,'00',2X,3A2,5X) IOUT(11)=IOUT(10) IOUT(10)=IOUT(9) IOUT(9)=IOUT(8) II=IACT(3,J) CALL STRMOV(IGBL(1,II),1,4,INFO,14) 105 WRITE(1,1400) INFO 110 CONTINUE C C CHECK FOR HOLE AFTER LAST TASK (IN SAME PARTITION) L=LPART(KPART) IF (LTASK.EQ.IPART(4,L)) GO TO 120 ISIZE=IPART(4,L)-LTASK IEND=IPART(4,L)-1 WRITE(1,1500) LTASK,IEND,ISIZE,(IOUT(II),II=9,11) C C MRL TASKS IN LAST PARTITION 120 IF (NMRL.EQ.0) GO TO 125 DO 121 II=1,NMRL IF (KOMSTR(IPART(1,L),1,4,IMRL(6,II),1).NE.0) GO TO 121 CALL R50ASC(6,IMRL(1,II),KOUT(1)) KOUT(4)=IMRL(3,II) KOUT(5)=IMRL(4,II) CALL R50ASC(6,IMRL(6,II),KOUT(6)) KOUT(9)=IMRL(8,II) ENCODE(58,3000,INFO) KTASK,KOUT IF ((IMRL(5,II).AND.1).NE.0) 1 CALL STRMOV('**** CHECKPOINTED ****',1,22,INFO,17) KTASK=KTASK+1 WRITE(1,1400) INFO 121 CONTINUE C C WRITE REMAINING PARTITIONS (OR COMMONS) 125 IF (IIPART(1).NE.0) GO TO 140 KPART=KPART+1 IF (KPART.GE.NPART) GO TO 140 DO 130 I=KPART,NPART WRITE(1,1200) L=LPART(I) CALL R50ASC(6,IPART(1,L),MPART(1)) ISIZE=IPART(4,L)-IPART(3,L) IEND=IPART(4,L)-1 WRITE(1,1500) IPART(3,L),IEND,ISIZE,MPART 130 CONTINUE 140 CONTINUE END