RCSNUSP/COBOL

This an SNUSP interpreter written in COBOL. It supports Modular SNUSP but not yet Bloated SNUSP.

The file path to the code is passed as a parameter to the program. The file is assumed to be a text file with lines having a maximum length of 100 characters. It is also assumed the file will not be more than 1024 lines long.

The memory is a 2048 byte array and the stack has a size of 512.

Works with: GNU Cobol version 2.0

<lang cobol> >>SOURCE FREE IDENTIFICATION DIVISION. PROGRAM-ID. snusp-interpreter.

ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL.

   SELECT code-file ASSIGN code-file-path
       ORGANIZATION LINE SEQUENTIAL
       FILE STATUS code-file-status.

DATA DIVISION. FILE SECTION. FD code-file. 01 code-record PIC X(100).

WORKING-STORAGE SECTION. 01 code-file-path PIC X(100). 01 code-file-status PIC 99.

   88  end-of-code-file                VALUE 10.

01 num-lines PIC 9(4) COMP. 01 code-area.

   03  code-lines                      OCCURS 1 TO 1024 TIMES
                                       DEPENDING ON num-lines
                                       INDEXED BY line-idx.
       05  code-chars                  PIC X OCCURS 100 TIMES
                                       INDEXED BY char-idx.

01 program-state-flag PIC X VALUE SPACE.

   88  program-ok                      VALUE SPACE.
   88  empty-stack                     VALUE "E".
   88  out-of-code-space               VALUE "O".

01 array-area.

   03  array                           OCCURS 2048 TIMES
                                       INDEXED BY table-idx.
       05  array-table                 USAGE BINARY-CHAR.
       05  array-table-char            REDEFINES array-table PIC X.

01 call-stack-area.

   03  calls                           OCCURS 512 TIMES INDEXED BY stack-idx.
       05  direction                   PIC X.
           88  up-dir                  VALUE "U".
           88  down-dir                VALUE "D".
           88  left-dir                VALUE "L".
           88  right-dir               VALUE "R".
       05  ip-line                     USAGE INDEX.
       05  ip-char                     USAGE INDEX.

01 input-char PIC X.

PROCEDURE DIVISION. DECLARATIVES. code-file-error SECTION.

   USE AFTER ERROR ON code-file.
   
   DISPLAY "An error occurred while using " code-file-path
   DISPLAY "Error code " code-file-status
   DISPLAY "Error triggered at " FUNCTION TRIM(FUNCTION EXCEPTION-LOCATION)
       " by " FUNCTION EXCEPTION-STATEMENT "."
   DISPLAY "The program will terminate."

   GOBACK
   .

END DECLARATIVES.

000-main SECTION.

   ACCEPT code-file-path FROM COMMAND-LINE

   *> Store contents of file into memory.
   OPEN INPUT code-file
   PERFORM VARYING line-idx FROM 1 BY 1 UNTIL end-of-code-file
       ADD 1 TO num-lines
       READ code-file INTO code-lines (line-idx)
           AT END
               SUBTRACT 1 FROM num-lines
               EXIT PERFORM
       END-READ
   END-PERFORM

   CLOSE code-file
   
   *> Search for any initial charcters.
   PERFORM VARYING ip-line (1) FROM 1 BY 1 UNTIL ip-line (1) > num-lines
           AFTER ip-char (1) FROM 1 BY 1 UNTIL ip-char (1) > 100
       IF code-chars (ip-line (1), ip-char (1)) = "$"
           EXIT PERFORM
       END-IF
   END-PERFORM
   *> Set position to first char if no initial characters were found.
   IF ip-line (1) > num-lines
       SET line-idx, char-idx TO 1
   END-IF
   
   *> Interpret the code while the instruction pointer remains in code space.
   SET right-dir (1) TO TRUE
   SET stack-idx TO 1
   PERFORM UNTIL NOT program-ok
       PERFORM 100-move-instruction-ptr
       IF out-of-code-space
           EXIT PERFORM
       END-IF
       
       EVALUATE code-chars (ip-line (stack-idx), ip-char (stack-idx))
           *> Core SNUSP
           WHEN ">"
               SET table-idx UP BY 1

           WHEN "<"
               SET table-idx DOWN BY 1

           WHEN "+"
               ADD 1 TO array-table (table-idx)

           WHEN "-"
               SUBTRACT 1 FROM array-table (table-idx)

           WHEN "."
               DISPLAY array-table-char (table-idx)

           WHEN ","
               ACCEPT array-table-char (table-idx)

           WHEN X"5C" *> Backslash mucks up syntax highlighting
               EVALUATE TRUE
                   WHEN up-dir (stack-idx)
                       SET left-dir (stack-idx) TO TRUE
                   WHEN down-dir (stack-idx)
                       SET right-dir (stack-idx) TO TRUE
                   WHEN left-dir (stack-idx)
                       SET up-dir (stack-idx) TO TRUE
                   WHEN right-dir (stack-idx)
                       SET down-dir (stack-idx) TO TRUE
               END-EVALUATE

           WHEN "/"
               EVALUATE TRUE
                   WHEN up-dir (stack-idx)
                       SET right-dir (stack-idx) TO TRUE
                   WHEN down-dir (stack-idx)
                       SET left-dir (stack-idx) TO TRUE
                   WHEN left-dir (stack-idx)
                       SET down-dir (stack-idx) TO TRUE
                   WHEN right-dir (stack-idx)
                       SET up-dir (stack-idx) TO TRUE
               END-EVALUATE
           
           WHEN "!"
               PERFORM 100-move-instruction-ptr
           
           WHEN "?"
               IF array-table (table-idx) = 0
                   PERFORM 100-move-instruction-ptr
               END-IF

           *> Modular SNUSP
           WHEN "@"
               *> Push current direction and IP location onto call stack
               MOVE calls (stack-idx) TO calls (stack-idx + 1)
               SET stack-idx UP BY 1
               
           WHEN "#"
               IF stack-idx <> 1
                   *> Pop direction and IP location off call stack and advance
                   *> the IP one step.
                   SET stack-idx DOWN BY 1
                   PERFORM 100-move-instruction-ptr
               ELSE
                   SET empty-stack TO TRUE
               END-IF

           *> Bloated SNUSP
               
           WHEN OTHER
               CONTINUE
       END-EVALUATE    
   END-PERFORM

   GOBACK
   .

100-move-instruction-ptr SECTION.

   EVALUATE TRUE
       WHEN up-dir (stack-idx)
           SET ip-line (stack-idx) DOWN BY 1
       WHEN down-dir (stack-idx)
           SET ip-line (stack-idx) UP BY 1
       WHEN left-dir (stack-idx)
           SET ip-char (stack-idx) DOWN BY 1
       WHEN right-dir (stack-idx)
           SET ip-char (stack-idx) UP BY 1
   END-EVALUATE
   .

END PROGRAM snusp-interpreter.</lang>