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, the stack has a size of 512 and there is a maximum of 16 threads.
<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>