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

From Rosetta Code
Content added Content deleted
(Added COBOL interpreter.)
 
(Re-factored interpreter, removing subprogram and replacing with a REDEFINES.)
Line 3:
<lang cobol> IDENTIFICATION DIVISION.
PROGRAM-ID. Brainfuck-Interpreter.
 
DATA DIVISION.
LOCAL-STORAGE SECTION.
 
01 Nesting-Level PIC 999.
 
01 Array-Area.
03 Array-Table USAGE BINARY-CHAR OCCURS 30000 TIMES INDEXED BY Table-Index.
INDEXED05 BY Array-Table USAGE BINARY-IndexCHAR.
05 USING InputArray-Table-Char REDEFINES Array-Table (Table-Index)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 UNSIGNEDBINARY-INTLONG 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 FUNCTIONArray-Table-Char CHAR(FUNCTION SUM(Table-Index)
Array-Table (Table-Index), 1))
WITH NO ADVANCING
 
WHEN ","
ACCEPT InputArray-Table-Char (Table-Index)
* *> See below.
CALL "Ascii-Char-To-Num"
▲ USING Input-Char Array-Table (Table-Index)
 
WHEN "["
IF Array-Table (Table-Index) = ZERO
PERFORM Jump-To-Block-End
END-IF
 
WHEN "]"
IF Array-Table (Table-Index) NOT = ZERO
Line 67 ⟶ 63:
END-EVALUATE
.
 
* *>> Move Program-Index back to position of matching '['
Jump-To-Block-Start.
Line 78 ⟶ 74:
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.
Line 94 ⟶ 90:
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 squresquare brackets. Aborting..."
GOBACK
END-IF
.</lang>
 
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>

Revision as of 16:47, 2 July 2013

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

Works with: OpenCOBOL

<lang cobol> 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
          .</lang>
Retrieved from "https://rosettacode.org/wiki/Execute_Brain****/COBOL?oldid=232578"