Please note, this is a STATIC archive of website www.tutorialspoint.com from 11 May 2019, cach3.com does not collect or store any user information, there is no "phishing" involved.
Tutorialspoint

Compile and Execute COBOL Online

IDENTIFICATION DIVISION.
PROGRAM-ID. INVESTMENT-CAL.
DATA DIVISION.
    WORKING-STORAGE SECTION.
    01  BTD             PIC X(20).
    01  DTB             PIC X(15).
    01  PRT-DTB         PIC X(15).
    01  INPUTS1         PIC X(20).
    01  INPUTS2         PIC X(20).
    01  INPUTS3         PIC X(20).
    01  INTLOOP         PIC 99 VALUE 1.
    01  TBLLOOP         PIC 99 VALUE 1.
    01  INT             PIC 9 OCCURS 10 TIMES.
    01  COUNTER         PIC 99.
    01  MULTIPLIER      PIC 9(6) VALUE 1.
    01  DECIMAL         PIC 9(5).
    01  CTR             PIC 9(20).
    01  COM             PIC 9.
    01  COM-DECIMAL     PIC 9(10).
    01  COM-DECIMAL2     PIC X(10).
    01  PRT-FINAL       PIC 9(10).
    01  PRT-DECIMAL     PIC ZZZZZZZZZ9.
    01  prt-final1       pic x(10).
    01  CNT1            PIC 99.
    01  CNT2            PIC 99.
    01  CTR1            PIC 9(20).
    01  CTR2            PIC 9(5).
    01  ANS             PIC 9.
    01  Q1              PIC 9(15).
    01  R1              PIC 9(02).
    01  R2              PIC 9(02).
    01  R3              PIC X(02).
    01  R4              PIC X(20).
    01  R5              PIC X(20).
    01  RLOOP           PIC 99 VALUE 1.
    01  RTBLLOOP        PIC 99 VALUE 1.
    01  RINT            PIC 9 OCCURS 20 TIMES.
    01  SLOOP           PIC 99 VALUE 1.
    01  STBLLOOP        PIC 99 VALUE 1.
    01  SINT            PIC 9 OCCURS 15 TIMES.
    01  WS              PIC 9(20) OCCURS 20 TIMES.
    01  WS1             PIC 9.
    
PROCEDURE DIVISION.
    DISPLAY "*******************************************************************"
    DISPLAY "**             BINARY TO DECIMAL/DECIMAL TO BINARY               **"
    DISPLAY "**                         CONVERTER                             **"
    DISPLAY "*******************************************************************"
    DISPLAY "**                       SELECT OPTION                           **"
    DISPLAY "**                                                               **"
    DISPLAY "**     1 BINARY TO DECIMAL         2 DECIMAL TO BINARY           **"
    DISPLAY "**                                                               **"
    ACCEPT ANS
    DISPLAY "**     OPTION  :  "ANS"                                              **"
    DISPLAY "**                                                               **"
    
    IF ANS = 1
        PERFORM 1000-BINARY-TO-DECIMAL
        ELSE IF ANS = 2
            PERFORM 2000-DECIMAL-TO-BINARY
        ELSE
        STOP RUN
    END-IF
    .
    1000-BINARY-TO-DECIMAL.
    ACCEPT BTD
    MOVE FUNCTION REVERSE(BTD) TO INPUTS2. 
    INSPECT INPUTS2
        TALLYING CTR1 FOR LEADING SPACES
    MOVE INPUTS2 (CTR1 + 1:) TO INPUTS3
    INSPECT INPUTS3
        TALLYING CNT1 FOR ALL "1"
    INSPECT INPUTS3
        TALLYING CNT2 FOR ALL "0"
    ADD CNT1 TO CNT2
    PERFORM 
        MOVE INPUTS3(INTLOOP:1) TO INT(TBLLOOP)
            COMPUTE MULTIPLIER = MULTIPLIER * 1
            MOVE INT(TBLLOOP) TO COM
            COMPUTE DECIMAL = COM * MULTIPLIER
            ADD DECIMAL TO COM-DECIMAL
            ADD 1 TO COUNTER
            ADD 1 TO INTLOOP
    END-PERFORM
    MOVE 0 TO DECIMAL
    PERFORM UNTIL COUNTER = CNT2
        MOVE INPUTS3(INTLOOP:1) TO INT(TBLLOOP)
            COMPUTE MULTIPLIER = MULTIPLIER * 2
            MOVE INT(TBLLOOP) TO COM
            COMPUTE DECIMAL = COM * MULTIPLIER
            ADD DECIMAL TO COM-DECIMAL
            ADD 1 TO COUNTER
            ADD 1 TO INTLOOP
    END-PERFORM
    MOVE COM-DECIMAL TO PRT-DECIMAL
    MOVE FUNCTION TRIM(prt-decimal LEADING) TO prt-final1
    display prt-final1
    
    DISPLAY "*******************************************************************"
    DISPLAY "**                      BINARY TO DECIMAL                        **"
    DISPLAY "*******************************************************************"
    DISPLAY "**                                                               **"
    DISPLAY "**                         *****************************         **"
    DISPLAY "**         BINARY CODE     *   " BTD              "    *         **"
    DISPLAY "**                         *****************************         **"
    DISPLAY "**                                                               **"
    DISPLAY "**                         ************************              **"
    DISPLAY "**         DECIMAL         *   " PRT-final1 "         *              **"
    DISPLAY "**                         ************************              **"
    DISPLAY "**                                                               **"
    DISPLAY "*******************************************************************"
    STOP RUN
    .
    2000-DECIMAL-TO-BINARY.
    ACCEPT DTB
    MOVE DTB TO Q1 PRT-DTB
    
    PERFORM UNTIL Q1 = 0
        DIVIDE Q1 BY 2 GIVING Q1 REMAINDER R1
        MOVE FUNCTION REVERSE(R1) TO R2 
        MOVE R2(RLOOP:1) TO RINT(RTBLLOOP)
        MOVE RINT(RTBLLOOP) TO R3
        STRING R4 DELIMITED BY " "
            R3 DELIMITED BY " "
            INTO R4
        END-STRING
        MOVE FUNCTION TRIM(FUNCTION REVERSE(R4) LEADING) TO R5
        ADD 1 TO RINT(RTBLLOOP)
    END-PERFORM
    
    DISPLAY "*******************************************************************"
    DISPLAY "**                      DECIMAL TO BINARY                        **"
    DISPLAY "*******************************************************************"
    DISPLAY "**                                                               **"
    DISPLAY "**                         ************************              **"
    DISPLAY "**         DECIMAL         *   " PRT-DTB "    *              **"
    DISPLAY "**                         ************************              **"
    DISPLAY "**                                                               **"
    DISPLAY "**                         *****************************         **"
    DISPLAY "**         BINARY CODE     *   " R5              "    *         **"
    DISPLAY "**                         *****************************         **"
    DISPLAY "**                                                               **"
    DISPLAY "*******************************************************************"
    
    STOP RUN.

Advertisements
Loading...

We use cookies to provide and improve our services. By using our site, you consent to our Cookies Policy.