Menu

Trouble in ACCEPT “ESC-CODE FROM ESCAPE KEY”. in COBOL

Anonymous
2015-02-15
2015-02-16
  • Anonymous

    Anonymous - 2015-02-15

    Hi I am currently having a problem with COBOL.

    Before I was using Microsoft COBOL Compiler version 2.2 and I have this code that completely worked fine.

    ::cobol
           IDENTIFICATION DIVISION.
           PROGRAM-ID. COCENTRY.
           ENVIRONMENT DIVISION.
           INPUT-OUTPUT SECTION.
           FILE-CONTROL.
               SELECT COC-FILE
                 ASSIGN TO DISK
                 ORGANIZATION IS INDEXED
                 ACCESS MODE IS RANDOM
                 RECORD KEY IS COCNO
                   FILE STATUS IS FILE-STATUS.
           DATA DIVISION.
           FILE SECTION.
           FD  COC-FILE LABEL RECORD IS STANDARD
               VALUE OF FILE-ID IS "COC.DAT".
           01  COC-RECORD.
               03  COCNO            PIC 9(5).
               03  COCDESC          PIC X(40).
           WORKING-STORAGE SECTION.
           01  FILE-STATUS  PIC XX.
           01  ESC-CODE PIC 99 VALUE 0.
               88  ESC-KEY  VALUE 1.
               88  F2       VALUE 3.
               88  F10      VALUE 11.
           01  ERRMSG       PIC X(70) VALUE SPACES.
           01  ERR          PIC 9 VALUE 0.
           SCREEN SECTION.
           01  FORM1.
               03 BLANK SCREEN BACKGROUND-COLOR 1.
               03 LINE 1 COLUMN 1 'COCNO'.
               03 LINE 2 COLUMN 1 'COCDESC'.
               03 LINE 24 COLUMN 1 "Esc=Exit  F2=Save  F10=Cancel".
               03 LINE 25 COLUMN 1 PIC X(70) FROM ERRMSG HIGHLIGHT.
           01  FORM2.
               03 LINE 1 COLUMN 14 PIC 9(5)
                  USING COCNO REVERSE-VIDEO.
               03 LINE 2 COLUMN 14 PIC X(40)
                  USING COCDESC REVERSE-VIDEO.
               03 LINE 24 COLUMN 1 PIC 99
                  USING ESC-CODE.
           PROCEDURE DIVISION.
           MAIN.
               OPEN I-O COC-FILE.
               IF FILE-STATUS NOT = '00'
                   OPEN OUTPUT COC-FILE
                   CLOSE COC-FILE
                   OPEN I-O COC-FILE.
               PERFORM ENTRY1 THRU ENTRYX UNTIL ESC-KEY.
               CLOSE COC-FILE.
               STOP RUN.
           ENTRY1.
               MOVE SPACES TO COC-RECORD.
               MOVE ZEROES TO COCNO.
           ENTRY2.
               DISPLAY FORM1 FORM2.
               ACCEPT FORM2.
               ACCEPT ESC-CODE FROM ESCAPE KEY.
               IF F10
                   MOVE 'Entries canceled...' TO ERRMSG
                   GO ENTRY1
               ELSE IF F2
                   GO ENTRY3
               ELSE IF ESC-KEY
                   GO ENTRYX
               ELSE
                   GO ENTRY2.
           ENTRY3.
               MOVE 0 TO ERR.
               WRITE COC-RECORD INVALID KEY MOVE 1 TO ERR.
               IF ERR = 1
                   MOVE 'Duplicate key not allowed...' TO ERRMSG
                   GO ENTRY2
               ELSE
                   MOVE 'Entries recorded...' TO ERRMSG
                   GO ENTRY1.
           ENTRYX.
               EXIT.
    

    Now I am using OpenCobol IDE 4.3.0 having GNUCobol version 1.1.0 and I am being prompted with this lines of

    syntax error, unexpected "Literal", expecting LEADING or TRAILING
    

    here

    ::cobolfree
     03 LINE 1 COLUMN 1 'COCNO'.
     03 LINE 2 COLUMN 1 'COCDESC'.
     03 LINE 24 COLUMN 1 "Esc=Exit  F2=Save  F10=Cancel".
    

    so I fix them by adding VALUE keyword:

    ::cobolfree
     03 LINE 1 COLUMN 1 VALUE 'COCNO'.
     03 LINE 2 COLUMN 1 VALUE 'COCDESC'.
     03 LINE 24 COLUMN 1 VALUE "Esc=Exit  F2=Save  F10=Cancel".
    

    but as soon as I do this I get a another prompt of

    ::cobolfree
    'ACCEPT .. FROM ESCAPE KEY' not implemented
    

    on this line

    ::cobolfree
    ACCEPT ESC-CODE FROM ESCAPE KEY.
    

    What could be the possible cause of this? and What could be the fix for this?

    Thanks in advance.

     

    Last edit: Simon Sobisch 2015-02-15
  • Simon Sobisch

    Simon Sobisch - 2015-02-15

    Hello Anonymous,

    this one is simple: "not implemented" is thrown when the first part of implementation (parser) is done but a stub. And GC 1.1 doesn't implement 'ACCEPT .. FROM ESCAPE KEY'.

    The fix is to move on to GC 2.0 which implements (together with many other things) 'ACCEPT .. FROM ESCAPE KEY' - thank you for letting me check, will add this missing bit to the Changelog (sadly the big step from OC 1.1 to OC 2.0 (and therefore the step from GC 1.1 to GC 2.0, too) miss many Changelog entries). Seems like current OCIDE has an configuration to use another compiler path, you may want to get a 2.x version, put this to another path, set OCIDE'S configuration accordingly and try again.

    BTW: GC 2.0 still wants "VALUE" added as you did but the program does what it's told to: on "ACCEPT FORM2" the first two bytes of LINE 24 will be overwritten by last value of ESC-CODE.

    Simon

     

    Last edit: Simon Sobisch 2015-02-15
    • Anonymous

      Anonymous - 2015-02-16

      Hi sir Simon, thank you very much for your response, Ill try it and Ill get back to you when its done. thank you again

       
    • Anonymous

      Anonymous - 2015-02-16

      Sir Simon I've downloaded the open-cobol-2.0 but the problem now is when I link it for custom compiler with OCIDE it just says "Cannot find cobc.exe". Im sorry if this is just so simple.

       
      • Simon Sobisch

        Simon Sobisch - 2015-02-16

        Where did you downloaded it from? Please try to open the cobc.exe you point OCIDE to directly, if it get's "xyz is missing" then install xyz (would be VisualStudio 2012 runtime if you use the gnu-cobol-2.0 nightly from the download area - which would itself a cl.exe (Microsoft's C compiler)).

        Simon

         
        • Anonymous

          Anonymous - 2015-02-16

          Hi Simon, I've now managed to link the OCIDE to GNU Cobol v2 but I got another error message,

          Configuration Error
          default.conf:34: Unknown configuration tag 'default-organization'
          default.conf:55: Unknown configuration tag 'auto-initialize'
          default.conf: No definition of 'standard-define'
          default.conf: No definition of 'cobol85-reserved'
          default.conf: No definition of 'hostsign'
          default.conf: No definition of 'accept-update'
          default.conf: No definition of 'accept-auto'
          default.conf: No definition of 'section-segments'
          default.conf: No definition of 'alter-statement'
          cobc: Error: Invalid option -std=default
          

          what should I do? :(

           
          • Simon Sobisch

            Simon Sobisch - 2015-02-16

            cobc points to a different configuration directory than you've placed it.

            Run cobc --info to see the current directories it's looking at (below GNU Cobol information). You may change them by setting the appropriate environment vars (for example COB_CONFIG_DIR=D:\PlacedGnuCOBOLhere\config). The fastest way is likely to start OCIDE using a batch which has the appropriate SET COB_xyz=abc entries in).

            Simon

             

Anonymous
Anonymous

Add attachments
Cancel





Want the latest updates on software, tech news, and AI?
Get latest updates about software, tech news, and AI from SourceForge directly in your inbox once a month.