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$
                                                                                                                                    