Voting
Category
real language
Bookmarking
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 28 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
| Version | Author | Date | Comments | Rate |
|---|---|---|---|---|
| Short Version with Descriptive Varnames. | Joseph James Frantz | 07/14/08 | 17 | |
| "Pretty" version | Sumanta Mukhopadhyay | 10/06/05 | 1 | |
| 3 | Donald Fraser | 04/20/05 | 6 | |
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!
Comments
It could be made prettier too, but as the writer mentions that wasn't the point he was making.
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.
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
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.