IDENTIFICATION DIVISION. PROGRAM-ID. CALLCREF. AUTHOR. KG. * * ********************************************************** * ** ** * ** REFERENCES CROISEES CALL-SOUS-PROGRAMME/PROGRAMMES ** * ** ** * ********************************************************** ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. VAX-11. OBJECT-COMPUTER. VAX-11. SPECIAL-NAMES. SYMBOLIC CHARACTERS TABULA ARE 10 DECIMAL-POINT IS COMMA. INPUT-OUTPUT SECTION. FILE-CONTROL. * * SELECT PARAM ASSIGN TO "DIR.LST". SELECT ENTRE ASSIGN TO "" STATUS IS ST-INP. SELECT SORTIE ASSIGN TO "SPCREF.DAT". SELECT IMP ASSIGN TO "". SELECT FTRI ASSIGN TO "STRFIL". * * ***************************************************************** * DATA DIVISION ***************************************************************** * DATA DIVISION. * FILE SECTION. * SD FTRI. 01 ENR-TRI. 02 TRI-PROG PIC X(9). 02 TRI-LIBE PIC X(15). * FD PARAM BLOCK CONTAINS 10240 CHARACTERS LABEL RECORD STANDARD. * 01 DIRENR. 02 DI-C PIC X OCCURS 80. * FD ENTRE VALUE OF ID IS FICHENTR LABEL RECORD STANDARD RECORD VARYING FROM 1 TO 255 DEPENDING ON ILE. 01 ENRENTR. 02 CE PIC X OCCURS 255. 01 ER0. 02 FILLER PIC X. 02 ER1. 03 FILLER PIC X. 03 ER2. 04 FILLER PIC X. 04 ER3. 05 FILLER PIC X. 05 ER4. 06 FILLER PIC X. 06 ER5 PIC X(75). 01 ENRENTV. 02 ZE1. 03 ZE3. 04 ZE2 PIC X(5). 04 FILLER PIC X(5). 03 FILLER PIC XX. * * DESCRIPTION FICHIER SPCREF * REFERENCES CROISEES CALL/PROGRAMME FD SORTIE LABEL RECORD IS STANDARD. * 01 AUS. 02 AU-PROG PIC X(9). * NOM DU PROGRAMME 02 AU-LIBE PIC X(15). * NOM SOUS-ROUTINE * * FD IMP BLOCK CONTAINS 1024 CHARACTERS VALUE OF ID IS NFIMP LABEL RECORD STANDARD RECORD VARYING. 01 LG PIC X(80). 01 LG3. 02 L3LIB PIC X(17). 02 L3PRO OCCURS 5. 03 L3NP PIC X(9). 03 L3SEP PIC X(4). 01 LG4. 02 L4PROG PIC X(11). 02 L4PRO OCCURS 4. 03 L4NSP PIC X(15). 03 L4SEP PIC X(3). * * WORKING-STORAGE SECTION. * 77 ST-INP PIC XX. 77 LLE PIC S9999 COMP. 77 ILE PIC 9999 COMP. 77 IX PIC S999 COMP. 77 K PIC S999 COMP. 77 REF PIC X(15). 77 NLG PIC S99 COMP. 77 LGMAX PIC S99 COMP VALUE 58. 77 NUMD PIC S99 COMP. 77 TALL PIC S999 COMP. 77 LRF PIC X. 77 C PIC X. 77 CP PIC X. 77 AIGD PIC 9. 77 TAB PIC X. 77 L1 PIC S999 COMP. 77 L2 PIC S999 COMP. 77 IMAX PIC S999 COMP. 77 LR PIC X. * 77 POS PIC 9(9) COMP. 77 APPEL PIC X(4) VALUE "CALL". 77 ST-POS PIC S9(9) COMP. * 77 IXC PIC S999 COMP. 77 IKC PIC S999 COMP. 77 IXC-MAX PIC S999 COMP. 77 IXC-I PIC S999 COMP. 77 SP-INF PIC X(15). * 01 IK PIC 9(9) COMP. 01 XCALL PIC X(4) VALUE "CALL". * 01 TABCALL. 02 SP PIC X(15) OCCURS 999. * * 01 NFIMP PIC X(32). * 01 FICHENTR. 02 CNF PIC X(40). 01 NOM. 02 CNN PIC X OCCURS 9. * 01 AIG1 PIC X. * 01 TABW. 02 TCW. * routines a referencer globalement 03 TCWR PIC X(6). 88 CW-FORM VALUE "AFFMSL" "INIECR" "SAIECR" "AFFMSL" "SAICHA" "AFFCHA" "CHGSAI" "CHGVIS" "AFFMSG" "SONNE" "SAITXT" "POSCUR" "AFFTXT" "AFFECR" "AFFLIB" "VALERR" "INIFRM" "EFFECR". 03 TCWRB REDEFINES TCWR. 05 TCWR4 PIC X(4). 88 CW-FMS VALUE "FDV$". 05 FILLER PIC XX. 03 FILLER PIC X(26). 02 TCW2 REDEFINES TCW. 03 CW PIC X OCCURS 32. * 01 DATEI PIC 9(6). 01 DATEI2 REDEFINES DATEI. 02 AAI PIC 99. 02 MMI PIC 99. 02 JOI PIC 99. * 01 DATED. 02 JOE PIC 99. 02 FILLER PIC X VALUE "/". 02 MME PIC 99. 02 FILLER PIC X VALUE "/". 02 AAE PIC 99. * * * 01 TABE. 02 TLG OCCURS 500. 03 NP PIC X(15). * 01 SAUT PIC 9. * **** LIGNE TITRE 1 * 01 LG1. 02 FILLER PIC X(8) VALUE "PROCAL ". 02 L1D PIC X(8). 02 FILLER PIC X(24) VALUE " REFERENCES CROISEES ". 02 L1T PIC X(28). 02 FILLER PIC X(8) VALUE " PAGE: ". 02 L1F PIC 99. / PROCEDURE DIVISION. DECLARATIVES. ERREUR SECTION. USE AFTER STANDARD ERROR PROCEDURE ON ENTRE. END DECLARATIVES. BEG-PGM SECTION. BEG. MOVE TABULA TO TAB. OPEN INPUT PARAM. OPEN OUTPUT SORTIE. LP. MOVE SPACE TO DIRENR. READ PARAM AT END GO TO FIN. * SUPPRESSION NUMERO DE VERSION MOVE 1 TO L1. MOVE ZERO TO L2. LNVE. IF L2 NOT = ZERO MOVE SPACE TO DI-C (L1) ELSE IF DI-C (L1) = ";" MOVE 1 TO L2. IF L1 < 40 ADD 1 TO L1 GO TO LNVE. * MOVE DIRENR TO FICHENTR. * RECHERCHE NOM DU PROGRAMME MOVE SPACE TO NOM. MOVE 1 TO L1. MOVE ZERO TO L2. LNNA. IF DI-C (L1) = "]" GO TO AP-LNNA. IF L1 < 80 ADD 1 TO L1 GO TO LNNA. DISPLAY "DESCRIPTION NON CONFORME " DIRENR. GO TO LP. AP-LNNA. ADD 1 TO L1. ADD 1 TO L2. IF L1 > 80 GO TO AP-NN. IF L2 > 9 GO TO AP-NN. IF DI-C (L1) = "." GO TO AP-NN. MOVE DI-C (L1) TO CNN (L2). GO TO AP-LNNA. AP-NN. * TRAITEMENT PROGRAMME OPEN INPUT ENTRE. IF ST-INP NOT = "00" DISPLAY "INCID OUVERTURE " FICHENTR " " ST-INP GO TO LP. MOVE ZERO TO AIGD. MOVE SPACE TO AUS. MOVE NOM TO AU-PROG. MOVE ZERO TO IXC-MAX. LECT. MOVE SPACE TO ENRENTR. READ ENTRE AT END GO TO FERM. MOVE ILE TO LLE. IF CE (1) = "*" OR "/" GO TO LECT. IF ENRENTR = SPACE GO TO LECT. MOVE ZERO TO TALL. INSPECT ENRENTR TALLYING TALL FOR LEADING SPACE TALL FOR LEADING TAB. IF TALL = ZERO GO TO AP-CADRAGE. IF TALL = 1 MOVE ER1 TO ER0 GO TO AP-CADRAGE. IF TALL = 2 MOVE ER2 TO ER0 GO TO AP-CADRAGE. IF TALL = 3 MOVE ER3 TO ER0 GO TO AP-CADRAGE. IF TALL = 4 MOVE ER4 TO ER0 GO TO AP-CADRAGE. IF TALL = 5 MOVE ER5 TO ER0 GO TO AP-CADRAGE. MOVE 1 TO IX. ADD 1 TALL GIVING K. CADRAGE. MOVE CE (K) TO CE (IX). MOVE SPACE TO CE (K). IF K < LLE ADD 1 TO K ADD 1 TO IX GO TO CADRAGE. AP-CADRAGE. MOVE ZERO TO IX. IF AIGD NOT = ZERO GO TO AP-PROCED. IF ZE3 NOT = "PROCEDURE " GO TO LECT. MOVE 1 TO AIGD. GO TO LECT. * RECHERCHE DES CALL AP-PROCED. CALL "LIB$INDEX" USING BY DESCRIPTOR ENRENTR BY DESCRIPTOR XCALL GIVING IK. IF IK = ZERO GO TO LECT. IF IK = 1 SUBTRACT 1 FROM IK GIVING IX MOVE SPACE TO CP. IF IK > 1 SUBTRACT 2 FROM IK GIVING IX MOVE "@" TO CP. LOOP. ADD 1 TO IX. IF IX > LLE GO TO LECT. MOVE CE (IX) TO C. IF C = "C" AND CP = SPACE GO TO COPRO. MOVE C TO CP. GO TO LOOP. COPRO. PERFORM DEMOT. * TEST SI TABW = CALL AP-DEMOT. IF TABW NOT = "CALL" MOVE SPACE TO CP GO TO LOOP. * RECHERCHE PROCHAIN MOT ENTMOT. ADD 1 TO IX. IF IX > LLE GO TO AP-ENTMOT. MOVE CE (IX) TO C. IF C = SPACE OR TAB OR """" GO TO ENTMOT. AP-ENTMOT. IF IX > LLE MOVE "??" TO TABW ELSE PERFORM DEMOT. IF CW-FORM MOVE "FORMVAX" TO TABW. IF CW-FMS MOVE "FDV$..." TO TABW. IF IXC-MAX > 998 DISPLAY "PLUS QUE 999 'CALL' DANS " NOM ELSE ADD 1 TO IXC-MAX MOVE TABW TO SP (IXC-MAX). GO TO LECT. * ***** FIN D'UN PROGRAMME COBOL * FERM. CLOSE ENTRE. * **** TRI TABLE DES SOUS-PROGRAMMES * IF IXC-MAX < 2 GO TO AP-TRI. MOVE 1 TO IXC. TRIA. MOVE IXC TO IKC. MOVE IKC TO IXC-I. MOVE SP (IXC-I) TO SP-INF. TRIB. ADD 1 TO IKC. IF SP (IKC) < SP-INF MOVE SP (IKC) TO SP-INF MOVE IKC TO IXC-I. IF IKC < IXC-MAX GO TO TRIB. MOVE SP (IXC) TO SP (IXC-I). MOVE SP-INF TO SP (IXC). ADD 1 TO IXC. IF IXC < IXC-MAX GO TO TRIA. AP-TRI. * RECHERCHE SP EN DOUBLE MOVE ZERO TO IXC. MOVE 1 TO IKC. RDD. ADD 1 TO IXC. ADD 1 TO IKC. IF IXC NOT < IXC-MAX GO TO AP-RDD. IF SP (IXC) = SP (IKC) GO TO DDD. GO TO RDD. DDD. MOVE SPACE TO SP (IXC). GO TO RDD. AP-RDD. * ECRITURE SORTIE MOVE ZERO TO IXC. WR. ADD 1 TO IXC. IF IXC > IXC-MAX GO TO AP-WR. MOVE NOM TO AU-PROG. MOVE SP (IXC) TO AU-LIBE. IF AU-LIBE = SPACE GO TO WR. WRITE AUS. GO TO WR. AP-WR. GO TO LP. * ************************************************************* * FIN DU FICHIER PARAMETRE ************************************************************* * FIN. CLOSE PARAM SORTIE. PERFORM EDIT2. SORT FTRI ON ASCENDING KEY TRI-LIBE TRI-PROG USING SORTIE OUTPUT PROCEDURE IS EDIT1. * * STOP RUN. * / * ********************************************************** * TRANSFERT UN MOT COBOL DANS TABW ********************************************************** * DEMOT SECTION. DEMOT_00. MOVE SPACE TO TABW. MOVE 1 TO K. DEMOT_10. MOVE CE (IX) TO CW (K). ADD 1 TO K. ADD 1 TO IX. IF K > 32 OR IX > LLE GO TO ODEMOT. MOVE CE (IX) TO C. IF C = SPACE OR "." OR """" GO TO ODEMOT. GO TO DEMOT_10. ODEMOT. EXIT. * ******************************************************* * PROCEDURE DE SORTIE DE TRI * IMPRESSION CREF S/P PROGRAMMES ******************************************************* * EDIT1 SECTION. ED1. MOVE "CALLCREFS.OUT" TO NFIMP. OPEN OUTPUT IMP. ACCEPT DATEI FROM DATE. MOVE AAI TO AAE MOVE MMI TO MME MOVE JOI TO JOE. MOVE DATED TO L1D. MOVE ZERO TO L1F. MOVE SPACE TO LG LR. MOVE "SOUS-PROGRAMME / PROGRAMMES" TO L1T. PERFORM ED1-LECT. ED1-MEP. IF LR NOT = SPACE GO TO ED1-FIN. MOVE SPACE TO TABE. MOVE ZERO TO IMAX. MOVE AU-LIBE TO REF L3LIB. IF L1F = 000 PERFORM ED1-WT. GO TO ED1-TESD. ED1-WT. ADD 1 TO L1F. WRITE LG FROM LG1 AFTER PAGE. MOVE SPACE TO LG. WRITE LG AFTER 2. MOVE 4 TO NLG. MOVE REF TO L3LIB. ED1-LECT. MOVE SPACE TO ENR-TRI. RETURN FTRI INTO AUS AT END MOVE "F" TO LR. ED1-TESD. IF LR NOT = SPACE OR REF NOT = AU-LIBE GO TO ED1-RUPT. IF IMAX > 499 DISPLAY "TROP DE PROG POUR LIBR. " REF " (" AU-PROG ")" GO TO ED1-LECT. ADD 1 TO IMAX. MOVE AU-PROG TO NP (IMAX). GO TO ED1-LECT. * ED1-RUPT. MOVE " ** " TO L3SEP (1) L3SEP (2) L3SEP (3) L3SEP (4). MOVE 1 TO IX. MOVE 1 TO K. MOVE 3 TO SAUT. ED1-LOOP. MOVE NP (IX) TO L3NP (K). ADD 1 TO K. ADD 1 TO IX. IF K > 5 PERFORM ED1-WL. IF IX NOT > IMAX GO TO ED1-LOOP. IF K > 1 PERFORM ED1-WL. GO TO ED1-MEP. * ED1-WL. WRITE LG AFTER SAUT. MOVE SPACE TO LG. MOVE 1 TO K. ADD SAUT TO NLG. MOVE 1 TO SAUT. IF NLG > LGMAX PERFORM ED1-WT. MOVE " ** " TO L3SEP (1) L3SEP (2) L3SEP (3) L3SEP (4). * ED1-FIN. CLOSE IMP. OEDIT1. EXIT. * ***************************************************************** * EDITION CREF PROGRAMMES S/P ***************************************************************** * EDIT2 SECTION. ED2. MOVE "CALLCREFP.OUT" TO NFIMP. OPEN OUTPUT IMP. OPEN INPUT SORTIE. ACCEPT DATEI FROM DATE. MOVE AAI TO AAE MOVE MMI TO MME MOVE JOI TO JOE. MOVE DATED TO L1D. MOVE ZERO TO L1F. MOVE SPACE TO LG LR. MOVE "PROGRAMME / SOUS-PROGRAMMES" TO L1T. PERFORM ED2-LECT. ED2-MEP. IF LR NOT = SPACE GO TO ED2-FIN. MOVE SPACE TO TABE. MOVE ZERO TO IMAX. MOVE AU-PROG TO REF L4PROG. IF L1F = 000 PERFORM ED2-WT. GO TO ED2-TESD. ED2-WT. ADD 1 TO L1F. WRITE LG FROM LG1 AFTER PAGE. MOVE SPACE TO LG. WRITE LG AFTER 2. MOVE 4 TO NLG. MOVE REF TO L4PROG. ED2-LECT. MOVE SPACE TO AUS. READ SORTIE AT END MOVE "F" TO LR. ED2-TESD. IF LR NOT = SPACE OR REF NOT = AU-PROG GO TO ED2-RUPT. IF IMAX > 499 DISPLAY "TROP DE PROG POUR LIBR. " REF " (" AU-PROG ")" GO TO ED2-LECT. ADD 1 TO IMAX. MOVE AU-LIBE TO NP (IMAX). GO TO ED2-LECT. * ED2-RUPT. MOVE " * " TO L4SEP (1) L4SEP (2) L4SEP (3) L4SEP (4). MOVE 1 TO IX. MOVE 1 TO K. MOVE 3 TO SAUT. ED2-LOOP. MOVE NP (IX) TO L4NSP (K). ADD 1 TO K. ADD 1 TO IX. IF K > 5 PERFORM ED2-WL. IF IX NOT > IMAX GO TO ED2-LOOP. IF K > 1 PERFORM ED2-WL. GO TO ED2-MEP. * ED2-WL. WRITE LG AFTER SAUT. MOVE SPACE TO LG. MOVE 1 TO K. ADD SAUT TO NLG. MOVE 1 TO SAUT. IF NLG > LGMAX PERFORM ED2-WT. MOVE " * " TO L4SEP (1) L4SEP (2) L4SEP (3) L4SEP (4). * ED2-FIN. CLOSE IMP SORTIE. OEDIT2. EXIT.