Return to CONSTR.f CVS log

Up to [Research Unix] / researchv10no / cmd / pfort

researchv10 Norman

      SUBROUTINE CONSTR(MAINND)
      LOGICAL SYSERR, ERR, ABORT, INSYM, GREEN, INDIR
      LOGICAL OVER
C      NOTE SETNOD SETS ABORT FOR 2 P.U. WITH SAME NAME
C      CONSTR SETS ABORT IF IT FINDS NO SYMBOL TABLES FROM PASS1
C      ASLEV SETS ABORT IF IT FINDS RECURSION IN CALLING GRAPH
      INTEGER OUTUT2, OUTUT3, OUTUT4, SYMLEN
      INTEGER PNODE, PLAT, LS(2)
      COMMON /HEAD/ LNODE, PNODE, NODE(500)
      COMMON /SCR1/ LINODE, INODE(500)
      COMMON /PARAMS/ I1, I2, I3, SYMLEN, OUTUT2, OUTUT3, OUTUT4
      COMMON /GRAPH/ LLAT, PLAT, LAT(6000)
      COMMON /DETECT/ ERR, SYSERR, ABORT
      DATA IBR /1/, JBR /4/
      DATA LS(1) /1H,/, LS(2) /1H /
C
C      CONSTR DIRECTS THE FIRST PORTION OF PASS2
C      CALLS SETNOD TO CONSTRUCT THE LAT NODES FOR EACH P.U..
C      CALLS SETEXT TO SETUP BASIC EXERNALS NODES
C      AS NEEDED.
C      CALLS SETREF TO MAKE CONNECTS BETWEEN THE NODES
C      CALLS INVOKE TO CALCULATE LEVELS AND ASSIMILATE
C      ALL PROC INFO NECESSARY
C     CALLS ERASE TO GET RID OF NON-REFERENCE LINKS IN
C     CALLING GRAPH
C      CALLS CHKALL TO DO FINAL CHECKS OF ALL REFS AND TO
C      WRITE ALL GOOD REFS OUT FOR FUTURE PROCESSING
C     FORMS SUPERROOT IN GRAPH
C      CALLS OUTPUT ROUTINES WHENEVER CAN, TO GIVE PARTIAL
C      LISTINGS OF CURRENT DATA STRUCTURE
C
C     USE INSYM TO POSSIBLY SKIP OVER BAD REFS WITH DUMMY SYM TBL
C     SETREF READS REFS FROM OUTUT3, WRITES ON OUTUT4
C     INVOKE READS FROM OUTUT4
C     CHKALL READS FROM OUTUT4, WRITES OUTUT3
C     UNSAFE READS FROM OUTUT3
C      INITIALIZE LEVEL ARRAY AND ISR
      ISR = 0
      DO 10 I=1,LNODE
        INODE(I) = 0
   10 CONTINUE
C     INITIALIZE LOGICAL FLAGS FOR DETECTION OF PRESENCE OF
C     EXTERNAL ENTITIES (GREEN) AND INDIRECT REFS(INDIR)
      GREEN = .FALSE.
      INDIR = .FALSE.
 20   IF(.NOT.INSYM(0,0)) GOTO 30
C
C      SUCCESSFULLY READ SYMBOL TABLE
C
      CALL SETNOD
      IF (SYSERR .OR. ABORT) GO TO 130
      GO TO 20
   30 REWIND OUTUT2
      IF (PNODE.EQ.1) GO TO 150
C      CHANGE LEVEL ON ASFS SO DONT PROCESS THEM
      L = PNODE - 1
      DO 40 I=1,L
        IF (NODE(I).LT.0) INODE(I) = -2
   40 CONTINUE
C
C      SETUP BASIC EXTERNAL DEFNS AS NEEDED
C
      CALL SETEXT
      IF (SYSERR) GO TO 130
C
C      READ IN SYMBOL TABLES
C      SETREF WILL READ IN REFS
C
 50   IF(.NOT.INSYM(OUTUT3, OUTUT4)) GOTO 60
      CALL SETREF ( GREEN, INDIR  )
      IF (SYSERR .OR. ABORT) GO TO 130
      GO TO 50
   60 REWIND OUTUT2
      REWIND OUTUT3
      WRITE (OUTUT4) IBR, JBR, IBR
      REWIND OUTUT4
      IF(.NOT.INDIR) GOTO 70
C
C       CALL LEVEL ALG
C
      CALL INVOKE
      IF (ABORT .OR. SYSERR) GO TO 130
      REWIND OUTUT2
      REWIND OUTUT4
C
C      CHECK AND EXPAND REFS AND SAVE ALL GOOD ONES FOR LATER
C
 70   IF(.NOT.INSYM(OUTUT4,OUTUT3)) GOTO 80
      CALL CHKALL
      IF (SYSERR) GO TO 130
      GO TO 70
   80 WRITE (OUTUT3) IBR, JBR, IBR
C
C      CONSTRUCT SUPEROOT IN LAT
C
      IF (PNODE+1.GT.LNODE) GO TO 180
      IF (PLAT+SYMLEN+7.GT.LLAT) GO TO 160
      NODE(PNODE) = PLAT
C      MAINND IS SUPEROOT INDEX IN NODE
C      ISR IS SUPEROOT INDEX IN LAT
      MAINND = PNODE
      ISR = PLAT
      PNODE = PNODE + 1
      LAT(PLAT) = LS(1)
      PLAT = PLAT + 1
      IF (SYMLEN.EQ.1) GO TO 100
      DO 90 I=2,SYMLEN
        L = PLAT + I - 2
        LAT(L) = LS(2)
   90 CONTINUE
      PLAT = L + 1
  100 L = PLAT + 5
      DO 110 I=PLAT,L
        LAT(I) = 0
  110 CONTINUE
      LAT(L+1) = 5
      PLAT = L + 2
C
C      LOOK FOR CALLABLE PGM UNITS WITHOUT PARENTS
C
      L = PNODE - 2
      DO 120 I=1,L
        K = SYMLEN + 3 + IABS(NODE(I))
        IF (LAT(K).EQ.0) CALL SETPD(IABS(NODE(I)), ISR)
        IF (SYSERR) GO TO 130
 120  CONTINUE
 130  IF(.NOT.GREEN) GOTO 190
C     ERASE GREEN LINKS
      L = PNODE - 2
      DO 210 I = 1,L
C     SKIP ASF NODES
      IF(NODE(I) .LT. 0) GOTO 210
C     FIND HEAD OF GREEN LINKS
      N = NODE(I) + SYMLEN + 3
 220  IF(LAT(N+1) .LE. 0) GOTO 230
      N = LAT(N+1)
      GOTO 220
 230  LAT(N+1) = 0
 210  CONTINUE
 190  OVER = SYSERR
      SYSERR = .FALSE.
      CALL OUT2 (ISR)
      SYSERR = SYSERR.OR.OVER
      IF(SYSERR) CALL ERROR1(
     *    56H ILLEGAL COMMON USAGE AND UNSAFE REFERENCES NOT VERIFIED,
     *    56)
      CALL OUT2C
  140 RETURN
  150 ABORT = .TRUE.
      GO TO 140
  160 CALL ERROR1(33H IN CONSTR, TABLE OVERFLOW OF LAT, 33)
  170 SYSERR = .TRUE.
      GO TO 130
  180 CALL ERROR1(34H IN CONSTR, TABLE OVERFLOW OF NODE, 34)
      GO TO 170
      END

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.