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)
 
Charlie_Gibbs@mindlink.bc.ca
Honk if your horn is broken.