FTN4,L C LYLE WEIMAN C 7/27/77 C C TRACK ASSIGNMENT TABLE PRINTOUT PROGRAM C C IDENTIFIES EACH TRACK AS BEING USED FOR: C -SYSTEM (MEMORY-RESIDENT PORTION) C -SYSTEM ENTRY POINTS C -SYSTEM RELOCATABLE LIBRARY C -DISC-RESIDENT PROGRAM STORAGE C " " " SWAP STORAGE C -OWNED BY A PROGRAM C -OWNED BY FMP (FMGR TRACKS) C -ALLOCATED GLOBALLY C - AVAILABLE C C C PROGRAM LTAT DIMENSION LU(5),IOWN(3,10) C C CALL RMPAR(LU) IF(LU.EQ.0)LU=1 WRITE (LU,300) 300 FORMAT (/"24999-16171 1752 SOFTWARE SERVICE KIT SYSTEM 1000"/) LUTTY=LU+400B LIST=LU(2) IF(LIST.EQ.0)LIST=LUTTY C C 15 WRITE(LIST,102) 102 FORMAT(/" TRACK ASSIGNMENT TABLE & = PROG ^ = SWAP"/ & " TRACK 0 1 2 3 4 5 6" & " 7 8 9") 120 FORMAT(I4,2X,10(1X,3A2)) C ITAT=IGET(1656B) NCNT=- IGET(1755B) NCNTP1 = NCNT + 1 C GET # TRACKS ON LU 2 NTDSK = IGET(1756B) NTDSK1 = NTDSK + 1 N= 0 INDEX = 0 ITRACK= -1 LUDISK = 2 C C TRACE THROUGH TAT C 20 DO 21 I=1,10 IOWN(1,I)=2H IOWN(2,I)=2H IOWN(3,I)=2H 21 CONTINUE C DO 100 JCNTR = 1,10 N = N + 1 ITRACK = ITRACK + 1 C IF LAST TRACK ON SYSTEM OR C AUXILIARY DISC, DUMP PRINT BUFFER. IF( N .GT. NCNTP1 ) GOTO 222 IF(N .EQ. NTDSK1) GOTO 222 C C GET T.A.T. ENTRY IAD=IGET(ITAT) C ADVANCE T.A.T. POINTER ITAT=ITAT + 1 C CHECK IF IT'S A SYSTEM TRACK IF(IAD.NE.100000B)GO TO 24 IOWN(1,JCNTR)=2HSY IOWN(2,JCNTR)=2HST IOWN(3,JCNTR)=2HEM C C NARROW DOWN 'SYSTEM' TO LG, ENTRY POINTS, RELOC. LIBRY, C PROGRAM SOURCE OR SWAP TRACKS. C C LGG = IGET(1765B) C CALCULATE DISK TRACK & LU FROM PACKED DISC PNTR CALL FDISK(LGG,NSPTRK,LUDS,LGSTRT) C CALCULATE LAST LG TRACK LGEND=LGSTRT+IAND(LGG,177B)-1 C NOT LG TRACK IF NOT RIGHT LU... IF(LUDISK .NE. LUDS) GOTO 232 IF((ITRACK .LT. LGSTRT) .OR. (ITRACK .GT. LGEND))GO TO 232 IOWN(1,JCNTR)=2H IOWN(2,JCNTR)=2HLG IOWN(3,JCNTR)=2H GO TO 100 C C SEE IF IT'S IN THE SYSTEM ENTRY POINT LIST... 232 CONTINUE C GET DISC PNTR LST = IGET(1761B) C CALCULATE LU & TRACK FROM PACKED DISC PNTR CALL FDISK(LST,NSPTRK,LUDS,IENTST) C CAN'T BE HERE IF NOT LU 2 IF(LUDISK .NE. 2) GOTO 234 IENTND=IENTST+(IGET(1762B)*4/64+IAND(LST,177B)-1)/NSPTRK IF((ITRACK .LT. IENTST) .OR. (ITRACK .GT. IENTND))GO TO 234 IOWN(1,JCNTR)=2H-E IOWN(2,JCNTR)=2HNT IOWN(3,JCNTR)=2HS- GO TO 100 C C SEE IF IT'S THE RELOCATABLE LIBRARY.... 234 CONTINUE C CAN'T BE IF NOT ON SYSTEM DISC... IF(LUDISK .NE. 2) GOTO 236 LBS=IGET(1763B) CALL FDISK(LBS,NSPTRK,LUDS,LBSTRT) IF((ITRACK .LT. LBSTRT) .OR. (ITRACK .GT. IENTST))GO TO 236 IOWN(1,JCNTR)=2HLI IOWN(2,JCNTR)=2HBR IOWN(3,JCNTR)=2HY- GO TO 100 C C SEE IF IT'S A PROGRAM 'SOURCE' OR SWAP TRACK... 236 CONTINUE CALL PRGTR(ITRACK,LUDISK,IOWN(1,JCNTR)) GO TO 100 C C NON-SYSTEM TRACKS C C GLOBAL? 24 IF(IAD.NE.77777B)GO TO 25 IOWN(1,JCNTR)=2HGL IOWN(2,JCNTR)=2HOB IOWN(3,JCNTR)=2HAL GO TO 100 C C FMP? 25 IF(IAD.NE.77776B)GO TO 26 IOWN(1,JCNTR)=2H-F IOWN(2,JCNTR)=2HMP IOWN(3,JCNTR)=2H-- GO TO 100 C C ANYBODY OWN IT? 26 IF(IAD.NE.0)GO TO 27 C NOBODY OWNS IT. IOWN(1,JCNTR)=2H IOWN(2,JCNTR)=2H-- IOWN(3,JCNTR)=2H GOTO 100 C SOME PROGRAM OWNS IT. 27 IOWN(1,JCNTR)=IGET(IAD+12) IOWN(2,JCNTR)=IGET(IAD+13) IOWN(3,JCNTR)=IOR(IAND(IGET(IAD+14),77400B),40B) C 100 CONTINUE 222 CONTINUE WRITE(LIST,120)INDEX,IOWN INDEX = INDEX + 10 IF(N .GT. NCNT) GOTO 90 IF(N .NE. NTDSK1) GOTO 20 C SWITCHING OVER TO AUXILIARY DISC. WRITE(LIST,103) 103 FORMAT(/" AUXILIARY DISC"/) ITRACK = -1 LUDISK = 3 INDEX= 0 GOTO 20 C END C 90 CALL EXEC(6,0,0,LU,LU(2)) END C C SUBROUTINE FDISK(IPNTR,NSPTRK,LUDISK,JTRAK) C C FINDS THE SYSTEM OR AUXILIARY DISC WHERE THE DISC C POINTER (IN PACKED FORMAT) POINTS TO, C AS WELL AS THE TRACK. C C USES RTE CONVENTION (IF IPNTR < 0 THEN LU IS 3, ELSE 2. C C ON RETURN: C NSPTRK = # SECTORS PER TRACK ON THE DISC C LUDISK = 2 OR 3 (DISK LU) C JTRAK = TRACK ADDRESS C LUDISK = 2 IF(IPNTR .LT. 0) LUDISK = 3 NSPTRK = IGET(1755B + LUDISK) JTRAK = IAND(IPNTR,77600B) / 128 RETURN END SUBROUTINE PRGTR(ITRACK,LUDISK,NAME) C C VERSION 7-27 - 77 LAW C DETERMINES IF ITRACK & LUDISK POINT TO A TRACK C USED FOR STORING THE VIRGIN VERSION OR C SWAPPED VERSION OF A PROGRAM. C C DIMENSION NAME(3) INTEGER SHRTID,HIGHBP INTEGER FSWTRK C C INITIALIZE SEARCH THRU KEYWORD BLOCK KEYWD=IGET(1657B) C 10 IDADR=IGET(KEYWD) IF(IDADR.LE.0)GO TO 90 NAME3=IGET(IDADR + 14) SHRTID = 0 IF(IAND(NAME3,20B) .NE. 0) SHRTID = -1 C MAKE SURE IT'S A DISC-RESIDENT PROGRAM C OR SHORT ID FOR SEGMENTS. IF(IAND(NAME3,22) .EQ. 0) GOTO 22 C SET FLAG FOR "SOURCE" TRACK ITYPE=46B C C GET HI & LOW MAIN & BP ADDRESSES C IF(SHRTID) 12,15 12 CONTINUE C C SHORT ID SEGMENT. C LOWMAN=IGET(IDADR + 15) MAINHI=IGET(IDADR + 16) LOWBP = IGET(IDADR + 17) HIGHBP=IGET(IDADR + 18) KTRAK=IGET(IDADR + 19) GOTO 16 15 CONTINUE C C LONG ID SEGMENT C LOWMAN = IGET(IDADR + 22) MAINHI = IGET(IDADR + 23) LOWBP = IGET(IDADR + 24) HIGHBP = IGET(IDADR + 25) KTRAK = IGET(IDADR + 26) 16 CONTINUE C IF BLANK ID SEGMENT THEN GO ON.... IF(KTRAK .EQ. 0) GOTO 22 C C CALCULATE # SECTORS REQUIRED FOR PROGRAM C STORAGE. NSECTS= ((MAINHI - LOWMAN + 127) /128) * 2 + 1((HIGHBP - LOWBP + 127) /128) * 2 C C FIND DISK TRACK & LU CALL FDISK(KTRAK,NSPTRK,LUDS,JTRAK) C CAN'T BE IF LUS NOT RIGHT.... IF(LUDISK .NE. LUDS) GOTO 20 C CALCULATE LAST TRACK LSTRK=JTRAK + NSECTS / NSPTRK IF((JTRAK .LE. ITRACK) .AND. (ITRACK .LE. LSTRK)) 25,20 C C NOT SOURCE TRACK. TRY SWAP TRACK. C C CHECK FOR SHORT ID SEGMENT 20 CONTINUE IF(SHRTID) 22,21 21 CONTINUE C GET CODED SWAP TRACK (LU, TRACK, # TRACKS) KTRAK = IGET(IDADR + 27) C IF NO SWAP TRACKS, GO ON... IF(KTRAK .EQ. 0) GOTO 22 C SEPARATE LU, FIRST & LAST SWAP TRACKS CALL FDISK(KTRAK,NSPTRK,LUDS,FSWTRK) LSWTRK = IAND(KTRAK,177B) + FSWTRK - 1 C IF LUS NOT SAME, THIS PROG NOT ON THIS TRACK IF(LUDISK .NE. LUDS) GOTO 22 C SET UP SPECIAL CHARACTER IN NAME C TO IDENTIFY TRACK AS SWAP TRACK (^) ITYPE=136B IF((FSWTRK .LE. ITRACK) .AND. (ITRACK .LE. LSWTRK)) 25,22 22 CONTINUE C IF TRACK IS NEITHER SOURCE NOR SWAP TRACK FOR C THIS PROGRAM, GO ON TO NEXT PROGRAM. KEYWD=KEYWD+1 GO TO 10 C C 25 CONTINUE C FOUND PROGRAM WHICH IS STORED ON THIS TRACK. NAME = IGET(IDADR + 12) NAME(2)=IGET(IDADR+13) C MERGE IN CHARACTER FOR SOURCE OR SWAP TRACK. NAME(3)=IOR(IAND(NAME3,77400B),ITYPE) 90 RETURN END END$