Philip Stanley
(converted to ANSI74 by Charlie Gibbs)
X-NEWS: spcvxb alt.folklore.computers: 7382
Relay-Version: VMS News - V6.0 13.10.90 VAX/VMS V5.4; site spcvxb.spc.edu
Path: spcvxb.spc.edu!njin!princeton!udel!wuarchive!zaphod.mps.ohio-state.edu!van-bc!rsoft!mindlink!a218
Newsgroups: alt.folklore.computers
Subject: The Common Business-Oriented Goldilocks
Message-ID: <4509@mindlink.UUCP>
From: a218@mindlink.UUCP (Charlie Gibbs)
Date: 20 Jan 91 16:58:51 GMT
Organization: MIND LINK! - British Columbia, Canada
Lines: 154
OK, by popular demand, here's
THE COMMON BUSINESS-ORIENTED GOLDILOCKS
(which originally appeared in an ancient issue of Datamation):
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID. ACOBOLFABLE.
000003 DATE-WRITTEN. ONCE UPON A TIME.
000004* THIS IS AN EXAMPLE OF COBOLX VERSATILITY.
000005
000006
000007
000008 ENVIRONMENT DIVISION.
000009 CONFIGURATION SECTION.
000010 OBJECT-COMPUTER. ANY MUSIC-BOX, MEMORY SIZE 8**64 CHARACTERS
000011 19 TAPE-DRIVES, 11 DISC-DRIVES,
000012 1 GOLDILOCKS, 3 BEARS.
000013 INPUT-OUTPUT SECTION.
000014 FILE-CONTROL.
000015 SELECT TAPE-DRIVES, ASSIGN TO CREDITOR.
000016 SELECT DISC-DRIVES.
000017 SELECT GOLDILOCKS, SELECT BEARS; ASSIGN TO ONE-COTTAGE.
000018 I-O-CONTROL.
000019 APPLY RED-TAPE ON TAPE-DRIVES
000020 APPLY HOFFNUNG-RECORD ON DISC-DRIVE
000021 APPLY GOLDI, BEARS ON COTTAGE.
000022
000023
000024
000025 DATA DIVISION.
000026 FILE SECTION.
000027 FD GOLDI
000028 LABEL RECORDS ARE STANDARD
000029 VALUE OF FILE-ID IS 'GOLDILOCKS'
000030 DATA RECORD IS GOLDILOCKS.
000031 01 GOLDILOCKS.
000032 02 HGT SIZE IS 62 INS.
000033 02 WGT SIZE IS 110 LBS.
000034 02 VITAL-STATS.
000035 03 B 38.
000036 03 W 24.
000037 03 H 36.
000038 02 RATING 100%.
000039 01 FD 3-BEARS
000040 LABEL RECORDS ARE STANDARD
000041 VALUE OF FILE-ID IS 'BEARS'
000042 DATA RECORDS ARE DADDY-BEAR, MUMMY-BEAR, BABY-BEAR.
000043 01 DADDY-BEAR.
000044 02 HGT 70 INS.
000045 02 WGT 750 LBS.
000046 02 COLOR OF EYES BLOODSHOT.
000047 02 DISPOSITION UNBEARABLE.
000048 01 MUMMY-BEAR.
000049 02 HGT 65 INS.
000050 02 WGT 700 LBS.
000051 02 COLOR OR EYES BLUE.
000052 02 DISPOSITION BEARABLE.
000053 01 BABY-BEAR.
000054 02 HGT 40 INS.
000055 02 WGT 200 LBS.
000056 02 COLOR OF EYES BLUE.
000057 02 DISPOSITION INFANTILE.
000058
000059 WORKING-STORAGE SECTION.
000060 01 COTTAGE PICTURE IS COZY.
000061 02 KITCHEN.
000062 03 TABLE SIZE IS LARGE, VALUE IS 1.
000063 03 CHAIRS SIZE IS MEDIUM, VALUE IS 3.
000064 02 PORRIDGE.
000065 03 KING-SIZE OCCURS 1 TIMES.
000066 03 QUEEN-SIZE OCCURS 1 TIMES.
000067 03 PRINCE-SIZE OCCURS 1 TIMES.
000068 02 DOOR SIZE IS USUAL, VALUE IS OPEN.
000069 02 BEDROOM.
000070 03 BED.
000071 04 LARGE OCCURS 1 TIMES.
000072 04 MEDIUM OCCURS 1 TIMES.
000073 04 SMALL OCCURS 1 TIMES.
000074 03 WINDOW SIZE IS SMALL, VALUE IS OPEN.
000075 01 RIGHT-COTTAGE REDEFINES COTTAGE, VALUE IS SAME.
000076 01 KING-SIZE-BED-SLEPT-IN SIZE IS BIG, VALUE IS ROCK-BOTTOM.
000077 01 QUEEN-SIZE-BED-SLEPT-IN SIZE IS MEDIUM, VALUE IS DEPRESSED.
000078 01 NO-PORRIDGE SIZE IS SMALL, VALUE IS ZERO.
000079 01 SIP SIZE IS LITTLE, VALUE IS 'SSSLUP'.
000080 01 SLUMBERLAND SIZE IS UNLIMITED, VALUE IS ZZZZZZZZZZ.
000081 CONSTANT SECTION.
000082 01 COMMENT1 PIC X(36)
000083 VALUE 'SOMEBODY HAS BEEN EATING MY PORRIDGE'.
000084 01 COMMENT2 PIC X(36)
000085 VALUE 'SOMEBODY HAS BEEN SLEEPING IN MY BED'.
000086
000087
000088
000089 PROCEDURE DIVISION.
000090 FOREST SECTION.
000091 START-OF-TALE.
000092 OPEN STORY. READ FOLLOWING.
000093 FIRST-MOVE.
000094 MOVE GOLDILOCKS TO COTTAGE.
000095 IF DOOR IS CLOSED OR BEARS ARE GREATER THAN ZERO
000096 ALTER ENTER-GOLDILOCKS TO PROCEED TO HASTY-RETREAT.
000097 ENTER-GOLDILOCKS.
000098 GO TO KITCHEN-SCENE.
000099 KITCHEN-SCENE.
000100 IF PORRIDGE = KING-SIZE
000101 PERFORM TASTE-ROUTINE
000102 VARYING PORRIDGE FROM KING-SIZE BY 1
000103 UNTIL PORRIDGE = PRINCE-SIZE
000104 ELSE
000105 COMPUTE IF COTTAGE = RIGHT-COTTAGE.
000106 GO TO BEDROOM-SCENE.
000107 TASTE-ROUTINE.
000108 SUBTRACT SIP FROM PORRIDGE (KING-SIZE).
000109 SUBTRACT SIP FROM PORRIDGE (QUEEN-SIZE).
000110 SUBTRACT SIP FROM PORRIDGE (PRINCE-SIZE) GIVING NO-PORRIDGE.
000111 BEDROOM-SCENE.
000112 MOVE GOLDILOCKS TO BEDROOM.
000113 ADD GOLDILOCKS TO BED (LARGE).
000114 DISPLAY 'IT IS TOO HARD'.
000115 SUBTRACT GOLDILOCKS FROM BED (LARGE)
000116 GIVING KING-SIZE-BED-SLEPT-IN.
000117 MOVE GOLDILOCKS TO BED (MEDIUM).
000118 DISPLAY 'IT IS TOO SOFT'.
000119 SUBTRACT GOLDILOCKS FROM BED (MEDIUM)
000120 GIVING QUEEN-SIZE-BED-SLEPT-IN.
000121 MOVE GOLDILOCKS TO BED (SMALL).
000122 DISPLAY 'IT IS JUST RIGHT'.
000123 ADD GOLDILOCKS TO SLUMBERLAND.
000124 BEARS-RETURN.
000125 MOVE DADDY-BEAR, MUMMY-BEAR, BABY-BEAR TO KITCHEN.
000126 MOVE CORRESPONDING BEARS TO PORRIDGE.
000127 DISPLAY 'DADDY BEAR', COMMENT1.
000128 DISPLAY 'MUMMY BEAR', COMMENT1.
000129 DISPLAY 'BABY BEAR', COMMENT1, 'AND EATEN IT ALL UP'.
000130 MOVE BEARS TO BEDROOM.
000131 BEARS-IN-BEDROOM.
000132 INSPECT BEDS REPLACING ALL GOLDILOCKS BY BEARS.
000133 DISPLAY 'DADDY BEAR', COMMENT2.
000134 DISPLAY 'MUMMY BEAR', COMMENT2.
000135 DISPLAY 'BABY BEAR', COMMENT2, 'AND HERE SHE IS'.
000136 HASTY-RETREAT.
000137 IF WINDOW IS OPEN
000138 EXIT GOLDILOCKS
000139 ELSE
000140 MOVE GOLDILOCKS TO DOOR.
000141 EXIT.
000142 END.
000143 CLOSE STORY.
000144 DISPLAY 'WOULD YOU BELIEVE CINDERELLA IN PL/I'.
000145 END TALE.
000146* "THE COMMON BUSINESS-ORIENTED GOLDILOCKS" BY PHILIP STANLEY
000147* (CONVERTED TO ANSI74 BY CHARLIE GIBBS)