*DECK,BUGPRO
      SUBROUTINE BUGPRO 
C 
C  IF IN DEBUG MODE, THIS ROUTINE BRINGS ALL DEBUG INFORMATION
C  PERTAINING TO THE ROUTINE BEING COMPILED FROM THE RANDOM ACCESS DEBUF
C  FILE INTO CENTRAL MEMORY.  THE B-CELL LINKS FOR THE -FROM- AND 
C  OPTIONS LISTS ARE SET UP AND THE SYMBOL TABLE ORDINALS ARE 
C  SUBSTITUTED FOR THE DVL ORDINALS.
C 
C  UPON ENTRY:  SDBGIND = THE STARTING ADDRESS OF THE DEBUG RANDOM
C                         ACCESS FILE INDEX 
C               DOLAST  = THE ENDING ADDRESS OF THE DO TABLES 
C               ELAST   = THE ADDRESS OF THE LAST WORD OF E-LIST
C               SSYMTAB = THE BEGINNING ADDRESS OF THE SYMBOL TABLE 
C 
C 
C  OPEN THE DEBUG RANDOM ACCESS FILE TO SEE IF IT CONTAINS ANY INFO 
C 
*CALL LDBGCOM 
      OPENFL = -1 
      LNDRLSV = LNG DRL 
      LNDVLSV = LNG DVL 
      CALL WRTMS1 
      IF (DF PACK .NE. 0) INDEX NO = 1
      LNG DRL = LENGTH(DEBUG(SDBGIND+INDEX NO)) 
      IF (LNG DRL .EQ. 0) 30, 10
   60 WRITE (DBGOUT, 71)
   71 FORMAT(14X, *DEBUG: MORE CORE IS NEEDED FOR DEBUG PROCESSING. *)
      LNG DRL = LNDRLSV 
      LNG DVL = LNDVLSV 
   30 IF (INDEXNO .EQ. 3) NOACT = -1
      CALL WRTMS4 
      RETURN
  
C  BRING IN DEBUG ROUTINE LIST FROM DISK AND SEARCH IT FOR NAME OF
C  CURRENT ROUTINE
  
   10 IF (DFPACK .EQ. 0) GO TO 11 
      CALL RDMS1 ( DEBUG(SDRL), LNG DRL, 1) 
      EDRL = SDRL + LNG DRL 
      LNG DVL = LENGTH (DEBUG(SDBGIND+2)) 
      CALL RDMS1 ( DEBUG(SDVL), LNG DVL, 2) 
      EDVL = SDVL + LNGDVL - 1
      CALL WRTMS4 
      LNG DRL = LNDRLSV 
      LNG DVL = LNDVLSV 
      RETURN
  
  
  
   11 CALL RDMS1 (DEBUG(DOLAST + LNG IND + 1), LNG DRL, INDEXNO)
      ROU NAME = DRLELT(DEBUG(SSYMTAB-2)) 
      DRL = DOLAST + LNG IND - 1
      SDRL = DRL + 2
      EDRL = DRL + LNG DRL + 2
      NN = 0
      N = 0 
      TOT LNG = 0 
   20 DRL = DRL + 2 
      IF (DRL .EQ. EDRL) GO TO 50 
      IF (ROU NAME .NE. DRLELT(DEBUG(DRL))) GO TO 20
C 
C  IF NAME IS FOUND, DETERMINE AMOUNT OF SPACE NECESSARY FOR DEBUG
C  TABLES FOR THIS ROUTINE. 
C 
      TEMP = ADDRESS(DEBUG(DRL+1))
      IF (TEMP .NE. 0)
     ,    TOT LNG = TLENGTH(DEBUG(SDBGIND + TEMP))
      N=2 
   40 IF (ROU NAME .NE. DRLELT(DEBUG(DRL + N))) GO TO 50
      TEMP = ADDRESS(DEBUG(DRL+N+1))
      IF (TEMP .NE. 0)
     ,    TOT LNG = TLENGTH(DEBUG(SDBGIND+TEMP)) + TOT LNG
      N= N + 2
      GO TO 40
   50 IDRL = SDRL - 2 
   52 IDRL = IDRL + 2 
      IF (IDRL .EQ. EDRL) GO TO 51
      IF (SPIDER .NE. DRLELT(DEBUG(IDRL))) GO TO 52 
      TEMP = ADDRESS(DEBUG(IDRL + 1)) 
      IF (TEMP .NE. 0)
     ,    TOT LNG = TLENGTH(DEBUG(SDBGIND + TEMP)) + TOT LNG
   53 NN = NN + 2 
      IF (SPIDER .NE. DRLELT(DEBUG(IDRL + NN ))) GO TO 51 
      TEMP = ADDRESS(DEBUG(IDRL + NN + 1))
      IF (TEMP .NE. 0)
     ,    TOT LNG = TLENGTH(DEBUG(SDBGIND + TEMP)) + TOT LNG
      GO TO 53
   51 IF (TOT LNG .EQ. 0) GO TO 30
      LNG DVL = LENGTH(DEBUG(SDBGIND + INDEX NO + 1)) 
      IF ((DOLAST + LNG IND + LNG DRL + LNG DVL) .GE. 
     ,    (ELAST - TOT LNG - (2* LNG DVL))) GO TO 60
C  MOVE SYMTAB AND E-LIST DOWN IN CORE SO THAT THE AREA AND OPTIONS 
C  LISTS CAN BE BROUGHT IN FROM DISK.  PROCESS AREA LISTS AS THEY ARE 
C  BROUGHT IN. FIRST BRING IN AREA LISTS, OPTION LISTS AS THEY ARE MET. 
C 
      BASE ADD = FIDIT
      AREAEND = FIDIT - 1 
      IF ((ELAST - TOT LNG) .GT. DOLAST) GO TO 81 
      WRITE (DBGOUT, 10020) 
10020 FORMAT(14X,*DEBUG: MORE CORE IS NEEDED TO BRING PACKETS IN FROM DI
     ,SK.  ONLY INTERSPERSED STATEMENTS WILL BE PROCESSED. *) 
      CALL WRTMS4 
      LNG DRL = LNDRLSV 
      LNG DVL = LNDVLSV 
      RETURN
  
  
  
   81 TOT LNG = TOT LNG + 1 
      CALL DMVWDS (FIDIT-ELAST+1, DEBUG(ELAST), DEBUG(ELAST-TOTLNG) ) 
      ELAST = ELAST - TOT LNG 
      SSYMTAB = SSYMTAB - TOT LNG 
      ESYMTAB = ESYMTAB - TOT LNG 
      ELIST = ELIST - TOT LNG 
      LELIST = LELIST - TOT LNG 
      EFIDIT = FIDIT
      FIDIT = FIDIT - TOT LNG 
      SAASI = SAASI - TOT LNG 
      CALL FIXPNTR
      SAV UP DT(1) = CUR UP DT (1)
      SAV UP DT(2) = CUR UP DT (2)
      IF (N .EQ. 0) GO TO 70
   80 N = N - 2 
      IF (N .LT. 0) GO TO 70
      TEMP = ADDRESS(DEBUG(DRL+N+1))
      IF (TEMP .EQ. 0) GO TO 80 
      LNG ROU = LENGTH(DEBUG(SDBGIND + TEMP)) 
      BASE ADD = BASE ADD - LNG ROU 
      IF (LNG ROU .EQ. 0) GO TO 80
      CALL RDMS1 (DEBUG(BASE ADD), LNG ROU, ADDRESS(DEBUG(DRL+N+1)))
      GO TO 80
   70 IF (NN .EQ. 0) GO TO 73 
   72 NN = NN - 2 
      IF (NN .LT. 0) GO TO 73 
      TEMP = ADDRESS(DEBUG(IDRL + NN + 1))
      IF (TEMP .EQ. 0) GO TO 72 
      LNG ROU = LENGTH(DEBUG(SDBGIND + TEMP)) 
      BASE ADD = BASE ADD - LNG ROU 
      IF (LNG ROU .EQ. 0) GO TO 72
      CALL RDMS1 ( DEBUG(BASE ADD), LNG ROU, ADDRESS(DEBUG(IDRL+NN+1))) 
      GO TO 72
   73 SAREA = BASE ADD
      EFIDIT = AREAEND
      FIDIT = SAREA 
      FT ADD = 0
      N = 0 
      AREAEND = AREAEND - SAREA 
  550 FT ADD = FT ADD + N 
      IF (AREAEND .LE. FT ADD) GO TO 90 
C 
C  GET NEXT WORD OF AREA LIST.  IF OPTIONS WORD, BRING CORRESPONDING
C  OPTION IN FROM DISK. 
      RECORD = ADDRESS(DEBUG(SAREA + FT ADD)) 
      IF (RECORD .EQ. 0) GO TO 600
      LNG OPT = LENGTH(DEBUG(SDBGIND + RECORD)) 
      BASE ADD = BASE ADD - LNG OPT 
      IF (LNG OPT .EQ. 0) GO TO 602 
      CALL RDMS1 ( DEBUG(BASE ADD), LNG OPT, RECORD)
  602 FT ADD = FT ADD +1
C 
C  IF B-CELL, .OR. IN FWA OPTIONS LIST.  SET UP -FROM- BOUND LIST LINKS.
C 
  600 DEBUG(SAREA + FT ADD) = DEBUG(SAREA + FT ADD) .OR. BASE ADD 
      TO FM = 1 
      BD ADD = FT ADD + 1 
      BDS ADD = FT ADD + 3
      IF ((SHIFT(DEBUG(SAREA + FT ADD), 2).AND. 3) - 1) 100, 200, 300 
  100 IF (ADDRESS(SHIFT(FM LIST, 20)) .NE. 0) GO TO 110 
      FM LIST = FM LIST .OR. SHIFT(BD ADD, 40)
      N = 3 
      GO TO 400 
  110 ITEM = SHIFT(DEBUG(SAREA + BDSADD) .AND. MASK(30),30) 
      NEXT = ADDRESS(SHIFT(FM LIST, 20))
      CALL PUT
      N = 3 
      GO TO 400 
  200 IF (ADDRESS(SHIFT(FM LIST, -20)) .NE. 0) GO TO 210
      FM LIST = FM LIST .OR. SHIFT(BD ADD, 20)
      N = 3 
      GO TO 400 
  210 ITEM = SHIFT(DEBUG(SAREA + BDSADD) .AND. MASK(30),30) 
      NEXT = ADDRESS(SHIFT(FM LIST, -20)) 
      CALL PUT
      N = 3 
      GO TO 400 
  300 NXT ITEM = 1
      NEXT = SHIFT(ADDRESS(FM LIST), 42)
      CUR UP DT(1) = DEBUG(SAREA + BDSADD) .AND..NOT. MINZERO 
      CUR UP DT(2) = SHIFT(DEBUG(SAREA + BDSADD) .AND. MINZERO, 48) 
     ,   .OR. SHIFT(DEBUG(SAREA + BDSADD + 1) .AND. MASK(30), -12)
      CALL PUT UP DT
      N = 4 
C 
C  SET THE -TO- BOUND LIST LINKS
C 
  400 BD ADD = BD ADD + 1 
      TO FM = 0 
      BDS ADD = FT ADD + N
      IF ((SHIFT(DEBUG(SAREA + FT ADD), 4) .AND. 3) - 1) 410, 410, 500
  410 N = N + 1 
      GO TO 550 
  500 NXT ITEM = -1 
      NEXT = SHIFT(ADDRESS(FM LIST), 42)
      CUR UP DT(1) = (SHIFT(DEBUG(SAREA + BDSADD), 30) .AND. MASK(30))
     ,    .OR. (SHIFT(ADDRESS(SHIFT(DEBUG(SAREA+BDS ADD+1), 18)), 12))
      CUR UP DT(2) = SHIFT(DEBUG(SAREA + BDS ADD + 1), 18).AND.MASK(42) 
      CALL PUT UP DT
      N = N + 2 
      GO TO 550 
C 
C  BRING THE DVL FROM DISK AND ADD ITS ENTRIES TO THE SYMBOL TABLE
C 
   90 IF (LNG DVL .EQ. 0) GO TO 900 
      TEMP = 2 * LNG DVL
      CALL DMVWDS ( ELIST-ELAST+1, DEBUG(ELAST), DEBUG(ELAST-TEMP) )
      ELAST = ELAST - TEMP
      ELIST = ELIST - TEMP
      LELIST = LELIST - TEMP
      CALL FIXPNTR
      CALL RDMS1 ( DEBUG(DOLAST + LNG IND + 1), LNG DVL, INDEX NO + 1)
      DVL = DOLAST + LNG IND + 1
      EDVL = DVL + LNG DVL
  610 DVL = DVL + 1 
      IF (DVL.EQ.EDVL) GO TO 620
      CALL DSYMTAB(DEBUG(DVL),OH) 
      DEBUG(DVL) = DRLELT(SHIFT(DEBUG(DVL), 12) ) .OR. OH 
      GO TO 610 
C 
C  GO THROUGH THE OPTIONS LISTS AND REPLACE DVL ORDINALS WITH SYMBOL
C  TABLE ORDINALS 
C 
  620 DFOPL = BASEADD - 1 
      DVL = DOLAST + LNG IND + 1
      OPENFL = -1 
  630 DFOPL = DFOPL + 1 
      IF (DFOPL .EQ. SAREA) GO TO 900 
      MULT = 5
  750 CALL GET OUT
      IF((OH.EQ.MINZERO) .OR. (OH.EQ.0)) GO TO 630
      GO TO (700, 700, 700, 710, 710, 700, 720, 730, 630) OH
  700 CALL GET OUT
      IF (OH.EQ.0) GO TO 750
      IF (OH .EQ. MINZERO) GO TO 630
      DFNESTW = DFOPL 
      DFNEST = MULT 
      OH = DEBUG(DVL + OH) .AND. MINZERO
      CALL PUT IN 
      GO TO 700 
  710 CALL GET OUT
      IF (OH.EQ.0) GO TO 750
      IF (OH.EQ.MINZERO) 630, 710 
  720 DFOPL = DFOPL + 1 
  640 DEBUG(DFOPL) = (DEBUG(DFOPL).AND.SHIFT(MASK(42), 60-12)) .OR. 
     , SHIFT(DEBUG(DVL + (SHIFT(DEBUG(DFOPL),12).AND.MINZERO)) .AND.
     , MINZERO, 48) 
      IF (BITON(DEBUG(DFOPL),VARBIT(1)))
     ,    DEBUG(DFOPL)  =  (DEBUG(DFOPL) .AND. SHIFT(MASK(48), 30)) .OR.
     ,     SHIFT((DEBUG(DVL + (SHIFT(DEBUG(DFOPL),30) .AND. MINZERO)) 
     ,     .AND. MINZERO), 29)
      MULT = 5
      DFOPL = DFOPL + 1 
      CALL GET OUT
      IF (OH.EQ.0) GO TO 750
      IF (OH.EQ.MINZERO) 630, 640 
  730 DFOPL = DFOPL + 1 
      MULT = 0
      CALL GET OUT
      IF (OH.EQ.0) 750, 630 
  900 IF ( ADDRESS(SHIFT(FM LIST, 20)).EQ. 0) GO TO 999 
      IF (DUKE1 - 1 .EQ. 0) RETURN
      DUKE1 = DUKE1 - 1 
      P ADD = 1 
      TO FM = 1 
      BD ADD = 0
      DO 910 ITEM = 1, DUKE1, 1 
      NEXT = ADDRESS(SHIFT(FM LIST, 20) ) 
      CALL PUT
      IF (NEXT .EQ. 0) GO TO 910
  905 DFOPL = ADDRESS(DEBUG(SAREA + NEXT - 1) ) 
      CALL TURN ON
      BD ADD = 0
      NEXT = ADDRESS(SHIFT(DEBUG(SAREA + NEXT), -20) )
      IF (NEXT .NE. 0) GO TO 905
  910 CONTINUE
      IF (ADDRESS(SHIFT(TO LIST, 20)).EQ. 0) GO TO 930
      TO FM = 0 
      DO 920 ITEM = 1, DUKE1, 1 
      NEXT = ADDRESS(SHIFT(TO LIST,20) )
      CALL PUT
      IF (NEXT .EQ. 0) GO TO 920
  915 DFOPL = ADDRESS(DEBUG(SAREA + NEXT - 2) ) 
      CALL TURN OFF 
      NEXT = ADDRESS(SHIFT(DEBUG(SAREA + NEXT), -20) )
      IF (NEXT .NE. 0) GO TO 915
  920 CONTINUE
  930 DUKE1 = DUKE1 + 1 
      P ADD = 0 
  999 CALL WRTMS4 
      CUR UP DT (1) = SAV UP DT (1) 
      CUR UP DT (2) = SAV UP DT (2) 
      LNG DRL = LNDRLSV 
      LNG DVL = LNDVLSV 
      RETURN
      END 
