Execute Brain****/COBOL: Difference between revisions

From Rosetta Code
Content added Content deleted
(Added COBOL interpreter.)
 
m (Fixed syntax highlighting.)
 
(One intermediate revision by one other user not shown)
Line 1: Line 1:
This is a simple [[Brainf***]] interpreter written in [[COBOL]], which receives its program from standard input.
This is a simple [[Brainf***]] interpreter written in [[COBOL]], which receives its program from standard input.
{{works with|OpenCOBOL}}
{{works with|OpenCOBOL}}
<lang cobol> IDENTIFICATION DIVISION.
<syntaxhighlight lang="cobol"> IDENTIFICATION DIVISION.
PROGRAM-ID. Brainfuck-Interpreter.
PROGRAM-ID. Brainfuck-Interpreter.

DATA DIVISION.
DATA DIVISION.
LOCAL-STORAGE SECTION.
LOCAL-STORAGE SECTION.

01 Nesting-Level PIC 999.
01 Nesting-Level PIC 999.

01 Array.
01 Array-Area.
03 Array-Table USAGE BINARY-CHAR OCCURS 30000 TIMES
03 Array OCCURS 30000 TIMES INDEXED BY Table-Index.
INDEXED BY Table-Index.
05 Array-Table USAGE BINARY-CHAR.
⚫
05 Array-Table-Char REDEFINES Array-Table PIC X.

01 Input-Char PIC X.
01 Input-Char PIC X.

* *>> Note: This limit is mostly arbitrary.
* *>> Note: This limit is mostly arbitrary.
01 Max-Program-Size CONSTANT 2048.
01 Max-Program-Size CONSTANT 2048.
01 Input-Program PIC X(Max-Program-Size).
01 Input-Program PIC X(Max-Program-Size).
01 Program-Index USAGE UNSIGNED-INT.
01 Program-Index USAGE BINARY-LONG UNSIGNED.

PROCEDURE DIVISION.
PROCEDURE DIVISION.
Main.
Main.
DISPLAY "Enter program: " WITH NO ADVANCING
DISPLAY "Enter program: " WITH NO ADVANCING
ACCEPT Input-Program
ACCEPT Input-Program

PERFORM Process-Statement VARYING Program-Index FROM 1 BY 1
PERFORM Process-Statement VARYING Program-Index FROM 1 BY 1
UNTIL Max-Program-Size < Program-Index
UNTIL Max-Program-Size < Program-Index

GOBACK
GOBACK
.
.

Process-Statement.
Process-Statement.
EVALUATE Input-Program (Program-Index:1)
EVALUATE Input-Program (Program-Index:1)
WHEN ">"
WHEN ">"
SET Table-Index UP BY 1
SET Table-Index UP BY 1

WHEN "<"
WHEN "<"
SET Table-Index DOWN BY 1
SET Table-Index DOWN BY 1

WHEN "+"
WHEN "+"
ADD 1 TO Array-Table (Table-Index)
ADD 1 TO Array-Table (Table-Index)

WHEN "-"
WHEN "-"
SUBTRACT 1 FROM Array-Table (Table-Index)
SUBTRACT 1 FROM Array-Table (Table-Index)

WHEN "."
WHEN "."
DISPLAY FUNCTION CHAR(FUNCTION SUM(
DISPLAY Array-Table-Char (Table-Index)
Array-Table (Table-Index), 1))
WITH NO ADVANCING

WHEN ","
WHEN ","
ACCEPT Input-Char
ACCEPT Array-Table-Char (Table-Index)
* *> See below.
CALL "Ascii-Char-To-Num"
⚫
USING Input-Char Array-Table (Table-Index)

WHEN "["
WHEN "["
IF Array-Table (Table-Index) = ZERO
IF Array-Table (Table-Index) = ZERO
PERFORM Jump-To-Block-End
PERFORM Jump-To-Block-End
END-IF
END-IF

WHEN "]"
WHEN "]"
IF Array-Table (Table-Index) NOT = ZERO
IF Array-Table (Table-Index) NOT = ZERO
Line 67: Line 63:
END-EVALUATE
END-EVALUATE
.
.

* *>> Move Program-Index back to position of matching '['
* *>> Move Program-Index back to position of matching '['
Jump-To-Block-Start.
Jump-To-Block-Start.
Line 78: Line 74:
WHEN "["
WHEN "["
SUBTRACT 1 FROM Nesting-Level
SUBTRACT 1 FROM Nesting-Level

WHEN "]"
WHEN "]"
ADD 1 TO Nesting-Level
ADD 1 TO Nesting-Level
END-EVALUATE
END-EVALUATE
END-PERFORM
END-PERFORM

PERFORM Check-Mismatched-Brackets
PERFORM Check-Mismatched-Brackets
.
.

* *>> Move Program-Index forward to position of matching ']'
* *>> Move Program-Index forward to position of matching ']'
Jump-To-Block-End.
Jump-To-Block-End.
Line 94: Line 90:
AND (Nesting-Level = 0))
AND (Nesting-Level = 0))
OR (Input-Program (Program-Index:1) = SPACE)
OR (Input-Program (Program-Index:1) = SPACE)

EVALUATE Input-Program (Program-Index:1)
EVALUATE Input-Program (Program-Index:1)
WHEN "["
WHEN "["
ADD 1 TO Nesting-Level
ADD 1 TO Nesting-Level

WHEN "]"
WHEN "]"
SUBTRACT 1 FROM Nesting-Level
SUBTRACT 1 FROM Nesting-Level
END-EVALUATE
END-EVALUATE
END-PERFORM
END-PERFORM

PERFORM Check-Mismatched-Brackets
PERFORM Check-Mismatched-Brackets
.
.

Check-Mismatched-Brackets.
Check-Mismatched-Brackets.
IF (Program-Index = 0)
IF (Program-Index = 0)
OR (Input-Program (Program-Index:1) = SPACE)
OR (Input-Program (Program-Index:1) = SPACE)
DISPLAY "Mismatched squre brackets. Aborting..."
DISPLAY "Mismatched square brackets. Aborting..."
GOBACK
GOBACK
END-IF
END-IF
.
.</syntaxhighlight>

END PROGRAM Brainfuck-Interpreter.</lang>
When accepting input from the user, the character entered must be converted by the function below because moving it straight into a numeric data item would cause the character to be parsed as a number, causing non-numeric characters to be converted to zero.
<lang cobol> IDENTIFICATION DIVISION.
PROGRAM-ID. Ascii-Char-To-Num.

DATA DIVISION.
WORKING-STORAGE SECTION.
01 Ascii PIC X(128) VALUE X"0102030405060708090A0B0C0D0E0F"
& X"101112131415161718191A1B1C1D1E1F" & " !" & QUOTE
& "#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ["
& "\]^_`abcdefghijklmnopqrstuvwxyz{|}~" & X"7F".

LOCAL-STORAGE SECTION.
01 I PIC 999.

LINKAGE SECTION.
01 Input-Char PIC X.
01 Ascii-Num USAGE BINARY-CHAR.

*>> Converts an ASCII character to its corresponding numerical value,
*>> placing the result in Ascii-Num.
PROCEDURE DIVISION USING Input-Char Ascii-Num.
IF Input-Char = X"00"
MOVE ZERO TO Ascii-Num
GOBACK
END-IF

PERFORM VARYING I FROM 1 BY 1 UNTIL 128 < I
IF Ascii (I:1) = Input-Char
MOVE I TO Ascii-Num
GOBACK
END-IF
END-PERFORM

DISPLAY "The character could not be matched."
MOVE -1 TO Ascii-Num
GOBACK
.

END PROGRAM Ascii-Char-To-Num.</lang>

Latest revision as of 11:09, 1 September 2022

This is a simple Brainf*** interpreter written in COBOL, which receives its program from standard input.

Works with: OpenCOBOL
       IDENTIFICATION DIVISION.
       PROGRAM-ID. Brainfuck-Interpreter.
 
       DATA DIVISION.
       LOCAL-STORAGE SECTION.
 
       01  Nesting-Level   PIC 999.
 
       01  Array-Area.
           03  Array OCCURS 30000 TIMES INDEXED BY Table-Index.
               05  Array-Table USAGE BINARY-CHAR.
               05  Array-Table-Char REDEFINES Array-Table PIC X.
 
       01  Input-Char       PIC X.
 
*     *>> Note: This limit is mostly arbitrary.
       01  Max-Program-Size CONSTANT 2048.
       01  Input-Program    PIC X(Max-Program-Size).
       01  Program-Index    USAGE BINARY-LONG UNSIGNED.
 
       PROCEDURE DIVISION.
       Main.
           DISPLAY "Enter program: " WITH NO ADVANCING
           ACCEPT Input-Program
 
           PERFORM Process-Statement VARYING Program-Index FROM 1 BY 1
                   UNTIL Max-Program-Size < Program-Index
 
           GOBACK
           .
 
       Process-Statement.
           EVALUATE Input-Program (Program-Index:1)
               WHEN ">"
                   SET Table-Index UP BY 1
 
               WHEN "<"
                   SET Table-Index DOWN BY 1
 
               WHEN "+"
                   ADD 1 TO Array-Table (Table-Index)
 
               WHEN "-"
                   SUBTRACT 1 FROM Array-Table (Table-Index)
 
               WHEN "."
                   DISPLAY Array-Table-Char (Table-Index)
 
               WHEN ","
                   ACCEPT Array-Table-Char (Table-Index)
 
                WHEN "["
                    IF Array-Table (Table-Index) = ZERO
                        PERFORM Jump-To-Block-End
                    END-IF
 
                WHEN "]"
                    IF Array-Table (Table-Index) NOT = ZERO
                        PERFORM Jump-To-Block-Start
                    END-IF
           END-EVALUATE
           .
 
*     *>> Move Program-Index back to position of matching '['
       Jump-To-Block-Start.
           SUBTRACT 1 FROM Program-Index
           PERFORM VARYING Program-Index FROM Program-Index BY -1
                   UNTIL ((Input-Program (Program-Index:1) = "[")
                       AND (Nesting-Level = 0))
                   OR (Program-Index = 0)
               EVALUATE Input-Program (Program-Index:1)
                   WHEN "["
                       SUBTRACT 1 FROM Nesting-Level
 
                   WHEN "]"
                       ADD 1 TO Nesting-Level
               END-EVALUATE
           END-PERFORM
 
           PERFORM Check-Mismatched-Brackets
           .
 
*     *>> Move Program-Index forward to position of matching ']'
       Jump-To-Block-End.
           ADD 1 TO Program-Index
           PERFORM VARYING Program-Index FROM Program-Index BY 1
                   UNTIL ((Input-Program (Program-Index:1) = "]")
                       AND (Nesting-Level = 0))
                   OR (Input-Program (Program-Index:1) = SPACE)
 
               EVALUATE Input-Program (Program-Index:1)
                   WHEN "["
                       ADD 1 TO Nesting-Level
 
                   WHEN "]"
                       SUBTRACT 1 FROM Nesting-Level
               END-EVALUATE
           END-PERFORM
 
           PERFORM Check-Mismatched-Brackets
           .
 
       Check-Mismatched-Brackets.
           IF (Program-Index = 0)
                   OR (Input-Program (Program-Index:1) = SPACE)
               DISPLAY "Mismatched square brackets. Aborting..."
               GOBACK
           END-IF
           .
Retrieved from "https://rosettacode.org/wiki/Execute_Brain****/COBOL?oldid=329428"