API tools faq
paste
Advertisement
Guest User

99 bottles of beer

a guest
Nov 14th, 2017
262
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
COBOL 9.25 KB | None | 0 0
raw download clone embed print report
  1.        IDENTIFICATION DIVISION.
  2.        PROGRAM-ID.    BOTTLE99.
  3.        AUTHOR.        BILL BASS.
  4.        DATE-WRITTEN.  APR 2008.
  5.        DATE-COMPILED.
  6.  
  7.       ******************************************************************
  8.        ENVIRONMENT DIVISION.
  9.       ******************************************************************
  10.        INPUT-OUTPUT SECTION.
  11.        FILE-CONTROL.
  12.            SELECT LYRICS-FILE              ASSIGN TO LYRICS.
  13.       ******************************************************************
  14.        DATA DIVISION.
  15.       ******************************************************************
  16.        FILE SECTION.
  17.        FD  LYRICS-FILE
  18.            LABEL RECORDS ARE STANDARD
  19.            RECORDING MODE IS F
  20.            BLOCK CONTAINS    0 RECORDS
  21.            DATA RECORD IS LYRICS-REC.
  22.  
  23.        01  LYRICS-REC                      PIC X(80).
  24.       *
  25.        WORKING-STORAGE SECTION.
  26.        01  WORK-AREAS.
  27.            05 WS-LYRICS-WRITTEN            PIC S9(8) COMP VALUE ZERO.
  28.            05 WS-BOTTLE-NUM                PIC S9(4) COMP VALUE ZERO.
  29.            05 WS-WHEN-COMPILED.
  30.               10 WS-COMP-DATE.
  31.                  15 WS-COMP-YEAR           PIC 9(4) VALUE ZERO.
  32.                  15 WS-COMP-MON            PIC 9(2) VALUE ZERO.
  33.                  15 WS-COMP-DAY            PIC 9(2) VALUE ZERO.
  34.               10 WS-COMP-TIME.
  35.                  15 WS-COMP-HOUR           PIC 9(2) VALUE ZERO.
  36.                  15 WS-COMP-MIN            PIC 9(2) VALUE ZERO.
  37.                  15 WS-COMP-SEC            PIC 9(2) VALUE ZERO.
  38.                  15 WS-COMP-HSEC           PIC 9(2) VALUE ZERO.
  39.                  15 WS-COMP-TZ-DIR         PIC X(1) VALUE SPACES.
  40.                  15 WS-COMP-TZ-HOUR        PIC 9(2) VALUE ZERO.
  41.                  15 WS-COMP-TZ-MIN         PIC 9(2) VALUE ZERO.
  42.            05 WS-CURR-DATE                 PIC 9(8) VALUE ZERO.
  43.            05 FILLER                       REDEFINES WS-CURR-DATE.
  44.               10 WS-CURR-YEAR              PIC 9(4).
  45.               10 WS-CURR-MON               PIC 9(2).
  46.               10 WS-CURR-DAY               PIC 9(2).
  47.            05 WS-CURR-TIME                 PIC 9(8) VALUE ZERO.
  48.            05 FILLER                       REDEFINES WS-CURR-TIME.
  49.               10 WS-CURR-HOUR              PIC 9(2).
  50.               10 WS-CURR-MIN               PIC 9(2).
  51.               10 WS-CURR-SEC               PIC 9(2).
  52.               10 WS-CURR-HSEC              PIC 9(2).
  53.            05 WS-DISPLAY-NUM               PIC --,---,--9 VALUE ZERO.
  54.       *
  55.        01  BEER-2-DIGIT.
  56.            05 B2D-BOTTLES-1                PIC 99         VALUE ZERO.
  57.            05 FILLER                       PIC X(30)      VALUE
  58.               ' bottles of beer on the wall, '.
  59.            05 B2D-BOTTLES-2                PIC 99         VALUE ZERO.
  60.            05 FILLER                       PIC X(46)      VALUE
  61.               ' bottles of beer.'.
  62.       *
  63.        01  BEER-1-DIGIT.
  64.            05 B1D-BOTTLES-1                PIC 9          VALUE ZERO.
  65.            05 FILLER                       PIC X(30)      VALUE
  66.               ' bottles of beer on the wall, '.
  67.            05 B1D-BOTTLES-2                PIC 9          VALUE ZERO.
  68.            05 FILLER                       PIC X(48)      VALUE
  69.               ' bottles of beer.'.
  70.       *
  71.        01  BEER-1-MORE.
  72.            05 FILLER                       PIC X(30)      VALUE
  73.               '1 bottle of beer on the wall, '.
  74.            05 FILLER                       PIC X(50)      VALUE
  75.               '1 bottle of beer.'.
  76.       *
  77.        01  BEER-NO-MORE.
  78.            05 FILLER                       PIC X(37)      VALUE
  79.               'No more bottles of beer on the wall, '.
  80.            05 FILLER                       PIC X(43)      VALUE
  81.               'no more bottles of beer.'.
  82.       *
  83.        01  TAKE-2-DIGIT.
  84.            05 FILLER                       PIC X(34)      VALUE
  85.               'Take one down and pass it around, '.
  86.            05 T2D-BOTTLES-1                PIC 99         VALUE ZERO.
  87.            05 FILLER                       PIC X(44)      VALUE
  88.               ' bottles of beer on the wall.'.
  89.       *
  90.        01  TAKE-1-DIGIT.
  91.            05 FILLER                       PIC X(34)      VALUE
  92.               'Take one down and pass it around, '.
  93.            05 T1D-BOTTLES-1                PIC 9          VALUE ZERO.
  94.            05 FILLER                       PIC X(45)      VALUE
  95.               ' bottles of beer on the wall.'.
  96.       *
  97.        01  TAKE-1-MORE.
  98.            05 FILLER                       PIC X(34)      VALUE
  99.               'Take one down and pass it around, '.
  100.            05 FILLER                       PIC X(46)      VALUE
  101.               '1 bottle of beer on the wall.'.
  102.       *
  103.        01  TAKE-NO-MORE.
  104.            05 FILLER                       PIC X(34)      VALUE
  105.               'Take one down and pass it around, '.
  106.            05 FILLER                       PIC X(46)      VALUE
  107.               'no more bottles of beer on the wall.'.
  108.       *
  109.        01  BUY-SOME-MORE.
  110.            05 FILLER                       PIC X(35)      VALUE
  111.               'Go to the store and buy some more, '.
  112.            05 FILLER                       PIC X(45)      VALUE
  113.               '99 bottles of beer on the wall.'.
  114.       *
  115.        01  BLANK-LINE                      PIC X(80)      VALUE SPACES.
  116.       ******************************************************************
  117.        PROCEDURE DIVISION.
  118.       ******************************************************************
  119.            ACCEPT WS-CURR-DATE           FROM DATE YYYYMMDD
  120.            ACCEPT WS-CURR-TIME           FROM TIME
  121.            MOVE FUNCTION WHEN-COMPILED     TO WS-WHEN-COMPILED
  122.       *
  123.            DISPLAY '****************************************'
  124.                    '****************************************'
  125.            DISPLAY '**** BEGIN PROGRAM BOTTLE99'
  126.            DISPLAY '**** COMPILED: '
  127.                    WS-COMP-YEAR '/' WS-COMP-MON '/' WS-COMP-DAY ' '
  128.                    WS-COMP-HOUR ':' WS-COMP-MIN ':'
  129.                    WS-COMP-SEC  '.' WS-COMP-HSEC
  130.            DISPLAY '**** START AT: '
  131.                    WS-CURR-YEAR '/' WS-CURR-MON '/' WS-CURR-DAY ' '
  132.                    WS-CURR-HOUR ':' WS-CURR-MIN ':'
  133.                    WS-CURR-SEC  '.' WS-CURR-HSEC
  134.            DISPLAY '****************************************'
  135.                    '****************************************'
  136.            DISPLAY '*'
  137.       *
  138.            OPEN OUTPUT LYRICS-FILE
  139.       *
  140.            MOVE 99                         TO B2D-BOTTLES-1
  141.            MOVE 99                         TO B2D-BOTTLES-2
  142.            WRITE LYRICS-REC              FROM BEER-2-DIGIT
  143.            ADD +1                          TO WS-LYRICS-WRITTEN
  144.       *
  145.            PERFORM 1000-MATCHING-VERSES    THRU 1000-EXIT
  146.                VARYING WS-BOTTLE-NUM FROM 98 BY -1
  147.                UNTIL WS-BOTTLE-NUM < 2
  148.       *
  149.            WRITE LYRICS-REC              FROM TAKE-1-MORE
  150.            WRITE LYRICS-REC              FROM BLANK-LINE
  151.            ADD +2                          TO WS-LYRICS-WRITTEN
  152.       *
  153.            WRITE LYRICS-REC              FROM BEER-1-MORE
  154.            WRITE LYRICS-REC              FROM TAKE-NO-MORE
  155.            WRITE LYRICS-REC              FROM BLANK-LINE
  156.            ADD +3                          TO WS-LYRICS-WRITTEN
  157.       *
  158.            WRITE LYRICS-REC              FROM BEER-NO-MORE
  159.            WRITE LYRICS-REC              FROM BUY-SOME-MORE
  160.            ADD +2                          TO WS-LYRICS-WRITTEN
  161.       *
  162.            CLOSE LYRICS-FILE
  163.       *
  164.            DISPLAY '*'
  165.            MOVE WS-LYRICS-WRITTEN          TO WS-DISPLAY-NUM
  166.            DISPLAY '* LYRICS RECORDS WRITTEN = ' WS-DISPLAY-NUM
  167.            DISPLAY '*'
  168.       *
  169.            DISPLAY '****************************************'
  170.                    '****************************************'
  171.            DISPLAY '**** END PROGRAM BOTTLE99'
  172.            ACCEPT WS-CURR-DATE           FROM DATE YYYYMMDD
  173.            ACCEPT WS-CURR-TIME           FROM TIME
  174.            DISPLAY '**** ENDED AT: '
  175.                    WS-CURR-YEAR '/' WS-CURR-MON '/' WS-CURR-DAY ' '
  176.                    WS-CURR-HOUR ':' WS-CURR-MIN ':'
  177.                    WS-CURR-SEC  '.' WS-CURR-HSEC
  178.            DISPLAY '****************************************'
  179.                    '****************************************'
  180.       *
  181.            GOBACK.
  182.            IF WS-BOTTLE-NUM > 9
  183.                MOVE WS-BOTTLE-NUM          TO T2D-BOTTLES-1
  184.                MOVE WS-BOTTLE-NUM          TO B2D-BOTTLES-1
  185.                MOVE WS-BOTTLE-NUM          TO B2D-BOTTLES-2
  186.  
  187.                WRITE LYRICS-REC          FROM TAKE-2-DIGIT
  188.                WRITE LYRICS-REC          FROM BLANK-LINE
  189.                WRITE LYRICS-REC          FROM BEER-2-DIGIT
  190.                ADD +3                      TO WS-LYRICS-WRITTEN
  191.            ELSE
  192.                MOVE WS-BOTTLE-NUM          TO T1D-BOTTLES-1
  193.                MOVE WS-BOTTLE-NUM          TO B1D-BOTTLES-1
  194.                MOVE WS-BOTTLE-NUM          TO B1D-BOTTLES-2
  195.  
  196.                WRITE LYRICS-REC          FROM TAKE-1-DIGIT
  197.                WRITE LYRICS-REC          FROM BLANK-LINE
  198.                WRITE LYRICS-REC          FROM BEER-1-DIGIT
  199.                ADD +3                      TO WS-LYRICS-WRITTEN
  200.            END-IF
  201.            .
  202.        1000-EXIT. EXIT.T DOES NOT
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!