Voting

Category

real language

Bookmarking

Del.icio.us Digg Diigo DZone Earthlink Google Kick.ie
Windows Live LookLater Ma.gnolia Reddit Rojo StumbleUpon Technorati

Language COBOL

(Typical of mainframe COBOL programs)

Date:04/24/08
Author:Bill Bass
URL:n/a
Comments:8
Info:n/a
Score: (3.00 in 23 votes)
       IDENTIFICATION DIVISION.
       PROGRAM-ID.    BOTTLE99.
       AUTHOR.        BILL BASS.
       DATE-WRITTEN.  APR 2008.
       DATE-COMPILED.
      *REMARKS.
      ******************************************************************
      * PURPOSE:
      *   THIS IS A DEMONSTRATION SAMPLE OF A COBOL II PROGRAM.
      *   IT WRITES AN 80 COLUMN OUTPUT FILE CONTAINING THE LYRICS OF
      *   THE SONG "99 BOTTLES OF BEER ON THE WALL".  IT DOES NOT NEED
      *   TO BE AS COMPLEX AS IT IS.  THIS WAS NOT AN ATTEMPT TO WRITE
      *   A "SHORT" PROGRAM OR A "MOST EFFICIENT" PROGRAM.  IT WAS
      *   INTENDED TO SERVE AS AN EXAMPLE OF WHAT ONE MIGHT COMMONLY
      *   SEE IN A "TYPICAL" MAINFRAME COBOL PROGRAM.
      ******************************************************************
       ENVIRONMENT DIVISION.
      ******************************************************************
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT LYRICS-FILE              ASSIGN TO LYRICS.
      ******************************************************************
       DATA DIVISION.
      ******************************************************************
       FILE SECTION.
       FD  LYRICS-FILE
           LABEL RECORDS ARE STANDARD
           RECORDING MODE IS F
           BLOCK CONTAINS    0 RECORDS
           DATA RECORD IS LYRICS-REC.

       01  LYRICS-REC                      PIC X(80).
      *
       WORKING-STORAGE SECTION.
       01  WORK-AREAS.
           05 WS-LYRICS-WRITTEN            PIC S9(8) COMP VALUE ZERO.
           05 WS-BOTTLE-NUM                PIC S9(4) COMP VALUE ZERO.
           05 WS-WHEN-COMPILED.
              10 WS-COMP-DATE.
                 15 WS-COMP-YEAR           PIC 9(4) VALUE ZERO.
                 15 WS-COMP-MON            PIC 9(2) VALUE ZERO.
                 15 WS-COMP-DAY            PIC 9(2) VALUE ZERO.
              10 WS-COMP-TIME.
                 15 WS-COMP-HOUR           PIC 9(2) VALUE ZERO.
                 15 WS-COMP-MIN            PIC 9(2) VALUE ZERO.
                 15 WS-COMP-SEC            PIC 9(2) VALUE ZERO.
                 15 WS-COMP-HSEC           PIC 9(2) VALUE ZERO.
                 15 WS-COMP-TZ-DIR         PIC X(1) VALUE SPACES.
                 15 WS-COMP-TZ-HOUR        PIC 9(2) VALUE ZERO.
                 15 WS-COMP-TZ-MIN         PIC 9(2) VALUE ZERO.
           05 WS-CURR-DATE                 PIC 9(8) VALUE ZERO.
           05 FILLER                       REDEFINES WS-CURR-DATE.
              10 WS-CURR-YEAR              PIC 9(4).
              10 WS-CURR-MON               PIC 9(2).
              10 WS-CURR-DAY               PIC 9(2).
           05 WS-CURR-TIME                 PIC 9(8) VALUE ZERO.
           05 FILLER                       REDEFINES WS-CURR-TIME.
              10 WS-CURR-HOUR              PIC 9(2).
              10 WS-CURR-MIN               PIC 9(2).
              10 WS-CURR-SEC               PIC 9(2).
              10 WS-CURR-HSEC              PIC 9(2).
           05 WS-DISPLAY-NUM               PIC --,---,--9 VALUE ZERO.
      *
       01  BEER-2-DIGIT.
           05 B2D-BOTTLES-1                PIC 99         VALUE ZERO.
           05 FILLER                       PIC X(30)      VALUE
              ' bottles of beer on the wall, '.
           05 B2D-BOTTLES-2                PIC 99         VALUE ZERO.
           05 FILLER                       PIC X(46)      VALUE
              ' bottles of beer.'.
      *
       01  BEER-1-DIGIT.
           05 B1D-BOTTLES-1                PIC 9          VALUE ZERO.
           05 FILLER                       PIC X(30)      VALUE
              ' bottles of beer on the wall, '.
           05 B1D-BOTTLES-2                PIC 9          VALUE ZERO.
           05 FILLER                       PIC X(48)      VALUE
              ' bottles of beer.'.
      *
       01  BEER-1-MORE.
           05 FILLER                       PIC X(30)      VALUE
              '1 bottle of beer on the wall, '.
           05 FILLER                       PIC X(50)      VALUE
              '1 bottle of beer.'.
      *
       01  BEER-NO-MORE.
           05 FILLER                       PIC X(37)      VALUE
              'No more bottles of beer on the wall, '.
           05 FILLER                       PIC X(43)      VALUE
              'no more bottles of beer.'.
      *
       01  TAKE-2-DIGIT.
           05 FILLER                       PIC X(34)      VALUE
              'Take one down and pass it around, '.
           05 T2D-BOTTLES-1                PIC 99         VALUE ZERO.
           05 FILLER                       PIC X(44)      VALUE
              ' bottles of beer on the wall.'.
      *
       01  TAKE-1-DIGIT.
           05 FILLER                       PIC X(34)      VALUE
              'Take one down and pass it around, '.
           05 T1D-BOTTLES-1                PIC 9          VALUE ZERO.
           05 FILLER                       PIC X(45)      VALUE
              ' bottles of beer on the wall.'.
      *
       01  TAKE-1-MORE.
           05 FILLER                       PIC X(34)      VALUE
              'Take one down and pass it around, '.
           05 FILLER                       PIC X(46)      VALUE
              '1 bottle of beer on the wall.'.
      *
       01  TAKE-NO-MORE.
           05 FILLER                       PIC X(34)      VALUE
              'Take one down and pass it around, '.
           05 FILLER                       PIC X(46)      VALUE
              'no more bottles of beer on the wall.'.
      *
       01  BUY-SOME-MORE.
           05 FILLER                       PIC X(35)      VALUE
              'Go to the store and buy some more, '.
           05 FILLER                       PIC X(45)      VALUE
              '99 bottles of beer on the wall.'.
      *
       01  BLANK-LINE                      PIC X(80)      VALUE SPACES.
      ******************************************************************
       PROCEDURE DIVISION.
      ******************************************************************
           ACCEPT WS-CURR-DATE           FROM DATE YYYYMMDD
           ACCEPT WS-CURR-TIME           FROM TIME
           MOVE FUNCTION WHEN-COMPILED     TO WS-WHEN-COMPILED
      *
           DISPLAY '****************************************'
                   '****************************************'
           DISPLAY '**** BEGIN PROGRAM BOTTLE99'
           DISPLAY '**** COMPILED: '
                   WS-COMP-YEAR '/' WS-COMP-MON '/' WS-COMP-DAY ' '
                   WS-COMP-HOUR ':' WS-COMP-MIN ':'
                   WS-COMP-SEC  '.' WS-COMP-HSEC
           DISPLAY '**** START AT: '
                   WS-CURR-YEAR '/' WS-CURR-MON '/' WS-CURR-DAY ' '
                   WS-CURR-HOUR ':' WS-CURR-MIN ':'
                   WS-CURR-SEC  '.' WS-CURR-HSEC
           DISPLAY '****************************************'
                   '****************************************'
           DISPLAY '*'
      *
           OPEN OUTPUT LYRICS-FILE
      *
           MOVE 99                         TO B2D-BOTTLES-1
           MOVE 99                         TO B2D-BOTTLES-2
           WRITE LYRICS-REC              FROM BEER-2-DIGIT
           ADD +1                          TO WS-LYRICS-WRITTEN
      *
           PERFORM 1000-MATCHING-VERSES    THRU 1000-EXIT
               VARYING WS-BOTTLE-NUM FROM 98 BY -1
               UNTIL WS-BOTTLE-NUM < 2
      *
           WRITE LYRICS-REC              FROM TAKE-1-MORE
           WRITE LYRICS-REC              FROM BLANK-LINE
           ADD +2                          TO WS-LYRICS-WRITTEN
      *
           WRITE LYRICS-REC              FROM BEER-1-MORE
           WRITE LYRICS-REC              FROM TAKE-NO-MORE
           WRITE LYRICS-REC              FROM BLANK-LINE
           ADD +3                          TO WS-LYRICS-WRITTEN
      *
           WRITE LYRICS-REC              FROM BEER-NO-MORE
           WRITE LYRICS-REC              FROM BUY-SOME-MORE
           ADD +2                          TO WS-LYRICS-WRITTEN
      *
           CLOSE LYRICS-FILE
      *
           DISPLAY '****************************************'
                   '****************************************'
           DISPLAY '**** RUN STATISTICS FOR PROGRAM BOTTLE99'
           DISPLAY '****************************************'
                   '****************************************'
           DISPLAY '*'
           MOVE WS-LYRICS-WRITTEN          TO WS-DISPLAY-NUM
           DISPLAY '* LYRICS RECORDS WRITTEN = ' WS-DISPLAY-NUM
           DISPLAY '*'
      *
           DISPLAY '****************************************'
                   '****************************************'
           DISPLAY '**** END PROGRAM BOTTLE99'
           ACCEPT WS-CURR-DATE           FROM DATE YYYYMMDD
           ACCEPT WS-CURR-TIME           FROM TIME
           DISPLAY '**** ENDED AT: '
                   WS-CURR-YEAR '/' WS-CURR-MON '/' WS-CURR-DAY ' '
                   WS-CURR-HOUR ':' WS-CURR-MIN ':'
                   WS-CURR-SEC  '.' WS-CURR-HSEC
           DISPLAY '****************************************'
                   '****************************************'
      *
           GOBACK.
      *****************************************************************
      *    THIS PARAGRAPH WRITES THE FIRST 98 MATCHING VERSES
      *****************************************************************
       1000-MATCHING-VERSES.
      *****************************************************************
           IF WS-BOTTLE-NUM > 9
               MOVE WS-BOTTLE-NUM          TO T2D-BOTTLES-1
               MOVE WS-BOTTLE-NUM          TO B2D-BOTTLES-1
               MOVE WS-BOTTLE-NUM          TO B2D-BOTTLES-2

               WRITE LYRICS-REC          FROM TAKE-2-DIGIT
               WRITE LYRICS-REC          FROM BLANK-LINE
               WRITE LYRICS-REC          FROM BEER-2-DIGIT
               ADD +3                      TO WS-LYRICS-WRITTEN
           ELSE
               MOVE WS-BOTTLE-NUM          TO T1D-BOTTLES-1
               MOVE WS-BOTTLE-NUM          TO B1D-BOTTLES-1
               MOVE WS-BOTTLE-NUM          TO B1D-BOTTLES-2

               WRITE LYRICS-REC          FROM TAKE-1-DIGIT
               WRITE LYRICS-REC          FROM BLANK-LINE
               WRITE LYRICS-REC          FROM BEER-1-DIGIT
               ADD +3                      TO WS-LYRICS-WRITTEN
           END-IF
           .
       1000-EXIT. EXIT.

Download Source | Write Comment

Alternative Versions

VersionAuthorDateCommentsRate
Short Version with Descriptive Varnames.Joseph James Frantz07/14/0817
2Donald Fraser04/20/056
"Pretty" versionSumanta Mukhopadhyay10/06/051

Comments

>>  Ximinez said on 09/20/08 01:22:52

Ximinez Oh, my, god. That's just... horrible.

>>  Nikron said on 02/01/09 18:13:51

Nikron It strikes me as strange, that code in the ugliest programming languages is often written completely in upper case. It's like adding insult to injury. Anyway, it's nice to see an example of how things look in the big iron, and it makes me happy that I have the option to choose a modern language instead of this.

>>  Scotty said on 03/13/09 08:08:35

Scotty That's actually nowhere near as ugly as most of the code I see everyday.

It could be made prettier too, but as the writer mentions that wasn't the point he was making.

>>  Wayne said on 04/11/09 20:26:16

Wayne Well, yes, it's all in upper case. But keep in mind how old Cobol is: it dates back to punch cards and teletypes when all you had is upper case. I would think that the current versions support shifted case, but they probably keep it U/C just for consistency.

>>  John T. said on 04/17/09 13:13:07

John T. Yes, I have seen code like this on mainframes, but most of it, certainly the bits I've written are not quite this 'verbose'.
For those of you, such as Nikron, who have not had the luxury of programming real computers, I'd like to suggest that the Assembler (s-390) version (http://www.99-bottles-of-beer.net/language-assembler-(s-390)-47.html) is perhaps a better example of mainframe code in traditional languages.

>>  Bill Talbot said on 04/25/09 05:51:46

Bill Talbot ...Are you sh*tting me? I love the statistic DISPLAY's....classic COBOL at it's finest.

>>  Randy said on 04/28/09 17:30:06

Randy I've been writing COBOL for more than 25 years, but for some strange reason I've done virtually none of it on "Big Iron". I have worked on HP3000, DG Eclips, Wang VS and HP/UX servers. So I have to say that much of the code is what I would expect from programs that run in batch on mainframes where you need audit logs of what happened, rather than interactive code.

But the fact is that I can read this code top to bottom in about 30 seconds and understand everything it does.

On the other hand, I can look at the C code versions of this, or the JAVA versions and 300 seconds later, I'm still trying to figure out if the code can actually compile!

I think that the reason that COBOL has outlasted so many other languages is not because it would cost too much to replace, but that it is just that easy to repair! Fixing many of the newer languages is often a case of replace rather than repair. Just the analysis time in reviewing the code is often more than the time required to go fix the same COBOL program. Why?? Because programers are notorious in TWO ways:

1.) We all pride ourselves on having some unique and interesting way of coding a particular function. We all think of what we do as some kind of art form, and we all want our code to have our "touch" to it.

2.) We all seem to have the idea that if the next guy to work our code is a "real" programmer, that he will be able to look at our code and understand it without hesitation. Therefore, we just don't see the need to document our little "touches".

As a result, we all to often write purposely cryptic code and could not be bothered with taking the time to actually try to explain why we did things the way we did, and / or how things work.

But COBOL fixes that because it is basically as close to English as you can get while still being a "code".

Not to mention that it performs back end processing probably faster than anything else on large data stores, it's fairly flexible, has evolved over 50 years, but never lost the basic components that made it so robust and usefull in the first place...

In the end, the language is still around because try as folks may, there is YET to be anything for file IO and background tasks that is anywhere near as good. While it may be unusual, sometimes folks just do get it right the first time ;-)

RB

>>  shftvmi said on 08/06/10 09:32:05

shftvmi Randy,
I have a Master in Comp Sci, and know many programming languages. When I read this code, I can not figure out what it does. Seriously. It is too much text. What is the point? Where is the point? It is like some pointy haired boss talking for 2 hours and all he said can be concluded in one line. Is that verbosity good? Jesus. COBOL is horrible.

Download Source | Write Comment

Add Comment

Please provide a value for the fields Name, Comment and Security Code.
This is a gravatar-friendly website.
E-mail addresses will never be shown.
Enter your e-mail address to use your gravatar.

Please don't post large portions of code here! Use the form to submit new examples or updates instead!

Name:

eMail:

URL:

Security Code:
  
Comment: