99 Bottles of Beer

Voting

Bookmarking

Language ALGOL 60

Date:	04/20/05
Author:	Tom Herbertson
URL:	n/a
Comments:	6
Info:	n/a
Score:	(3.00 in 33 votes)

% Algol (60), Unisys MCP (descendant of Burroughs B6700) variant.
%
% January 21, 2003 by Tom Herbertson
% http://members.cox.net/herbertsont/
%
% Run with ;VALUE = <number> to specify initial quantity NEQ 99
% Run with ;SW1 for American ("happen to fall") version
% Run with ;SW2 to spell out numbers
% Send results to printer by running with ;FILE TERM(PRINTER)
% or to disk with ;FILE TERM(DISK,PROTECTION=SAVE,TITLE=<file name>)
% Enter ?HI to quit early
BEGIN
FILE TERM(KIND=REMOTE,MYUSE=OUT);
EBCDIC ARRAY OUTLINE[0:71];
TRANSLATETABLE LOWERTOUPPER
  ("abcdefghijklmnopqrstuvwxyz" TO "ABCDEFGHIJKLMNOPQRSTUVWXYZ");
EBCDIC VALUE ARRAY
   TENS
   ("           ","           ",
    "twenty     ","thirty     ","forty      ","fifty      ",
    "sixty      ","seventy    ","eighty     ","ninety     "),
   UNDER_TWENTY
   ("zero       ","one        ","two        ","three      ",
    "four       ","five       ","six        ","seven      ",
    "eight      ","nine       ","ten        ","eleven     ",
    "twelve     ","thirteen   ","fourteen   ","fifteen    ",
    "sixteen    ","seventeen  ","eighteen   ","nineteen   ");
PROCEDURE BOTTLECOUNT(I,P,SPELLING);
   VALUE I, SPELLING;
   INTEGER I; POINTER P; BOOLEAN SPELLING;
   BEGIN
   POINTER FIRST_LETTER;
   INTEGER T, U;
   IF I EQL 0 THEN
     REPLACE P:P BY "No more"
   ELSE
     BEGIN
     IF SPELLING AND I LEQ 99 THEN
       BEGIN
       T := I DIV 10;
       U := I MOD 10;
       FIRST_LETTER := P;
       IF T GEQ 2 THEN
         BEGIN
         REPLACE P:P BY TENS [T*12] UNTIL = " "; % each entry is 12 chars
         IF U NEQ 0 THEN
           REPLACE P:P BY "-";
         END
       ELSE
         IF T = 1 THEN
           U:=*+10; % bring back the teens
       IF U NEQ 0 THEN
         REPLACE P:P BY UNDER_TWENTY [U*12] UNTIL = " "; % like TENS
       REPLACE FIRST_LETTER BY FIRST_LETTER FOR 1 WITH LOWERTOUPPER;
       END TURNING NUMBER INTO WORDS
     ELSE
       REPLACE P:P BY I FOR * DIGITS
     END;
   REPLACE P:P BY " bottles" FOR 7 + REAL(I NEQ 1), " ";
   END;
DEFINE FORM = REPLACE OP:OP BY # ;
POINTER OP;
BOOLEAN REMOTE_OUTPUT, EARLYEXIT;
INTERRUPT HI;
   BEGIN
   EARLYEXIT := TRUE;
   END;
PROCEDURE SPOUT;
   BEGIN
   WRITE(TERM,72,OUTLINE);
   REPLACE (OP:=OUTLINE) BY " " FOR 72;
   END;
BOOLEAN FALL, SPELL;
REAL TV;
INTEGER BOTTLES;
DEFINE MANTISSAF = [38:39] #, % Determines max single-precision integer
        ALL1 = REAL (NOT FALSE) #,
        MAXINT = ALL1.MANTISSAF #;
REPLACE (OP:=OUTLINE) BY " " FOR 72;
OPEN(TERM);
REMOTE_OUTPUT := (TERM.KIND EQL VALUE(REMOTE));
FALL := MYSELF.SW1;
SPELL := MYSELF.SW2;
IF (TV := MYSELF.TASKVALUE) GTR MAXINT THEN
   BEGIN
   FORM "Too many bottles, using ";
   IF SPELL THEN
     FORM "ninety-nine."
   ELSE
     FORM "99.";
   SPOUT;
   SPOUT; % blank line
   BOTTLES := 99;
   END
ELSE
   IF (BOTTLES := TV) EQL 0 THEN
     BOTTLES := 99;
IF BOTTLES > 99 AND SPELL THEN
   BEGIN
   FORM "I know the words only up to ninety-nine.";
   SPOUT;
   SPOUT; % blank line
   END;
ATTACH HI TO MYSELF.EXCEPTIONEVENT;
FOR BOTTLES := BOTTLES STEP -1 UNTIL 1 DO
   BEGIN
   BOTTLECOUNT(BOTTLES,OP,SPELL);
   FORM "of beer on the wall,";
   SPOUT;
   BOTTLECOUNT(BOTTLES,OP,SPELL);
   FORM "of beer,";
   SPOUT;
   IF FALL THEN
     BEGIN
     FORM "If ";
     IF BOTTLES = 1 THEN
        FORM "that bottle "
     ELSE
        FORM "one of those bottles ";
     FORM "should happen to fall,";
     END
   ELSE
     BEGIN
     FORM "Take ";
     IF BOTTLES = 1 THEN
        FORM "it "
     ELSE
        FORM "one ";
     FORM "down and pass it around,";
     END;
   SPOUT;
   BOTTLECOUNT(BOTTLES-1,OP,SPELL);
   FORM "of beer on the wall.";
   SPOUT;
   IF BOTTLES GTR 1 THEN
     BEGIN
     SPOUT; % interstanza blank separator line
     IF EARLYEXIT THEN
       BEGIN
       FORM "Closing time!";
       SPOUT;
       BOTTLES := 1; % stop loop
       END
     ELSE
       IF REMOTE_OUTPUT THEN
         WHEN (1); % one-second interval to allow terminal to catch up
                   % (and be responsive to EXCEPTIONEVENT (?HI))
     END;
   END OF BOTTLES LOOP;
END.

Download Source | Write Comment

Alternative Versions

Version	Author	Date	Comments	Rate
A shorter version using Unisys MCP Algol	Paul Kimpel	03/03/08	1

Comments

Kevin Lipe said on 03/10/06 02:01:13

is there any way to make this code cleaner, or is Algol-60 really this much of a nightmare?

Tom Herbertson said on 07/06/06 09:21:30

My aim was not to write the simplest or cleanest code, but rather to implement some flexibility in the output, and demonstrate the use of some common Algol programming idioms.

nick said on 12/07/06 09:42:35

I am searching for a company that still programs in Algol - we would need some consultancy. Would you know of any specific company that teaches / trains / programs in Algol?
Please send an answer to my email (if thats not too much to ask)

BRs,
Nick

Joydeep said on 02/15/08 07:41:39

Hi Nick - do contact me at joyran642ATyahoo.com

Paul Kimpel said on 03/03/08 16:31:59

Tom's version using Unisys MCP Algol exhibits a lot of features of that variant of Algol 60, but it's hardly the most compact. To address Kevin's complaint, I've posted two shorter versions, one using remote file I/O and one using DISPLAY statements.

Nick, if you are still looking for some Algol consulting, you can contact me at paulDOTkimpelATdigmDOTcom.

Richard Botting said on 06/17/09 02:31:38

This looks like BEAGOL -- Burrough's Extended Algol rather than Algol 60.
But then the real Algol 60 had no input and output:-(
I might try a Elliot 503 Algol version some day.

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!

one program in 1500 variations