RCSNUSP/COBOL

This an SNUSP interpreter written in COBOL. It supports Modular and 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 num-args PIC 9 COMP. 01 arg-num PIC 9 COMP. 01 arg PIC X(100).

01 Flag-Indicator CONSTANT "-". 01 Help-Flag-Char CONSTANT "h". 01 Read-Num-Flag-Char CONSTANT "r". 01 Write-Num-Flag-Char CONSTANT "w". 01 program-flag PIC X.

   88  help-flag                       VALUE Help-Flag-Char.
   88  read-num-flag                   VALUE Read-Num-Flag-Char.
   88  write-num-flag                  VALUE Write-Num-Flag-Char.
   

01 read-flag PIC X.

   88 read-numbers                     VALUE "N".
   

01 write-flag PIC X.

   88  write-numbers                   VALUE "N".
   

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.

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 memory-area.

   03  memory-rows                     OCCURS 1024 TIMES.
       05  memory-cols                 OCCURS 1024 TIMES.
           07  memory-cell             USAGE BINARY-CHAR.
           07  memory-cell-char        REDEFINES memory-cell PIC X.

01 num-threads PIC 99 COMP VALUE 1. 01 threads-data-area.

   03  threads-data                    OCCURS 1 TO 16 TIMES
                                       DEPENDING ON num-threads
                                       INDEXED BY thread-idx.
       05  thread-status-flag          PIC X VALUE SPACE.
           88  thread-started          VALUE "Y".
       05  call-stack.
           07  calls                   OCCURS 512 TIMES
                                       INDEXED BY stack-idx.
               09  direction           PIC X.
                   88  up-dir          VALUE "U".
                   88  down-dir        VALUE "D".
                   88  left-dir        VALUE "L".
                   88  right-dir       VALUE "R".
               09  ip-line             USAGE INDEX.
               09  ip-char             USAGE INDEX.
       05  memory-pointer.
           07  row-idx                 USAGE INDEX.
           07  col-idx                 USAGE INDEX.

01 input-char PIC X.

01 current-thread-idx USAGE INDEX.

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

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

   GOBACK
   .

END DECLARATIVES.

000-main SECTION.

   ACCEPT num-args FROM ARGUMENT-NUMBER
   IF num-args = 0
       PERFORM 300-display-help
       GOBACK
   END-IF

   PERFORM VARYING arg-num FROM 1 BY 1 UNTIL arg-num > num-args
       DISPLAY arg-num UPON ARGUMENT-NUMBER
       ACCEPT arg FROM ARGUMENT-VALUE
       EVALUATE TRUE
           WHEN arg (1:1) = Flag-Indicator
               MOVE arg (2:1) TO program-flag
               EVALUATE TRUE
                   WHEN help-flag
                       PERFORM 300-display-help
                       GOBACK
                   WHEN read-num-flag
                       SET read-numbers TO TRUE
                   WHEN write-num-flag
                       SET write-numbers TO TRUE
                   WHEN OTHER
                       DISPLAY "Flag '" FUNCTION TRIM(arg) "' not recongnized."
               END-EVALUATE
               
           WHEN code-file-path <> SPACES
               DISPLAY "Argument " arg-num " ignored - only one source code "
                   "file can be interpreted."
                   
           WHEN OTHER
               MOVE arg TO code-file-path
       END-EVALUATE
   END-PERFORM

   IF code-file-path = SPACES
       DISPLAY "No file path specified."
       GOBACK
   END-IF
   
   *> 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, 1) FROM 1 BY 1 UNTIL ip-line (1, 1) > num-lines
           AFTER ip-char (1, 1) FROM 1 BY 1 UNTIL ip-char (1, 1) > 100
       IF code-chars (ip-line (1, 1), ip-char (1, 1)) = "$"
           EXIT PERFORM
       END-IF
   END-PERFORM
   *> Set position to first char if no initial characters were found.
   IF ip-line (1, 1) > num-lines
       SET ip-line (1, 1), ip-char (1, 1) TO 1
   END-IF
   
   *> Interpret the code while there are threads left.
   SET right-dir (1, 1) TO TRUE
   SET stack-idx, thread-idx, row-idx (1), col-idx (1) TO 1
   PERFORM UNTIL num-threads = 0
       PERFORM VARYING thread-idx FROM 1 BY 1 UNTIL thread-idx > num-threads
           PERFORM 100-move-instruction-ptr
           IF out-of-code-space
               PERFORM 200-stop-thread
           END-IF
           
           EVALUATE code-chars (ip-line (thread-idx, stack-idx),
                   ip-char (thread-idx, stack-idx))
               *> Core SNUSP
               WHEN "<" *> LEFT
                   SET col-idx (thread-idx) DOWN BY 1

               WHEN ">" *> RIGHT
                   SET col-idx (thread-idx) UP BY 1

               WHEN "+" *> INCR
                   ADD 1 TO
                      memory-cell (row-idx (thread-idx), col-idx (thread-idx))

               WHEN "-" *> DECR
                   SUBTRACT 1 FROM
                       memory-cell (row-idx (thread-idx), col-idx (thread-idx))

               WHEN "." *> WRITE
                   IF NOT write-numbers
                       DISPLAY memory-cell-char (row-idx (thread-idx),
                           col-idx (thread-idx))
                   ELSE
                       DISPLAY memory-cell (row-idx (thread-idx),
                           col-idx (thread-idx))
                   END-IF

               WHEN "," *> READ
                   IF NOT read-numbers
                       ACCEPT memory-cell-char (row-idx (thread-idx),
                           col-idx (thread-idx))
                   ELSE
                       ACCEPT memory-cell (row-idx (thread-idx),
                           col-idx (thread-idx))
                   END-IF

               *> LURD (/ is not used as it is mucks up syntax highlighting.)
               WHEN X"5C"
                   EVALUATE TRUE
                       WHEN up-dir (thread-idx, stack-idx)
                           SET left-dir (thread-idx, stack-idx) TO TRUE
                       WHEN down-dir (thread-idx, stack-idx)
                           SET right-dir (thread-idx, stack-idx) TO TRUE
                       WHEN left-dir (thread-idx, stack-idx)
                           SET up-dir (thread-idx, stack-idx) TO TRUE
                       WHEN right-dir (thread-idx, stack-idx)
                           SET down-dir (thread-idx, stack-idx) TO TRUE
                   END-EVALUATE

               WHEN "/" *> RULD
                   EVALUATE TRUE
                       WHEN up-dir (thread-idx, stack-idx)
                           SET right-dir (thread-idx, stack-idx) TO TRUE
                       WHEN down-dir (thread-idx, stack-idx)
                           SET left-dir (thread-idx, stack-idx) TO TRUE
                       WHEN left-dir (thread-idx, stack-idx)
                           SET down-dir (thread-idx, stack-idx) TO TRUE
                       WHEN right-dir (thread-idx, stack-idx)
                           SET up-dir (thread-idx, stack-idx) TO TRUE
                   END-EVALUATE

               WHEN "!" *> SKIP
                   PERFORM 100-move-instruction-ptr

               WHEN "?" *> SKIPZ
                   IF memory-cell (row-idx (thread-idx), col-idx (thread-idx))
                           = 0
                       PERFORM 100-move-instruction-ptr
                   END-IF

               *> Modular SNUSP
               WHEN "@" *> ENTER
                   *> Push current direction and IP location onto call stack
                   MOVE calls (thread-idx, stack-idx)
                       TO calls (thread-idx, stack-idx + 1)
                   SET stack-idx UP BY 1

               WHEN "#" *> LEAVE
                   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
                       PERFORM 200-stop-thread
                   END-IF

               *> Bloated SNUSP
               WHEN ":" *> UP
                   SET row-idx (thread-idx) UP BY 1

               WHEN ";" *> DOWN
                   SET row-idx (thread-idx) DOWN BY 1

               WHEN "&" *> SPLIT
                   *> Create a new thread
                   ADD 1 TO num-threads
                   MOVE call-stack (thread-idx) TO call-stack (num-threads)
                   MOVE memory-pointer (thread-idx) TO call-stack (num-threads)
                   SET thread-started (thread-idx) TO TRUE

               WHEN "%" *> RAND
                   COMPUTE memory-cell (row-idx (thread-idx),
                           col-idx (thread-idx)) =
                       FUNCTION MOD(FUNCTION RANDOM,
                           memory-cell (row-idx (thread-idx),
                               col-idx (thread-idx)) + 1)
               WHEN OTHER
                   CONTINUE
           END-EVALUATE
           
           IF out-of-code-space
               PERFORM 200-stop-thread
           END-IF
       END-PERFORM
   END-PERFORM
   .

099-terminate.

   GOBACK
   .

100-move-instruction-ptr SECTION.

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

199-exit.

   EXIT
   .

200-stop-thread SECTION.

   *> Shift data from following threads over stopped thread.
   SET current-thread-idx TO thread-idx
   PERFORM VARYING thread-idx FROM thread-idx BY 1
           UNTIL NOT thread-started (thread-idx + 1)
               OR thread-idx = num-threads
       MOVE threads-data (thread-idx + 1) TO threads-data (thread-idx)
   END-PERFORM
   
   SUBTRACT 1 FROM num-threads
   SET thread-idx TO current-thread-idx
   .

299-exit.

   EXIT
   .

300-display-help SECTION.

    DISPLAY "This is a interpreter for SNUSP written in COBOL."
    DISPLAY "The file path to the source code should be specified as a "
        "command-line argument."
    DISPLAY "This program supports the following flags as arguments:"
    DISPLAY X"09" Flag-Indicator Help-Flag-Char ": Displays this help message."
    DISPLAY X"09" Flag-Indicator Write-Num-Flag-Char ": Display memory "
        "contents as numbers."
    DISPLAY X"09" Flag-Indicator Read-Num-Flag-Char ": Reads a byte to memory "
        "as a number."
    .

399-exit.

   EXIT
   .

END PROGRAM snusp-interpreter.</lang>