SUBROUTINE SUBFCN(TYPE) C C TYPE IS EXPLICIT TYPE OF FUNCTION, ELSE IS -1 C ALL FCNS GIVEN EXPLICIT TYPE SINCE FCN NAME CANNOT APPEAR IN C NONEXECUTABLE STMT WITHIN FCN SUBPRGM EXCEPT HEAD STMT C ROUTINES DEFINES SUBROUTINE AND FUNCTION NAMES AND CREATES C LINKED LISTS OF POINTERS TO THEIR ARGUMENTS IN DSA. C SETS NAME TO POINT TO CURRENT FUNCN OR SUBRTNE. IN CASE C OF BAD SYNTAX IN NAME CONSTRUCT OR FCN WITHOUT PARAMS., C PROGRAM UNIT BECOMES MAIN PGM BY DEFAULT C INTEGER STMT, PSTMT, DSA, SYMHD, TYPE, BNEXT, S(5), PDSA LOGICAL ERR, SYSERR, ABORT COMMON /INPUT/ NSTMT, PSTMT, STMT(1327) COMMON /FACTS/ NAME, NOST, ITYP, IASF COMMON /TABL/ NEXT, LABHD, SYMHD, BNEXT COMMON /CTABL/ LDSA, PDSA, DSA(5000) COMMON /DETECT/ ERR, SYSERR, ABORT DATA S(1) /66/, S(2) /42/, S(3) /30/, S(4) /38/, S(5) /43/ KCELL = 0 CALL NEXTOK(PSTMT, K2, I1) IF (I1.NE.0) GO TO 120 C C SET FCN OR SUBR USE IN SYMBOL TABLE. TYPE FCN AND RECORD EXPLICIT C OR IMPLICIT TYPE C K = LOOKUP(K2,.FALSE.) IF (SYSERR) GO TO 90 NAME = K L = ITYP - 8 GO TO (10, 20), L 10 CALL SATT1(K, 8, 3) GO TO 40 20 CALL SATT1(K, 8, 4) IF (TYPE.LT.0) GO TO 30 CALL SATT1(K, 1, TYPE+8) GO TO 40 30 L = 1 IF (STMT(PSTMT).GE.38 .AND. STMT(PSTMT).LE.43) L = 2 CALL SATT1(K, 1, L) 40 IF (STMT(K2).NE.65) GO TO 140 50 PSTMT = K2 + 1 IF (PSTMT.GE.NSTMT) GO TO 120 CALL NEXTOK(PSTMT, K2, L) IF (L.NE.0) GO TO 80 C C ENTER PARAMETER IN SYMBOL TABLE; TYPE IMPLICITLY; ADD ONTO PARAM C LIST HANGING OFF SUBR/FCN NAME; SET DUMMYARG BIT ON; DO NOT SET C USAGE C N = LOOKUP(K2,.FALSE.) IF (SYSERR) GO TO 90 I2 = IGATT1(N,4) I1 = IGATT1(N,8) IF (I1.NE.0 .OR. I2.NE.0) GO TO 80 L = 1 IF (STMT(PSTMT).GE.38 .AND. STMT(PSTMT).LE.43) L = 2 CALL SATT1(N, 1, L) L = IGATT1(N,4) IF (L.EQ.1) GO TO 80 CALL SATT1(N, 4, 1) IF (NEXT+2.GE.BNEXT) GO TO 150 IF (KCELL.EQ.0) GO TO 60 DSA(KCELL+1) = NEXT GO TO 70 C C START PARAM LIST C 60 DSA(K+2) = NEXT 70 KCELL = NEXT DSA(NEXT) = N DSA(NEXT+1) = 0 NEXT = NEXT + 2 C C SEARCH FOR ")" OR "," C IF (STMT(K2).EQ.62) GO TO 100 IF (STMT(K2).EQ.68) GO TO 50 80 CALL ERROR1(33H ILLEGAL SYNTAX IN PARAMETER LIST, 33) 90 RETURN 100 K2 = K2 + 1 110 IF (K2.EQ.NSTMT) GO TO 90 CALL ERROR1(39H ILLEGAL CHARACTERS AFTER SUBR/FCN HEAD, 39) GO TO 90 120 CALL ERROR1(15H ILLEGAL SYNTAX, 15) PSTMT = 6 DO 130 I1=1,5 STMT(I1+5) = S(I1) 130 CONTINUE NAME = LOOKUP(11,.FALSE.) IF (SYSERR) GO TO 90 CALL SATT1(NAME, 8, 11) GO TO 90 140 IF (ITYP.EQ.9) GO TO 110 CALL ERROR1(20H NO PARAMS SPECIFIED, 20) GO TO 120 150 SYSERR = .TRUE. CALL ERROR1(33H IN SUBFCN, TABLE OVERFLOW OF DSA,33) GO TO 90 END