Return to MAIN0.f CVS log

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

researchv10 Norman

      INTEGER STMT, PSTMT, SYMLEN, OUTUT, SYMHD, BNEXT, HASH, DSA,
     *    STACK, DOLIST, DOPT, OUTUT2, OUTUT3, PDSA, OUTUT4, REF, PREF,
     *    PNODE, PLAT, PCOM, COM
      LOGICAL ERR, SYSERR, OPT, P1ERR, ABORT, P2
      LOGICAL SW, QBR
      COMMON /SWS/ SW(10)
C*****SWS
C     SW(1) (LOG) IF TRUE, CAN USE END= OPTION IN READ STMTS
C
      COMMON /OPTNS/ OPT(5), P1ERR
C
C*****OPTNS
C     OPT(1) (LOG) IF TRUE, SYMBOL TABLE PRINTED FOR EACH P. U.
C     OPT(2) (LOG) IF TRUE, CROSS REFERENCES PRINTED FOR EACH SYMBOL
C     OPT(3) (LOG) IF TRUE, PASS 2 IS EXECUTED
C     OPT(4) (LOG) IF TRUE, LISTING PRINTED FOR EACH P. U.
C     OPT(5) (LOG) IF TRUE, FORTRAN PGM COMPILED AFTER VERIFIER
C     RUN;  IF ANY OF THESE ARE FALSE THE CORRESPONDING ACTION IS NOT TA
C     P1ERR (LOG) SET TO TRUE IF INFO NORMALLY SAVED FOR PASS 2 IS
C     SUPPRESSED FOR THIS P. U.
C
      COMMON /INPUT/ NSTMT, PSTMT, STMT(1327)
C
C*****INPUT
C     NSTMT (INT) INDEX OF END-OF-INPUT-STMT CHARACTER IN STMT
C     PSTMT (INT) POINTS TO CURRENT POSITION IN STMT (EXCEPT IN LEXICAL
C     SUBPGMS WHERE IT IS UPDATED IN CALLING SUBPGM AFTER A TOKEN IS
C     FOUND)
C     STMT (INT) ENCODED FORM OF DEBLANKED INPUT STMT
C
      COMMON /CEXPRS/ LSTACK, STACK(620)
C
C*****CEXPRS
C     LSTACK (INT) LENGTH OF STACK
C     STACK(*), (INT) ARRAY USED IN EXPR AS A STACK; ALSO FOR AUXILLARY
C     STORAGE AND OUTPUT
C
      COMMON /PARAMS/ INUT, OUTUT, NOCHAR, SYMLEN, OUTUT2, OUTUT3,
     *    OUTUT4
C
C*****PARAMS
C     INUT (INT) LOGICAL INPUT NUMBER FOR THE HOST MACHINE
C     OUTUT (INT) LOGICAL OUTPUT NUMBER FOR THE HOST MACHINE
C     NOCHAR (INT) NUMBER OF CHARACTERS PER MACHINE WORD IN HOST
C     SYMLEN (INT) NUMBER OF WORDS NECESSARY ON HOST TO STORE 6
C     CHARACTERS (I.E. A FORTRAN SYMBOL)
C     OUTUT2 (INT), OUTUT3(INT), OUTUT4(INT) LOGICAL OUTPUT NUMBERS
C     FOR THE HOST MACHINE TO BE USED BY THE VERIFIER FOR INTERPASS
C     COMMUNICATION
C
      COMMON /FACTS/ NAME, NOST, ITYP, IASF
C
C*****FACTS
C     NAME (INT) INDEX IN SYMBOL TABLE OF ENTRY FOR CURRENT P.U.
C     NOST (INT) STMT NUMBER OF CURRENT STMT BEING PROCESSED
C     ITYP (INT) TYPE OF STMT CURRENTLY BEING PROCESSED (SEE PU
C     FOR FURTHER DOC)
C
      COMMON /DETECT/ ERR, SYSERR, ABORT
C
C*****DETECT
C     ERROR (LOG) SET TO TRUE IN VARIOUS SUBPGMS USUALLY TO CEASE PROCES
C     OF CURRENT STMT
C     SYSERR (LOG) IRRECOVERABLE ERROR IN SYSTEM; (E.G., TABLE OVERFLOW)
C     IN PASS 1 CAUSES CURRENT P.U. TO HAVE AN END STMT SIMULATED AND
C     EXECUTION PROCEDES TO NEXT P.U.;  IN PASS 2 CAUSES PROCESSING
C     OF PROGRAM TO CEASE.
C
      COMMON /TABL/ NEXT, LABHD, SYMHD, BNEXT
C
C*****TABL
C     NEXT (INT) POINTS TO NEXT FREE WORD IN DSA (COUNTING FROM DSA(1))
C     LABHD (INT) POINTS TO HEAD OF LINEAR LINKED LIST IN DSA OF ALL
C     LABELS IN P.U.
C     SYMHD (INT) POINTS TO HEAD OF LINEAR LINKED LIST IN DSA OF ALL
C     SYMBOLS IN P.U.
C     BNEXT (INT) POINTS TO NEXT FREE WORD IN DSA (COUNTING FROM
C     DSA(LDSA))
C
      COMMON /CHASH/ LHASH, HASH(401)
C
C*****CHASH
C     LHASH (INT) LENGTH OF HASH ARRAY
C     HASH (*) (INT) HASH TABLE USED TO INDEX INTO DSA
C
      COMMON /CTABL/ LDSA, PDSA, DSA(5000)
C
C*****CTABL
C     LDSA (INT) LENGTH OF DSA
C     DSA(*) (INT) SYMBOL TABLE (SEE LOOKUP FOR MORE EXPLICIT DOC)
C
      COMMON /DOS/ DOPT, LDO, DOLIST(192)
C
C*****DOS
C     DOPT (INT) POINTER TO FIRST FREE WORD IN DOLIST
C     LDO (INT) LENGTH OF DOLIST
C     DOLIST (*) (INT) ARRAY USED AS STACK FOR NESTING OF DOS (USED
C     TO TEST FOR LEGAL BRANCHING WITHIN P.U. (SEE DOSPEC FOR FURTHER
C     DOC)
C
      COMMON /LISTDO/ LPT, LEN, LS(64)
C
C*****LISTDO
C     LPT (INT) POINTER TO FIRST FREE WORD IN LS
C     LEN (INT) LENGTH OF LS
C     LS (*) (INT) ARRAY USED AS STACK FOR NESTING OF IMPLIED
C     DO'S IN INPUT/OUTPUT STMTS (SEE DOSPEC FOR FURTHER DOC)
C
      COMMON /PASS/ P2, QBR
C
C*****PASS
C     P2 (LOG) IF TRUE, VERIFIER IS IN PASS 2; ELSE VERIFIER IS IN PASS
C     QBR (LOG) IF TRUE, VERIFIER IS TO PRINT ERROR MESSAGES
C     ELSE IS NOT
C
      COMMON /CREF/ LREF, PREF, REF(100)
C
C*****CREF
C     LREF (INT) TOTAL LENGTH OF ARRAY REF
C     PREF (INT) CURRENT LENGTH OF REF
C     REF (*) (INT) ARRAY CONTAINING INFORMATION CONCERNING A SUBR/FCN
C     REF (SEE SETREF FOR FURTHER DOC)
C
      COMMON /HEAD/ LNODE, PNODE, NODE(500)
C
C*****HEAD
C     LNODE (INT) LENGTH OF NODE
C     PNODE (INT) POINTER TO NEXT FREE WORD IN NODE
C     NODE (*) (INT) ARRAY OF INDICES OF P.U. ENTRIES IN LAT
C
      COMMON /GRAPH/ LLAT, PLAT, LAT(6000)
C
C*****GRAPH
C     LLAT (INT) LENGTH OF LAT
C     PLAT (INT)  POINTER TO NEXT FREE WORD IN LAT
C     LAT (*) (INT) ARRAY WHOSE ENTRIES DESCRIBE EACH P.U. IN PGM
C     AND THEIR INTER-RELNS (SEE SETNOD FOR FURTHER DOC)
C
      COMMON /COMS/ LCOM, PCOM, COM(300)
C
C*****COMS
C     LCOM (INT) LENGTH OF COM
C     PCOM (INT) POINTER TO NEXT FREE WORD IN COM
C     COM (*) (INT) ARRAY WHOSE ENTRIES DESCRIBE EACH COMMON BLOCK
C     IN PGM (SEE  SETCOM FOR FURTHER DOC)
      COMMON /SCR1/ LINODE, INODE(500)
      COMMON /SCR2/ LNNODE, NNODE(500)
C
C***SCR1,SCR2,SCR3
C     INODE(INT), NNODE(INT) SCRATCH ARRAYS KEYED ON LENGTH NODE(*)
C     LINNODE = LNNODE .GE. MAX( LNODE, LCOM/(SYMLEN+5) )
C
C     THREE MORE BLOCK COMMON REGIONS ARE USED : STS -SEE TYPST
C     TRANS - SEE MAPCHR EXPRS - SEE EXPR FOR FURTHER DOC
C
      QBR = .FALSE.
      NOCHAR = 4
      INUT = 5
      OUTUT = 6
      OUTUT2 = 7
      OUTUT3 = 8
      OUTUT4 = 9
C	NOCHAR WAS &, OUT2-4 was 12,13,14 in distribution tape
      REWIND INUT
      REWIND OUTUT2
      REWIND OUTUT3
      REWIND OUTUT4
      LEN = 64
      SYMLEN = (5/NOCHAR) + 1
      P2 = .FALSE.
      ERR = .FALSE.
      ABORT = .FALSE.
      SYSERR = .FALSE.
      SW(1) = .FALSE.
      PDSA = 1
      LDSA = 5000
      LHASH = 401
      DO 10 I=1,LHASH
        HASH(I) = 0
   10 CONTINUE
      OPT(1) = .TRUE.
      OPT(2) = .TRUE.
      OPT(3) = .TRUE.
      OPT(4) = .TRUE.
      OPT(5) = .FALSE.
      LSTACK = 620
      LREF = 100
      PREF = 1
      LDO = 192
      CALL OVRLAY(1)
      CALL PU
      IF (.NOT.OPT(3) .OR. SYSERR) GO TO 30
      P2 = .TRUE.
      IF (.NOT.OPT(4)) WRITE (OUTUT,99999)
99999 FORMAT (1H1)
      CALL OVRLAY(2)
      LLAT = 6000
      PLAT = 1
      BNEXT = LDSA
      NEXT = 1
      LNODE = 500
      PNODE = 1
      LCOM = 300
      PCOM = 1
      LINODE = LNODE
      LNNODE = LNODE
C
C     PASS 1 CAN SUPPRESS PASS 2 PROCESSING FOR SPECIFIC P.U.
C     BUT NEVER SHUTS OFF PASS 2 COMPLETELY;  PASS 2 CAN CEASE
C     PROCESSING FOR VARIOUS REASONS:
C      1. 2 SUBPRGMS WITH SAME NAME(IN SETNOD)
C      2. NO PROGRAM UNIT SUCCESSFULLY PASSED TO PASS 2
C       (IN CONSTR)
C      3. RECURSION (IN ASLEV AND INVOKE)
C     IF MISSING SUBPRGMS ARE DISCOVERED, PASS 2 CAN
C     PROCEDE WITH INCOMPLETE PROCESSING, A MESSAGE
C     IS PRINTED TO INFORM THE USER
C
      REWIND OUTUT2
      REWIND OUTUT3
      REWIND OUTUT4
      CALL CONSTR(IROOT)
C     CAN RETURN FROM CONSTR IN ERROR CONDITION WITH FILES LACKING
C     VERIFIER SOFTWARE END OF FILE
      IF (ABORT .OR. SYSERR) GO TO 30
      REWIND OUTUT4
      REWIND OUTUT3
      REWIND OUTUT2
      CALL CHECKS(IROOT)
   20 REWIND INUT
      CALL OVRLAY(3)
      CALL COMPIL(.NOT.(ABORT.OR.SYSERR).AND.OPT(5))
      STOP
   30 WRITE (OUTUT,99998)
99998 FORMAT (47H1INTER-PROGRAM-UNIT COMMUNICATIONS NOT VERIFIED)
      GO TO 20
      END

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