Brainfuck Interpreter

[Aureal]

Well, I've written an interpreter for brainfuck, why? why not? But I've ran into a bug that I can't solve.
I don't understand the reason, but even though I included a line that wraps the data pointer to the upper bound of the data array, the program keeps subtracting 1 to it, this is crucial for loops to work. Here's the code

Code: QB64: [Select]

1. $console
2. _console on
3. dim shared prog(&hffff&) as string
4. dim shared ostream       as _unsigned _byte
5. dim shared arr(&hffff&)  as _unsigned _byte
6. dim shared istream       as _unsigned _byte
7. dim shared ptr           as integer
8.  
9. do
10.     sleep
11.     do
12.         select case inkey$
13.             case ">"     : s$ = s$ + ">": cnt = cnt + 1: prog(cnt) = ">": exit do
14.             case "<"     : s$ = s$ + "<": cnt = cnt + 1: prog(cnt) = "<": exit do
15.             case "+"     : s$ = s$ + "+": cnt = cnt + 1: prog(cnt) = "+": exit do
16.             case "-"     : s$ = s$ + "-": cnt = cnt + 1: prog(cnt) = "-": exit do
17.             case "."     : s$ = s$ + ".": cnt = cnt + 1: prog(cnt) = ".": exit do
18.             case ","     : s$ = s$ + ",": cnt = cnt + 1: prog(cnt) = ",": exit do
19.             case "["     : s$ = s$ + "[": cnt = cnt + 1: prog(cnt) = "[": exit do
20.             case "]"     : s$ = s$ + "]": cnt = cnt + 1: prog(cnt) = "]": exit do
21.             case chr$(8) : if len(s$) then s$ = left$(s$, len(s$) - 1)  : exit do
22.             case chr$(13): exec
23.             case "v"     : for i = 1 to len(_clipboard$): prog(i + cnt) = chr$(asc(_clipboard$, i)): next: s$ = s$ + _clipboard$: exit do
24.             case else    :
25.         end select
26.     loop
27.     print s$;
28.     _display:cls
29.     _keyclear
30. loop
31.  
32. sub exec
33.     for i = 0 to ubound(prog)
34.         select case prog(i)
35.             case ">": ptr = ptr + 1
36.             case "<": if ptr then ptr = ptr - 1 else ptr = ubound(arr) 'What the heck?
37.             case "+": arr(ptr) = arr(ptr) + 1
38.             case "-": arr(ptr) = arr(ptr) - 1
39.             case ".": ostream  = arr(ptr)
40.             case ",": arr(ptr) = istream
41.             case "[":
42.                 if arr(ptr) = 0 then
43.                     for y = i to ubound(prog)
44.                         if prog(x) = "]" then i = x + 1: exit for
45.                     next
46.                 end if
47.             case "]":
48.                 if arr(ptr) then
49.                     for x = i to 0 step -1
50.                         if prog(x) = "[" then i = x: exit for
51.                     next
52.                 end if
53.         end select
54.         updateOutput
55.         updateConsole(i)
56.     next
57. end sub
58.  
59. sub updateOutput     : print chr$(ostream): _display: cls: end sub
60. sub updateInput      : istream = asc(inkey$)             : end sub
61. sub updateConsole(i) : cout "dataptr           =" + str$(ptr)
62.     cout "data    (current) ="  + str$(arr(ptr))
63.     cout "program (current) = " + prog(i)
64.     cout "---------------------"
65. end sub
66. sub cout(s$)      : _dest _console: print s$: _dest 0 : end sub
67.  

And here's the test program (paste with v, execute with [enter]):

Code: QB64: [Select]

1. ++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.
2.  

[SkyCharger001]

make ptr an unsigned integer and underflow/overflow will cause a wrap-around instead of a crash. (you won't need to handle them manually)

[Petr]

Hello. I think it's going to be 13-20 code lines. The minimum value for cnt is 1 to fix this, you must first assign the field value and then increase the cnt index.

[bplus]

This is 2nd time I've seen talk of this, this month, so I checked out Rosetta Code and did a double translation.

Code: QB64: [Select]

1. 'BF translation.bas for QB64 fork (B+=MGA) 2017-07-23
2. ' BF in QB.bas for SmallBASIC 0.12.9 (B+=MGA) 2017-07-22
3. ' I just translated some QB code from Rosetta to SmallBASIC
4. ' and tested a couple of programs Hello World, Goodbye World
5. ' count down also found at Rosetta Code
6. '======================================================================
7. ' QB64 has excellent Help wiki, thanks to all who put that together!
8. '======================================================================
9. _TITLE "Brainf***, Rosetta Code - Quick Basic translation to SB then to QB64 (fork)"
10. 'for directory stuff
11. CONST ListMAX% = 20
12. COMMON SHARED dirList$()
13. COMMON SHARED DIRCount% 'returns file count if desired
14.  
15. memsize% = 20000
16. DIM memory%(memsize%)
17. instChars$ = "+-<>.,[]" 'valid characters
18. loadDirList "bf*.txt"
19.  
20. WHILE 1
21.     ptr% = 0 'memory pointer
22.     source$ = ""
23.     CLS
24.     IF DIRCount% THEN
25.         FOR i% = 1 TO DIRCount%
26.             PRINT i%, dirList$(i%)
27.         NEXT
28.     ELSE
29.         PRINT "Sorry, no bf*.txt files found."
30.         SLEEP
31.         END
32.     END IF
33.     PRINT: INPUT "Enter line number of BF Filename you desire "; ln%
34.     IF ln% < 1 OR ln% > DIRCount% THEN END
35.     filename$ = dirList$(ln%)
36.  
37.     OPEN filename$ FOR INPUT AS #1
38.     DO
39.         LINE INPUT #1, FLINE$
40.         source$ = source$ + FLINE$
41.     LOOP UNTIL EOF(1)
42.     CLOSE #1
43.  
44.     IF LEN(source$) < 1 THEN
45.         PRINT "No source code to BF."
46.         SLEEP
47.         END
48.     END IF
49.  
50.     'let's clean the code up, check bracket balance
51.     bktCnt% = 0
52.     code$ = ""
53.     FOR i% = 1 TO LEN(source$)
54.         char$ = MID$(source$, i%, 1)
55.         'check to see if this is a valid instruction character
56.         IF INSTR(instChars$, char$) THEN
57.             code$ = code$ + char$
58.             'count brackets
59.             IF char$ = "[" THEN bktCnt% = bktCnt% + 1
60.             IF char$ = "]" THEN bktCnt% = bktCnt% - 1
61.         END IF
62.     NEXT
63.  
64.     IF bktCnt% THEN 'mismatched brackets
65.         PRINT "Uneven brackets"
66.         SLEEP
67.         END
68.     ELSE
69.         PRINT "Code:": PRINT code$: PRINT: PRINT "Output:"
70.     END IF
71.     'clear last if any
72.     ERASE memory%
73.     DIM memory%(memsize%)
74.     inLine$ = "" 'input buffer
75.     FOR i% = 1 TO LEN(code$) 'loop through the code
76.         instruction$ = MID$(code$, i%, 1) 'get the instruction we're on
77.         SELECT CASE instruction$
78.             CASE "+"
79.                 memory%(ptr%) = memory%(ptr%) + 1
80.             CASE "-"
81.                 memory%(ptr%) = memory%(ptr%) - 1
82.             CASE "."
83.                 PRINT CHR$(memory%(ptr%));
84.             CASE ","
85.                 IF inLine$ = "" THEN LINE INPUT inLine$ 'buffer input
86.                 inChar$ = LEFT$(inLine$, 1) 'take the first char off the buffer
87.                 inLine$ = MID$(inLine$, 2) 'delete it from the buffer
88.                 memory%(ptr%) = ASC(inChar$) 'use it
89.             CASE ">"
90.                 ptr% = ptr% + 1
91.                 IF ptr% > memsize% THEN
92.                     PRINT "Memory pointer out of range"
93.                     SLEEP
94.                     END
95.                 END IF
96.             CASE "<"
97.                 ptr% = ptr% - 1
98.                 IF ptr% < 0 THEN
99.                     PRINT "Memory pointer out of range"
100.                     SLEEP
101.                     END
102.                 END IF
103.             CASE "["
104.                 IF memory%(ptr%) = 0 THEN
105.                     bktCnt% = 1 'count the bracket we're on
106.                     i% = i% + 1 'move the code pointer to the next char
107.                     WHILE bktCnt% <> 0
108.                         'count nested loops till we find the matching one
109.                         IF MID$(code$, i%, 1) = "]" THEN bktCnt% = bktCnt% - 1
110.                         IF MID$(code$, i%, 1) = "[" THEN bktCnt% = bktCnt% + 1
111.                         i% = i% + 1 'search forward
112.                     WEND
113.                 END IF
114.             CASE "]"
115.                 IF memory%(ptr%) <> 0 THEN
116.                     bktCnt% = -1 'count the bracket we're on
117.                     i% = i% - 1 'move the code pointer back a char
118.                     WHILE bktCnt% <> 0
119.                         'count nested loops till we fine the matching one
120.                         IF MID$(code$, i%, 1) = "]" THEN bktCnt% = bktCnt% - 1
121.                         IF MID$(code$, i%, 1) = "[" THEN bktCnt% = bktCnt% + 1
122.                         i% = i% - 1 'search backwards
123.                     WEND
124.                 END IF
125.         END SELECT
126.     NEXT
127.     PRINT: PRINT: INPUT "Press y for yes to do another "; yes$
128.     IF yes$ <> "y" THEN END
129. WEND
130.  
131. ' modified function from Help files
132. SUB loadDirList (spec$)
133. CONST TmpFile$ = "DIR$INF0.INF"
134. STATIC Ready%, Index%
135. IF NOT Ready% THEN REDIM dirList$(ListMAX%): Ready% = -1 'DIM array first use
136. IF spec$ > "" THEN 'get file names when a spec is given
137.     SHELL _HIDE "DIR " + spec$ + " /b > " + TmpFile$
138.     Index% = 0: dirList$(Index%) = "": ff% = FREEFILE
139.     OPEN TmpFile$ FOR APPEND AS #ff%
140.     size& = LOF(ff%)
141.     CLOSE #ff%
142.     IF size& = 0 THEN KILL TmpFile$: EXIT SUB
143.     OPEN TmpFile$ FOR INPUT AS #ff%
144.     DO WHILE NOT EOF(ff%) AND Index% < ListMAX%
145.         Index% = Index% + 1
146.         LINE INPUT #ff%, dirList$(Index%)
147.     LOOP
148.     DIRCount% = Index% 'SHARED variable can return the file count
149.     CLOSE #ff%
150.     KILL TmpFile$
151. ELSE IF Index% > 0 THEN Index% = Index% - 1 'no spec sends next file name
152. END IF
153. END SUB
154.  

I think the interpreter is probably easier to write than a program. Very interesting subject!

Included in zip are some short programs to get a directory listing in files list.

[STxAxTIC]

Thanks for keeping us posted bplus. I was going to respond over at the "other" forum but didn't because... reasons... namely all of my posts need to be approved first. Still waiting for a few posts (from days ago) to make it past the admin over there. No telling what a PG-13 site would do with a title like BrainFuck. Ya know, the same place that throws me ads for mail-in Thai brides. Very child-friendly as a concept.

[bplus]

Thanks for keeping us posted bplus. I was going to respond over at the "other" forum but didn't because... reasons... namely all of my posts need to be approved first. Still waiting for a few posts (from days ago) to make it past the admin over there. No telling what a PG-13 site would do with a title like BrainFuck. Ya know, the same place that throws me ads for mail-in Thai brides. Very child-friendly as a concept.

"The Lords work in mysterious ways." - (This is definitely NOT from the Bible)

Since translating this crazy little interpreter, I am very curious now how one might go about making up a program that does anything like print "Hello World!". I did offer it up as a challenge at two other forums, because I have only the tiniest clue from reading Wiki on subject. I would like to pursue this further. An IDE? Modifications to plug-in "subroutines"?

I hope Aureal is also intrigued and that I haven't hi-jacked his thread.

[Aureal]

Hi, bplus, actually, I might do something else with this, I do have some experience on writing many tools for weird things : D (please note my "suite" for the Chip8, including a disassembler, emulator, and assembler!)

[bplus]

After reading more, I too have another idea to go at this sort of thing.

[eoredson]

If you are serious about writing your own interpreter, you should look at the attached file:

Erik.

[bplus]

If you are serious about writing your own interpreter, you should look at the attached file:

Erik.

Thanks Erik, I will check this out!

You might like this:
http://www.thejoyfulprogrammer.com/qb64/forum/showthread.php?tid=814&rndtime=1500917497749477912


To All,

I am pursuing this topic mainly in a PL called SmallBASIC (one word BASIC in all CAPs) an Interpreter only , NOT MS Small Basic (2 words last word not all caps).

Here (SmallBASIC Forum):
https://smallbasic.sourceforge.io/?q=node/1743

Here (Retrogamecoding.org in board where any Basic is welcome):
http://retrogamecoding.org/board/index.php?topic=592.0

Here (The QB64 Edition, a sub forum of [banned user]):
http://www.thejoyfulprogrammer.com/qb64/forum/showthread.php?tid=948&rndtime=1500919068149440136

I will pursue here too but first I want to see what Aureal is up to!  :)

[bplus]

Hi Erik,

It's epic! Awesome!

But I only skimmed as I have another little one in the works. 2nd mod since BF, BQ (Be Quicker) 1st mod, EIN (Everything Is Number) 2nd mod (Smaller than my Nano?). BF taught me stuff! but I've tossed the ptr and incrementors of memory locations :)

I noticed mention of DOS, does it work in Windows? dumb question?

Also if it does work in Windows, do I need QB64? ;)

A cool thing I caught, I think, was assembler or machine code capable? or did i misread in skim.

Can QB64 do that?

[STxAxTIC]

Bump. Status on this?

[bplus]

Bump. Status on this?

Hmm... Aureal, no sign of him in long time, you have Erik's SICK in Library and my QB64 version of Nano is either at Walter's or [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there] (if not here somewhere else). I did rework Nano with another parser but still stuck on very limited String manipulation and no arrays... QB64 is way more interesting!

[STxAxTIC]

Oh wait NANO!

That was a fun period though. Want to dust it off?

[bplus]

Oh wait NANO!

That was a fun period though. Want to dust it off?

:) Yeah sure, like we haven't stirred up enough stuff already. Are you on vacation or something?