Original IBM HLASM assembler
Source of a game by Keith Fenske (All rights acknowledged).
* Downloaded from:
* http://www.psc-consulting.ca/fenske/cpmis04s.txt
*
*
ZOOFOOD TITLE ' Feeding Animals in a Zoo @
Keith Fenske, UQV'
*
* Program Name: SHOW:ZOOFOOD
*
* Program Title: Feeding Animals in a Zoo
*
* Author: Keith Fenske, Department of Mathematics, University
* of Alberta.
*
* Date: 16 July 1977. Copyright (c) 1977 by Keith Fenske. All
* rights reserved.
*
* Source Language: IBM 370 Assembler
*
* Routine Type: Single use, meaning that Zoofood modifies its data
* regions in such a way that a new copy of the program
* must be loaded before it will run properly.
*
* Purpose: To play a not-event game, in which the user wins if
* a certain event does not occur.
*
* Description: Being the zookeeper for a small collection of
* animals, the user is required to feed them periodically.
* Each of the seven animals may be fed any six of seven
* foods. The seventh means disaster as the animal will
* attack. The animals are randomly associated with the
* touchy foods, leaving the user the choice of how
* he is going to allocate the food types.
*
* Animal names are: bear, child, elephant, giraffe, monkey,
* rhinoceros and seal.
*
* Foods are: banana, chocolate, fish, grass, leaf,
* marshmallow and peanut.
*
* Restrictions: Nothing special.
*
* Size: About 2112 bytes.
*
* Timing: 0.01 to 0.1 seconds (Amdahl 470 V/6).
*
* Usage: $RUN SHOW:ZOOFOOD
*
* External References:
* MTS Resident System
* SCARDS, SETPFX, SPRINT
*
* SHOW:LIB Subroutines
* CMDSCAN, COPY, RANDOM
*
* Assembler Macro References:
* *SYSMAC Macros
* CALL, ENTER, EXIT, LITADDR, REQU, SCARDS, SPRINT
*
* Logical I/O Units Referenced:
* SCARDS - input from the user.
* SPRINT - messages and prompting.
*
* Input Lines: All input from the user is via direct prompts,
* asking for a YES or NO response, or for a food name.
* Food may be specified by any proper abbreviation.
*
* Parameters: None.
*
* Error Messages: Self-explanatory.
*
* Chances of Winning: Zoofood is essentially a matching game.
* There are "n" objects to be tagged by "n" tags. On the
* first try, the user has a one in "n" chance of tagging
* the wrong object. Thus, he has a (n-1)/n chance of
* getting to the next round. The interesting point is this:
* if the user tags a safe object, the corresponding
* dangerous tag is now safe also. This released tag may
* be ignored. Next try, the user has a (n-2)/(n-1) chance
* of getting by. Repeat this process until slightly over
* half the objects have been tagged; the rest are "safe".
* Example:
*
* p(7) = 6/7 * 5/6 * 4/5 * 3/4
*
* p(n) = 1/2, when "n" is even. p(n) = (n-1)/(2*n), when
* "n" is odd. p(odd) has 1/2 as a limit. As a table:
*
* objects win probability
*
* 3 1/3
* 5 2/5
* 7 3/7
* 9 4/9
* 11 5/11
*
* References: SHOW:LIB.W documents the subroutine library.
* SHOW:ZOOFOOD.W has this program's writeup.
*
EJECT
PRINT NOGEN INHIBIT PRINTING OF MACRO CODE
ZOOFOOD START 0 BEGIN A MAIN PROGRAM
REQU PFX=GR,TYPE=DEC equate the general registers
LITADDR YES literals are adressable
SPACE 3
*
* Save the caller's registers, prepare a new save area, and
* establish GR12 as our base register.
*
ENTER GR12,SA=SAVEAREA MTS *SYSMAC MACRO
SPACE 3
*
* Initialize the terminal I/O prefix. Then introduce ourselves
* on the logical I/O unit SPRINT.
*
CALL SETPFX,(PFXOUT,ONE) set a blank terminal prefix
SPRINT '1Zoofood, a game for future zookeepers'
SPACE 3
*
* Prompt the user as to whether he requires a copy of this
* program's writeup.
*
SPRINT '0Have you run this zoo before?'
SPACE 3
*
* Read the user's response from the logical I/O unit SCARDS.
* Modifiers are set for uppercase and no implicit concatenation
* ($CONTINUE WITH lines). An end-of-file will cause program
* termination.
*
CALL SETPFX,(PFXIN,ONE) question mark input prefix
SCARDS INPUT,INLEN,@-IC,@UC,EXIT=STOP READ AWAY
CALL SETPFX,(PFXOUT,ONE) blank the I/O prefix
SPACE 3
*
* Using the SHOW:LIB subroutine CMDSCAN, look for any form of a
* YES reply. If one abbreviation is found, the command scanning
* table will cause execution to advance to SHUFFLE.
*
LH GR0,INLEN INPUT TEXT LENGTH
LA GR1,INPUT INPUT TEXT ADDRESS
LA GR2,YESCMD COMMAND TABLE FOR "YES"
CALL CMDSCAN BRANCH AND LINK TO SCANNER
SPACE 3
*
* Control comes to this point if the input was null, empty or
* not an abbreviation of YES. A call to the SHOW:LIB COPY subroutine
* is used to print SHOW:ZOOFOOD.W as the program writeup.
* COPY will process its own attention interrupts.
*
CALL COPY,(COPYFLAG,COPYFILE,COPYUNIT) INFO FOR YOU
EJECT
*
* SHUFFLE
*
* We now shuffle the assignments between the animals and their
* restricted foods. By design, there are seven of each. Since
* seven is a prime number, we may multiply the digits 0 through
* 6 by any integer, and still have 0 through 6 upon division by
* 7. The pairings are decided by the vector PAIRINGS. The
* zero-origin n'th halfword gives the zero-origin dangerous food
* index for the n'th animal.
*
* Initially, PAIRINGS is set to 0, 1, ..., 6 by the statement which
* defines it. To shuffle the assignments, we
* (1) select a base from 0 to 6.
* (2) select a multiplier from 1 to 6.
* (3) starting at the first animal:
* (a) place the base in PAIRINGS.
* (b) base = base + multiplier.
* (c) base = remainder of base upon division by 7.
* i.e. base = base (mod 7)
*
* This process generates a new order of the elements 0 through 6.
*
SHUFFLE EQU *
SPACE 3
*
* Call the SHOW:LIB subroutine RANDOM to obtain a scaled pseudo-
* random integer from 0 to 6. This will be our base value.
*
CALL RANDOM,(CHOICES) RETURNS ZERO-ORIGIN RESULT IN GR0
LR GR9,GR0 SAVE FOR THE FUTURE
SPACE 3
*
* Now a multiplier (or increment) must be selected from 1 through
* 6. Zero makes little sense here.
*
CALL RANDOM,(CHOICEM) GETS 0 TO 5
LR GR8,GR0 MOVE THE PSEUDO-RANDOM
LA GR8,1(0,GR8) ADD ONE FOR 1 TO 6
SPACE 3
*
* Store the base as the assignment for the first animal. Then
* continuously increment and modularize the base for each
* following animal.
*
LA GR6,PAIRINGS FIRST ANIMAL HALFWORD
LA GR7,OBJECTS ANIMALS TO BE DONE
SPACE
SHUFANIM EQU *
STH GR9,0(0,GR6) SAVE ANIMAL/FOOD INDEX
SPACE
SR GR0,GR0 CLEAR FOR DIVISION
LA GR1,0(GR8,GR9) NEXT BASE (NON-MODULAR)
D GR0,CHOICES DIVIDE BY 7
LR GR9,GR0 NEXT BASE (MODULO 7)
SPACE
LA GR6,2(0,GR6) NEXT PAIRINGS HALFWORD
BCT GR7,SHUFANIM REPEAT FOR ALL ANIMALS
EJECT
*
* FEED
*
* Now we begin to ask the user what he wants to feed each animal.
* As we prompt him with a name, he must respond with a food type
* that has not already been used. The food can be named by any
* abbreviation of its true name. Should the user fail to
* give us a valid name, a message is printed listing the
* remaining foods. Feeding a dangerous food to its paired
* animal provokes an immediate attack, and user failure.
* When all of the animals have been fed properly, the user wins.
*
SR GR8,GR8 ZERO-ORIGIN INDEX OF FIRST ANIMAL
LA GR9,OBJECTS TOTAL NUMBER OF ANIMALS
SPACE 3
*
* Ask the user what he is going to feed the current animal. We do
* this by selectively moving pieces of text into the OUTPUT
* buffer. GR1 is used as a pointer to the next available byte
* in the buffer. Eventually, we subtract the address of OUTPUT
* from GR1 to obtain the length used for output.
*
FEEDANIM EQU *
MVC OUTPUT(FEDMSG1L),FEDMSG1 "WHAT ARE YOU ..."
LA GR1,OUTPUT+FEDMSG1L NEXT OUTPUT LOCATION
SPACE
LR GR2,GR8 INDEX OF THE ANIMAL
SLA GR2,4 OFFSET INTO ANIMAL NAMES
LA GR2,ANIMALS(GR2) ADDRESS OF ANIMAL ENTRY
MVC 0(14,GR1),2(GR2) MOVE THE FULL NAME
AH GR1,0(0,GR2) NEXT OUTPUT LOCATION
SPACE
MVC 0(FEDMSG2L,GR1),FEDMSG2 A QUESTION MARK OR SO
LA GR1,FEDMSG2L(0,GR1) NEXT OUTPUT LOCATION
SPACE
LA GR0,OUTPUT STARTING OUTPUT ADDRESS
SR GR1,GR0 LENGTH OF TEXT USED
STH GR1,OUTLEN SAVE FOR SPRINT CALL
SPRINT OUTPUT,OUTLEN POP THE QUESTION
SPACE 3
*
* Get a response from the user. We must set the terminal I/O prefix.
* An end-of-file while reading causes us to branch to the chunk of
* code which displays the final animal/food assignments.
*
CALL SETPFX,(PFXIN,ONE) question mark input prefix
SCARDS INPUT,INLEN,@-IC,@UC,EXIT=SHOW READ FROM TERMINAL
CALL SETPFX,(PFXOUT,ONE) blank for an output prefix
SPACE 3
*
* Look for the beginning of a keyword in our input buffer. In
* particular, we skip as many blanks as necessary in our
* search for a non-blank character. A null input, or all-blank
* (empty) line causes us to print the available choices.
*
LH GR0,INLEN LENGTH OF INPUT TEXT
LTR GR0,GR0 ANYTHING THERE?
BNP PICKLIST QUIT ON NULL INPUT
SPACE
LA GR1,INPUT ADDRESS OF INPUT BUFFER
SPACE
LOOKTRY EQU *
CLI 0(GR1),C' ' LOOKING AT A NON-BLANK?
BNE LOOKKEEP BRANCH IF SO
LA GR1,1(0,GR1) NEXT INPUT LOCATION
BCT GR0,LOOKTRY LOOP AGAIN
B PICKLIST QUIT IF ALL BLANK
SPACE 3
*
* Now find the end of the keyword, either by another blank or
* running out of characters.
*
LOOKKEEP EQU *
LR GR2,GR1 SAVE THE STARTING ADDRESS
SPACE
LOOKKTRY EQU *
CLI 0(GR1),C' ' AT A BLANK YET?
BE LOOKKGOT SKIP AROUND IF BLANK
LA GR1,1(0,GR1) NEXT INPUT LOCATION
BCT GR0,LOOKKTRY KEEP TRYING
SPACE 3
*
* Compute the keyword length as the difference of the final scanning
* address, and the start of the keyword. In addition, the length
* will be truncated to 14 characters, if necessary.
*
LOOKKGOT EQU *
SR GR1,GR2 LENGTH OF INPUT KEYWORD
LA GR0,14 MAXIMUM ACCEPTABLE LENGTH
CR GR0,GR1 HOW DO THE LENGTHS COMPARE?
BNL LOOKFIND BRANCH IF ALL RIGHT
LR GR1,GR0 SWAP REGISTERS TO TRUNCATE
SPACE 3
*
* Using variable length comparisons, a check is now made to
* see if a matching keyword can be found in our FOOD table. Note
* the use of zero-origin (IBM) lengths with the EX instruction.
*
LOOKFIND EQU *
BCTR GR1,0 IBM (zero origin) keyword length
SR GR3,GR3 INDEX OF FIRST FOOD
LA GR4,FOOD ADDRESS OF FIRST FOOD ENTRY
LA GR5,OBJECTS NUMBER OF FOOD TYPES
SPACE
LOOKFTRY EQU *
EX GR1,LOOKSEE DO INPUT AND TABLE MATCH?
BE LOOKFED BRANCH IF SO
LA GR3,1(0,GR3) NEXT FOOD INDEX
LA GR4,16(0,GR4) NEXT FOOD ENTRY
BCT GR5,LOOKFTRY SCAN ENTIRE FOOD TABLE
B PICKLIST TELL USER WHAT HE CAN PICK
SPACE 3
*
* Check if the input-given food has already been handed out. If it
* has not, save the animal index to tell us WHERE the food went,
* and note what we FED this animal.
*
LOOKFED EQU *
LA GR1,0(GR3,GR3) TWICE THE FOOD INDEX
LH GR0,WHERE(GR1) WHO HAS BEEN GIVEN THIS FOOD?
LTR GR0,GR0 NEGATIVE FOR NOBODY?
BNM PICKLIST QUIT IF ALREADY TAKEN
SPACE
STH GR8,WHERE(GR1) PUT CURRENT ANIMAL CODE
LA GR1,0(GR8,GR8) TWICE ANIMAL CODE
STH GR3,FED(GR1) WHAT ANIMAL WAS GIVEN
SPACE 3
*
* Ensure that the user did not feed the animal his danger food.
*
CH GR3,PAIRINGS(GR1) DO GIVEN AND BAD MATCH?
BNE FEEDNEXT GO IF SAFE
SPACE 6
*
* Tell the user that he was attacked by a food-wielding animal,
* and dump the animal/food list. Once again, we build up our
* output image by attaching message pieces to our OUTPUT buffer.
*
MVC OUTPUT(FEDMSG3L),FEDMSG3 "You've been attacked"
LA GR1,OUTPUT+FEDMSG3L NEXT OUTPUT LOCATION
SPACE
LR GR2,GR3 INDEX OF FOOD TYPE
SLA GR2,4 OFFSET INTO FOOD NAMES
LA GR2,FOOD(GR2) ADDRESS OF FOOD ENTRY
MVC 0(14,GR1),2(GR2) MOVE THE ENTIRE NAME
AH GR1,0(0,GR2) NEXT OUTPUT LOCATION
SPACE
MVC 0(FEDMSG4L,GR1),FEDMSG4 "-WIELDING"
LA GR1,FEDMSG4L(0,GR1) NEXT OUTPUT LOCATION
SPACE
LR GR2,GR8 INDEX OF ANIMAL TYPE
SLA GR2,4 OFFSET INTO ANIMAL NAMES
LA GR2,ANIMALS(GR2) ADDRESS OF ANIMAL ENTRY
MVC 0(14,GR1),2(GR2) MOVE THE ENTIRE NAME
AH GR1,0(0,GR2) NEXT OUTPUT LOCATION
SPACE
LA GR0,OUTPUT STARTING OUTPUT ADDRESS
SR GR1,GR0 LENGTH OF TEXT
STH GR1,OUTLEN HOW MANY OUTPUT BYTES
SPRINT OUTPUT,OUTLEN WRITE ON SPRINT
SPACE
B SHOW TELL THE USER EVERYTHING
SPACE 6
*
* Either due to invalid input, or a food already being in use,
* we now tell the user what food types he can choose from.
* Any entries that are non-negative in WHERE have already been
* given away. The resulting message is built in the OUTPUT
* buffer.
*
PICKLIST EQU *
MVC OUTPUT(FEDMSG5L),FEDMSG5 "PICK FROM"
LA GR1,OUTPUT+FEDMSG5L NEXT OUTPUT LOCATION
SPACE
LA GR2,FOOD FIRST FOOD NAME ENTRY
LA GR3,WHERE FIRST ALLOCATION HALFWORD
LA GR4,OBJECTS NUMBER OF FOODS TO DO
SPACE
PICKLOOP EQU *
TM 0(GR3),X'80' IS THE WHERE CODE NEGATIVE?
BZ PICKNEXT SKIP AROUND IF IN USE
SPACE
MVC 0(14,GR1),2(GR2) MOVE FULL FOOD NAME
AH GR1,0(0,GR2) NEXT OUTPUT LOCATION
LA GR1,1(0,GR1) LEAVE A BLANK BYTE
SPACE
PICKNEXT EQU *
LA GR2,16(0,GR2) NEXT FOOD NAME ENTRY
LA GR3,2(0,GR3) NEXT ALLOCATION HALFWORD
BCT GR4,PICKLOOP REPEAT FOR ALL FOODS
SPACE
LA GR0,OUTPUT STARTING OUTPUT ADDRESS
SR GR1,GR0 OUTPUT BYTES USED
STH GR1,OUTLEN LENGTH OF TEXT
SPRINT OUTPUT,OUTLEN WRITE ON SPRINT
SPACE
B FEEDANIM TRY THIS ANIMAL AGAIN
SPACE 6
*
* Loop back to feed the next animal. If all of them are fed
* successfully, the user wins the game.
*
FEEDNEXT EQU *
LA GR8,1(0,GR8) NEXT ANIMAL INDEX
BCT GR9,FEEDANIM FEED ALL THE ANIMALS
SPACE
SPRINT '-Jolly good, you fed the entire zoo without problems'
EJECT
*
* SHOW
*
* Inform the user about the final state of the animal feedings. The
* prefix character is blanked, in case we came here from a SCARDS
* end-of-file. Two header lines are printed, then the report starts.
* For each animal, PAIRINGS is used to obtain the dangerous
* food name, and FED gives the actual feeding.
*
SHOW EQU *
CALL SETPFX,(PFXOUT,ONE) blank terminal prefix
SPRINT '0Following are the animals, what not to feed them,'
SPRINT ' and what they were actually given by you:'
SPACE
LA GR6,ANIMALS ADDRESS OF FIRST ANIMAL NAME
LA GR7,PAIRINGS FIRST DEFENSIVE FOOD HALFWORD
LA GR8,FED WHAT THEY WERE FED HALFWORDS
LA GR9,OBJECTS NUMBER OF ANIMALS
SPACE 3
*
* Each animal loops to this point in telling its story. We use
* the usual OUTPUT buffer technique to prepare our text.
*
MVI OUTPUT,C' ' BLANK THE CARRIAGE CONTROL
SPACE
SHOWANIM EQU *
MVC OUTPUT+1(14),2(GR6) MOVE THE ANIMAL'S NAME
LA GR1,OUTPUT+15 NEXT OUTPUT LOCATION
SPACE
LH GR2,0(0,GR7) INDEX FOR DEFENSIVE FOOD
SLA GR2,4 OFFSET INTO FOOD NAMES
LA GR2,FOOD(GR2) ADDRESS OF FOOD ENTRY
MVC 0(14,GR1),2(GR2) MOVE THE FOOD'S NAME
LA GR1,14(0,GR1) NEXT OUTPUT LOCATION
SPACE
LH GR2,0(0,GR8) INDEX FOR ACTUAL FOOD
LTR GR2,GR2 WAS ANIMAL FED?
BM SHOWNEXT SKIP IF STILL HUNGRY
SPACE
SLA GR2,4 OFFSET INTO FOOD NAMES
LA GR2,FOOD(GR2) ADDRESS OF FOOD ENTRY
MVC 0(14,GR1),2(GR2) MOVE THE FOOD'S NAME
LA GR1,14(0,GR1) NEXT OUTPUT LOCATION
SPACE 3
*
* Print the formed output, and loop back for the next animal.
*
SHOWNEXT EQU *
LA GR0,OUTPUT INITIAL OUTPUT LOCATION
SR GR1,GR0 ACTUAL BYTES USED
STH GR1,OUTLEN SAVE TEXT LENGTH
SPRINT OUTPUT,OUTLEN WRITE ON SPRINT
SPACE
LA GR6,16(0,GR6) NEXT ANIMAL NAME
LA GR7,2(0,GR7) NEXT DEFENSIVE FOOD HALFWORD
LA GR8,2(0,GR8) NEXT "WERE FED" HALFWORD
BCT GR9,SHOWANIM FINISH ALL ANIMALS
EJECT
*
* STOP
*
* Return back to MTS, normally terminating the program.
*
STOP EQU *
EXIT 0 RESTORES REGISTERS, ETC.
SPACE 3
DROP GR12 KILL THE BASE REGISTER
EJECT
*
* Program Data Regions
*
* Equates that control the allocation of data regions.
*
OBJECTS EQU 7 PRIME NUMBER OF ANIMALS/FOODS
SPACE 3
*
* Double-word regions. The ANIMALS and FOOD tables have 16-byte
* entries, of which the first halfword is the true length of the
* name.
*
DC 0D'0' CLEAN ALIGNMENT
ANIMALS EQU * NAMES OF THE ANIMALS
DC H'4',CL14'BEAR'
DC H'5',CL14'CHILD'
DC H'8',CL14'ELEPHANT'
DC H'7',CL14'GIRAFFE'
DC H'6',CL14'MONKEY'
DC H'10',CL14'RHINOCEROS'
DC H'4',CL14'SEAL'
COPYUNIT DC CL8'SPRINT' "COPY" OUTPUT UNIT NAME
FOOD EQU * NAMES OF THE FOOD TYPES
DC H'6',CL14'BANANA'
DC H'9',CL14'CHOCOLATE'
DC H'4',CL14'FISH'
DC H'5',CL14'GRASS'
DC H'4',CL14'LEAF'
DC H'11',CL14'MARSHMALLOW'
DC H'6',CL14'PEANUT'
INPUT DC CL256' ' TERMINAL INPUT BUFFER
OUTPUT DC CL120' ' TERMINAL OUTPUT BUFFER
SAVEAREA DC 9D'0' PROGRAM SAVE AREA
SPACE 3
*
* Fullword-aligned data regions.
*
CHOICEM DC A(OBJECTS-1) POSSIBLE SHUFFLE MULTIPLIERS
CHOICES DC A(OBJECTS) CHOICES OF ANIMAL/FOOD TYPES
COPYFLAG DC XL4'6' FILE TO UNIT COPY WITH ...
* ATTENTION INTERRUPTS ENABLED
ONE DC F'1'
SPACE 3
*
* Halfword-aligned data regions.
*
FED DC (OBJECTS)H'-1' FOOD GIVEN TO THIS ANIMAL,
* -1 FOR NOT FED
INLEN DC H'0' LENGTH OF INPUT TEXT
LOOKSEE CLC 0(0,GR2),2(GR4) FOR LOOKING UP FOOD NAMES,
* "EX" GIVES THE LENGTH
OUTLEN DC H'0' LENGTH OF OUTPUT TEXT
PAIRINGS DC (OBJECTS)Y((*-PAIRINGS)/2) DANGEROUS FOOD FOR ANIMAL,
* GENERATES 0, 1, ..., 6,
* THE FACT OF WHICH IS NEVER USED
WHERE DC (OBJECTS)H'-1' WHICH ANIMAL GOT THIS FOOD,
* -1 FOR NOT YET USED
SPACE 3
*
* Byte-aligned data regions.
*
COPYFILE DC C'SHOW:ZOOFOOD.W ' program write-up file
PFXIN DC C'?' terminal input prefix
PFXOUT DC C' ' terminal output prefix
YESCMD DC AL1(3),C'YES',AL4(SHUFFLE),AL1(0)
* CMDSCAN TABLE FOR "YES" KEYWORD
SPACE 3
*
* Messages. Each text string has a length equate making it easy
* to move around.
*
FEDMSG1 DC C'0What are you going to feed the '
FEDMSG1L EQU *-FEDMSG1
FEDMSG2 DC C'?'
FEDMSG2L EQU *-FEDMSG2
FEDMSG3 DC C'-You have been attacked by a '
FEDMSG3L EQU *-FEDMSG3
FEDMSG4 DC C'-wielding '
FEDMSG4L EQU *-FEDMSG4
FEDMSG5 DC C' Pick from '
FEDMSG5L EQU *-FEDMSG5
EJECT
*
* Program Literal Pool.
*
DC 0D'0' CLEAN ALIGNMENT
LTORG
SPACE 3
END