T H E C O M M O N B U S I N E S S O R I E N T E D G O L D I L O C K S ----- ----------- --------------- --------------- ------------------- IDENTIFICATION DIVISON. PROGRAM ID. A COBOL FABLE. SECURITY. INSECURE. PROGRAMMER-ID. ARTHUR SHAPIRO. REMARKS. SLIGHTLY MORE MANGLED VERSION OF ONE IN JAN., 1968 DATAMATION. DATE WRITTEN. ONCE UPON A TIME. ENVIRONMENT DIVISON. CONFIGURATION SECTION. OBJECT COMPUTER. ANY MUSIC BOX, MEMORY SIZE 8X64 BYTES, 19 TAPE DRIVES, 11 DISK DRIVES, 1 GOLDILOCKS, 3 BEARS. INPUT-OUTPUT SECION. FILE-CONTROL. SELECT TAPE DRIVES, ASSIGN THEM TO CREDITOR. SELECT DISK DRIVES. SELECT GOLDILOCKS, SELECT BEARS, ASSIGN TO ONE COTTAGE. I-O CONTROL. APPLY RED TAPE TO TAPE DRIVES, APPLY BRAHMS RECORD TO DISK DRIVE, APPLY GOLDI, BEARS TO COTTAGE. DATA DIVISON. FD GOLDI. LABEL RECORDS ARE STANDARD VALUE OF IDENTIFACTION IS "GOLDILOCKS" DATA RECORD IS GOLDILOCKS. 01 GOLDILOCKS. 02 HGT SIZE IS 62 INS. 02 WGT SIZE IS 110 LBS. 02 VITAL-STATS. 03 B 38. 03 W 24. 03 H 36. 02 RATING 100%. FD THREE-BEARS. LABEL RECORDS ARE STANDARD VALUE OF IDENTIFICATION IS "BEARS" DATA RECORDS ARE DADDY-BEAR, MUMMY-BEAR, BABY-BEAR. 01 DADDY-BEAR. 02 HGT 70 INS. 02 WGT 750 LBS. 02 COLOR-OF-EYES BLOODSHOT. 02 DISPOSITION UNBEARABLE. 01 MUMMY-BEAR. 02 HGT 65 INS. 02 WGT 700 LBS. 02 COLOR-OF-EYES BLUE. 02 DISPOSITION BEARABLE. 01 BABY-BEAR. 02 HGT 40 INS. 02 DISPOSITION INFANTILE. WORKING-STORAGE SECTION. 01 COTTAGE PICTURE IS COZY. 02 KITCHEN. 03 TABLE SIZE IS LARGE, VALUE IS 1. 03 CHAIRS SIZE IS MEDIUM, VALUE IS 3. 02 PORRIDGE. 03 KING-SIZE OCCURS 1 TIME. 03 QUEEN-SIZE OCCURS 1 TIME. 03 PRINCE-SIZE OCCURS 1 TIME. 02 DOOR SIZE IS USUAL, VALUE IS OPEN. 02 BEDROOM. 03 BED. 04 LARGE OCCURS 1 TIME. 04 MEDIUM OCCURS 1 TIME. 04 SMALL OCCURS 1 TIME. 03 WINDOW SIZE IS SMALL, VALUE IS OPEN. 01 CORRECT-COTTAGE REDEFINES COTTAGE, VALUE IS SAME. 77 KING-SIZE-BED-SLEPT-IN SIZE IS BIG, VALUE IS ROCK-BOTTOM. 77 QUEEN-SIZE-BED-SLEPT-IN SIZE IS MEDIUM, VALUE IS DEPRESSED. 77 NO-PORRIDGE SIZE IS SMALL, VALUE IS ZERO. 77 SIP SIZE IS LITTLE, VALUE IS "SSSLURP". 77 SLUMBERLAND SIZE IS UNLIMITED, VALUE IS ZZZZZZZZZ. CONSTANT SECTION. 01 COMMENT1 SIZE IS 36, VALUE IS "SOMEBODY HAS BEEN EATING MY PORRIDGE". 01 COMMENT2 SIZE IS 36, VALUE IS "SOMEBODY HAS BEEN SLEEPING IN MY BED". PROCEDURE DIVISION. FOREST SECTION. START-OF-TALE. OPEN STORY. READ FOLLOWING. FIRST-MOVE. MOVE GOLDILOCKS TO COTTAGE. IF DOOR IS CLOSED OR BEARS ARE GREATER THAN ZERO ALTER ENTER-GO3 PROCEED TO HASTY-RETREAT. ENTER-GOLDILOCKS. GO TO KITCHEN-SCENE. KITCHEN-SCENE. IF PORRIDGE IS KING-SIZE, PERFORM TASTE-ROUTINE VARYING PORRIDGE- KING-SIZE BY 1 UNTIL PORRIDGE EQUALS PRINCE-SIZE OTHERWISE COMPUTE IF COTTAGE = CORRECT-COTTAGE GO TO BEDROOM-SCENE. TASTE-ROUTINE. SUBTRACT SIP FROM PORRIDGE(KING-SIZE). SUBTRACT SIP FROM PORRIDGE(QUEEN-SIZE). SUBTRACT SIP FROM PORRIDGE(PRINCE-SIZE) GIVING NO-PORRIDGE. BEDROOM-SCENE. MOVE GOLDILOCKS TO BEDROOM. ADD GOLDILOCKS TO BED(LARGE). DISPLAY "IT IS TOO HARD". SUBTRACT GOLDILOCKS FROM BED(LARGE) GIVING KING-SIZE-BED-SLEPT-IN. MOVE GOLDILOCKS TO BED(MEDIUM). DISPLAY "IT IS TOO SOFT". SUBTRACT GOLDILOCKS FROM BED(MEDIUM) GIVING QUEEN-SIZE-BED-SLEPT-IN. MOVE GOLDILOCKS TO BED(SMALL). DISPLAY "IT IS JUST RIGHT". ADD GOLDILOCKS TO SLUMBERLAND. BEARS-RETURN. MOVE DADDY-BEAR, MUMMY-BEAR, BABY-BEAR TO KITCHEN. MOVE CORRESPONDING BEARS TO PORRIDGE. DISPLAY "DADDY BEAR ", COMMENT1. DISPLAY "MUMMY BEAR ", COMMENT1. DISPLAY "BABY BEAR ", COMMENT1, " AND EATEN IT ALL UP". MOVE BEARS TO BEDROOM. BEARS-IN-BEDROOM. EXAMINE BEDS, REPLACING ALL GOLDILOCKS WITH BEARS. DISPLAY "DADDY BEAR ", COMMENT2. DISPLAY "MUMMY BEAR ", COMMENT2. DISPLAY "BABY BEAR ", COMMENT2, " AND HERE SHE IS". HASTY-RETREAT. IF WINDOW IS OPEN EXIT GOLDILOCKS OTHERWISE MOVE GOLDILOCKS TO DOOR. END-OF-TALE. CLOSE STORY, DISPLAY "WOULD YOU BELIEVE CINDERELLA IN PL/I?". STOP RUN. FAR OUT OP CODES AI ADD IMPROPER ARNZ ADD AND RESET TO NON-ZERO ARZ ADD AND RESET TO ZERO BB BRANCH ON BUG BBRAB BITE BAUDY BIT AND BRANCH BBI BRANCH ON BLINKING INDICATOR BCBF BRANCH ON CHIP BOX FULL BCR BACKSPACE CARD READER BIRM BRANCH ON INDEX REGISTER MISSING BLI BRANCH AND LOOP INDEFINITE BOBOI BRANCH ON BURNED OUT INDICATOR BPO BRANCH ON POWER OFF BSO BRANCH ON SLEEPY OPERATOR BSP BACKSPACE PRINTER BXC BURST SELECTOR CHANNEL BST BACKSPACE AND STRETCH TAPE BYR BYTE AND RUN CCS CHINESE CHARACTER SET CD CREATE DATA CM CIRCULATE MEMORY CMB CREATE MACHINE BUG CRN CONVERT TO ROMAN NUMERALS CVU CONVERT TO UNARY (BASE 1) DD DESTROY DISK DIA DEVELOP INEFFECTIVE ADDRESS DIC DIVIDE AND CONQUER DMPK DESTROY MEMORY PROTECT KEY DO DIVIDE AND OVERFLOW DPK DESTROY STORAGE PROTECT KEY EC EAT CARD ECP ERASE CARD PUNCH EDPMB EXECUTE DP MANAGER AND BRANCH EIOC EXECUTE INVALID OP-CODE EJD EJECT DISK ENH EXECUTE NO-OP AND HANG EO EXECUTE OPERATOR EPI EXECUTE PROGRAMMER IMMEDIATE EROS ERASE READ ONLY STORAGE FCJ FEED CARD AND JAM FSRA FORMS SKIP RUN AWAY GSP GULP AND STORE PUNCH HCF HALT AND CATCH FIRE ** PRIVILEGED OPERATION ** IIB IGNORE INQUIRY AND BRANCH IND ILLOGICAL AND IOR ILLOGICAL OR IRB INVERT RECORD AND BRANCH ISC IGNORE SUPERVISOR CALL LC LOOP CONTINOUSLY LCC LOAD AND CLEAR CORE LMB LOOSE MESSAGE AND BRANCH MC MOVE CONTINOUS MDB MOVE AND DROP BITS MLR MOVE AND LOOSE RECORD MLSB MEMORY LEFT SHIFT AND BRANCH MTI MAKE TAPE INVALID MWC MOVE AND WRAP CORE PADZ PACK ALPHA AND DROP ZONES PAS PRINT AND SMEAR PBC PRINT AND BREAK CHAIN PD PUNCH DISC PI PUNCH INVALID PIRI PRINT IN RED INK PO PUNCH OPERATOR POF PRINT ON FLY PPSW PACK PROGRAM STATUS WORD PS PRINT AND SHEAR RASC READ AND SHRED CARD RBG RANDOM BUG GENERATOR RBT REWIND AND BREAK TAPE RC READ CHAOS RCKG READ COUNT-KEY AND GARBAGE RID READ INVALID DATA RDI REVERSE DRUM IMMEDIATE RIRG READ INTER-RECORD GAP RM REINITIALIZE METER RNR READ NOISE RECORD RP READ PRINTER RPAB READ, PRINT, AND BLUSH RPB REVERSE PARITY AND BRANCH RRRA READ RECORD AND RUN AWAY RT REDUCE THRUPUT RWRT READ AND WRITE WHILE RIPPING TAPE SC SCRAMBLE CHANNELS SCP SCATTER PRINT SIP STORE INDEFINITE PRECISION SLD SLIP DISC SLP SHARPEN LIGHT PENCIL SPSW SCRAMBLE PROGRAM STATUS WORD SRCC SELECT READER AND CHEW CARDS SRSD SEEK RECORD AND SCAR DISK SRZ SUBTRACT AND RESET TO ZERO SSD STACKER SELECT DISK SSJ STACKER SELECT AND JAM SU STACKER UPSET TBD TRANSFER AND DROP BITS TLR TRANSFER AND LOOSE RETURN TPD TRIPLE PACK DECIMAL TSH TRAP SECRETARY AND HALT UCPUB UNCOUPLE CPU AND BRANCH UER UPDATE AND ERASE RECORD UNPD UNPLUG AND DUMP UT UPDATE TRANSACTION WCKG WRITE COUNT-KEY AND GARBAGE WNR WRITE NOISE RECORD WWLR WRITE WRONG-LENGTH RECORD ZAM ZERO ALL MEMORY