99 Bottles of Beer

Voting

Bookmarking

Language PL-516

Date:	03/28/08
Author:	Adrian Wise
URL:	http://www.series16.adrianwise.co.uk
Comments:	0
Info:	http://www.series16.adrianwise.co.uk/software/pl516
Score:	(2.00 in 1 votes)

&
& PL-516 VERSION OF 99 BEERS ON THE WALL
&
& TYPE 99 BOTTLES ON THE ASR-33
&

.COMPCONST CR = '215, & OCTAL CARRIAGE-RETURN CHARACTER
           LF = '212; & OCTAL LINE-FEED CHARACTER
.COMPCONST TRUE  = -1;
.COMPCONST NBOTTLES = 99;

.INTEGER BOTTLES;   & COUNT THEM
.INTEGER STARTLINE; & FLAG - AT START OF LINE

&
& PL-516 HAS NO LIBRARIES FOR I/O (OR ANYTHING ELSE)
& WE'RE PROGRAMMING ON THE BARE METAL HERE...
&
& SO START WITH SOME SIMPLE ROUTINES TO OUTPUT
& CHARACTERS
&

&
& THIS IMPLEMENTS A TEST THAT THE CHARAACTER
& PASSED AS AN ARGUMENT IS A LETTER
&
@ .CONDITIONAL .PROCEDURE LETTER;
  .WHEN @ .RANGE $$A .TO $$Z .THEN
    .EXITTRUE;

&
& TYPE ONE CHARACTER ON THE ASR
&
& THERE'S SOME CRUFTY CODE HERE BECAUSE PL-516
& DATES FROM AN ERA WHEN THE USUAL I/O DEVICE WAS
& AN ASR-33 (A MECHANICAL TELETYPE) THAT HAD NO
& LOWER-CASE LETTERS, SO ALTHOUGH THE ASCII CODES
& WE NOW USE AS LOWER-CASE LETTERS COULD BE SENT
& THEY'D PRINT AS UPPER-CASE.
& FOR SOME REASON THE SOURCE INPUT READER OF THE
& PL-516 COMPILER DISCARDS LOWER-CASE LETTERS, EVEN
& IN STRINGS AND CHARACTER CONSTANTS, WHICH IS
& WHY THE CODE BELOW IS ALL IN UPPER-CASE.
&
& IN ORDER TO GET THE CORRECT CASE OF TEXT
& PRINTED OUT I CONVERT ALMOST EVERYTHING TO LOWER-
& CASE IN THIS 'TYPE' ROUTINE, EXCEPT I LEAVE
& THE FIRST CHARACTER OF EACH LINE AS UPPER-CASE
&
@ .PROCEDURE TYPE;
.INTEGER C;
.BEGIN

  C := @;
  @ := .IF LETTER(.CLEFT @) .AND
         STARTLINE .Z .THEN
           C + '040 & MAKE IT LOWER CASE
         .ELSE C;   & ELSE USE AS IS

  &
  & EMBEDDED ASSEMBLY LANGUAGE INSTRUCTIONS
  & TO ACTUALLY OUTPUT TO THE ASR
  &
  %SKS,'104; & SKIP IF ASR NOT BUSY
  %JMP,*-1;  & LOOP UNTIL NOT BUSY
  %OCP,'104; & ASR TO OUTPUT MODE
  %OTA,'4;   & OUTPUT CHARACTER IN A REGISTER
  %JMP,*-1;  & LOOP UNTIL READY

  STARTLINE := .Z;
  @ := C; & RESTORE ACCUMULATOR (FOR CHARACTER IN OTHER HALF)
.END;

&
& TYPE THE TWO 8-BIT CHARACTERS IN THE 16-BIT ARGUMENT
&
@ .PROCEDURE TYPE2;
.BEGIN
  TYPE(.SWOP @); & UPPER CHARACTER IN A REG.
  TYPE(.SWOP @); & AND THE LOWER ONE
.END;

&
& TYPE CARRIAGE-RETURN, LINE-FEED TO GET TO START OF LINE
&
.PROCEDURE NEWLINE;
.BEGIN
  TYPE(<CR,LF>);
  STARTLINE := TRUE;
.END;

&
& TYPE A STRING
& THE STRING IS TERMINATED BY AN ASTERIX
& (C-STYLE NULL-TERMINATION WOULD HAVE BEEN MORE
& SENSIBLE, BUT PL-516 DOESN'T DO THAT, SO THE
& TERMINATION NEEDS TO BE A PRINTABLE CHARACTER)
&
@ .PROCEDURE TYPESTRING;
.INTEGER P; & POINTER INTO STRING
.ARRAY STRING[0]; & ARRAY WORD THAT WILL POINT TO STRING
.BEGIN
  %STA, STRING; & POINT AT THE STRING TO TYPE
  .FOR P := .Z .DO .BEGIN
    INDEX := P .SHSRA 1; & DIVIDE P BY TWO
    @ := STRING[#];      & GET TWO CHARACTERS

    & IF P WAS ODD THEN THE SHIFT (THAT DIVIDED
    & BY TWO) WILL HAVE SET THE CARRY BIT
    .UNLESS .CSET .THEN
      @ := .SWOP @;

    & CLEAR THE UPPER HALF OF THE ACCUMULATOR
    & AND COMPARE TO THE STRING TERMINATION
    .WHEN .CLEFT @ = $$* .THEN
      .EXIT;

    TYPE(@);
  .END;
.END;

&
& TYPE A POSITIVE INTEGER IN DECIMAL
&
@ .PROCEDURE TYPEDECIMAL;
.INTEGER N;      & THE NUMBER STILL TO BE PRINTED
.INTEGER TYPING; & FLAG (SUPPRESS LEADING ZEROS)
.COMPCONST NPOWER=-5; & ARRAYS HAVE NEGATIVE INDICES
.ARRAY POWER[NPOWER](10000,1000,100,10,1);
.BEGIN
  N := @;       & SAVE THE NUMBER TO PRINT
  TYPING := .Z; & 

  & SPECIAL-CASE ZERO
  .IF N .Z .THEN
    TYPE($$0)
  .ELSE .BEGIN
    .FOR # := NPOWER .DO .BEGIN
      .WHEN TYPING .NZ .OR
            N .GE POWER[#] .THEN .BEGIN
        TYPE(N/POWER[#]+$$0);
        N := .B; & PICK UP THE REMAINDER FROM THE DIVIDE
        TYPING := TRUE;
      .END;
    .END;
  .END;
.END;

&
& TYPEBOTTLE DEALS WITH PRINTING "N BOTTLE(S)"
& DEALING WITH THE CASES OF ONE BOTTLE (NOT PLURAL)
& AND ZERO BOTTLES ("NO MORE BOTTLES")
& 
@ .PROCEDURE TYPEBOTTLE;
.INTEGER BOT;
.BEGIN
  BOT := @;
  .IF @ .Z .THEN .BEGIN
    TYPESTRING("NO MORE*");
  .END .ELSE
    TYPEDECIMAL(BOT);
  TYPESTRING(" BOTTLE*");
  .WHEN BOT .NE 1 .THEN
    TYPE($$S);
.END;

&
& PRINT OUT ONE ENTIRE VERSE, THE ARGUMENT
& IS THE NUMBER OF BOTTLES (AT THE START OF
& THE VERSE)
&
@ .PROCEDURE VERSE;
.INTEGER BOT;
.BEGIN
  BOT := @;
  TYPEBOTTLE(BOT);
  TYPESTRING(" OF BEER ON THE WALL, *");
  TYPEBOTTLE(BOT);
  TYPESTRING(" OF BEER.*");
  NEWLINE;
  .IF BOT .Z .THEN .BEGIN
    TYPESTRING("GO TO THE STORE AND BUY SOME MORE, *");
    BOT := NBOTTLES;
  .END .ELSE .BEGIN
    TYPESTRING("TAKE ONE DOWN AND PASS IT AROUND, *");
    BOT := BOT-1;
  .END;
  TYPEBOTTLE(BOT);
  TYPESTRING(" OF BEER ON THE WALL.*");
  NEWLINE;
.END;

&
& AND FINALLY THE MAIN PROGRAM
&
.ORIGIN '1000;
.BEGIN
  NEWLINE;

  .FOR BOTTLES := NBOTTLES .STEPDOWN -1 .UNTIL 0 .DO .BEGIN
     VERSE(BOTTLES);
     NEWLINE;
  .END;

.END;

Download Source | Write Comment

Alternative Versions

Comments

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