C C VRS -- SYMBOLIC VARIABLES TABLE FILE(.VRS FILE) BUILDING ROUTINE C C INPUTS: TITLE MODULE NAME C SEGNM SEGMENT NAME C C OUTPUTS: .VRS FILE C SUBROUTINE VRS(TITLE,SEGNM) BYTE REC(80),REC2(132),PST(30),OCT11(2),WK(6) INTEGER TITLE(3),SEGNM(3),NM(3,5),TY(2,5),PSN(5),AD(5) INTEGER IPSN(200),SEGNM2(3),PNAM(3),ADDRES,PSECT(3,200) INTEGER IPSET(5),MODULE(3) INTEGER*4 IREC7,IREC8 COMMON /COUNTS/IREC7,IREC8 COMMON /PSECT/PST DATA OCT11/"11,"0/ C C PROCESS .VRS FILE C OPEN(UNIT=9,NAME=PST,TYPE='OLD',ACCESS='DIRECT', + ASSOCIATEVARIABLE=IREC9,RECORDSIZE=5) 10 READ(3,15)NCH,REC 15 FORMAT(Q,80A) IF(LSTRNG(REC,1,80,'PROGRAM SECTIONS',1,16).LE.0)GOTO10 DO 22 I=1,3 READ(3,15)NCH,REC 22 CONTINUE I=0 25 READ(3,15)NCH,REC IF(REC(1).NE."14)GOTO26 READ(3,15)NCH,REC GOTO25 26 IF(REC(3).LT."60.OR.REC(3).GT."71)GOTO30 ISPOT=5 I=I+1 IF(I.GT.200)GOTO9090 ICT1=I DECODE(3,46,REC),IPSN(I) CALL STRMOV(' ',1,6,PSECT(1,I),1) ISPOT2=LSTRNG(REC,ISPOT,80-ISPOT,OCT11,1,1) ISPOT3=LSTRNG(REC,ISPOT,80-ISPOT,' ',1,1) IF(ISPOT2.EQ.0)ISPOT2=NCH IF(ISPOT3.EQ.0)ISPOT3=NCH IF(ISPOT3.LT.ISPOT2)ISPOT2=ISPOT3 ISPOT2=ISPOT2-ISPOT IF(ISPOT2.GT.6)ISPOT2=6 CALL STRMOV(REC,ISPOT,ISPOT2,PSECT(1,I),1) GOTO25 9090 TYPE 9091 9091 FORMAT('**THERE ARE MORE THAN 200 PSECTS IN THIS MODULE', + /,' THE PSECT IN EXCESS OF 200 ARE IGNORED**') C C PROCESS VARIABLES C 30 READ(3,15)NCH,REC IF(LSTRNG(REC,1,30,'TOTAL SPACE',1,11).GT.0)GOTO100 IF(LSTRNG(REC,1,30,'ARRAYS',1,6).GT.0)GOTO85 IF(LSTRNG(REC,1,30,'VARIABLES',1,9).LE.0)GOTO30 DO 32 I=1,3 READ(3,15)NCH,REC 32 CONTINUE 40 READ(3,45)NCH,REC2 45 FORMAT(Q,132A) IF(NCH.EQ.0)GOTO80 IF(REC2(1).NE."14)GOTO200 READ(3,45)NCH,REC2 GOTO40 200 IPT1=2 DO 50 ICT2=1,5 IPT2=LSTRNG(REC2,IPT1+1,132-IPT1,OCT11,1,1) IF(IPT2.EQ.0)GOTO55 CALL STRMOV(' ',1,6,NM(1,ICT2),1) CALL STRMOV(REC2,IPT1,IPT2-IPT1,NM(1,ICT2),1) CALL STRMOV(REC2,IPT2+1,4,TY(1,ICT2),1) IPSET(ICT2)=0 IF(REC2(IPT2+7).LT."60.OR.REC2(IPT2+7).GT."71)GOTO48 GOTO49 48 IPSET(ICT2)=1 GOTO44 49 DECODE(3,46,REC2(IPT2+5),ERR=40),PSN(ICT2) 46 FORMAT(I3) 44 DECODE(6,47,REC2(IPT2+9),ERR=40),AD(ICT2) 47 FORMAT(O6) IPT1=IPT2+17 50 CONTINUE 55 DO 60 I=1,ICT2-1 DO 56 J=1,ICT1 IF(IPSN(J).EQ.PSN(I))GOTO57 56 CONTINUE GOTO60 57 IF(IPSET(I).GT.0)GOTO60 IREC9=1 58 READ(9'IREC9,ERR=60)SEGNM2,MODULE,PNAM,ADDRES IF(KOMSTR(PNAM,1,6,PSECT(1,J),1,6).EQ.0.AND. + KOMSTR(TITLE,1,6,MODULE,1,6).EQ.0.AND. + KOMSTR(SEGNM,1,6,SEGNM2,1,6).EQ.0)GOTO70 GOTO58 70 ADDRES=ADDRES+AD(I) ITYPE=0 IF(KOMSTR(TY(1,I),1,1,'I',1,1).EQ.0)ITYPE=1 IF(KOMSTR(TY(1,I),1,1,'R',1,1).EQ.0)ITYPE=2 IF(KOMSTR(TY(1,I),1,1,'L',1,1).EQ.0)ITYPE=3 DECODE(1,75,TY(2,I))ISIZE 75 FORMAT(I1) 77 CALL STRMOV(NM(1,I),1,6,WK,1) IF(KOMSTR(' ',1,1,WK,1,1).NE.0)GOTO76 CALL STRMOV(WK,2,5,NM(1,I),1) CALL STRMOV(' ',1,1,NM(1,I),6) GOTO77 76 WRITE(8'IREC8)SEGNM,TITLE,(NM(K,I),K=1,3),ADDRES,ITYPE,ISIZE 60 CONTINUE GOTO40 C C PROCESS ARRAYS C 80 I=0 81 READ(3,15,END=100)NCH,REC IF(LSTRNG(REC,1,30,'ARRAYS',1,6).GT.0)GOTO85 I=I+1 IF(I.GT.10)GOTO100 GOTO81 85 DO 82 I=1,3 READ(3,15)NCH,REC 82 CONTINUE 90 READ(3,15)NCH,REC IF(REC(1).NE."14)GOTO300 READ(3,15)NCH,REC GOTO90 300 ISPOT=LSTRNG(REC,1,10,OCT11,1,1) IF(ISPOT.LE.0)GOTO100 CALL STRMOV(' ',1,6,NM(1,1),1) CALL STRMOV(REC,2,ISPOT-2,NM(1,1),1) CALL STRMOV(REC,ISPOT+1,4,TY(1,1),1) IF(REC(ISPOT+7).LT."60.OR.REC(ISPOT+7).GT."71)GOTO90 DECODE(3,46,REC(ISPOT+5)),PSN(1) DECODE(6,47,REC(ISPOT+9)),AD(1) DECODE(6,47,REC(ISPOT+16)),ISIZE 92 IREC9=1 DO 94 I=1,ICT1 93 IF(IPSN(I).EQ.PSN(1))GOTO95 94 CONTINUE GOTO90 95 READ(9'IREC9,ERR=96)SEGNM2,MODULE,PNAM,ADDRES IF(KOMSTR(PNAM,1,6,PSECT(1,I),1,6).EQ.0.AND. + KOMSTR(TITLE,1,6,MODULE,1,6).EQ.0.AND. + KOMSTR(SEGNM,1,6,SEGNM2,1,6).EQ.0)GOTO97 GOTO95 96 TYPE 98,(PSECT(K,I),K=1,3),(NM(K,1),K=1,3),TITLE 98 FORMAT(' *PSECT: ',3A2,' VARIABLE: ',3A2,' OF ',3A2, + ' IS NOT FOUND*') GOTO90 97 ADDRES=ADDRES+AD(1) ITYPE=0 IF(KOMSTR(TY(1,1),1,1,'I',1,1).EQ.0)ITYPE=1 IF(KOMSTR(TY(1,1),1,1,'R',1,1).EQ.0)ITYPE=2 IF(KOMSTR(TY(1,1),1,1,'L',1,1).EQ.0)ITYPE=3 WRITE(8'IREC8)SEGNM,TITLE,(NM(K,1),K=1,3),ADDRES,ITYPE,ISIZE GOTO90 100 CLOSE(UNIT=9) RETURN END