Voting
Category
real language
Bookmarking
Language Cobol
| Date: | 04/20/05 |
| Author: | Donald Fraser |
| URL: | n/a |
| Comments: | 6 |
| Info: | n/a |
| Score: |  (2.97 in 34 votes) |
IDENTIFICATION DIVISION.
PROGRAM-ID.BOTTLES_OF_BEER.
AUTHOR.DONALD FRASER.
*
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. VAX.
OBJECT-COMPUTER. VAX.
*
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT OUTPUT-FILE
ASSIGN TO BEERS_ON_THE_WALL.
*
DATA DIVISION.
FILE SECTION.
FD OUTPUT-FILE
LABEL RECORDS ARE OMITTED.
01 BEERS-OUT PIC X(133).
*
WORKING-STORAGE SECTION.
01 FLAGS-COUNTERS-ACCUMULATORS.
05 FLAGS.
10 E-O-F PIC 9.
88 END-OF-FILE VALUE 1.
05 COUNTERS.
10 BOTTLES PIC 999
VALUE 0.
01 RECORD-OUT.
05 LINE1.
10 NUMBER-OF-BEERS-1 PIC ZZ9.
10 PIC X(28)
VALUE "BOTTLES OF BEER IN THE WALL ".
10 PIC
X
VALUE ",".
10 NUMBER-OF-BEERS-2 PIC ZZ9.
10 PIC
X.
10 PIC X(17)
VALUE "BOTTLES OF BEER.".
05 LINE2.
10 PIC X(34)
VALUE "TAKE ONE DOWN AND PASS IT ARROUND ".
10 NUMBER-OF-BEERS-3 PIC ZZ9.
10 PIC X.
10 PIC X(28)
VALUE "BOTTLES OF BEER IN THE WALL".
*
PROCEDURE DIVISION.
DRIVER-MODULE.
PERFORM INITIALIZATION.
PERFORM PROCESS UNTIL END-OF-FILE.
PERFORM TERMINATION.
STOP RUN.
*
INITIALIZATION.
OPEN OUTPUT OUTPUT-FILE.
ADD 100 TO BOTTLES.
*
PROCESS.
IF BOTTLES = 0 THEN
COMPUTE E-O-F = 1
ELSE PERFORM WRITE-ROUTINE
END-IF.
*
TERMINATION.
CLOSE OUTPUT-FILE.
*
WRITE-ROUTINE.
MOVE BOTTLES TO NUMBER-OF-BEERS-1, NUMBER-OF-BEERS-2.
COMPUTE BOTTLES = BOTTLES - 1.
WRITE BEERS-OUT FROM LINE1.
MOVE BOTTLES TO NUMBER-OF-BEERS-3.
WRITE BEERS-OUT FROM LINE2.
Download Source | Write Comment
Alternative Versions
| Version | Author | Date | Comments | Rate |
|---|---|---|---|---|
| Short Version with Descriptive Varnames. | Joseph James Frantz | 07/14/08 | 17 | |
| Typical of mainframe COBOL programs | Bill Bass | 04/24/08 | 8 | |
| "Pretty" version | Sumanta Mukhopadhyay | 10/06/05 | 1 | |
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
And now all you people know why, in my waking hours, in my sleep, in my dreams, I curse COBOL and everything it stands for.
I hate COBOL. This language sucks. It can die a terrible, terrible death.
I don't have to work in COBOL anymore ....
PROGRAM-ID. 99-Bottles-of-Beer-On-The-Wall.
AUTHOR. KONENAS.
************************************************************************
******* PURPOSE:
******* This is a sample COBOL program to display the lyrics of the
******* song "99 Bottles of Beer on the Wall."
******* COMPILATION:
******* cobc -x -free 99.cbl
******* COMMENTS:
******* It runs on every 85 COBOL compiler only check formatting
************************************************************************
DATA DIVISION.
WORKING-STORAGE SECTION.
01 Working-Variables.
05 Bottles pic S99 value 0.
05 Bottles-1 pic S99 value 0.
05 W-Bottles1 pic 9 value zeros.
05 W-Bottles2 pic 99 value zeros.
01 Lyric-Variables.
05 L-No-Bottles pic x(15) value spaces.
05 L-Bottles pic x(15) value spaces.
05 L-Line pic x(70) value spaces.
01 Lyric-Static.
05 Title pic x(37) value
"Lyrics of the song 99 Bottles of Beer".
05 ofbeeron pic x(20) value " of beer on the wall".
05 ofbeer pic x(09) value " of beer.".
05 takeone pic x(34) value
"Take one down and pass it around, ".
05 nomore pic x(8) value "No more ".
05 buysome pic x(35) value
"Go to the store and buy some more, ".
05 bottle-s pic x(7) value " bottle".
05 bottle-p pic x(8) value " bottles".
PROCEDURE DIVISION.
Write-Lyrics.
move Title to L-Line
display L-Line.
perform varying Bottles from 99 by -1
until Bottles = 0
move Bottles to Bottles-1
perform Write-line1
subtract 1 from Bottles Giving Bottles-1
perform Write-line2
end-perform
perform Write-line1
move spaces to L-Line
move 99 to Bottles-1
perform Write-line2
stop run.
******* Here we check how many bottles of beer lyrics
*******
Write-line1.
move spaces to L-Line
display L-Line
perform Fix-Bottles
string L-No-Bottles L-Bottles ofbeeron ", "
L-No-Bottles L-Bottles ofbeer
delimited by " " into L-Line
display L-Line.
Write-line2.
perform Fix-Bottles
string takeone L-No-Bottles
L-Bottles ofbeeron "."
delimited by " " into L-Line
display L-Line.
Fix-Bottles.
evaluate Bottles-1
when 0
move nomore to L-No-Bottles
when 1 thru 9
move Bottles-1 to W-Bottles1
move W-Bottles1 to L-No-Bottles
when other
move Bottles-1 to W-Bottles2
move W-Bottles2 to L-No-Bottles
end-evaluate
evaluate Bottles-1
when 1
move bottle-s to L-Bottles
when other
move bottle-p to L-Bottles
end-evaluate.