Quine Program In Cobol

See QuineProgram.


        IDENTIFICATION DIVISION.                                         

        PROGRAM-ID. QUINE.                                              

        AUTHOR. DAVE BURT.                                              

        DATE-WRITTEN. 18-09-2002.                                       

        ENVIRONMENT DIVISION.                                            

        DATA DIVISION.                                                   

        WORKING-STORAGE SECTION.

WS.
1. WS-DATA.
  1. PIC X(40) VALUE " 09 PIC X(40) VALUE ".
  2. PIC X(40) VALUE ". ".
  3. PIC X(40) VALUE "IDENTIFICATION DIVISION. ".
  4. PIC X(40) VALUE " PROGRAM-ID. QUINE. ".
  5. PIC X(40) VALUE " AUTHOR. DAVE BURT. ".
  6. PIC X(40) VALUE " DATE-WRITTEN. 18-09-2002. ".
  7. PIC X(40) VALUE "ENVIRONMENT DIVISION. ".
  8. PIC X(40) VALUE "DATA DIVISION. ".
  9. PIC X(40) VALUE " WORKING-STORAGE SECTION. ".
  10. PIC X(40) VALUE " 01 WS. ".
  11. PIC X(40) VALUE " 05 WS-DATA. ".
  12. PIC X(40) VALUE " 05 WS-ARR PIC X(40) ".
  13. PIC X(40) VALUE " OCCURS 4 REDEFINES WS-DATA. ".
  14. PIC X(40) VALUE " 05 WS-INTS USAGE IS COMPUTATIONAL. ".
  15. PIC X(40) VALUE " 09 WS-NDX PIC 9(4) VALUE ZERO. ".
  16. PIC X(40) VALUE " 09 WS-START PIC 9(4) VALUE 3. ".
  17. PIC X(40) VALUE " 09 WS-SPLIT PIC 9(4) VALUE 12. ".
  18. PIC X(40) VALUE " 09 WS-CNT PIC 9(4) VALUE 51. ".
  19. PIC X(40) VALUE " 01 WS-OUT-REC. ".
  20. PIC X(40) VALUE " 05 FILLER PIC X(7) VALUE SPACES. ".
  21. PIC X(40) VALUE " 05 WS-OUT-AREA. ".
  22. PIC X(40) VALUE " 09 WS-OUT-PFX PIC X(22). ".
  23. PIC X(40) VALUE " 09 WS-OUT-Q1 PIC X. ".
  24. PIC X(40) VALUE " 09 WS-OUT-STR PIC x(40). ".
  25. PIC X(40) VALUE " 09 WS-OUT-Q2 PIC X. ".
  26. PIC X(40) VALUE " 09 WS-OUT-SFX PIC X. ".
  27. PIC X(40) VALUE "PROCEDURE DIVISION. ".
  28. PIC X(40) VALUE " 000-MAIN. ".
  29. PIC X(40) VALUE " PERFORM VARYING WS-NDX ".
  30. PIC X(40) VALUE " FROM WS-START BY 1 ".
  31. PIC X(40) VALUE " UNTIL WS-NDX >= WS-SPLIT ".
  32. PIC X(40) VALUE " MOVE WS-ARR(WS-NDX) TO WS-OUT-AREA ".
  33. PIC X(40) VALUE " DISPLAY WS-OUT-REC ".
  34. PIC X(40) VALUE " END-PERFORM ".
  35. PIC X(40) VALUE " MOVE WS-ARR(1) TO WS-OUT-PFX ".
  36. PIC X(40) VALUE " MOVE QUOTE TO WS-OUT-Q1 ".
  37. PIC X(40) VALUE " MOVE QUOTE TO WS-OUT-Q2 ".
  38. PIC X(40) VALUE " MOVE WS-ARR(2) TO WS-OUT-SFX ".
  39. PIC X(40) VALUE " PERFORM VARYING WS-NDX ".
  40. PIC X(40) VALUE " FROM 1 BY 1 ".
  41. PIC X(40) VALUE " UNTIL WS-NDX > WS-CNT ".
  42. PIC X(40) VALUE " MOVE WS-ARR(WS-NDX) TO WS-OUT-STR ".
  43. PIC X(40) VALUE " DISPLAY WS-OUT-REC ".
  44. PIC X(40) VALUE " END-PERFORM ".
  45. PIC X(40) VALUE " PERFORM VARYING WS-NDX ".
  46. PIC X(40) VALUE " FROM WS-SPLIT BY 1 ".
  47. PIC X(40) VALUE " UNTIL WS-NDX > WS-CNT ".
  48. PIC X(40) VALUE " MOVE WS-ARR(WS-NDX) TO WS-OUT-AREA ".
  49. PIC X(40) VALUE " DISPLAY WS-OUT-REC ".
  50. PIC X(40) VALUE " END-PERFORM ".
  51. PIC X(40) VALUE " STOP RUN. ".
2. WS-ARR PIC X(40)


        OCCURS 4 REDEFINES WS-DATA.

WS-INTS USAGE IS COMPUTATIONAL.
1. WS-NDX PIC 9(4) VALUE ZERO.
2. WS-START PIC 9(4) VALUE 3.
3. WS-SPLIT PIC 9(4) VALUE 12.
4. WS-CNT PIC 9(4) VALUE 51.
  1. WS-OUT-REC.
FILLER PIC X(7) VALUE SPACES.
WS-OUT-AREA.
1. WS-OUT-PFX PIC X(22).
2. WS-OUT-Q1 PIC X.
3. WS-OUT-STR PIC x(40).
4. WS-OUT-Q2 PIC X.
5. WS-OUT-SFX PIC X.


        PROCEDURE DIVISION.

-MAIN.


        PERFORM VARYING WS-NDX                                       

        FROM WS-START BY 1                                   

        UNTIL WS-NDX >= WS-SPLIT                             

        MOVE WS-ARR(WS-NDX) TO WS-OUT-AREA                          

        DISPLAY WS-OUT-REC                                          

        END-PERFORM                                                  

        MOVE WS-ARR(1) TO WS-OUT-PFX                                 

        MOVE QUOTE TO WS-OUT-Q1                                      

        MOVE QUOTE TO WS-OUT-Q2                                      

        MOVE WS-ARR(2) TO WS-OUT-SFX                                 

        PERFORM VARYING WS-NDX                                       

        FROM 1 BY 1                                          

        UNTIL WS-NDX > WS-CNT                                

        MOVE WS-ARR(WS-NDX) TO WS-OUT-STR                           

        DISPLAY WS-OUT-REC                                          

        END-PERFORM                                                  

        PERFORM VARYING WS-NDX                                       

        FROM WS-SPLIT BY 1                                   

        UNTIL WS-NDX > WS-CNT                                

        MOVE WS-ARR(WS-NDX) TO WS-OUT-AREA                          

        DISPLAY WS-OUT-REC                                          

        END-PERFORM                                                  

        STOP RUN.

-- dave@burt.id.au

Excuse: I was very bored, and saw on some QuineInManyLanguages Web site that such a thing was missing. If I recall correctly, this is version two. CobolLanguage presents an interesting challenge in writing such things in a number of ways, not least of which is the line length limit. Also there is a shorter version by Tom Dawes-Gamble (a real COBOL programmer) at http://www.tmdg.co.uk/programing/quine.cbl.php