COBFD is a gnuCOBOL opensource cobol command line record analyzer to check your file description file and put the result into an output flat file.
To run the tools open a console prompt and use the c:\>cobfd yourfd.cbl yourreport.txt where: yourfd.cbl is the file description that you want to analyze
yourreport.txt the name of the file that will contains the report (if none is declared it will use cobfd.txt as default name)
Take the result from the output file
000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. COBFD.
000030
000040*---------------------------------------------------------------
000050* COSTRUISCE IL DIZIONARIO PER LA FD SPECIFICATA
000060*---------------------------------------------------------------
000070*
000080* Copyright (C) Federico Priolo TP ONE SRL federico.priolo@tp-one.it
000090*
000100* This program is free software; you can redistribute it and/or
000110* it under the terms of the GNU General Public License as publis
000120* the Free Software Foundation; either version 2, or (at your op
000130* any later version.
000140*
000150* This program is distributed in the hope that it will be useful
000160* but WITHOUT ANY WARRANTY; without even the implied warranty of
000170* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
000180* GNU General Public License for more details.
000190*
000200* You should have received a copy of the GNU General Public Lice
000210* along with this software; see the file COPYING. If not, write
000220* the Free Software Foundation, 51 Franklin Street, Fifth Floor
000230* Boston, MA 02110-1301 USA
000240*
000250*
000260*---------------------------------------------------------------
000270 ENVIRONMENT DIVISION.
000280 CONFIGURATION SECTION.
000290 SOURCE-COMPUTER. PC-IBM.
000300 OBJECT-COMPUTER. PC-IBM.
000310 SPECIAL-NAMES.
000320
000330 DECIMAL-POINT IS COMMA.
000340
000350 INPUT-OUTPUT SECTION.
000360 FILE-CONTROL.
000370
000380*
000390** your copy fd to examine
000400*
000410
000420 SELECT ARK-IN ASSIGN TO FILE-IN
000430 ORGANIZATION IS LINE SEQUENTIAL
000440 FILE STATUS IS STATUS-IN.
000450*
000460** isam to figure out size and offset...
000470*
000480 SELECT ARKDATA ASSIGN ".\WORKAREA.DAT"
000490
000500 ORGANIZATION IS INDEXED
000510 ACCESS MODE IS DYNAMIC
000520 RECORD KEY IS KEY-DATA
000530 ALTERNATE RECORD KEY IS KEY-NAME-DATA
000540 DUPLICATES
000550 FILE STATUS IS STATUS-DATA.
000560
000570
000580*
000590** The output result
000600*
000610
000620 SELECT ARK-OUT ASSIGN TO FILE-OUT
000630 ORGANIZATION IS LINE SEQUENTIAL
000640 FILE STATUS IS STATUS-OUT.
000650
000660
000670 DATA DIVISION.
000680 FILE SECTION.
000690
000700 FD ARK-IN LABEL RECORD IS STANDARD.
000710
000720 01 REC-IN.
000730 02 FILLER PIC X(80).
000740
000750 FD ARK-OUT LABEL RECORD IS STANDARD.
000760
000770 01 REC-OUT.
000780 02 FILLER-OUT PIC X(80).
000790
000800 01 REC-OUTX.
000810 02 LEVEL-OUT PIC 99.
000820 02 FILLER-OUT PIC X.
000830 02 NAME-OUT PIC X(31).
000840 02 FILLER-OUT PIC X.
000850 02 PICTURE-OUT PIC X(15).
000860 02 FILLER-OUT PIC X.
000870 02 TYPE-OUT PIC X(4).
000880 02 FILLER-OUT PIC X.
000890 02 OCCURS-OUT PIC ZZZZZZ.
000900 02 FILLER-OUT PIC X.
000910 02 SIZE-OUT PIC ZZZZZZ.
000920 02 FILLER-OUT PIC X.
000930 02 OFFSET-OUT PIC ZZZZZ9.
000940
000950*
000960 FD ARKDATA LABEL RECORD IS STANDARD GLOBAL.
000970*
000980 01 REC-DATA.
000990
001000 02 KEY-DATA PIC 9(9).
001010 02 KEY-NAME-DATA.
001020 05 LEV-DATA PIC 99.
001030 05 FIELD-DATA PIC X(30).
001040 02 FIELDS-DATA.
001050 05 LEVEL-DATA PIC 99.
001060 05 NAME-DATA PIC X(30).
001070 05 FILLER-DATA PIC X.
001080 05 PICTURE-DATA PIC X(30).
001090 05 FILLER-DATA PIC X.
001100 05 TYPE-DATA PIC X(08).
001110 05 OCCURS-DATA PIC 9(2).
001120 05 FILLER-DATA PIC X.
001130 05 SIZE-DATA PIC 9(7).
001140 05 FILLER-DATA PIC X.
001150 05 OFFSET-DATA PIC 9(7).
001160 05 REDEFINES-DATA PIC X(30).
001170 05 ARRAY-SIZE-DATA PIC 9(7).
001180 05 FLAG-REDEFINES-DATA PIC X.
001190
001200 WORKING-STORAGE SECTION.
001210
001220 77 FILE-DATA PIC X(20) VALUE "ARKDATA".
001230 77 STATUS-DATA PIC XX VALUE "00".
001240 77 FINE-FILE PIC X.
001250 77 STATUS-IN PIC XX VALUE "00".
001260 77 STATUS-OUT PIC XX VALUE "00".
001270
001280 77 IND PIC 999.
001290 77 IND1 PIC 999.
001300 77 IND2 PIC 999.
001310 77 IND3 PIC 999.
001320 77 IND4 PIC 999.
001330
001340 01 FILE-IN PIC X(150).
001350 01 FILE-OUT PIC X(150).
001360 77 WPARAM PIC X(512).
001370 77 WSIZE PIC 9(9).
001380 77 WOFFSET PIC 9(9).
001390 77 WLEVEL PIC 99.
001400 77 WPICTURE PIC X(30).
001410 77 WKEY PIC 9(9).
001420 77 WREDEFINES PIC X(30).
001430 77 COUNT-ITEM PIC 9(9) VALUE ZEROS.
001440 01 STRINGA PIC X(18).
001450 01 NUMERO PIC 9(18).
001460
001470 01 TAB-BUFFER.
001480 02 IND-BUFFER PIC 99.
001490 02 IND1-BUFFER PIC 99.
001500 02 BUFFER PIC X(30) OCCURS 50 TIMES.
001510
001520 01 TAB-STRINGA PIC X(1504) VALUE SPACE.
001530
001540
001550 PROCEDURE DIVISION.
001560
001570 MAIN SECTION.
001580 INIZIO.
001590
001600
001610
001620 PERFORM OPEN-FILES THRU EX-OPEN-FILES.
001630
001640 MOVE SPACES TO FINE-FILE.
001650 MOVE ZEROS TO COUNT-ITEM
001660
001670 DISPLAY
001680 "COBFD Version 1.00 "
001690 "Copyright (C) 2022 Federico Priolo TP ONE SRL".
001700
001710 DISPLAY
001720 "Analyzing " FUNCTION TRIM(FILE-IN).
001730
001740
001750
001760 PERFORM PROCESS-IN THRU EX-PROCESS-IN
001770 UNTIL FINE-FILE = "S".
001780
001790 PERFORM BUILD THRU EX-BUILD.
001800
001810 PERFORM CALCULATE THRU EX-CALCULATE.
001820
001830 PERFORM OFFSET THRU EX-OFFSET.
001840
001850 PERFORM EXPORT THRU EX-EXPORT.
001860
001870 FINE.
001880
001890 DISPLAY "COBFD: end of job ".
001900
001910 CLOSE ARK-IN ARKDATA ARK-OUT.
001920 GOBACK.
001930
001940
001950 OPERATE.
001960
001970 IF FINE-FILE = "S" GO TO EX-OPERATE.
001980
001990 INITIALIZE TAB-BUFFER.
002000
002010
002020 UNSTRING REC-IN DELIMITED BY ALL SPACES
002030 INTO BUFFER(1)
002040 BUFFER(2)
002050 BUFFER(3)
002060 BUFFER(4)
002070 BUFFER(5)
002080 BUFFER(6)
002090 BUFFER(7)
002100 BUFFER(8)
002110 BUFFER(9)
002120 BUFFER(10)
002130 BUFFER(11)
002140 BUFFER(12)
002150 BUFFER(13)
002160 BUFFER(14)
002170 BUFFER(15)
002180 TALLYING IND-BUFFER
002190
002200 PERFORM VARYING IND FROM LENGTH OF REC-IN BY -1 UNTIL
002210 REC-IN(IND:1) NOT = SPACES
002220 CONTINUE
002230 END-PERFORM
002240
002250 IF REC-IN(IND:1) = "." GO TO END-OPERATE.
002260
002270 PERFORM READ-IN THRU EX-READ-IN
002280
002290 UNSTRING REC-IN DELIMITED BY ALL SPACES
002300 INTO BUFFER(16)
002310 BUFFER(17)
002320 BUFFER(18)
002330 BUFFER(19)
002340 BUFFER(20)
002350 BUFFER(21)
002360 BUFFER(22)
002370 BUFFER(23)
002380 BUFFER(24)
002390 BUFFER(25)
002400 BUFFER(26)
002410 BUFFER(27)
002420 BUFFER(28)
002430 BUFFER(29)
002440 BUFFER(30).
002450
002460 IF IND-BUFFER NOT = 15
002470 ADD 1 TO IND-BUFFER
002480 MOVE 16 TO IND1-BUFFER
002490 PERFORM 15 TIMES
002500 MOVE BUFFER(IND1-BUFFER) TO BUFFER(IND-BUFFER)
002510 MOVE SPACES TO BUFFER(IND1-BUFFER)
002520 ADD 1 TO IND-BUFFER IND1-BUFFER
002530 END-PERFORM.
002540
002550
002560 END-OPERATE.
002570
002580 ADD 1 TO COUNT-ITEM.
002590
002600 MOVE FUNCTION UPPER-CASE(TAB-BUFFER) TO TAB-STRINGA
002610
002620 MOVE TAB-STRINGA TO TAB-BUFFER
002630 INITIALIZE REC-DATA
002640
002650*** FIRST ITEM CONTAINS THE RECORD LEVEL
002660
002670 PERFORM VARYING IND FROM 1 BY 1 UNTIL IND > 30
002680
002690
002700**** HERE A COBOL LEVEL...
002710
002720 IF BUFFER(IND) > SPACES
002730 AND NAME-DATA = SPACES
002740 AND BUFFER(IND) (1:1) NUMERIC
002750
002760
002770 MOVE BUFFER(IND) TO STRINGA
002780 PERFORM ALFA-TO-NUM THRU EX-ALFA-TO-NUM
002790 MOVE NUMERO TO LEVEL-DATA
002800
002810**** ...AND AFTER THE NAME OF COBOL FIELD
002820
002830 ADD 1 TO IND
002840 MOVE BUFFER(IND) TO FIELD-DATA NAME-DATA
002850
002860 ADD 1 TO IND
002870
002880**** here a field WITHOUT PICTURE... E.G. 01 NAME.
002890
002900 IF BUFFER(IND) = SPACES
002910 MOVE "Group" TO PICTURE-DATA
002920 END-IF
002930
002940 END-IF
002950
002960
002970 IF BUFFER(IND) = "REDEFINES"
002980 ADD 1 TO IND
002990 MOVE BUFFER(IND) TO REDEFINES-DATA
003000 END-IF
003010
003020
003030 IF BUFFER(IND)(1:3) = "PIC"
003040 ADD 1 TO IND
003050 MOVE BUFFER(IND) TO PICTURE-DATA
003060
003070 EVALUATE PICTURE-DATA(1:1)
003080
003090 WHEN "X" MOVE "AN" TO TYPE-DATA
003100 WHEN "S" MOVE "N" TO TYPE-DATA
003110 PERFORM DO-NUMBER-TYPE THRU EX-DO-NUMBER-TYPE
003120
003130 WHEN "9" MOVE "N" TO TYPE-DATA
003140 PERFORM DO-NUMBER-TYPE THRU EX-DO-NUMBER-TYPE
003150
003160 WHEN "A" MOVE "A" TO TYPE-DATA
003170
003171 WHEN "-" MOVE "NE" TO TYPE-DATA
003172
003173 WHEN "+" MOVE "NE" TO TYPE-DATA
003174
003175 WHEN "Z" MOVE "NE" TO TYPE-DATA
003176
003177 WHEN OTHER DISPLAY "TYPE" PICTURE-DATA " NOT MANAGED"
003178
003179
003180 END-EVALUATE
003181
003190
003200 END-IF
003210
003220 IF BUFFER(IND) = "OCCURS"
003230
003240**** here a field WITHOUT PICTURE... E.G. 02 NAME OCCURS 5 TIMES...
003250
003260 MOVE ZEROS TO IND1
003270 INSPECT TAB-BUFFER TALLYING IND1 FOR ALL "PIC"
003280 IF IND1 = ZEROS
003290 MOVE "Group" TO PICTURE-DATA
003300 END-IF
003310
003320 ADD 1 TO IND
003330 MOVE BUFFER(IND) TO STRINGA
003340 PERFORM ALFA-TO-NUM THRU EX-ALFA-TO-NUM
003350 MOVE NUMERO TO OCCURS-DATA
003360 END-IF
003370
003380
003390 END-PERFORM.
003400
003410 PERFORM CALCULATE-SIZE THRU EX-CALCULATE-SIZE.
003420
003430 MOVE COUNT-ITEM TO KEY-DATA.
003440
003450 IF PICTURE-DATA = SPACES
003460 MOVE "Group" TO PICTURE-DATA.
003470
003480 INSPECT KEY-NAME-DATA REPLACING ALL "." BY " "
003490
003500 MOVE LEVEL-DATA TO LEV-DATA
003510
003520 WRITE REC-DATA
003530 INVALID KEY CONTINUE.
003540
003550 IF STATUS-DATA = "02"
003560 IF NAME-DATA(1:6) NOT = "FILLER"
003570 DISPLAY
003580 "Warning:found duplicates name with the same level:"
003590 FUNCTION TRIM(NAME-DATA)
003600 END-IF.
003610
003620
003630 EX-OPERATE.
003640 EXIT.
003650
003660 DO-NUMBER-TYPE.
003670
003680 MOVE ZEROS TO IND1
003690 INSPECT TAB-BUFFER TALLYING IND1
003700 FOR ALL "LEADING"
003710 INSPECT TAB-BUFFER TALLYING IND1
003720 FOR ALL "SEPARATE"
003730 IF IND1 = 2 MOVE "SL" TO TYPE-DATA.
003740
003750 MOVE ZEROS TO IND1
003760 INSPECT TAB-BUFFER TALLYING IND1
003770 FOR ALL "TRAIDING"
003780 INSPECT TAB-BUFFER TALLYING IND1
003790 FOR ALL "SEPARATE"
003800 IF IND1 = 2 MOVE "ST" TO TYPE-DATA.
003810
003820 MOVE ZEROS TO IND1
003830 INSPECT TAB-BUFFER TALLYING IND1
003840 FOR ALL " COMP-5"
003850 IF IND1 = 1 MOVE "C5" TO TYPE-DATA.
003860
003870 MOVE ZEROS TO IND1
003880 INSPECT TAB-BUFFER TALLYING IND1
003890 FOR ALL " COMP-3"
003900 IF IND1 = 1 MOVE "C3" TO TYPE-DATA.
003910
003920 MOVE ZEROS TO IND1
003930 INSPECT TAB-BUFFER TALLYING IND1
003940 FOR ALL " COMP-1"
003950 IF IND1 = 1 MOVE "C1" TO TYPE-DATA.
003960
003970 MOVE ZEROS TO IND1
003980 INSPECT TAB-BUFFER TALLYING IND1
003990 FOR ALL " BINARY"
004000 IF IND1 = 1 MOVE "C" TO TYPE-DATA.
004010
004020
004030 EX-DO-NUMBER-TYPE.
004040 EXIT.
004050
004060
004070 PROCESS-IN.
004080
004090 IF FINE-FILE = "S" GO TO EX-PROCESS-IN.
004100
004110 PERFORM READ-IN THRU EX-READ-IN.
004120
004130**** ANY SYNTAX NOT ALLOWED HERE MUST BE SKIPPED (E.G: CLAUSOLE FD...)
004140
004150 PERFORM VARYING IND FROM 7 BY 1
004160 UNTIL IND > LENGTH OF REC-IN
004170
004180 OR REC-IN(IND:1) NOT = SPACES
004190 CONTINUE
004200 END-PERFORM
004210
004220 IF REC-IN(IND:1) NOT NUMERIC GO TO PROCESS-IN.
004230
004240 PERFORM OPERATE THRU EX-OPERATE.
004250
004260 EX-PROCESS-IN.
004270 EXIT.
004280
004290
004300
004310 READ-IN.
004320
004330 IF FINE-FILE = "S" GO TO EX-READ-IN.
004340
004350 MOVE SPACES TO REC-IN.
004360
004370 READ ARK-IN NEXT RECORD AT END MOVE "S" TO FINE-FILE
004380 GO TO EX-READ-IN.
004390
004400* SKIP ANY COMMENT LINES IF FOUND (E.G. DECLARED IN A FREE SYTLE )
004410
004420 PERFORM VARYING IND FROM 7 BY 1
004430 UNTIL IND > LENGTH OF REC-IN
004440 OR REC-IN(IND:1) NOT = SPACES
004450 CONTINUE
004460 END-PERFORM
004470
004480 IF REC-IN(IND:1) = "*" GO TO READ-IN.
004490
004500 IF REC-IN(IND:) = SPACES GO TO READ-IN.
004510
004520 IF REC-IN(IND:2) = "88" GO TO READ-IN.
004530
004540 IF REC-IN(IND:2) = "66" GO TO READ-IN.
004550
004560* REMOVE ANY UNCONSISTENTLY FIELDS ITEMS INSIDE THE REFCORD
004570
004580 IF REC-IN(1:6) NUMERIC
004590 MOVE SPACES TO REC-IN(1:6).
004600
004610 EX-READ-IN.
004620 EXIT.
004630
004640
004650
004660 ALFA-TO-NUM.
004670
004680 MOVE ALL ZEROS TO NUMERO.
004690 MOVE 18 TO IND3
004700 PERFORM VARYING IND2 FROM 18 BY -1 UNTIL IND2 = ZERO
004710 IF STRINGA(IND2:1) NUMERIC
004720 MOVE STRINGA(IND2:1) TO NUMERO(IND3:1)
004730 SUBTRACT 1 FROM IND3
004740 END-IF
004750
004760 END-PERFORM.
004770
004780 EX-ALFA-TO-NUM.
004790 EXIT.
004800
004810
004820 OPEN-FILES.
004830
004840 ACCEPT WPARAM FROM COMMAND-LINE.
004850
004860 IF WPARAM = SPACES
004870 PERFORM HELP THRU EX-HELP
004880 STOP RUN.
004890
004900 UNSTRING WPARAM DELIMITED BY ALL SPACES
004910 INTO FILE-IN FILE-OUT
004920
004930 IF FILE-OUT = SPACES MOVE "COBFD.TXT" TO FILE-OUT.
004940
004950 OPEN OUTPUT ARKDATA.
004960 CLOSE ARKDATA.
004970 OPEN I-O ARKDATA.
004980
004990
005000 OPEN INPUT ARK-IN.
005010
005020 IF STATUS-IN = "35"
005030 DISPLAY "File not found:" FILE-IN
005040 CLOSE ARKDATA
005050 STOP RUN.
005060
005070 OPEN OUTPUT ARK-OUT.
005080
005090
005100 EX-OPEN-FILES.
005110 EXIT.
005120
005130
005140 CALCULATE-SIZE.
005150
005160
005170 MOVE ZEROS TO WSIZE
005180
005190 IF PICTURE-DATA = "Group"
005200 GO TO END-CALCULATE-SIZE.
005210
005220 MOVE PICTURE-DATA TO WPICTURE.
005230
005240 MOVE ZERO TO IND1
005250
005260 PERFORM VARYING IND1 FROM LENGTH OF WPICTURE
005270 BY -1 UNTIL IND1 = ZEROS
005280 OR WPICTURE(IND1:1) > SPACES
005290 CONTINUE
005300 END-PERFORM
005310
005320*** REMOVE "." from THE END OF THE PICTURE E.G. PIC X. allowed ONLY FOR 999.999....
005330
005340 IF WPICTURE(IND1:1) = "."
005350 MOVE SPACES TO WPICTURE(IND1:1).
005360
005370 MOVE ZEROS TO IND1.
005380 INSPECT WPICTURE TALLYING IND1 FOR ALL "("
005390
005400 IF IND1 = ZEROS GO TO CALCULATE-SINGLE.
005410
005420 PERFORM VARYING IND1 FROM 1 BY 1
005430 UNTIL IND1 > LENGTH OF WPICTURE
005440
005450 if WPICTURE(IND1:1) = "("
005460 COMPUTE IND2 = IND1 - 1
005470 MOVE SPACES TO WPICTURE(IND2:1)
005480 MOVE SPACES TO WPICTURE(IND1:1)
005490 ADD 1 TO IND1
005500 MOVE 1 TO IND2
005510 MOVE SPACES TO STRINGA
005520 PERFORM VARYING IND1 FROM IND1 BY 1 UNTIL
005530 WPICTURE(IND1:1) = ")"
005540 MOVE WPICTURE(IND1:1) TO STRINGA(IND2:1)
005550 MOVE SPACES TO WPICTURE(IND1:1)
005560 ADD 1 TO IND2
005570 END-PERFORM
005580
005590 IF WPICTURE(IND1:1) = ")"
005600 MOVE SPACES TO WPICTURE(IND1:1)
005610 END-IF
005620
005630 PERFORM ALFA-TO-NUM THRU EX-ALFA-TO-NUM
005640 ADD NUMERO TO WSIZE
005650 END-IF
005660
005670 END-PERFORM.
005680
005690 CALCULATE-SINGLE.
005700
005710
005720
005730 PERFORM VARYING IND1 FROM 1 BY 1
005740 UNTIL IND1 > LENGTH OF WPICTURE
005750
005760 IF WPICTURE(IND1:1) = "9" ADD 1 TO WSIZE END-IF
005770 IF WPICTURE(IND1:1) = "X" ADD 1 TO WSIZE END-IF
005780 IF WPICTURE(IND1:1) = "A" ADD 1 TO WSIZE END-IF
005790 IF WPICTURE(IND1:1) = "," ADD 1 TO WSIZE END-IF
005800 IF WPICTURE(IND1:1) = "." ADD 1 TO WSIZE END-IF
005810 IF WPICTURE(IND1:1) = "B" ADD 1 TO WSIZE END-IF
005820 IF WPICTURE(IND1:1) = "Z" ADD 1 TO WSIZE END-IF
005821 IF WPICTURE(IND1:1) = "-" ADD 1 TO WSIZE END-IF
005822 IF WPICTURE(IND1:1) = "+" ADD 1 TO WSIZE END-IF
005830
005840 END-PERFORM.
005850
005860 END-CALCULATE-SIZE.
005870
005880 MOVE WSIZE TO SIZE-DATA.
005890
005900 IF TYPE-DATA = "SL" ADD 1 TO SIZE-DATA.
005910 IF TYPE-DATA = "ST" ADD 1 TO SIZE-DATA.
005920
005930 EVALUATE TYPE-DATA
005940
005950 WHEN "C5"
005960
005970 EVALUATE SIZE-DATA
005980 WHEN 1 MOVE 1 TO SIZE-DATA
005990 WHEN 2 MOVE 1 TO SIZE-DATA
006000 WHEN 3 MOVE 2 TO SIZE-DATA
006010 WHEN 4 MOVE 2 TO SIZE-DATA
006020 WHEN 5 MOVE 3 TO SIZE-DATA
006030 WHEN 6 MOVE 3 TO SIZE-DATA
006040 WHEN 7 MOVE 3 TO SIZE-DATA
006050 WHEN 8 MOVE 4 TO SIZE-DATA
006060 WHEN 9 MOVE 4 TO SIZE-DATA
006070 WHEN 10 MOVE 5 TO SIZE-DATA
006080 WHEN 11 MOVE 5 TO SIZE-DATA
006090 WHEN 12 MOVE 5 TO SIZE-DATA
006100 WHEN 13 MOVE 6 TO SIZE-DATA
006110 WHEN 14 MOVE 6 TO SIZE-DATA
006120 WHEN 15 MOVE 7 TO SIZE-DATA
006130 WHEN 16 MOVE 7 TO SIZE-DATA
006140 WHEN 17 MOVE 8 TO SIZE-DATA
006150 WHEN 18 MOVE 8 TO SIZE-DATA
006160 END-EVALUATE
006170
006180 WHEN "C3"
006190
006200 EVALUATE SIZE-DATA
006210 WHEN 1 MOVE 1 TO SIZE-DATA
006220 WHEN 2 MOVE 2 TO SIZE-DATA
006230 WHEN 3 MOVE 2 TO SIZE-DATA
006240 WHEN 4 MOVE 3 TO SIZE-DATA
006250 WHEN 5 MOVE 3 TO SIZE-DATA
006260 WHEN 6 MOVE 4 TO SIZE-DATA
006270 WHEN 7 MOVE 4 TO SIZE-DATA
006280 WHEN 8 MOVE 5 TO SIZE-DATA
006290 WHEN 9 MOVE 5 TO SIZE-DATA
006300 WHEN 10 MOVE 6 TO SIZE-DATA
006310 WHEN 11 MOVE 6 TO SIZE-DATA
006320 WHEN 12 MOVE 7 TO SIZE-DATA
006330 WHEN 13 MOVE 7 TO SIZE-DATA
006340 WHEN 14 MOVE 8 TO SIZE-DATA
006350 WHEN 15 MOVE 8 TO SIZE-DATA
006360 WHEN 16 MOVE 9 TO SIZE-DATA
006370 WHEN 17 MOVE 9 TO SIZE-DATA
006380 WHEN 18 MOVE 10 TO SIZE-DATA
006390 END-EVALUATE
006400
006410 WHEN "C1"
006420
006430 EVALUATE SIZE-DATA
006440 WHEN 1 MOVE 4 TO SIZE-DATA
006450 WHEN 2 MOVE 4 TO SIZE-DATA
006460 WHEN 3 MOVE 4 TO SIZE-DATA
006470 WHEN 4 MOVE 4 TO SIZE-DATA
006480 WHEN 5 MOVE 4 TO SIZE-DATA
006490 WHEN 6 MOVE 4 TO SIZE-DATA
006500 WHEN 7 MOVE 4 TO SIZE-DATA
006510 WHEN 8 MOVE 4 TO SIZE-DATA
006520 WHEN 9 MOVE 4 TO SIZE-DATA
006530 WHEN 10 MOVE 4 TO SIZE-DATA
006540 WHEN 11 MOVE 4 TO SIZE-DATA
006550 WHEN 12 MOVE 4 TO SIZE-DATA
006560 WHEN 13 MOVE 4 TO SIZE-DATA
006570 WHEN 14 MOVE 4 TO SIZE-DATA
006580 WHEN 15 MOVE 4 TO SIZE-DATA
006590 WHEN 16 MOVE 4 TO SIZE-DATA
006600 WHEN 17 MOVE 4 TO SIZE-DATA
006610 WHEN 18 MOVE 4 TO SIZE-DATA
006620 END-EVALUATE
006630
006640 WHEN OTHER CONTINUE.
006650
006660 IF OCCURS-DATA NOT = ZEROS
006670 COMPUTE ARRAY-SIZE-DATA = SIZE-DATA * OCCURS-DATA
006680 ELSE
006690 MOVE SIZE-DATA TO ARRAY-SIZE-DATA.
006700
006710 EX-CALCULATE-SIZE.
006720 EXIT.
006730
006740 BUILD.
006750
006760 MOVE ZEROS TO KEY-DATA.
006770 START ARKDATA KEY IS NOT < KEY-DATA
006780 INVALID KEY GO TO EX-BUILD.
006790
006800 LOOP-BUILD.
006810
006820 READ ARKDATA NEXT RECORD AT END GO TO END-BUILD.
006830
006840 IF PICTURE-DATA NOT = "Group" GO TO LOOP-BUILD.
006850
006860 IF SIZE-DATA NOT = ZEROS GO TO LOOP-BUILD.
006870
006880 IF LEVEL-DATA = 01 GO TO LOOP-BUILD.
006890
006900
006910 REINDEX-BUILD.
006920
006930 MOVE ZEROS TO WSIZE.
006940 MOVE LEVEL-DATA TO WLEVEL.
006950 MOVE KEY-DATA TO WKEY.
006960 MOVE REDEFINES-DATA TO WREDEFINES.
006970
006980 LOOP-INTERNAL-LEVEL.
006990
007000 READ ARKDATA NEXT RECORD AT END GO TO LOOP-BUILD1.
007010
007020 IF LEVEL-DATA NOT > WLEVEL GO TO LOOP-BUILD1.
007030
007040** HERE: found a group inside another group.. this take the priority end loop inside it before.. NAME-DATA
007050
007060 IF PICTURE-DATA = "Group"
007070** HERE: found a group inside another group with size zeros OK process it
007080
007090 IF SIZE-DATA = ZEROS
007100 GO TO REINDEX-BUILD
007110 ELSE
007120*** HERE: found a group inside another group already processed skip it...
007130
007140 GO TO LOOP-INTERNAL-LEVEL.
007150
007160 IF WREDEFINES > SPACES
007170 MOVE "S" TO FLAG-REDEFINES-DATA
007180 REWRITE REC-DATA.
007190
007200 ADD ARRAY-SIZE-DATA TO WSIZE.
007210
007220 GO TO LOOP-INTERNAL-LEVEL.
007230
007240 LOOP-BUILD1.
007250
007260 MOVE WKEY TO KEY-DATA.
007270 READ ARKDATA KEY IS KEY-DATA.
007280 MOVE WSIZE TO SIZE-DATA.
007290
007300 REWRITE REC-DATA.
007310
007320 GO TO BUILD.
007330
007340 END-BUILD.
007350
007360 EX-BUILD.
007370 EXIT.
007380
007390 CALCULATE.
007400
007410 MOVE ZEROS TO KEY-DATA.
007420 START ARKDATA KEY IS NOT < KEY-DATA
007430 INVALID KEY GO TO EX-CALCULATE.
007440
007450 MOVE ZEROS TO WLEVEL.
007460 MOVE ZEROS TO WSIZE.
007470
007480 LOOP-CALCULATE.
007490
007500 READ ARKDATA NEXT RECORD AT END GO TO END-CALCULATE.
007510
007520 IF REDEFINES-DATA > SPACES
007530 MOVE LEVEL-DATA TO WLEVEL
007540 GO TO LOOP-EXCLUDE.
007550
007560 IF PICTURE-DATA = "Group" GO TO LOOP-CALCULATE.
007570
007580 LOOP-ADD.
007590
007600 IF FLAG-REDEFINES-DATA = "S" GO TO LOOP-CALCULATE.
007610
007620 ADD ARRAY-SIZE-DATA TO WSIZE.
007630
007640 GO TO LOOP-CALCULATE.
007650
007660
007670 LOOP-EXCLUDE.
007680
007690 READ ARKDATA NEXT RECORD AT END GO TO END-CALCULATE.
007700
007710 IF LEVEL-DATA > WLEVEL GO TO LOOP-EXCLUDE.
007720
007730 MOVE ZEROS TO WLEVEL.
007740
007750 GO TO LOOP-ADD.
007760
007770 END-CALCULATE.
007780
007790 MOVE 1 TO KEY-DATA
007800
007810 READ ARKDATA KEY IS KEY-DATA.
007820
007830 MOVE WSIZE TO SIZE-DATA ARRAY-SIZE-DATA.
007840
007850 REWRITE REC-DATA.
007860
007870 EX-CALCULATE.
007880 EXIT.
007890
007900
007910 EXPORT.
007920
007930 MOVE ZEROS TO KEY-DATA.
007940 START ARKDATA KEY IS NOT < KEY-DATA
007950 INVALID KEY GO TO EX-EXPORT.
007960
007970 MOVE SPACES TO REC-OUT
007980 STRING "COBOL Source FILE " FILE-IN(1:30)
007990 " (c) 2022 Priolo Federico TP ONE Srl "
008000 DELIMITED BY SIZE INTO REC-OUT.
008010
008020 WRITE REC-OUT.
008030
008040 MOVE SPACES TO REC-OUT
008050
008060 WRITE REC-OUT.
008070
008080 STRING
008090 "Level and Dataname "
008100 "Picture Type Occurs Size Offset"
008110 DELIMITED BY SIZE INTO REC-OUT.
008120 WRITE REC-OUT.
008130
008140 MOVE SPACES TO REC-OUT.
008150 STRING
008160 "-------------------------- "
008170 "------------ ------ ---- ------"
008180 DELIMITED BY SIZE INTO REC-OUT.
008190 WRITE REC-OUT.
008200
008210
008220 LOOP-EXPORT.
008230
008240 READ ARKDATA NEXT RECORD AT END GO TO EX-EXPORT.
008250
008260 INITIALIZE REC-OUT.
008270 MOVE LEVEL-DATA TO LEVEL-OUT
008280 MOVE NAME-DATA TO NAME-OUT.
008290 MOVE PICTURE-DATA TO PICTURE-OUT.
008300 MOVE TYPE-DATA TO TYPE-OUT.
008310 MOVE SIZE-DATA TO SIZE-OUT.
008320 MOVE OCCURS-DATA TO OCCURS-OUT.
008330
008340 MOVE OFFSET-DATA TO OFFSET-OUT.
008350
008360 WRITE REC-OUT.
008370
008380 GO TO LOOP-EXPORT.
008390
008400 EX-EXPORT.
008410 EXIT.
008420
008430
008440 OFFSET.
008450
008460 MOVE 2 TO KEY-DATA
008470 move zeros TO WOFFSET.
008480
008490 START ARKDATA KEY IS NOT < KEY-DATA
008500 INVALID KEY GO TO EX-OFFSET.
008510
008520 LOOP-OFFSET.
008530
008540 READ ARKDATA NEXT RECORD AT END GO TO EX-OFFSET.
008550
008560 MOVE WOFFSET TO OFFSET-DATA
008570
008580 REWRITE REC-DATA.
008590
008600 IF REDEFINES-DATA = SPACES GO TO AHEAD-OFFSET.
008610
008620 MOVE KEY-DATA TO WKEY
008630 MOVE REDEFINES-DATA TO FIELD-DATA
008640 MOVE LEVEL-DATA TO LEV-DATA
008650 INSPECT KEY-NAME-DATA REPLACING ALL "." BY " "
008660
008670 READ ARKDATA KEY IS KEY-NAME-DATA
008680 INVALID KEY
008690 DISPLAY "Internal error: ERROR READING "
008700 " check: " function trim (KEY-NAME-DATA)
008710* STOP RUN
008720 END-READ
008730
008740 MOVE OFFSET-DATA TO WOFFSET.
008750 MOVE WKEY TO KEY-DATA
008760 READ ARKDATA KEY IS KEY-DATA.
008770
008780 REWRITE REC-DATA.
008790
008800 AHEAD-OFFSET.
008810
008820
008830 ADD ARRAY-SIZE-DATA TO WOFFSET.
008840
008850 GO TO LOOP-OFFSET.
008860
008870 EX-OFFSET.
008880 EXIT.
008890
008900 HELP.
008910
008920 DISPLAY "Usage: COBFD fdfile.cbl [cobfd.txt]".
008930 DISPLAY " ".
008940
008950 EX-HELP.
008960 EXIT.
008970
008980
008990 end program COBFD.
009000
000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. COBFD.
000030
000040*---------------------------------------------------------------
000050* COSTRUISCE IL DIZIONARIO PER LA FD SPECIFICATA
000060*---------------------------------------------------------------
000070*
000080* Copyright (C) Federico Priolo TP ONE SRL federico.priolo@tp-one.it
000090*
000100* This program is free software; you can redistribute it and/or
000110* it under the terms of the GNU General Public License as publis
000120* the Free Software Foundation; either version 2, or (at your op
000130* any later version.
000140*
000150* This program is distributed in the hope that it will be useful
000160* but WITHOUT ANY WARRANTY; without even the implied warranty of
000170* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
000180* GNU General Public License for more details.
000190*
000200* You should have received a copy of the GNU General Public Lice
000210* along with this software; see the file COPYING. If not, write
000220* the Free Software Foundation, 51 Franklin Street, Fifth Floor
000230* Boston, MA 02110-1301 USA
000240*
000250*
000260*---------------------------------------------------------------
000270 ENVIRONMENT DIVISION.
000280 CONFIGURATION SECTION.
000290 SOURCE-COMPUTER. PC-IBM.
000300 OBJECT-COMPUTER. PC-IBM.
000310 SPECIAL-NAMES.
000320 ARGUMENT-NUMBER IS ARG-NUM
000330 ARGUMENT-VALUE IS ARG-VAL
000340 DECIMAL-POINT IS COMMA.
000350
000360
000370 INPUT-OUTPUT SECTION.
000380 FILE-CONTROL.
000390
000400*
000410** your copy fd to examine
000420*
000430
000440 SELECT ARK-IN ASSIGN TO FILE-IN
000450 ORGANIZATION IS LINE SEQUENTIAL
000460 FILE STATUS IS STATUS-IN.
000470*
000480** isam to figure out size and offset...
000490*
000500 SELECT ARKDATA ASSIGN ".\WORKAREA.DAT"
000510
000520 ORGANIZATION IS INDEXED
000530 ACCESS MODE IS DYNAMIC
000540 RECORD KEY IS KEY-DATA
000550 ALTERNATE RECORD KEY IS KEY-NAME-DATA
000560 DUPLICATES
000570 FILE STATUS IS STATUS-DATA.
000580
000590
000600*
000610** The output result
000620*
000630
000640 SELECT ARK-OUT ASSIGN TO FILE-OUT
000650 ORGANIZATION IS LINE SEQUENTIAL
000660 FILE STATUS IS STATUS-OUT.
000670
000680
000690 DATA DIVISION.
000700 FILE SECTION.
000710
000720 FD ARK-IN LABEL RECORD IS STANDARD.
000730
000740 01 REC-IN.
000750 02 FILLER PIC X(80).
000760
000770 FD ARK-OUT LABEL RECORD IS STANDARD.
000780
000790 01 REC-OUT.
000800 02 FILLER-OUT PIC X(80).
000810
000820 01 REC-OUTX.
000830 02 LEVEL-OUT PIC 99.
000840 02 FILLER-OUT PIC X.
000850 02 NAME-OUT PIC X(31).
000860 02 FILLER-OUT PIC X.
000870 02 PICTURE-OUT PIC X(15).
000880 02 FILLER-OUT PIC X.
000890 02 TYPE-OUT PIC X(4).
000900 02 FILLER-OUT PIC X.
000910 02 OCCURS-OUT PIC ZZZZZZ.
000920 02 FILLER-OUT PIC X.
000930 02 SIZE-OUT PIC ZZZZZZ.
000940 02 FILLER-OUT PIC X.
000950 02 OFFSET-OUT PIC ZZZZZ9.
000960
000970*
000980 FD ARKDATA LABEL RECORD IS STANDARD GLOBAL.
000990*
001000 01 REC-DATA.
001010
001020 02 KEY-DATA PIC 9(9).
001030 02 KEY-NAME-DATA.
001040 05 LEV-DATA PIC 99.
001050 05 FIELD-DATA PIC X(30).
001060 02 FIELDS-DATA.
001070 05 LEVEL-DATA PIC 99.
001080 05 NAME-DATA PIC X(30).
001090 05 FILLER-DATA PIC X.
001100 05 PICTURE-DATA PIC X(30).
001110 05 FILLER-DATA PIC X.
001120 05 TYPE-DATA PIC X(08).
001130 05 OCCURS-DATA PIC 9(2).
001140 05 FILLER-DATA PIC X.
001150 05 SIZE-DATA PIC 9(7).
001160 05 FILLER-DATA PIC X.
001170 05 OFFSET-DATA PIC 9(7).
001180 05 REDEFINES-DATA PIC X(30).
001190 05 ARRAY-SIZE-DATA PIC 9(7).
001200 05 FLAG-REDEFINES-DATA PIC X.
001210
001220 WORKING-STORAGE SECTION.
001230
001240 77 FILE-DATA PIC X(20) VALUE "ARKDATA".
001250 77 STATUS-DATA PIC XX VALUE "00".
001260 77 FINE-FILE PIC X.
001270 77 STATUS-IN PIC XX VALUE "00".
001280 77 STATUS-OUT PIC XX VALUE "00".
001290
001300 77 IND PIC 999.
001310 77 IND1 PIC 999.
001320 77 IND2 PIC 999.
001330 77 IND3 PIC 999.
001340 77 IND4 PIC 999.
001350 77 NUM PIC 9(4).
001360
001370 01 FILE-IN PIC X(150).
001380 01 FILE-OUT PIC X(150).
001390 77 WPARAM PIC X(512).
001400 77 WSIZE PIC 9(9).
001410 77 WOFFSET PIC 9(9).
001420 77 WLEVEL PIC 99.
001430 77 WPICTURE PIC X(30).
001440 77 WKEY PIC 9(9).
001450 77 WREDEFINES PIC X(30).
001460 77 COUNT-ITEM PIC 9(9) VALUE ZEROS.
001470 01 STRINGA PIC X(18).
001480 01 NUMERO PIC 9(18).
001490
001500 01 TAB-BUFFER.
001510 02 IND-BUFFER PIC 99.
001520 02 IND1-BUFFER PIC 99.
001530 02 BUFFER PIC X(30) OCCURS 50 TIMES.
001540
001550 01 TAB-STRINGA PIC X(1504) VALUE SPACE.
001560
001570
001580 PROCEDURE DIVISION.
001590
001600 MAIN SECTION.
001610 INIZIO.
001620
001630
001640
001650 PERFORM OPEN-FILES THRU EX-OPEN-FILES.
001660
001670 MOVE SPACES TO FINE-FILE.
001680 MOVE ZEROS TO COUNT-ITEM
001690
001700 DISPLAY
001710 "COBFD Version 1.00 "
001720 "Copyright (C) 2022 Federico Priolo TP ONE SRL".
001730
001740 DISPLAY
001750 "Analyzing " FILE-IN .
001760
001770
001780
001790 PERFORM PROCESS-IN THRU EX-PROCESS-IN
001800 UNTIL FINE-FILE = "S".
001810
001820 PERFORM BUILD THRU EX-BUILD.
001830
001840 PERFORM CALCULATE THRU EX-CALCULATE.
001850
001860 PERFORM OFFSET THRU EX-OFFSET.
001870
001880 PERFORM EXPORT THRU EX-EXPORT.
001890
001900 FINE.
001910
001920 DISPLAY "COBFD: end of job ".
001930
001940 CLOSE ARK-IN ARKDATA ARK-OUT.
001950 GOBACK.
001960
001970
001980 OPERATE.
001990
002000 IF FINE-FILE = "S" GO TO EX-OPERATE.
002010
002020 INITIALIZE TAB-BUFFER.
002030
002040
002050 UNSTRING REC-IN DELIMITED BY ALL SPACES
002060 INTO BUFFER(1)
002070 BUFFER(2)
002080 BUFFER(3)
002090 BUFFER(4)
002100 BUFFER(5)
002110 BUFFER(6)
002120 BUFFER(7)
002130 BUFFER(8)
002140 BUFFER(9)
002150 BUFFER(10)
002160 BUFFER(11)
002170 BUFFER(12)
002180 BUFFER(13)
002190 BUFFER(14)
002200 BUFFER(15)
002210 TALLYING IND-BUFFER
002220
002230 PERFORM VARYING IND FROM LENGTH OF REC-IN BY -1 UNTIL
002240 REC-IN(IND:1) NOT = SPACES
002250 CONTINUE
002260 END-PERFORM
002270
002280 IF REC-IN(IND:1) = "." GO TO END-OPERATE.
002290
002300 PERFORM READ-IN THRU EX-READ-IN
002310
002320 UNSTRING REC-IN DELIMITED BY ALL SPACES
002330 INTO BUFFER(16)
002340 BUFFER(17)
002350 BUFFER(18)
002360 BUFFER(19)
002370 BUFFER(20)
002380 BUFFER(21)
002390 BUFFER(22)
002400 BUFFER(23)
002410 BUFFER(24)
002420 BUFFER(25)
002430 BUFFER(26)
002440 BUFFER(27)
002450 BUFFER(28)
002460 BUFFER(29)
002470 BUFFER(30).
002480
002490 IF IND-BUFFER NOT = 15
002500 ADD 1 TO IND-BUFFER
002510 MOVE 16 TO IND1-BUFFER
002520 PERFORM 15 TIMES
002530 MOVE BUFFER(IND1-BUFFER) TO BUFFER(IND-BUFFER)
002540 MOVE SPACES TO BUFFER(IND1-BUFFER)
002550 ADD 1 TO IND-BUFFER IND1-BUFFER
002560 END-PERFORM.
002570
002580
002590 END-OPERATE.
002600
002610 ADD 1 TO COUNT-ITEM.
002620
002630 MOVE FUNCTION UPPER-CASE(TAB-BUFFER) TO TAB-STRINGA
002640
002650 MOVE TAB-STRINGA TO TAB-BUFFER
002660 INITIALIZE REC-DATA
002670
002680*** FIRST ITEM CONTAINS THE RECORD LEVEL
002690
002700 PERFORM VARYING IND FROM 1 BY 1 UNTIL IND > 30
002710
002720
002730**** HERE A COBOL LEVEL...
002740
002750 IF BUFFER(IND) > SPACES
002760 AND NAME-DATA = SPACES
002770 AND BUFFER(IND) (1:1) NUMERIC
002780
002790
002800 MOVE BUFFER(IND) TO STRINGA
002810 PERFORM ALFA-TO-NUM THRU EX-ALFA-TO-NUM
002820 MOVE NUMERO TO LEVEL-DATA
002830
002840**** ...AND AFTER THE NAME OF COBOL FIELD
002850
002860 ADD 1 TO IND
002870 MOVE BUFFER(IND) TO FIELD-DATA NAME-DATA
002880
002890 ADD 1 TO IND
002900
002910**** here a field WITHOUT PICTURE... E.G. 01 NAME.
002920
002930 IF BUFFER(IND) = SPACES
002940 MOVE "Group" TO PICTURE-DATA
002950 END-IF
002960
002970 END-IF
002980
002990
003000 IF BUFFER(IND) = "REDEFINES"
003010 ADD 1 TO IND
003020 MOVE BUFFER(IND) TO REDEFINES-DATA
003030 END-IF
003040
003050
003060 IF BUFFER(IND)(1:3) = "PIC"
003070 ADD 1 TO IND
003080 MOVE BUFFER(IND) TO PICTURE-DATA
003090
003100 EVALUATE PICTURE-DATA(1:1)
003110
003120 WHEN "X" MOVE "AN" TO TYPE-DATA
003130 WHEN "S" MOVE "N" TO TYPE-DATA
003140 PERFORM DO-NUMBER-TYPE THRU EX-DO-NUMBER-TYPE
003150
003160 WHEN "9" MOVE "N" TO TYPE-DATA
003170 PERFORM DO-NUMBER-TYPE THRU EX-DO-NUMBER-TYPE
003180
003190 WHEN "A" MOVE "A" TO TYPE-DATA
003191
003192 WHEN "-" MOVE "NE" TO TYPE-DATA
003193
003194 WHEN "+" MOVE "NE" TO TYPE-DATA
003195
003196 WHEN "Z" MOVE "NE" TO TYPE-DATA
003197
003198 WHEN OTHER DISPLAY "TYPE" PICTURE-DATA " NOT MANAGED"
003199
003200 END-EVALUATE
003210
003220
003230 END-IF
003240
003250 IF BUFFER(IND) = "OCCURS"
003260
003270**** here a field WITHOUT PICTURE... E.G. 02 NAME OCCURS 5 TIMES...
003280
003290 MOVE ZEROS TO IND1
003300 INSPECT TAB-BUFFER TALLYING IND1 FOR ALL "PIC"
003310 IF IND1 = ZEROS
003320 MOVE "Group" TO PICTURE-DATA
003330 END-IF
003340
003350 ADD 1 TO IND
003360 MOVE BUFFER(IND) TO STRINGA
003370 PERFORM ALFA-TO-NUM THRU EX-ALFA-TO-NUM
003380 MOVE NUMERO TO OCCURS-DATA
003390 END-IF
003400
003410
003420 END-PERFORM.
003430
003440 PERFORM CALCULATE-SIZE THRU EX-CALCULATE-SIZE.
003450
003460 MOVE COUNT-ITEM TO KEY-DATA.
003470
003480 IF PICTURE-DATA = SPACES
003490 MOVE "Group" TO PICTURE-DATA.
003500
003510 INSPECT KEY-NAME-DATA REPLACING ALL "." BY " "
003520
003530 MOVE LEVEL-DATA TO LEV-DATA
003540
003550 WRITE REC-DATA
003560 INVALID KEY CONTINUE.
003570
003580 IF STATUS-DATA = "02"
003590 IF NAME-DATA(1:6) NOT = "FILLER"
003600 DISPLAY
003610 "Warning:found duplicates name with the same level:"
003620 NAME-DATA
003630 END-IF.
003640
003650
003660 EX-OPERATE.
003670 EXIT.
003680
003690 DO-NUMBER-TYPE.
003700
003710 MOVE ZEROS TO IND1
003720 INSPECT TAB-BUFFER TALLYING IND1
003730 FOR ALL "LEADING"
003740 INSPECT TAB-BUFFER TALLYING IND1
003750 FOR ALL "SEPARATE"
003760 IF IND1 = 2 MOVE "SL" TO TYPE-DATA.
003770
003780 MOVE ZEROS TO IND1
003790 INSPECT TAB-BUFFER TALLYING IND1
003800 FOR ALL "TRAIDING"
003810 INSPECT TAB-BUFFER TALLYING IND1
003820 FOR ALL "SEPARATE"
003830 IF IND1 = 2 MOVE "ST" TO TYPE-DATA.
003840
003850 MOVE ZEROS TO IND1
003860 INSPECT TAB-BUFFER TALLYING IND1
003870 FOR ALL " COMP-5"
003880 IF IND1 = 1 MOVE "C5" TO TYPE-DATA.
003890
003900 MOVE ZEROS TO IND1
003910 INSPECT TAB-BUFFER TALLYING IND1
003920 FOR ALL " COMP-3"
003930 IF IND1 = 1 MOVE "C3" TO TYPE-DATA.
003940
003950 MOVE ZEROS TO IND1
003960 INSPECT TAB-BUFFER TALLYING IND1
003970 FOR ALL " COMP-1"
003980 IF IND1 = 1 MOVE "C1" TO TYPE-DATA.
003990
004000 MOVE ZEROS TO IND1
004010 INSPECT TAB-BUFFER TALLYING IND1
004020 FOR ALL " BINARY"
004030 IF IND1 = 1 MOVE "C" TO TYPE-DATA.
004040
004050
004060 EX-DO-NUMBER-TYPE.
004070 EXIT.
004080
004090
004100 PROCESS-IN.
004110
004120 IF FINE-FILE = "S" GO TO EX-PROCESS-IN.
004130
004140 PERFORM READ-IN THRU EX-READ-IN.
004150
004160**** ANY SYNTAX NOT ALLOWED HERE MUST BE SKIPPED (E.G: CLAUSOLE FD...)
004170
004180 PERFORM VARYING IND FROM 7 BY 1
004190 UNTIL IND > LENGTH OF REC-IN
004200
004210 OR REC-IN(IND:1) NOT = SPACES
004220 CONTINUE
004230 END-PERFORM
004240
004250 IF REC-IN(IND:1) NOT NUMERIC GO TO PROCESS-IN.
004260
004270 PERFORM OPERATE THRU EX-OPERATE.
004280
004290 EX-PROCESS-IN.
004300 EXIT.
004310
004320
004330
004340 READ-IN.
004350
004360 IF FINE-FILE = "S" GO TO EX-READ-IN.
004370
004380 MOVE SPACES TO REC-IN.
004390
004400 READ ARK-IN NEXT RECORD AT END MOVE "S" TO FINE-FILE
004410 GO TO EX-READ-IN.
004420
004430* SKIP ANY COMMENT LINES IF FOUND (E.G. DECLARED IN A FREE SYTLE )
004440
004450 PERFORM VARYING IND FROM 7 BY 1
004460 UNTIL IND > LENGTH OF REC-IN
004470 OR REC-IN(IND:1) NOT = SPACES
004480 CONTINUE
004490 END-PERFORM
004500
004510 IF REC-IN(IND:1) = "*" GO TO READ-IN.
004520
004530 IF REC-IN(IND:) = SPACES GO TO READ-IN.
004540
004550 IF REC-IN(IND:2) = "88" GO TO READ-IN.
004560
004570 IF REC-IN(IND:2) = "66" GO TO READ-IN.
004580
004590* REMOVE ANY UNCONSISTENTLY FIELDS ITEMS INSIDE THE REFCORD
004600
004610 IF REC-IN(1:6) NUMERIC
004620 MOVE SPACES TO REC-IN(1:6).
004630
004640 EX-READ-IN.
004650 EXIT.
004660
004670
004680
004690 ALFA-TO-NUM.
004700
004710 MOVE ALL ZEROS TO NUMERO.
004720 MOVE 18 TO IND3
004730 PERFORM VARYING IND2 FROM 18 BY -1 UNTIL IND2 = ZERO
004740 IF STRINGA(IND2:1) NUMERIC
004750 MOVE STRINGA(IND2:1) TO NUMERO(IND3:1)
004760 SUBTRACT 1 FROM IND3
004770 END-IF
004780
004790 END-PERFORM.
004800
004810 EX-ALFA-TO-NUM.
004820 EXIT.
004830
004840
004850 OPEN-FILES.
004860
004870 ACCEPT NUM FROM ARG-NUM
004880
004890 EVALUATE NUM
004900 WHEN 2
004910 ACCEPT FILE-IN FROM ARG-VAL
004920 ACCEPT FILE-OUT FROM ARG-VAL
004930 WHEN 1
004940 ACCEPT FILE-IN FROM ARG-VAL
004950 MOVE SPACES TO FILE-OUT
004960 WHEN OTHER
004970 DISPLAY "Missing command line parameter for COBFD usage: COBFD fdefile.cbl [your-report.txt]"
004980 stop run
004990
005000 END-EVALUATE.
005010
005020
005030 IF FILE-OUT = SPACES MOVE "COBFD.TXT" TO FILE-OUT.
005040
005050 OPEN OUTPUT ARKDATA.
005060 CLOSE ARKDATA.
005070 OPEN I-O ARKDATA.
005080
005090
005100 OPEN INPUT ARK-IN.
005110
005120 IF STATUS-IN = "35"
005130 DISPLAY "File not found:" FILE-IN
005140 CLOSE ARKDATA
005150 STOP RUN.
005160
005170 OPEN OUTPUT ARK-OUT.
005180
005190
005200 EX-OPEN-FILES.
005210 EXIT.
005220
005230
005240 CALCULATE-SIZE.
005250
005260
005270 MOVE ZEROS TO WSIZE
005280
005290 IF PICTURE-DATA = "Group"
005300 GO TO END-CALCULATE-SIZE.
005310
005320 MOVE PICTURE-DATA TO WPICTURE.
005330
005340 MOVE ZERO TO IND1
005350
005360 PERFORM VARYING IND1 FROM LENGTH OF WPICTURE
005370 BY -1 UNTIL IND1 = ZEROS
005380 OR WPICTURE(IND1:1) > SPACES
005390 CONTINUE
005400 END-PERFORM
005410
005420*** REMOVE "." from THE END OF THE PICTURE E.G. PIC X. allowed ONLY FOR 999.999....
005430
005440 IF WPICTURE(IND1:1) = "."
005450 MOVE SPACES TO WPICTURE(IND1:1).
005460
005470 MOVE ZEROS TO IND1.
005480 INSPECT WPICTURE TALLYING IND1 FOR ALL "("
005490
005500 IF IND1 = ZEROS GO TO CALCULATE-SINGLE.
005510
005520 PERFORM VARYING IND1 FROM 1 BY 1
005530 UNTIL IND1 > LENGTH OF WPICTURE
005540
005550 if WPICTURE(IND1:1) = "("
005560 COMPUTE IND2 = IND1 - 1
005570 MOVE SPACES TO WPICTURE(IND2:1)
005580 MOVE SPACES TO WPICTURE(IND1:1)
005590 ADD 1 TO IND1
005600 MOVE 1 TO IND2
005610 MOVE SPACES TO STRINGA
005620 PERFORM VARYING IND1 FROM IND1 BY 1 UNTIL
005630 WPICTURE(IND1:1) = ")"
005640 MOVE WPICTURE(IND1:1) TO STRINGA(IND2:1)
005650 MOVE SPACES TO WPICTURE(IND1:1)
005660 ADD 1 TO IND2
005670 END-PERFORM
005680
005690 IF WPICTURE(IND1:1) = ")"
005700 MOVE SPACES TO WPICTURE(IND1:1)
005710 END-IF
005720
005730 PERFORM ALFA-TO-NUM THRU EX-ALFA-TO-NUM
005740 ADD NUMERO TO WSIZE
005750 END-IF
005760
005770 END-PERFORM.
005780
005790 CALCULATE-SINGLE.
005800
005810
005820
005830 PERFORM VARYING IND1 FROM 1 BY 1
005840 UNTIL IND1 > LENGTH OF WPICTURE
005850
005860 IF WPICTURE(IND1:1) = "9" ADD 1 TO WSIZE END-IF
005870 IF WPICTURE(IND1:1) = "X" ADD 1 TO WSIZE END-IF
005880 IF WPICTURE(IND1:1) = "A" ADD 1 TO WSIZE END-IF
005890 IF WPICTURE(IND1:1) = "," ADD 1 TO WSIZE END-IF
005900 IF WPICTURE(IND1:1) = "." ADD 1 TO WSIZE END-IF
005910 IF WPICTURE(IND1:1) = "B" ADD 1 TO WSIZE END-IF
005920 IF WPICTURE(IND1:1) = "Z" ADD 1 TO WSIZE END-IF
005930 IF WPICTURE(IND1:1) = "-" ADD 1 TO WSIZE END-IF
005931 IF WPICTURE(IND1:1) = "+" ADD 1 TO WSIZE END-IF
005932
005940 END-PERFORM.
005950
005960 END-CALCULATE-SIZE.
005970
005980 MOVE WSIZE TO SIZE-DATA.
005990
006000 IF TYPE-DATA = "SL" ADD 1 TO SIZE-DATA.
006010 IF TYPE-DATA = "ST" ADD 1 TO SIZE-DATA.
006020
006030 EVALUATE TYPE-DATA
006040
006050 WHEN "C5"
006060
006070 EVALUATE SIZE-DATA
006080 WHEN 1 MOVE 1 TO SIZE-DATA
006090 WHEN 2 MOVE 1 TO SIZE-DATA
006100 WHEN 3 MOVE 2 TO SIZE-DATA
006110 WHEN 4 MOVE 2 TO SIZE-DATA
006120 WHEN 5 MOVE 3 TO SIZE-DATA
006130 WHEN 6 MOVE 3 TO SIZE-DATA
006140 WHEN 7 MOVE 3 TO SIZE-DATA
006150 WHEN 8 MOVE 4 TO SIZE-DATA
006160 WHEN 9 MOVE 4 TO SIZE-DATA
006170 WHEN 10 MOVE 5 TO SIZE-DATA
006180 WHEN 11 MOVE 5 TO SIZE-DATA
006190 WHEN 12 MOVE 5 TO SIZE-DATA
006200 WHEN 13 MOVE 6 TO SIZE-DATA
006210 WHEN 14 MOVE 6 TO SIZE-DATA
006220 WHEN 15 MOVE 7 TO SIZE-DATA
006230 WHEN 16 MOVE 7 TO SIZE-DATA
006240 WHEN 17 MOVE 8 TO SIZE-DATA
006250 WHEN 18 MOVE 8 TO SIZE-DATA
006260 END-EVALUATE
006270
006280 WHEN "C3"
006290
006300 EVALUATE SIZE-DATA
006310 WHEN 1 MOVE 1 TO SIZE-DATA
006320 WHEN 2 MOVE 2 TO SIZE-DATA
006330 WHEN 3 MOVE 2 TO SIZE-DATA
006340 WHEN 4 MOVE 3 TO SIZE-DATA
006350 WHEN 5 MOVE 3 TO SIZE-DATA
006360 WHEN 6 MOVE 4 TO SIZE-DATA
006370 WHEN 7 MOVE 4 TO SIZE-DATA
006380 WHEN 8 MOVE 5 TO SIZE-DATA
006390 WHEN 9 MOVE 5 TO SIZE-DATA
006400 WHEN 10 MOVE 6 TO SIZE-DATA
006410 WHEN 11 MOVE 6 TO SIZE-DATA
006420 WHEN 12 MOVE 7 TO SIZE-DATA
006430 WHEN 13 MOVE 7 TO SIZE-DATA
006440 WHEN 14 MOVE 8 TO SIZE-DATA
006450 WHEN 15 MOVE 8 TO SIZE-DATA
006460 WHEN 16 MOVE 9 TO SIZE-DATA
006470 WHEN 17 MOVE 9 TO SIZE-DATA
006480 WHEN 18 MOVE 10 TO SIZE-DATA
006490 END-EVALUATE
006500
006510 WHEN "C1"
006520
006530 EVALUATE SIZE-DATA
006540 WHEN 1 MOVE 4 TO SIZE-DATA
006550 WHEN 2 MOVE 4 TO SIZE-DATA
006560 WHEN 3 MOVE 4 TO SIZE-DATA
006570 WHEN 4 MOVE 4 TO SIZE-DATA
006580 WHEN 5 MOVE 4 TO SIZE-DATA
006590 WHEN 6 MOVE 4 TO SIZE-DATA
006600 WHEN 7 MOVE 4 TO SIZE-DATA
006610 WHEN 8 MOVE 4 TO SIZE-DATA
006620 WHEN 9 MOVE 4 TO SIZE-DATA
006630 WHEN 10 MOVE 4 TO SIZE-DATA
006640 WHEN 11 MOVE 4 TO SIZE-DATA
006650 WHEN 12 MOVE 4 TO SIZE-DATA
006660 WHEN 13 MOVE 4 TO SIZE-DATA
006670 WHEN 14 MOVE 4 TO SIZE-DATA
006680 WHEN 15 MOVE 4 TO SIZE-DATA
006690 WHEN 16 MOVE 4 TO SIZE-DATA
006700 WHEN 17 MOVE 4 TO SIZE-DATA
006710 WHEN 18 MOVE 4 TO SIZE-DATA
006720 END-EVALUATE
006730
006740 WHEN OTHER CONTINUE.
006750
006760 IF OCCURS-DATA NOT = ZEROS
006770 COMPUTE ARRAY-SIZE-DATA = SIZE-DATA * OCCURS-DATA
006780 ELSE
006790 MOVE SIZE-DATA TO ARRAY-SIZE-DATA.
006800
006810 EX-CALCULATE-SIZE.
006820 EXIT.
006830
006840 BUILD.
006850
006860 MOVE ZEROS TO KEY-DATA.
006870 START ARKDATA KEY IS NOT < KEY-DATA
006880 INVALID KEY GO TO EX-BUILD.
006890
006900 LOOP-BUILD.
006910
006920 READ ARKDATA NEXT RECORD AT END GO TO END-BUILD.
006930
006940 IF PICTURE-DATA NOT = "Group" GO TO LOOP-BUILD.
006950
006960 IF SIZE-DATA NOT = ZEROS GO TO LOOP-BUILD.
006970
006980 IF LEVEL-DATA = 01 GO TO LOOP-BUILD.
006990
007000
007010 REINDEX-BUILD.
007020
007030 MOVE ZEROS TO WSIZE.
007040 MOVE LEVEL-DATA TO WLEVEL.
007050 MOVE KEY-DATA TO WKEY.
007060 MOVE REDEFINES-DATA TO WREDEFINES.
007070
007080 LOOP-INTERNAL-LEVEL.
007090
007100 READ ARKDATA NEXT RECORD AT END GO TO LOOP-BUILD1.
007110
007120 IF LEVEL-DATA NOT > WLEVEL GO TO LOOP-BUILD1.
007130
007140** HERE: found a group inside another group.. this take the priority end loop inside it before.. NAME-DATA
007150
007160 IF PICTURE-DATA = "Group"
007170** HERE: found a group inside another group with size zeros OK process it
007180
007190 IF SIZE-DATA = ZEROS
007200 GO TO REINDEX-BUILD
007210 ELSE
007220*** HERE: found a group inside another group already processed skip it...
007230
007240 GO TO LOOP-INTERNAL-LEVEL.
007250
007260 IF WREDEFINES > SPACES
007270 MOVE "S" TO FLAG-REDEFINES-DATA
007280 REWRITE REC-DATA.
007290
007300 ADD ARRAY-SIZE-DATA TO WSIZE.
007310
007320 GO TO LOOP-INTERNAL-LEVEL.
007330
007340 LOOP-BUILD1.
007350
007360 MOVE WKEY TO KEY-DATA.
007370 READ ARKDATA KEY IS KEY-DATA.
007380 MOVE WSIZE TO SIZE-DATA.
007390
007400 REWRITE REC-DATA.
007410
007420 GO TO BUILD.
007430
007440 END-BUILD.
007450
007460 EX-BUILD.
007470 EXIT.
007480
007490 CALCULATE.
007500
007510 MOVE ZEROS TO KEY-DATA.
007520 START ARKDATA KEY IS NOT < KEY-DATA
007530 INVALID KEY GO TO EX-CALCULATE.
007540
007550 MOVE ZEROS TO WLEVEL.
007560 MOVE ZEROS TO WSIZE.
007570
007580 LOOP-CALCULATE.
007590
007600 READ ARKDATA NEXT RECORD AT END GO TO END-CALCULATE.
007610
007620 IF REDEFINES-DATA > SPACES
007630 MOVE LEVEL-DATA TO WLEVEL
007640 GO TO LOOP-EXCLUDE.
007650
007660 IF PICTURE-DATA = "Group" GO TO LOOP-CALCULATE.
007670
007680 LOOP-ADD.
007690
007700 IF FLAG-REDEFINES-DATA = "S" GO TO LOOP-CALCULATE.
007710
007720 ADD ARRAY-SIZE-DATA TO WSIZE.
007730
007740 GO TO LOOP-CALCULATE.
007750
007760
007770 LOOP-EXCLUDE.
007780
007790 READ ARKDATA NEXT RECORD AT END GO TO END-CALCULATE.
007800
007810 IF LEVEL-DATA > WLEVEL GO TO LOOP-EXCLUDE.
007820
007830 MOVE ZEROS TO WLEVEL.
007840
007850 GO TO LOOP-ADD.
007860
007870 END-CALCULATE.
007880
007890 MOVE 1 TO KEY-DATA
007900
007910 READ ARKDATA KEY IS KEY-DATA.
007920
007930 MOVE WSIZE TO SIZE-DATA ARRAY-SIZE-DATA.
007940
007950 REWRITE REC-DATA.
007960
007970 EX-CALCULATE.
007980 EXIT.
007990
008000
008010 EXPORT.
008020
008030 MOVE ZEROS TO KEY-DATA.
008040 START ARKDATA KEY IS NOT < KEY-DATA
008050 INVALID KEY GO TO EX-EXPORT.
008060
008070 MOVE SPACES TO REC-OUT
008080 STRING "COBOL Source FILE " FILE-IN(1:30)
008090 " (c) 2022 Priolo Federico TP ONE Srl "
008100 DELIMITED BY SIZE INTO REC-OUT.
008110
008120 WRITE REC-OUT.
008130
008140 MOVE SPACES TO REC-OUT
008150
008160 WRITE REC-OUT.
008170
008180 STRING
008190 "Level and Dataname "
008200 "Picture Type Occurs Size Offset"
008210 DELIMITED BY SIZE INTO REC-OUT.
008220 WRITE REC-OUT.
008230
008240 MOVE SPACES TO REC-OUT.
008250 STRING
008260 "-------------------------- "
008270 "------------ ------ ---- ------"
008280 DELIMITED BY SIZE INTO REC-OUT.
008290 WRITE REC-OUT.
008300
008310
008320 LOOP-EXPORT.
008330
008340 READ ARKDATA NEXT RECORD AT END GO TO EX-EXPORT.
008350
008360 INITIALIZE REC-OUT.
008370 MOVE LEVEL-DATA TO LEVEL-OUT
008380 MOVE NAME-DATA TO NAME-OUT.
008390 MOVE PICTURE-DATA TO PICTURE-OUT.
008400 MOVE TYPE-DATA TO TYPE-OUT.
008410 MOVE SIZE-DATA TO SIZE-OUT.
008420 MOVE OCCURS-DATA TO OCCURS-OUT.
008430
008440 MOVE OFFSET-DATA TO OFFSET-OUT.
008450
008460 WRITE REC-OUT.
008470
008480 GO TO LOOP-EXPORT.
008490
008500 EX-EXPORT.
008510 EXIT.
008520
008530
008540 OFFSET.
008550
008560 MOVE 2 TO KEY-DATA
008570 move zeros TO WOFFSET.
008580
008590 START ARKDATA KEY IS NOT < KEY-DATA
008600 INVALID KEY GO TO EX-OFFSET.
008610
008620 LOOP-OFFSET.
008630
008640 READ ARKDATA NEXT RECORD AT END GO TO EX-OFFSET.
008650
008660 MOVE WOFFSET TO OFFSET-DATA
008670
008680 REWRITE REC-DATA.
008690
008700 IF REDEFINES-DATA = SPACES GO TO AHEAD-OFFSET.
008710
008720 MOVE KEY-DATA TO WKEY
008730 MOVE REDEFINES-DATA TO FIELD-DATA
008740 MOVE LEVEL-DATA TO LEV-DATA
008750 INSPECT KEY-NAME-DATA REPLACING ALL "." BY " "
008760
008770 READ ARKDATA KEY IS KEY-NAME-DATA
008780 INVALID KEY
008790 DISPLAY "Internal error: ERROR READING "
008800 " check: " KEY-NAME-DATA
008810* STOP RUN
008820 END-READ
008830
008840 MOVE OFFSET-DATA TO WOFFSET.
008850 MOVE WKEY TO KEY-DATA
008860 READ ARKDATA KEY IS KEY-DATA.
008870
008880 REWRITE REC-DATA.
008890
008900 AHEAD-OFFSET.
008910
008920
008930 ADD ARRAY-SIZE-DATA TO WOFFSET.
008940
008950 GO TO LOOP-OFFSET.
008960
008970 EX-OFFSET.
008980 EXIT.
008990
009000 HELP.
009010
009020 DISPLAY "Usage: COBFD fdfile.cbl [cobfd.txt]".
009030 DISPLAY " ".
009040
009050 EX-HELP.
009060 EXIT.
009070
009080
009090 end program COBFD.
009100