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 MODIFIED JUNE 1978 R FRENCH CONVERTED TO IAS VERSION 3.0 C C TASK BUILD FILE C C SCAN/PR/-CP/-FP=SCAN,SYSCAN,ORDERI,[1,1]EXEC.STB 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(60),IBUF(80),MSG(20) DIMENSION IACT(10,100),IOUT(13),IMRL(8,50),KOUT(11) DIMENSION IIPART(2),IPRM(2),ERRMSG(5) EQUIVALENCE (IBUF(1),IACT(1,1)),(ERRMSG,MSG) DIMENSION IGBL(2,5),IPNAME(2) DIMENSION KLOC(100),LOC(100) DIMENSION IPART(4,10),JPART(10),LPART(10),MPART(3) DIMENSION ISTAT(68) DIMENSION IPARTX(2),IGEN(2) REAL*8 STAT(17) EQUIVALENCE (STAT,ISTAT) DATA STAT/'LRPLRQLR','SLRFLRGR','UNASTSUS','WNDWSMST','PST0ST1S', 1'T2ST3ST4','WF0WF1WF','2WF3WF4E','XTIR1IR2','IR3IR4TF','FTNRSTNS', 2'FCRRQRRS','RRFPARTS','ETS1TS2M','RLMREMRR','WDIDIFID','LWACEX1 '/ DATA IGBL/'CO','M ','LI','B ','PU','RE','OV','LY','PL','AS'/ DATA LSTFLG,IIPFLG,IIPART/4*0/ DATA ERRMSG/' NO ','SUCH',' PAR','TITI','ON '/ DATA MSG(1),MSG(19)/"12,"15/ DATA IGEN/3RGEN,0/ DATA IXFLG/0/ 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) C***** D WRITE(6,9999) NACT,NMRL,NPART D9999 FORMAT(' NACT = ',I3,3X,'NMRL = ',I3,3X,'NPART = ',I3) D WRITE(6,9998) ((IACT(I,J),I=1,10),J=1,NACT) D9998 FORMAT(1H0,10O10) D WRITE(6,9997) ((IMRL(I,J),I=1,8),J=1,NMRL) D9997 FORMAT(1H0,8O10) D WRITE(6,9996) ((IPART(I,J),I=1,4),J=1,NPART) D9996 FORMAT(1H0,4O10) C***** 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)=19 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(1)=IACT(7,LOC(1)) IPARTX(2)=IACT(8,LOC(1)) C C WRITE TITLE LINE WRITE(1,1000) 1000 FORMAT(6X,'TASK',3X,'TI',4X,'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,'IAS3.0',18X,'0 -',O5,'77',O7,'00',2X,'SYSTEM') 29 WRITE(1,1200) 1200 FORMAT(1X,60('-')) C C PROCESS ACTIVE TASK DATA 33 KTASK=1 DO 110 I=1,NACT J=LOC(I) IF (I.EQ.1) GO TO 44 IF (IACT(5,J).EQ.IACT(5,LOC(I-1))) GO TO 110 44 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 (IIPART(1).NE.0) GO TO 41 IF (IXFLG.NE.0) GO TO 34 IF (KOMSTR(IACT(7,J),1,4,IGEN,1).NE.0) GO TO 42 LTASK=IPART(4,KPART) IXFLG=1 GO TO 34 41 IF (KOMSTR(IACT(7,J),1,4,IIPART,1).EQ.0) GO TO 34 42 IF (KOMSTR(IACT(7,J),1,4,IPARTX,1).EQ.0) GO TO 110 IPARTX(1)=IACT(7,J) IPARTX(2)=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(3,J) GO TO 35 31 IOUT(4)=IACT(3,J) KSTAT=(IACT(4,J)/2)*3+1 IOUT(6)=' ' CALL STRMOV(ISTAT,KSTAT,3,IOUT(5),1) 35 IOUT(7)=IACT(5,J) IOUT(9)=IACT(6,J) IOUT(8)=IOUT(7)+IOUT(9) CALL R50ASC(6,IACT(7,J),IOUT(10)) IF (IACT(9,J).NE.0) IOUT(13)=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(7).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) KSTAT=(IMRL(5,II)/2)*3+1 KOUT(6)=' ' CALL STRMOV(ISTAT,KSTAT,3,KOUT(5),1) KOUT(7)=IMRL(4,II) CALL R50ASC(6,IMRL(6,II),KOUT(8)) KOUT(11)=IMRL(8,II) ENCODE(60,3000,INFO) KTASK,KOUT 3000 FORMAT(I2,2X,3A2,O4,4X,2A2,2X,'* SWAPPED OUT *',O6,'00', 1 2X,3A2,I5) KTASK=KTASK+1 WRITE(1,1400) INFO 1400 FORMAT(1X,60A1) 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(7).EQ.LTASK) GO TO 90 ISIZE=IOUT(7)-LTASK IEND=IOUT(7)-1 WRITE(1,1500) LTASK,IEND,ISIZE,(IOUT(II),II=10,12) 1500 FORMAT(22X,O8,'00-',O5,'77',O6,'00',2X,3A2) C C WRITE ACTIVE TASK DATA 90 LTASK=IOUT(8) IF (IACT(9,J).EQ.0) GO TO 100 IOUT(8)=IOUT(8)-1 ENCODE(60,2000,INFO) KTASK,IOUT 2000 FORMAT(I2,2X,3A2,O4,4X,2A2,O7,'00-',O5,'77',O6,'00',2X,3A2,I5) KTASK=KTASK+1 IF ((IACT(10,J).AND."2000).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+2) IOUT(4)=IACT(4,J) IOUT(6)=IOUT(6)-1 ENCODE(60,2500,INFO) (IOUT(II),II=1,10) 2500 FORMAT(4X,3A2,9X,I2,O8,'00-',O5,'77',O6,'00',2X,3A2,5X) IOUT(12)=IOUT(10) IOUT(11)=IOUT(9) IOUT(10)=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=10,12) 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) KSTAT=(IMRL(5,II)/2)*3+1 KOUT(6)=' ' CALL STRMOV(ISTAT,KSTAT,3,KOUT(5),1) KOUT(7)=IMRL(4,II) CALL R50ASC(6,IMRL(6,II),KOUT(8)) KOUT(11)=IMRL(8,II) ENCODE(60,3000,INFO) KTASK,KOUT 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