IDENTIFICATION DIVISION. PROGRAM-ID. LIBPROG. AUTHOR. KG. * * ********************************************************** * ** ** * ** REFERENCES CROISEES COPY-LIB/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 "". SELECT SORTIE ASSIGN TO "LPCREF.DAT". * * ***************************************************************** * DATA DIVISION ***************************************************************** * DATA DIVISION. * FILE SECTION. * FD PARAM 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(248). 01 ENRENTV. 02 ZE1. 03 ZE3. 04 ZE2 PIC X(5). 04 FILLER PIC X(5). 03 FILLER PIC XX. * FD SORTIE LABEL RECORD IS STANDARD. COPY LPCREF. * WORKING-STORAGE SECTION. * 77 SAV-DIV PIC X. 77 ILE PIC 9999 COMP. 77 LLE PIC S9999 COMP. 77 IX PIC S999 COMP. 77 K PIC S999 COMP. 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. 01 IK PIC 9(9) COMP. 01 XCOP PIC X(4) VALUE "COPY". * 01 FICHENTR. 02 CNF PIC X(40). 01 NOM. 02 CNN PIC X OCCURS 9. * 01 AIG1 PIC X. * 01 TABW. 02 CW PIC X OCCURS 32. * / PROCEDURE DIVISION. 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. 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. MOVE ZERO TO AIGD. MOVE SPACE TO AUS. MOVE NOM TO AU-PROG. LECT. MOVE SPACE TO ENRENTR. READ ENTRE AT END GO TO FERM. MOVE ILE TO LLE. IF LLE = ZERO 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-ENVIR. IF ZE1 NOT = "ENVIRONMENT " GO TO LECT. MOVE 1 TO AIGD. MOVE "E" TO AU-DIV. GO TO LECT. * RECHERCHE DES COPY AP-ENVIR. IF ZE2 = "DATA " MOVE "D" TO AU-DIV GO TO LECT. IF ZE3 = "PROCEDURE " MOVE "P" TO AU-DIV GO TO LECT. CALL "LIB$INDEX" USING BY DESCRIPTOR ENRENTR BY DESCRIPTOR XCOP 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 = COPY AP-DEMOT. IF TABW NOT = "COPY" 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 GO TO ENTMOT. AP-ENTMOT. IF IX > LLE MOVE "??" TO TABW ELSE PERFORM DEMOT. MOVE TABW TO AU-LIB. * ECRITURE SORTIE WR. IF CE (1) = "*" MOVE AU-DIV TO SAV-DIV MOVE "*" TO AU-DIV. WRITE AUS. IF CE (1) = "*" MOVE SAV-DIV TO AU-DIV. AP-WR. GO TO LECT. * ************************************************************ * FIN D'UN PROGRAMME COBOL ************************************************************ * FERM_FICH SECTION. FERM. CLOSE ENTRE. GO TO LP. * ********************************************************** * 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. * ********************************************************** * FIN DU FICHIER PARAMETRE ********************************************************** * FIN_PGM SECTION. FIN. CLOSE PARAM SORTIE. STOP RUN.