7
\$\begingroup\$

I've been getting into COBOL lately, and I find it a very peculiar and interesting language that can still hold up to this day.

The reason I'm uploading this is mostly to get some feedback in code organisation and conventions, as well as in optimal uses for subroutines, since I had a hard time trying to reuse some of them and avoid copying pieces of code several times. Thus any professional advice or insight into what's wrong with this is welcome (I sincerely appreciate critiques!).

This is basically a database where a user can store up to 100 subjects of 5 exams each. The program calculates the average of each subject, as well as a general average of all subjects entered. It assigns an id to each subject by increasing a counter, which never resets.

The program is also capable of retiring subjects from the table by zeroing their camps. When adding another subject, it will search for zeroed ids and store the new subject in their camps.

I must admit it is a pretty primitive program, but I made it for learning purposes only.

   IDENTIFICATION DIVISION.
   PROGRAM-ID. SUBJECTS-DATA-BASE.
   DATA DIVISION.
   WORKING-STORAGE SECTION.
   77  WK-MAX-SUBJECTS                 PIC 9(03)           VALUE 0.
   77  WK-LAST-SUBJECT-ADDED           PIC 9(03)           VALUE 0.
   77  WK-ID-COUNTER                   PIC 9(03)           VALUE 0.
   77  WK-SEARCH-ID                    PIC 9(03)           VALUE 0.
   77  WK-END-PROGRAM                  PIC 9(01)           VALUE 0.
   77  WK-AVERAGE-GRADE                PIC 9(03)V99        VALUE 0.
   77  WK-NUMBER-OF-SUBJECTS           PIC 9(09)           VALUE 0.
   77  WK-FORMAT-INDEX                 PIC ZZZZ9.
   77  WK-FORMAT-GRADE                 PIC ZZ9.99.

   01  WK-IF-FOUND                     PIC 9(01)           VALUE 0.
       88 WK-FOUND                                         VALUE 1.
       88 WK-NOT-FOUND                                     VALUE 0.

   01  WK-YES-OR-NO                    PIC X(01)           VALUE' '.
       88 WK-YES                                           VALUE'Y'.
       88 WK-NO                                            VALUE'N'.

   01  WK-MAIN-MENU-OPTIONS            PIC X(01)           VALUE' '.
       88  WK-NEW-SUBJECT                                  VALUE'N'.
       88  WK-ALL-SUBJECTS                                 VALUE'A'.
       88  WK-SEARCH-SUBJECT                               VALUE'S'.
       88  WK-RETIRE-SUBJECT                               VALUE'R'.
       88  WK-QUIT                                         VALUE'Q'.

   01  WK-SUBJECTS                     OCCURS 1 TO 100 TIMES DEPENDI
  -    NG ON WK-MAX-SUBJECTS INDEXED BY WK-SUBJECT-INDEX.
       02  WK-SUBJECT-NAME             PIC X(30).
       02  WK-SUBJECT-ID               PIC 9(03).
       02  WK-SUBJECT-GRADE            PIC 9(03)V9(02)     VALUE 0.
       02  WK-NUMBER-OF-EXAMS          PIC 9(01)           VALUE 0.
       02  WK-EXAMS                    OCCURS 5 TIMES INDEXED BY WK-
  -    EXAM-INDEX.
           03  WK-EXAM-NAME            PIC X(30).
           03  WK-EXAM-GRADE           PIC 9(03)V9(02)     VALUE 0.


   PROCEDURE DIVISION.
   MAIN-PROCEDURES SECTION.

   0001-SYSTEM-ENTRY-POINT.
       DISPLAY "SUBJECTS DATA BASE".
       PERFORM 0002-MENU UNTIL WK-END-PROGRAM > ZERO.
       DISPLAY "GOODBYE!".
       STOP RUN.

   0002-MENU.
       MOVE WK-AVERAGE-GRADE TO WK-FORMAT-GRADE.
       DISPLAY "OPTIONS: (N)EW SUBJECT, SEE (A)LL SUBJECTS"
       " OR (S)EARCH SUBJECT, (R)ETIRE SUBJECT, (Q)UIT",
       DISPLAY "AVERAGE GRADE = " WK-FORMAT-GRADE.
       ACCEPT WK-MAIN-MENU-OPTIONS.
       IF WK-NEW-SUBJECT

           ADD 1 TO WK-LAST-SUBJECT-ADDED

           PERFORM 0001-ENTER-SUBJECT UNTIL WK-MAX-SUBJECTS
           >= WK-LAST-SUBJECT-ADDED

           PERFORM 0005-GENERAL-AVERAGE

       ELSE IF WK-ALL-SUBJECTS
           PERFORM 0002-SHOW-SUBJECT VARYING WK-SUBJECT-INDEX FROM 1
           BY 1 UNTIL WK-SUBJECT-INDEX > WK-MAX-SUBJECTS

       ELSE IF WK-SEARCH-SUBJECT
           DISPLAY "INTRODUCE THE EXAM'S ID:"
           ACCEPT WK-SEARCH-ID
           PERFORM 0003-SUBJECT-SEARCH

       ELSE IF WK-RETIRE-SUBJECT
           PERFORM 0004-RETIRE-SUBJECT
           PERFORM 0005-GENERAL-AVERAGE

       ELSE IF WK-QUIT
           MOVE 1 TO WK-END-PROGRAM

       ELSE
           DISPLAY "INVALID SELECTION"
           PERFORM 0002-MENU.



   SUBJECT-PROCEDURES SECTION.

   0001-ENTER-SUBJECT.
       MOVE 0 TO WK-SEARCH-ID.
       PERFORM 0003-SUBJECT-SEARCH.

       IF WK-NOT-FOUND AND WK-MAX-SUBJECTS >= 100
           DISPLAY "LIMIT OF 100 SUBJECTS REACHED!!"
           SUBTRACT 1 FROM WK-LAST-SUBJECT-ADDED
           PERFORM 0001-SYSTEM-ENTRY-POINT.

       IF WK-FOUND AND WK-SUBJECT-INDEX > WK-MAX-SUBJECTS
           ADD 1 TO WK-MAX-SUBJECTS
       ELSE IF WK-FOUND
           SUBTRACT 1 FROM WK-LAST-SUBJECT-ADDED
       ELSE IF WK-NOT-FOUND
           ADD 1 TO WK-MAX-SUBJECTS
           SET WK-SUBJECT-INDEX TO WK-LAST-SUBJECT-ADDED.

       DISPLAY "SUBJECT NAME: "
       ACCEPT WK-SUBJECT-NAME(WK-SUBJECT-INDEX).

       DISPLAY "NUMBER OF EXAMS: "
       ACCEPT WK-NUMBER-OF-EXAMS(WK-SUBJECT-INDEX).

       IF WK-NUMBER-OF-EXAMS(WK-SUBJECT-INDEX) <= 5 AND > 0
           PERFORM 0001-ENTER-EXAM VARYING WK-EXAM-INDEX FROM 1 BY 1 
           UNTIL WK-EXAM-INDEX > WK-NUMBER-OF-EXAMS(WK-SUBJECT-INDEX
           )

           PERFORM 0003-EXAM-AVERAGE

           ADD 1 TO WK-ID-COUNTER
           MOVE WK-ID-COUNTER TO WK-SUBJECT-ID(WK-SUBJECT-INDEX)
           ADD 1 TO WK-NUMBER-OF-SUBJECTS
       ELSE
           DISPLAY "NUMBER OF EXAMS CAN'T EXCEED 5!!"
           IF WK-SUBJECT-INDEX = WK-MAX-SUBJECTS
               SUBTRACT 1 FROM WK-MAX-SUBJECTS
           END-IF
           PERFORM 0001-ENTER-SUBJECT.


   0002-SHOW-SUBJECT.
       IF WK-SUBJECT-ID(WK-SUBJECT-INDEX) NOT = 0
           DISPLAY "SUBJECT NAME:", WK-SUBJECT-NAME(WK-SUBJECT-INDEX
           )
           MOVE WK-SUBJECT-GRADE(WK-SUBJECT-INDEX)TO WK-FORMAT-GRADE
           DISPLAY "SUBJECT GRADE:", WK-FORMAT-GRADE
           DISPLAY "ID:", WK-SUBJECT-ID(WK-SUBJECT-INDEX)

           DISPLAY "EXAMS:"
           PERFORM 0002-SHOW-EXAM VARYING WK-EXAM-INDEX FROM 1 BY 1
           UNTIL WK-EXAM-INDEX > WK-NUMBER-OF-EXAMS
  -        (WK-SUBJECT-INDEX).

   0003-SUBJECT-SEARCH.
       SET WK-SUBJECT-INDEX TO 1.
       SEARCH WK-SUBJECTS
           AT END
               IF WK-SEARCH-ID NOT = 0
                   DISPLAY "SUBJECT " WK-SEARCH-ID " NOT FOUND"
               END-IF
               MOVE 0 TO WK-IF-FOUND
           WHEN WK-SUBJECT-ID(WK-SUBJECT-INDEX) = WK-SEARCH-ID
               MOVE 1 TO WK-IF-FOUND
               PERFORM 0002-SHOW-SUBJECT.

   0004-RETIRE-SUBJECT.
       DISPLAY "INTRODUCE THE SUBJECT'S ID:".
       ACCEPT WK-SEARCH-ID.
       PERFORM 0003-SUBJECT-SEARCH.
       IF WK-FOUND
           DISPLAY "ARE YOU SURE YOU WANT TO RETIRE THIS SUBJECT?", 
           " (Y)ES, (N)O"
           ACCEPT WK-YES-OR-NO
           IF WK-YES
               IF WK-MAX-SUBJECTS > 0
                   MOVE LOW-VALUES TO WK-SUBJECTS(WK-SUBJECT-INDEX)
                   MOVE 0 TO WK-SUBJECT-GRADE(WK-SUBJECT-INDEX)
                   MOVE 0 TO WK-SUBJECT-ID(WK-SUBJECT-INDEX)

                   IF WK-LAST-SUBJECT-ADDED = WK-SUBJECT-INDEX
                       SUBTRACT 1 FROM WK-LAST-SUBJECT-ADDED, WK-MAX
  -                    -SUBJECTS
                   END-IF

                   SUBTRACT 1 FROM WK-NUMBER-OF-SUBJECTS
               END-IF
           ELSE IF WK-NO
               NEXT SENTENCE
           ELSE
               DISPLAY "INVALID SELECTION"
           END-IF
       ELSE IF WK-NOT-FOUND
           DISPLAY "RETURNING TO MAIN MENU".

   0005-GENERAL-AVERAGE.
       MOVE 0 TO WK-AVERAGE-GRADE

       IF WK-NUMBER-OF-SUBJECTS > 0

           PERFORM VARYING WK-SUBJECT-INDEX FROM 1 BY 1 UNTIL WK-SUB
  -        JECT-INDEX > WK-MAX-SUBJECTS

           IF WK-SUBJECT-ID(WK-SUBJECT-INDEX) NOT = 0
               ADD WK-SUBJECT-GRADE(WK-SUBJECT-INDEX) TO WK-AVERA
  -            GE-GRADE

           END-IF

           END-PERFORM

           DIVIDE WK-NUMBER-OF-SUBJECTS INTO WK-AVERAGE-GRADE.



   EVALUACIONES-PROCEDURE SECTION.

   0001-ENTER-EXAM.
       MOVE WK-EXAM-INDEX TO WK-FORMAT-INDEX.
       DISPLAY "NAME OF EXAM #", WK-FORMAT-INDEX,":".
       ACCEPT WK-EXAM-NAME(WK-SUBJECT-INDEX, WK-EXAM-INDEX).

       DISPLAY "EXAM GRADE:".
       ACCEPT WK-EXAM-GRADE(WK-SUBJECT-INDEX, WK-EXAM-INDEX).

   0002-SHOW-EXAM.
       MOVE WK-EXAM-GRADE(WK-SUBJECT-INDEX, WK-EXAM-INDEX) TO WK-FOR
  -    MAT-GRADE.
       DISPLAY "   ", WK-EXAM-NAME(WK-SUBJECT-INDEX, WK-EXAM-INDEX),
       " = ", WK-FORMAT-GRADE.

   0003-EXAM-AVERAGE.
       IF WK-NUMBER-OF-EXAMS(WK-SUBJECT-INDEX) > 0
           PERFORM VARYING WK-EXAM-INDEX FROM 1 BY 1 UNTIL 
           WK-EXAM-INDEX > WK-NUMBER-OF-EXAMS(WK-SUBJECT-INDEX)

               ADD WK-EXAM-GRADE(WK-SUBJECT-INDEX, WK-EXAM-INDEX)
               TO WK-SUBJECT-GRADE(WK-SUBJECT-INDEX)

           END-PERFORM

           DIVIDE WK-NUMBER-OF-EXAMS(WK-SUBJECT-INDEX) INTO WK-SUBJE
  -        CT-GRADE(WK-SUBJECT-INDEX).


   END PROGRAM SUBJECTS-DATA-BASE.
\$\endgroup\$
1
  • \$\begingroup\$ Good point! For the record, the current title is itself an edit to the original, which was less descriptive. I'll edit it inmediately. \$\endgroup\$ Commented May 9, 2018 at 16:30

1 Answer 1

2
\$\begingroup\$

The general algorithm and the use of procedures looks fine to me. Perhaps consider adding a subject-assigned flag to check whether an entry of wk-subjects can be overwritten, instead of overloading the purpose of wk-subject-id.

Most of my remaining suggestions relate to style:

  • WS- is more common prefix than WK-
  • Always put a space after VALUE.
  • Don't use line continuation - it's an archaic feature and rarely used. Just put things on a new line with an indent instead.
  • wk-subjects should be an 02-level or higher (having OCCURS items at level 01 is non-standard extension.)
  • Be consistent use ZERO or 0
  • Always use scope terminators (END-IF, END-SEARCH, etc.). It's very easy to put a period in the wrong place and cause a perplexing bug; scope terminators have been standard for 30 years and there's no excuse to not use them. On a related note, don't use NEXT SENTENCE, use CONTINUE instead.
  • Use EVALUATE TRUE over ELSE IF. You may have noticed that using ELSE IF with scope terminators requires lots of END-IF's. That's because ELSE IF is not a special part of the IF statement syntax; it's just another IF statement nested in the ELSE clause. EVALUATE TRUE has the same effect as an IF ... ELSE IF ... chain, but with more thoughtfully designed syntax.
  • Be consistent with blank lines before/after IF/ELSE/AT END/etc.
  • There are lots of redundant IF/ELSE IF checks (e.g. IF work-found ... ELSE IF work-not-found ...). If a variable only ever takes two values, just use IF ... ELSE ....
  • If a statement is spread over multiple lines, the second, third, fourth, etc. lines of it should be indented.
  • Consider replacing the conditions wk-end-program > 0 and wk-number-of-exams(wk-subject-index) <= 5 AND > 0 with 88-levels (e.g. wk-end-program VALUE 1 and wk-valid-number-exams VALUE 1 THRU 5).
  • Consider replacing some magic numbers with named constants (use the syntax 01 max-num-exams CONSTANT 5. or 78 max-num-exams VALUE 5.).
  • [Since this is a primitive program, feel free to ignore this point:] Validate input! It was quite happy to have exam grades like -1 and A*, which don't make sense here. Use FUNCTION TEST-NUMVAL to check whether a string is numeric.

Here are some more suggestions, but these are my more personal/contentious opinions:

  • COBOL supports lower-case letters and lower-case words are easier to read and distinguish than upper-case words.
  • Don't bother with periods after every statement, just have one at the end of paragraph/section. You can't consistently add a period to statements and their only use is as an alternative to scope terminators, and, as I argued above, they are a bad alternative.
  • Don't use WK- prefix. What does it add? I can't see any good argument in favour of them.
    • Maybe you have multiple sections in the data division and then it makes the definition easier to find. But you could just your text editor's/IDE's search feature to find it for you.
    • Maybe to indicate the variable's lifetime, e.g. that a WK- is static and retains its value between calls to a program. I assert that it should be possible to tell that from the name of the variable, without the WK-.
  • Likewise, 000x- etc. prefixes aren't useful. You don't need them in any other language, so why in COBOL? They're a holdover from 1970's software engineering techniques.
  • 77-levels don't have any special use over 01-levels. It's more consistent/prettier to use 01-levels everywhere.
  • Consider using free format. This is less portable (despite being in the language standard) but allows you to use the first seven characters every line and have lines longer than 72 characters.

I hope you enjoy learning COBOL! If you want to extend your program, look at learning about INDEXED files, which is a 1960 take on a key–value database.

Code with most of my suggestions applied:

       IDENTIFICATION DIVISION.
       PROGRAM-ID. subjects-data-base.

       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  max-subjects                 PIC 9(03)       VALUE 0.
       01  last-subject-added           PIC 9(03)       VALUE 0.
       01  id-counter                   PIC 9(03)       VALUE 0.
       01  search-id                    PIC 9(03)       VALUE 0.
       01  end-program                  PIC 9(01)       VALUE 0.
       01  average-grade                PIC 9(03)V99    VALUE 0.
       01  number-of-subjects           PIC 9(09)       VALUE 0.
       01  format-index                 PIC ZZZZ9.
       01  format-grade                 PIC ZZ9.99.

       01  if-found                     PIC 9(01)       VALUE 0.
           88 found                                     VALUE 1.
           88 not-found                                 VALUE 0.

       01  yes-or-no                    PIC X(01)       VALUE ' '.
           88 yes                                       VALUE 'y'.
           88 nno *> [sic] NO is a reserved word
                                                        VALUE 'n'.

       01  main-menu-options            PIC X(01)       VALUE ' '.
           88  new-subject                              VALUE 'n'.
           88  all-subjects                             VALUE 'a'.
           88  search-subject                           VALUE 's'.
           88  retire-subject                           VALUE 'r'.
           88  quit                                     VALUE 'q'.

       01  subjects                     OCCURS 1 TO 100 TIMES
                                           DEPENDING ON max-subjects
                                           INDEXED BY subject-index.
           02  subject-name             PIC X(30).
           02  subject-id               PIC 9(03).
           02  subject-grade            PIC 9(03)V9(02) VALUE 0.
           02  number-of-exams          PIC 9(01)       VALUE 0.
           02  exams                    OCCURS 5 TIMES
                                           INDEXED BY exam-index.
               03  exam-name            PIC X(30).
               03  exam-grade           PIC 9(03)V9(02) VALUE 0.


       PROCEDURE DIVISION.
       main-procedures SECTION.
       0001-system-entry-point.
           DISPLAY "subjects data base"
           PERFORM 0002-menu UNTIL end-program > ZERO
           DISPLAY "goodbye!"
           STOP RUN
           .
       0002-menu.
           MOVE average-grade TO format-grade
           DISPLAY "options: (n)ew subject, see (a)ll subjects"
               " or (s)earch subject, (r)etire subject, (q)uit",
           DISPLAY "average grade = " format-grade
           ACCEPT main-menu-options
           EVALUATE TRUE
               WHEN new-subject
                   ADD 1 TO last-subject-added

                   PERFORM 0001-enter-subject
                       UNTIL max-subjects >= last-subject-added

                   PERFORM 0005-general-average

               WHEN all-subjects
                   PERFORM 0002-show-subject
                       VARYING subject-index FROM 1 BY 1
                       UNTIL subject-index > max-subjects

               WHEN search-subject
                   DISPLAY "introduce the exam's id:"
                   ACCEPT search-id
                   PERFORM 0003-subject-search

               WHEN retire-subject
                   PERFORM 0004-retire-subject
                   PERFORM 0005-general-average

               WHEN quit
                   MOVE 1 TO end-program

               WHEN OTHER
                   DISPLAY "invalid selection"
                   PERFORM 0002-menu
           END-EVALUATE
           .
       subject-procedures SECTION.
       0001-enter-subject.
           MOVE 0 TO search-id
           PERFORM 0003-subject-search

           IF not-found AND max-subjects >= 100
               DISPLAY "limit of 100 subjects reached!!"
               SUBTRACT 1 FROM last-subject-added
               PERFORM 0001-system-entry-point
           END-IF

           EVALUATE TRUE
               WHEN found AND subject-index > max-subjects
                   ADD 1 TO max-subjects
               WHEN found
                   SUBTRACT 1 FROM last-subject-added
               WHEN OTHER *> Work not found
                   ADD 1 TO max-subjects
                   SET subject-index TO last-subject-added
           END-EVALUATE

           DISPLAY "subject name: "
           ACCEPT subject-name(subject-index)

           DISPLAY "number of exams: "
           ACCEPT number-of-exams(subject-index)

           IF number-of-exams(subject-index) <= 5 AND > 0
               PERFORM 0001-enter-exam VARYING exam-index FROM 1 BY 1
                   UNTIL exam-index
                         > number-of-exams(subject-index)

               PERFORM 0003-exam-average

               ADD 1 TO id-counter
               MOVE id-counter TO subject-id(subject-index)
               ADD 1 TO number-of-subjects
           ELSE
               DISPLAY "number of exams can't exceed 5!!"
               IF subject-index = max-subjects
                   SUBTRACT 1 FROM max-subjects
               END-IF
               PERFORM 0001-enter-subject
           END-IF
           .
       0002-show-subject.
           IF subject-id(subject-index) NOT = 0
               DISPLAY "subject name:",
                   subject-name(subject-index)
               MOVE subject-grade(subject-index)TO format-grade
               DISPLAY "subject grade:", format-grade
               DISPLAY "id:", subject-id(subject-index)

               DISPLAY "exams:"
               PERFORM 0002-show-exam VARYING exam-index FROM 1 BY 1
                   UNTIL exam-index
                         > number-of-exams (subject-index)
           END-IF
           .
       0003-subject-search.
           SET subject-index TO 1
           SEARCH subjects
               AT END
                   IF search-id NOT = 0
                       DISPLAY "subject " search-id " not found"
                   END-IF
                   MOVE 0 TO if-found
               WHEN subject-id(subject-index) = search-id
                   MOVE 1 TO if-found
                   PERFORM 0002-show-subject
           END-SEARCH
           .
       0004-retire-subject.
           DISPLAY "introduce the subject's id:"
           ACCEPT search-id
           PERFORM 0003-subject-search
           IF found
               DISPLAY "are you sure you want to retire this subject?",
               " (y)es, (n)o"
               ACCEPT yes-or-no
               IF yes
                   IF max-subjects > 0
                       MOVE LOW-VALUES TO subjects(subject-index)
                       MOVE 0 TO subject-grade(subject-index)
                       MOVE 0 TO subject-id(subject-index)

                       IF last-subject-added = subject-index
                           SUBTRACT 1 FROM last-subject-added,
                               max-subjects
                       END-IF

                       SUBTRACT 1 FROM number-of-subjects
                   END-IF
               ELSE
                   DISPLAY "invalid selection"
               END-IF
           ELSE
               DISPLAY "returning to main menu"
           END-IF
           .
       0005-general-average.
           MOVE 0 TO average-grade

           IF number-of-subjects > 0
               PERFORM VARYING subject-index FROM 1 BY 1
                       UNTIL subject-index > max-subjects
                   IF subject-id(subject-index) NOT = 0
                       ADD subject-grade(subject-index)
                           TO average-grade
                   END-IF
               END-PERFORM

               DIVIDE number-of-subjects INTO average-grade
           END-IF
           .
       evaluations-procedure SECTION.
       0001-enter-exam.
           MOVE exam-index TO format-index
           DISPLAY "name of exam #", format-index, ":"
           ACCEPT exam-name(subject-index, exam-index)

           DISPLAY "exam grade:"
           ACCEPT exam-grade(subject-index, exam-index)
           .
       0002-show-exam.
           MOVE exam-grade(subject-index, exam-index)
               TO format-grade
           DISPLAY "   ", exam-name(subject-index, exam-index),
               " = ", format-grade
           .
       0003-exam-average.
           IF number-of-exams(subject-index) > 0
               PERFORM VARYING exam-index FROM 1 BY 1 UNTIL
                       exam-index
                       > number-of-exams(subject-index)
                   ADD exam-grade(subject-index, exam-index)
                       TO subject-grade(subject-index)
               END-PERFORM

               DIVIDE number-of-exams(subject-index)
                   INTO subject-grade(subject-index)
           END-IF
           .
       END PROGRAM subjects-data-base.
\$\endgroup\$
1
  • \$\begingroup\$ caps are mandatory on some sites(I've even seen compilers set up to accept only caps), so it's really shop-dependant. For the rest, +1. You even mentioned my favorite, the EVALUATE TRUE, in an especially strikingly useful setup. Thanks 1000 times! \$\endgroup\$
    – gazzz0x2z
    Commented May 21, 2018 at 13:11

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.