Execute Brain****: Difference between revisions
m
→{{header|Binary Lambda Calculus}}
| (105 intermediate revisions by 48 users not shown) | |||
Line 27:
|}
Any cell size is allowed, EOF (<u>E</u>nd-<u>O</u>-<u>F</u>ile) support is optional, as is whether you have bounded or unbounded memory.
<br><br>
=={{header|11l}}==
<syntaxhighlight lang="11l">F bf(source)
V tape = DefaultDict[Int, Int]()
V cell = 0
V ptr = 0
L ptr < source.len
S source[ptr]
‘>’
cell++
‘<’
cell--
‘+’
tape[cell]++
‘-’
tape[cell]--
‘.’
:stdout.write(Char(code' tape[cell]))
‘,’
tape[cell] = :stdin.read(1).code
‘[’
I tape[cell] == 0
V nesting_level = 0
L
S source[ptr]
‘[’
nesting_level++
‘]’
I --nesting_level == 0
L.break
ptr++
‘]’
I tape[cell] != 0
V nesting_level = 0
L
S source[ptr]
‘[’
I --nesting_level == 0
L.break
‘]’
nesting_level++
ptr--
ptr++
bf(‘++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.’)</syntaxhighlight>
=={{header|68000 Assembly}}==
Takes a Brainfuck program as a command line parameter. Escape character (escape key!) is handled as a 0 when inputting characters. Does NOT support break, so programs that don't end by themselves will run forever.
<
; Brainfuck interpreter by Thorham
;
Line 362 ⟶ 407:
ds.b 1024*64
tapeEnd
</syntaxhighlight>
=={{header|8080 Assembly}}==
In order to allow Brain**** programs to run at a somewhat acceptable speed on 8080-based
computers, this program compiles the input to 8080 machine code, which it appends to itself.
Contractions and clear loops are optimized. It expects to run under CP/M.
<syntaxhighlight lang="8080asm"> ;;; CP/M Brainfuck compiler/interpreter, with a few optimizations
getch: equ 1 ; Read character from console
putch: equ 2 ; Print character to console
puts: equ 9 ; Print string to console
fopen: equ 15 ; Open file
fread: equ 20 ; Read from file
dmaoff: equ 26 ; Set DMA address
fcb: equ 5Ch ; FCB for first command line argument
EOFCH: equ -1 ; Value stored on the tape on EOF
org 100h
jmp start
;;; Print the character on the tape, saving HL (tape location),
;;; and including CR/LF translation.
bfout: push h ; Keep tape location
mov a,m ; What are we printing?
cpi 10 ; Newline?
jnz outch ; If not, just print the character.
mvi e,13 ; Otherwise, print a carriage return first.
mvi c,putch
call 5
pop h ; Then get the tape back
push h
outch: mov e,m ; Print the character in A.
mvi c,putch
call 5
pop h ; Restore tape location.
ret
;;; Read a character and store it on the tape, including CR/LF
;;; translation; ^Z is EOF.
bfin: push h ; Keep tape location
lda bfeoff ; Have we seen EOF yet?
ana a
jnz bfeof ; If so, return EOF.
mvi c,getch ; Otherwise, read character
call 5
cpi 26 ; Was it EOF?
jz bfeof ; Then handle EOF.
cpi 13 ; Was it CR? (Pressing 'Enter' only gives CR.)
jnz bfin_s ; If not, just store the character.
mvi c,putch ; Otherwise, output a LF (only CR is echoed as well)
mvi e,10
call 5
mvi a,10 ; And then store a LF instead of the CR.
bfin_s: pop h ; Restore tape location
mov m,a ; Store the character
ret
bfeof: sta bfeoff ; Set the EOF flag (A is nonzero here)
pop h ; Restore tape location
mvi m,EOFCH ; Store EOF return value.
ret
bfeoff: db 0 ; EOF flag, EOF seen if nonzero.
;;; Print mismatched brackets error
brkerr: lxi d,ebrk
;;; Print error message under DE and quit
err: mvi c,puts ; Print string
call 5
rst 0 ; Then quit
;;; Error messages.
efile: db 'Cannot read file.$'
ebrk: db 'Mismatched brackets.$'
;;; BF characters
bfchr: db '+-<>,.[]',26
;;; Main program
start: lhld 6 ; Set stack pointer to highest available address
sphl
mvi c,fopen ; Try to open the file given on the command line
lxi d,fcb
call 5
inr a ; A=FF on error,
lxi d,efile ; so if we couldn't open the file, say so, and stop
jz err
;;; Read file into memory in its entirety
lxi d,pgm ; Start of input
block: mvi c,dmaoff
push d ; Keep current address on stack
call 5 ; Set DMA to location of current block
mvi c,fread ; Read 128-byte block to that address
lxi d,fcb
call 5
dcr a ; A=1 = end of file
jz fdone
inr a ; Otherwise, A<>0 = error
lxi d,efile
jnz err
pop h ; Retrieve DMA address
lxi d,128 ; Add 128 (advance to next block)
dad d
xchg ; Put in DE
jmp block ; Go get next block.
fdone: pop h ; When done, find next address
mvi m,26 ; Write EOF, so file always ends with EOF.
;;; Filter out all the non-BF characters
lxi h,pgm ; Output pointer
push h ; On stack
lxi b,pgm ; Input pointer
filter: ldax b ; Get current character
inx b ; Look at next char next time
lxi h,bfchr ; Test against 9 brainfuck characters (8 + EOF)
mvi e,9
filchk: cmp m ; Is it a match?
jz filfnd ; Then we found it
inx h
dcr e
jnz filchk
jmp filter ; Otherwise, try next character
filfnd: pop h ; Get pointer from stack
mov m,a ; Store current character
inx h ; Move pointer
push h ; Store pointer back on stack
cpi 26 ; Reached the end?
jnz filter ; If not, keep going.
;;; Move the program as high up into memory as possible.
lxi h,-1024 ; Keep 1K stack space (allowing 512 levels of nested
dad sp ; loops)
pop d ; Source pointer in DE (destination in HL)
move: ldax d ; Copy backwards
dcx d
mov m,a
dcx h
ana a ; Until zero is reached
jnz move
inx h ; Move pointer to byte after zero
inx h
;;; Compile the Brainfuck code into 8080 machine code
lxi b,0 ; Push zero on stack (as boundary marker)
push b
lxi d,pgm ; DE = start of binary area (HL at start of source)
compil: mov a,m ; Get source byte
cpi '+' ; Plus or minus - change the tape value
jz tapval
cpi '-'
jz tapval
cpi '<' ; Left or right - move the tape
jz tapmov
cpi '>'
jz tapmov
cpi '.' ; Input and output
jz chout
cpi ','
jz chin
cpi '[' ; Start of loop
jz loops
cpi ']' ; End of loop
jz loope
cpi 26 ; EOF?
jz cdone
inx h ; Anything else is ignored
jmp compil
;;; Write code for '+' or '-' (change cell value)
tapval: mvi c,0 ; C = change in value necessary
tapv_s: mov a,m ; Get current byte
cpi '+' ; If plus,
jz tapinc ; Then we need to increment
cpi '-' ; If minus,
jz tapdec ; Then we need to decrement
;;; The effect of the last instructions should be to
;;; change the cell at the tape head by C.
;;; If -3 <= B <= 3, INR M/DCR M are most efficient.
;;; Otherwise, MVI A,NN / ADD M / MOV M,A is most efficient.
mov a,c
ana a ; Zero?
jz compil ; Then we do nothing.
cpi 4 ; Larger than 3?
jc tapinr ; If not, 'INR M' * C
cpi -3 ; Smaller than -3?
jnc tapdcr ; Then, 'DCR M' * -C
xchg ; Otherwise, use an ADD instruction
mvi m,3Eh ; 'MVI A,'
inx h
mov m,c ; C (all math is mod 256)
inx h
mvi m,86h ; 'ADD M'
inx h
mvi m,77h ; 'MOV M,A'
inx h
xchg
jmp compil
tapinc: inr c ; '+' means one more
inx h ; Check next byte
jmp tapv_s
tapdec: dcr c ; '-' means one less
inx h ; Check next byte
jmp tapv_s
tapinr: mvi a,34h ; INR M (increment cell)
jmp wrbyte
tapdcr: mvi a,35h ; DCR M (decrement cell)
jmp wrnegc
;;; Write code for '<' or '>' (move tape head)
tapmov: lxi b,0 ; BC = change in value necessary
tapm_s: mov a,m ; Get current byte
cpi '>' ; If right,
jz taprgt ; Then we need to move the tape right
cpi '<' ; If left,
jz taplft ; Then we need to move the tape left
;;; Move the tape by BC.
;;; If -4 <= BC <= 4, INX H/DCX H are most efficient.
;;; Otherwise, LXI B,NNNN / DAD B is most efficient.
mov a,b ; Is the displacement zero?
ora c
jz compil ; Then do nothing
mov a,b ; Otherwise, is the high byte 0?
ana a
jnz tbchi ; If not, it might be FF, but
mov a,c ; if so, is low byte <= 4?
cpi 5
jc tapinx ; Then we need to write 'INX H' C times
xra a ; Otherwise, do it the long way
tbchi: inr a ; Is the high byte FF?
jnz tapwbc ; If not, we'll have to do it the long way
mov a,c ; But if so, is low byte >= -4?
cpi -4
jnc tapdcx ; Then we can write 'DCX H' -C times
tapwbc: xchg ; Otherwise, use a DAD instruction
mvi m,1h ; 'LXI B,'
inx h
mov m,c ; Low byte
inx h
mov m,b ; High byte
inx h
mvi m,9h ; 'DAD B'
inx h
xchg
jmp compil
taprgt: inx b ; '>' is one to the right
inx h ; Check next byte
jmp tapm_s
taplft: dcx b ; '<' is one to the left
inx h ; Check next byte
jmp tapm_s
tapinx: mvi a,23h ; INX H (move tape right)
jmp wrbyte
tapdcx: mvi a,2Bh ; DCX H (move tape left)
jmp wrnegc
;;; Write the byte in A, -C times, to [DE++]
wrnegc: mov b,a ; Keep A
mov a,c ; Negate C
cma
inr a
mov c,a
mov a,b
;;; Write the byte in A, C times, to [DE++]
wrbyte: stax d
inx d
dcr c
jnz wrbyte
jmp compil
;;; Write code to print the current tape value
chout: inx h ; We know the cmd is '.', so skip it
lxi b,bfout ; Call the output routine
jmp wrcall
;;; Write code to read a character and store it on the tape
chin: inx h ; We know the cmd is ',', so skip it
lxi b,bfin
;;; Write code to CALL the routine with address BC
wrcall: xchg
mvi m,0CDh ; CALL
inx h
mov m,c ; Low byte
inx h
mov m,b ; High byte
inx h
xchg
jmp compil
;;; Write code to start a loop
loops: inx h ; We know the first cmd is '['
mov b,h ; Check for '-]'
mov c,l
ldax b
cpi '-'
jnz loopsw ; If not '-', it's a real loop
inx b
ldax b
cpi ']'
jz lzero ; If ']', we just need to set the cell to 0
;;; Code for loop: MOV A,M / ANA A / JZ cmd-past-loop
loopsw: xchg ; Destination pointer in HL
mvi m,7Eh ; MOV A,M
inx h
mvi m,0A7h ; ANA A
inx h
mvi m,0CAh ; JZ
inx h
inx h ; Advance past where the destination will go
inx h ; (End of loop will fill it in)
push h ; Store the address to jump back to on the stack
xchg
jmp compil
;;; Code to set a cell to zero in one go: MVI M,0
lzero: inx h ; Move past '-]'
inx h
xchg ; Destination pointer in HL
mvi m,36h ; MVI M,
inx h
mvi m,0 ; 0
inx h
xchg
jmp compil
;;; Write code to end a loop: MOV A,M / ANA A / JNZ loop-start
loope: inx h ; We know the first cmd is ']'
xchg ; Destination pointer in HL
mvi m,7Eh ; MOV A,M
inx h
mvi m,0A7h ; ANA A
inx h
mvi m,0C2h ; JNZ
inx h
pop b ; Get loop-start from the stack
mov a,b ; If it is 0, we've hit the sentinel, which means
ora c ; mismatched brackets
jz brkerr
mov m,c ; Store loop-start, low byte first,
inx h
mov m,b ; then high byte.
inx h
dcx b ; The two bytes before loop-start must be filled in
mov a,h ; with the address of the cmd past the loop, high
stax b ; byte last,
dcx b
mov a,l ; then low byte
stax b
xchg
jmp compil
;;; Done: finish the code with a RST 0 to end the program
cdone: xchg
mvi m,0C7h
pop b ; If the brackets are all matched, there should be
mov a,b ; a zero on the stack.
ora c
jnz brkerr
;;; Initialize the tape. The fastest way to fill up memory on the
;;; 8080 is to push values to the stack, so we will fill it up
;;; with zeroes, and position the tape there.
;;; HL contains the top of the program.
lxi d,32 ; The Brainfuck program doesn't use the stack, so
dad d ; reserving 16 levels for CP/M is more than enough.
mov a,l ; Complement the value (almost negation, but low bit
cma ; doesn't really matter here)
mov l,a
mov a,h
cma
mov h,a
dad sp ; Add the current stack pointer, giving bytes to fill
ana a ; Zero carry
mov a,h ; Divide value by two (we push words)
rar
mov h,a
mov a,l
rar
mov l,a
lxi d,0
ztape: push d ; Zero out the tape (on the stack)
dcx h
mov a,h
ora l
jnz ztape
dad sp ; HL is now 0, add SP to get tape bottom
;;; The compiled program is stored after this point, so we just
;;; fall through into it.
nop ; No-op (sentinel value)
pgm: equ $ ; Compiled BF program stored here.</syntaxhighlight>
{{out}}
<pre>A>type hello.bf
++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.
A>brainfk hello.bf
Hello World!
A></pre>
=={{header|8086 Assembly}}==
{{trans|8080 Assembly}}
Like the 8080 version, this program compiles its BF input to 8086 machine code, and then jumps to it.
Contractions and clear loops are optimized, and the 8086's memory segmentation is used to provide a
circular 64k-cell tape with 8-bit cells.
<syntaxhighlight lang="asm"> ;;; MS-DOS Brainf*** interpreter/compiler
cpu 8086
putch: equ 2h ; Print character
puts: equ 9h ; Print string
open: equ 3Dh ; Open file
read: equ 3Fh ; Read from file
exit: equ 4Ch ; Exit to DOS
flags: equ 33h ; Set break flags
CMDLEN: equ 80h ; Address of length of command line argument
CMDARG: equ 81h ; Address of text of command line argument
BRK: equ 1 ; Break flag
EOFCH: equ -1 ; Written to the tape on EOF
section .text
org 100h
;;; See if there is enough memory
mov sp,stack.top ; Move stack inward to free up memory
mov ax,cs ; Get allocated memory size from DOS
dec ax ; (It is at location 3 in the MCB, which
mov es,ax ; is located one paragraph above CS.)
mov ax,[es:3]
mov bx,sp ; The amount of memory the program itself
mov cl,4 ; needs is from CS:0 up to CS:SP in bytes,
shr bx,cl ; shifted right by 4 to give paragraphs;
inc bx ; making sure to round up.
mov bp,cs ; The paragraph right after this is used
add bp,bx ; as the segment base for BF's memory.
sub ax,bx ; Free mem = allocated mem - program mem
cmp ax,128*1024/16 ; We'll require at least 128k bytes
jae mem_ok ; (for two separate code and data segments)
mov dx,err.mem ; If we don't have enough,
jmp error ; give an error message.
;;; Stop on Ctrl+C
mem_ok: mov ax,flags<<8|BRK
mov dl,1
int 21h
;;; See if a command line argument was given
mov bl,[CMDLEN] ; Get length of argument
test bl,bl ; See if it's zero
jnz arg_ok
mov dx,err.usage ; Print usage string if no argument given
jmp error
arg_ok: xor bh,bh
mov [CMDARG+bx],bh ; Terminate the argument string with a zero
mov ax,open<<8 ; Try to open the file for reading
mov dx,CMDARG+1 ; Skip first item (always 1)
int 21h
jnc fileok
mov dx,err.file ; Print file error if it fails
jmp error
fileok: mov di,ax ; Keep file handle in DI
xor si,si ; Keep pointer in SI
mov ds,bp ; Start reading into the memory past our stack
block: mov ah,read ; Read from file
mov bx,di
mov cx,0FFFEh
mov dx,si ; To the place just beyond the last read
int 21h
jnc .rdok
mov dx,err.file ; Read error
jmp error
.rdok: test ax,ax ; If zero bytes read, we're done
jz .done
add si,ax ; Move pointer past read
jnc block ; If there's still room, do another read
mov dx,err.mem ; If we overshot, then give memory error
jmp error
.done: mov [si],byte 0 ; Zero-terminate the data
;;; Filter out all non-BF characters
push ds ; Set ES to DS
pop es
xor si,si ; Source and destination pointer to beginning
xor di,di
filter: lodsb ; Get byte from source
xor bx,bx ; See if byte is BF command
.test: cmp al,[cs:bx+bfchar] ; Test against current character
je .match ; If a match, we found it
inc bx ; If not, try next possible command
cmp bx,8
jbe .test
jmp filter ; If we didn't find it, ignore this character
.match: stosb ; We found it, keep it
test al,al ; If zero, we found the end,
jnz filter ; Otherwise, do next character
;;; Compile the BF source into 8086 machine code
add bp,65536/16 ; Set ES to point to the start of the second
mov es,bp ; 64k (4k paragraphs) that we allocated earlier
xor di,di ; Start at address zero,
push di ; Store a zero on the stack as boundary marker,
mov ax,stop ; At 0000, store a far pointer to the
stosw ; cleanup routine,
mov ax,cs
stosw
mov ax,bfout ; At 0004, store a far pointer to the
stosw ; output routine,
mov ax,cs
stosw
mov ax,bfin ; At 0008, store a far pointer to the
stosw ; input routine,
mov ax,cs
stosw ; Compiled BF code starts at 000C.
xor si,si ; Start at beginning of BF source code
compil: lodsb ; Get current command
.ch: cmp di,-16 ; See if we still have 16 bytes free
jb .fch ; (Loop is 11 bytes, +5 for INT 21h/4Ch at end)
mov dx,err.mem ; If not, we're out of memory
jmp error
.fch: cmp al,'+' ; + and - change the value of the current cell
je tapval
cmp al,'-'
je tapval
cmp al,'>' ; < and > move the tape
je tapmov
cmp al,'<'
je tapmov
cmp al,',' ; I/O
jne .tsout ; Conditional jumps are limited to 128-byte
jmp chin ; displacement
.tsout: cmp al,'.'
jne .tsls
jmp chout
.tsls: cmp al,'[' ; Loops
jne .tsle
jmp loops
.tsle: cmp al,']'
jne .tsend
jmp loope
.tsend: test al,al ; Reached zero?
jnz compil ; If not, next command
jmp cdone ; If so, we're done
;;; Compile a string of +s and -s into an 8086 instruction
tapval: xor cl,cl ; Count up contiguous +s and -s modulo 256
.ch: cmp al,'+'
je .inc
cmp al,'-'
je .dec
test cl,cl ; If zero,
jz compil.ch ; it's a no-op.
mov bl,al ; Otherwise, keep next character
cmp cl,-1 ; If -1, decrement cell
mov ax,0FFEh ; DEC BYTE [BX]
je .wword
cmp cl,1 ; If 1, increment cell
mov ax,07FEh ; INC BYTE [BX]
je .wword
mov ax,0780h ; ADD BYTE [BX],
stosw
mov al,cl ; change to cell
stosb
mov al,bl ; Move next character back into AL
jmp compil.ch ; Compile next command
.inc: inc cl ; Increment cell
lodsb
jmp .ch
.dec: dec cl ; Decrement cell
lodsb
jmp .ch
.wword: stosw ; Write instruction word
mov al,bl ; Move next character back into AL
jmp compil.ch ; Compile next command
;;; Compile a string of <s and >s into an 8086 instruction
tapmov: xor cx,cx ; Count up contiguous <s and >s modulo 65536
.ch: cmp al,'>'
je .right
cmp al,'<'
je .left
test cx,cx ; Is there any net movement at all?
jnz .move ; If so, generate a move instruction
jmp compil.ch ; But otherwise it's a no-op, ignore it
.move: mov bl,al ; Otherwise, keep next character
cmp cx,4 ; If CX<4, a series of INC BX are best
mov al,43h ; INC BX
jb .wbyte
neg cx
cmp cx,4 ; If -CX<4, a series of DEC BX are best
mov al,4Bh ; DEC BX
jb .wbyte
neg cx
mov ax,0C381h ; ADD BX,
stosw
mov ax,cx ; tape movement
stosw
mov al,bl ; Move next character back into AL
jmp compil.ch ; Compile next command
.left: dec cx ; Left: decrement pointer
lodsb
jmp .ch
.right: inc cx ; Right: increment pointer
lodsb
jmp .ch
.wbyte: rep stosb ; Write AL, CX times.
mov al,bl ; Move next character back into AL
jmp compil.ch ; Compile next command
;;; Compile BF input
chin: mov al,2Eh ; CS segment override
stosb
mov ax,1EFFh ; CALL FAR PTR
stosw
mov ax,8 ; Pointer to input routine at address 8
stosw
jmp compil ; Compile next command
;;; Compile BF output
chout: mov al,2Eh ; CS segment override
stosb
mov ax,1EFFh ; CALL FAR PTR
stosw
mov ax,4 ; Pointer to output routine at address 4
stosw
jmp compil
;;; Compile start of loop
loops: cmp word [si],5D2Dh ; Are the next two characters '-]'?
je .zero ; Then just set the cell to zero
mov ax,078Ah ; Otherwise, write out a real loop
stosw ; ^- MOV AL,[BX]
mov ax,0C084h ; TEST AL,AL
stosw
mov ax,0575h ; JNZ loop-body
stosw
mov al,0B8h ; MOV AX, (simulate absolute near jmp)
stosb
xor ax,ax ; loop-end (we don't know it yet so 0)
stosw
mov ax,0E0FFh ; JMP AX
stosw
push di ; Store addr of loop body on stack
jmp compil ; Compile next command
.zero: mov ax,07C6h ; MOV BYTE [BX],
stosw
xor al,al ; 0
stosb
inc si ; Move past -]
inc si
jmp compil ; Compile next command
;;; Compile end of loop
loope: pop bx ; Retrieve address of loop body from stack
test bx,bx ; If it is zero, we've hit the top of stack
jz .ebrkt ; so the brackets aren't balanced.
mov ax,078Ah ; MOV AL,[BX]
stosw
mov ax,0C084h ; TEST AL,AL
stosw
mov ax,0574h ; JZ loop-end
stosw
mov al,0B8h ; MOV AX, (simulate absolute near jmp)
stosb
mov ax,bx ; loop-start
stosw
mov ax,0E0FFh ; JMP AX
stosw
mov [es:bx-4],di ; Store loop-end in matching loop start code
jmp compil
.ebrkt: mov dx,err.brk
jmp error
;;; Compilation is done.
cdone: mov al,2Eh ; Code to jump to cleanup routine
stosb ; ^- CS segment override
mov ax,2EFFh ; JMP FAR PTR
stosw
pop ax ; Should be zero if all loops closed
stosw
test ax,ax ; Were all loops closed?
jz .lp_ok
mov dx,err.brk ; If not, print error
jmp error
.lp_ok: mov [cs:cp],word 12 ; Make far pointer to start of BF code
mov [cs:cp+2],bp ; (which starts at ES:0C = BP:0C)
mov ax,ds ; Set both DS and ES to BF tape segment
mov es,ax ; (also the initial source segment)
xor ax,ax ; Clear the tape (set all bytes to zero)
mov cx,32768
rep stosw
xor bx,bx ; Tape begins at address 0
xor cx,cx ; No EOF and char buffer is empty
jmp far [cs:cp] ; Jump into the BF code
;;; BF program jumps here to stop the program
stop: mov ax,exit<<8|0 ; Quit to DOS with return code 0
int 21h
;;; Print error message in CS:DX and quit with errorlevel 2
error: push cs ; Set DS to CS
pop ds
mov ah,puts ; Print DS:DX
int 21h
mov ax,exit<<8|2 ; Quit to DOS
int 21h
;;; Output subroutine called by the BF program (far call)
bfout: mov ah,putch ; Prepare to write character
mov dl,[bx] ; Get character from tape
cmp dl,10 ; Is it LF?
jne .wr ; If not, just write it
mov dl,13 ; Otherwise, print CR first,
int 21h
mov dl,10 ; then LF.
.wr: int 21h ; Write character
retf
;;; Input subroutine called by the BF program (far call)
;;; Buffered input with CR/LF translation
;;; Note: this keeps state in registers!
;;; CL = chars left in buffer, CH = set if EOF seen,
;;; SI = buffer pointer, ES = BF data segment
bfin: test ch,ch ; EOF seen?
jnz .r_eof
mov ax,cs ; Set DS to our segment
mov ds,ax
.getch: test cl,cl ; Characters left in buffer?
jnz .retch ; If so, return next character
mov bp,bx ; Keep BF tape pointer
mov ah,read ; Read
xor bx,bx ; From STDIN
mov cx,255 ; Max 255 characters
mov dx,ibuf ; Into the buffer
int 21h
mov bx,bp ; Restore tape pointer
jc .ioerr ; If carry set, I/O error
test ax,ax ; If nothing returned, EOF
jz .s_eof
mov cx,ax ; Otherwise, set character count,
mov si,ibuf ; set buffer pointer back to start,
jmp .getch ; and return first character from buffer.
.s_eof: inc ch ; We've seen EOF now
.r_eof: mov al,EOFCH ; Return EOF
jmp .ret
.retch: lodsb ; Get char from buffer
dec cl ; One fewer character left
cmp al,26 ; ^Z = EOF when reading from keyboard
je .s_eof
cmp al,10 ; If it is LF, ignore it and get another
je .getch
cmp al,13 ; If it is CR, return LF instead
jne .ret
mov al,10
.ret: mov dx,es ; Set DS back to BF's data segment
mov ds,dx
mov [bx],al ; Put character on tape
retf
.ioerr: mov dx,err.io ; Print I/O error and quit
jmp error
section .data
bfchar: db '+-<>,.[]',0
err: ;;; Error messages
.usage: db 'BRAINFK PGM.B',13,10,10,9,'Run the BF program in PGM.B$'
.file: db 'Cannot read file$'
.brk: db 'Mismatched brackets$'
.mem: db 'Out of memory$'
.io: db 'I/O Error$'
section .bss
cp: resw 2 ; Far pointer to start of BF code
ibuf: resb 256 ; 255 char input buffer
stack: resw 512 ; 512 words for the stack
.top: equ $</syntaxhighlight>
{{out}}
<pre>C:\>type hello.bf
++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.
C:\>brainfk hello.bf
Hello World!
C:\></pre>
=={{header|Ada}}==
[[/Ada|Implementation in Ada]].
=={{header|Agena}}==
Tested with Agena 2.9.5 Win32
<
# execute the Brain**** program in the code string
Line 454 ⟶ 1,247:
bf( code )
until code = ""
epocs;</
=={{header|ALGOL 68}}==
===Interpreter===
[[/ALGOL 68|Implementation in Algol 68]].
==
Based on the interpreter. Attempts to optimise consecutive +, -, <, > and ? operations.
<syntaxhighlight lang="algol68">BEGIN # Brain**** -> Algol 68 transpiler #
# a single line of Brain**** code is prompted for and read from #
# standard input, the generated code is written to standard output #
# the original code is included in the output as a comment #
# transpiles the Brain**** code in code list to Algol 68 #
PROC generate = ( STRING code list )VOID:
BEGIN
PROC emit = ( STRING code )VOID: print( ( code, newline ) );
PROC emit1 = ( STRING code )VOID:
print( ( IF need semicolon THEN ";" ELSE "" FI
, newline, indent, code
)
);
PROC next = CHAR: IF c pos > c max
THEN "$"
ELSE CHAR result = code list[ c pos ];
c pos +:= 1;
result
FI;
# address and data modes and the data space #
emit( "BEGIN" );
emit( " MODE DADDR = INT; # data address #" );
emit( " MODE DATA = INT;" );
emit( " DATA zero = 0;" );
emit( " [-255:255]DATA data; # finite data space #" );
emit( " FOR i FROM LWB data TO UPB data DO data[i] := zero OD;" );
emit( " DADDR addr := ( UPB data + LWB data ) OVER 2;" );
# actual code #
STRING indent := " ";
BOOL need semicolon := FALSE;
INT c pos := LWB code list;
INT c max = UPB code list;
CHAR c := next;
WHILE c /= "$" DO
IF c = "?"
THEN emit1( "SKIP" );
need semicolon := TRUE;
WHILE ( c := next ) = "?" DO SKIP OD
ELIF c = "<" OR c = ">"
THEN CHAR op code = c;
CHAR assign op = IF c = ">" THEN "+" ELSE "-" FI;
INT incr := 1;
WHILE ( c := next ) = op code DO incr +:= 1 OD;
emit1( "addr " + assign op + ":= " + whole( incr, 0 ) );
need semicolon := TRUE
ELIF c = "+" OR c = "-"
THEN CHAR op code = c;
INT incr := 1;
WHILE ( c := next ) = op code DO incr +:= 1 OD;
emit1( "data[ addr ] " + op code + ":= " + whole( incr, 0 ) );
need semicolon := TRUE
ELIF c = "."
THEN emit1( "print( ( REPR data[ addr ] ) )" );
need semicolon := TRUE;
c := next
ELIF c = ","
THEN emit1( "data[ addr ] := ABS read char" );
need semicolon := TRUE;
c := next
ELIF c = "["
THEN emit1( "WHILE data[ addr ] /= zero DO" );
indent +:= " ";
need semicolon := FALSE;
c := next
ELIF c = "]"
THEN need semicolon := FALSE;
indent := indent[ LWB indent + 2 : ];
emit1( "OD" );
need semicolon := TRUE;
c := next
ELSE
print( ( "Invalid op code: """, c, """", newline ) );
c := next
FI
OD;
emit( "" );
emit( "END" )
END # gen # ;
# get the code to transpile and output it as a comment at the start #
# of the code #
print( ( "CO BF> " ) );
STRING code list;
read( ( code list, newline ) );
print( ( newline, code list, newline, "CO", newline ) );
# transpile the code #
generate( code list )
END</syntaxhighlight>
With the following input:
<syntaxhighlight lang="bf">>++++++++[<+++++++++>-]<.>>+>+>++>[-]+<[>[->+<<++++>]<<]>.+++++++..+++.>>+++++++.<<<[[-]<[-]>]<+++++++++++++++.>>.+++.------.--------.>>+.>++++.</syntaxhighlight>
The follwoing Algol 68 program is output:
<syntaxhighlight lang="algol68">CO BF>
>++++++++[<+++++++++>-]<.>>+>+>++>[-]+<[>[->+<<++++>]<<]>.+++++++..+++.>>+++++++.<<<[[-]<[-]>]<+++++++++++++++.>>.+++.------.--------.>>+.>++++.
CO
BEGIN
MODE DADDR = INT; # data address #
MODE DATA = INT;
DATA zero = 0;
[-255:255]DATA data; # finite data space #
FOR i FROM LWB data TO UPB data DO data[i] := zero OD;
DADDR addr := ( UPB data + LWB data ) OVER 2;
addr +:= 1;
data[ addr ] +:= 8;
WHILE data[ addr ] /= zero DO
addr -:= 1;
data[ addr ] +:= 9;
addr +:= 1;
data[ addr ] -:= 1
OD;
addr -:= 1;
print( ( REPR data[ addr ] ) );
addr +:= 2;
data[ addr ] +:= 1;
addr +:= 1;
data[ addr ] +:= 1;
addr +:= 1;
data[ addr ] +:= 2;
addr +:= 1;
WHILE data[ addr ] /= zero DO
data[ addr ] -:= 1
OD;
data[ addr ] +:= 1;
addr -:= 1;
WHILE data[ addr ] /= zero DO
addr +:= 1;
WHILE data[ addr ] /= zero DO
data[ addr ] -:= 1;
addr +:= 1;
data[ addr ] +:= 1;
addr -:= 2;
data[ addr ] +:= 4;
addr +:= 1
OD;
addr -:= 2
OD;
addr +:= 1;
print( ( REPR data[ addr ] ) );
data[ addr ] +:= 7;
print( ( REPR data[ addr ] ) );
print( ( REPR data[ addr ] ) );
data[ addr ] +:= 3;
print( ( REPR data[ addr ] ) );
addr +:= 2;
data[ addr ] +:= 7;
print( ( REPR data[ addr ] ) );
addr -:= 3;
WHILE data[ addr ] /= zero DO
WHILE data[ addr ] /= zero DO
data[ addr ] -:= 1
OD;
addr -:= 1;
WHILE data[ addr ] /= zero DO
data[ addr ] -:= 1
OD;
addr +:= 1
OD;
addr -:= 1;
data[ addr ] +:= 15;
print( ( REPR data[ addr ] ) );
addr +:= 2;
print( ( REPR data[ addr ] ) );
data[ addr ] +:= 3;
print( ( REPR data[ addr ] ) );
data[ addr ] -:= 6;
print( ( REPR data[ addr ] ) );
data[ addr ] -:= 8;
print( ( REPR data[ addr ] ) );
addr +:= 2;
data[ addr ] +:= 1;
print( ( REPR data[ addr ] ) );
addr +:= 1;
data[ addr ] +:= 4;
print( ( REPR data[ addr ] ) )
END</syntaxhighlight>
Which when run, produces the following:
{{out}}
<pre>
Hello World!
</pre>
=={{header|Amazing Hopper}}==
Based on the ALGOL 68's "transpiler". Program generated is ANSI C:
<syntaxhighlight lang="amazing hopper">
/*
BFC.COM
BrainF**k's Pseudo-compiler!
Mr_Dalien. NOV 26, 2021
*/
#include <hopper.h>
#proto checkMove(_S_,_OPE_,_CODE_,_BF_)
#proto check(_S_,_OPE_,_CODE_,_BF_)
#proto tabulation(_S_)
main:
total arg,minus(1) zero?
do {
{"\LR","Bad filename!\OFF\n"}print
{0}return
}
filename = [&2] // get filename parameter 2 (parameter 1 is "bfc.com")
sf="",{filename}exist?,not,
do{
{"File: \LR",filename,"\OFF"," don't exist!\n"}print
{0}return
}
{filename}load string(sf) // load file as string
--sf // "load string" load adding a newline at the EOS. "--sf" delete it!
// determine tape size:
rightMove=0,{">",sf}count at, mov(rightMove)
leftMove=0,{"<",sf}count at, mov(leftMove)
totalCells = 0
prec(0) // precision 0 decimals: all number are integers!
{0}{rightMove}minus(leftMove), cpy(totalCells),lt?
do{
{"In file \LR",filename,"\OFF",": program bad formed!\n"}print
{0}return
}
// start process!
nLen=0, {sf}len,mov(nLen)
i=1, // index
res={}, // new file "C"
space=5 // tab space
// header:
{"#include <stdio.h>","int main(){"," int ptr=0, i=0, cell["},{totalCells},xtostr,cat,{"];"}cat,push all(res)
{" for( i=0; i<",totalCells},xtostr,cat,{"; ++i) cell[i]=0;"}cat,push(res)
iwhile={},swOk=0,true(swOk)
cntMove=0
v=""
__PRINCIPAL__:
[i:i]get(sf),mov(v),
switch(v)
case(">")::do{
_checkMove(">","+","ptr",sf),
_tabulation(space),{"if(ptr>="}cat,{totalCells},xtostr,cat
{") perror(\"Program pointer overflow\");"}cat,push(res),
exit
}
case("<")::do{
_checkMove("<","-","ptr",sf),
_tabulation(space),{"if(ptr<0) perror(\"Program pointer underflow\");"}cat,push(res),
exit
}
case("+")::do{
_check("+","+","cell[ptr]",sf), exit
}
case("-")::do{
_check("-","-","cell[ptr]",sf), exit
}
case("[")::do{
{"]"}push(iwhile)
_tabulation(space),{"while(cell[ptr])"}cat,push(res),
_tabulation(space),{"{"}cat,push(res)
space += 5
exit
}
case("]")::do{
try
pop(iwhile),kill
space -= 5, _tabulation(space),{"}"}cat,push(res)
catch(e)
{"SIMBOL: ",v,", POS: ",i,": \LR","Symbol out of context \OFF"}println
false(swOk)
finish
exit
}
case(".")::do{
_tabulation(space),{"putchar(cell[ptr]);"}cat,push(res)
exit
}
case(",")::do{
_tabulation(space),{"cell[ptr] = getc(stdin);"}cat,push(res)
exit
}
// otherwise?
{"WARNING! SIMBOL(ASCII): ",v}asc,{", POS: ",i,": \LY","Invalid code, is ommited!\OFF\n"}print
end switch
{cntMove}neg? // exist more "<" than ">" ??
do {
{"SIMBOL: ",v,", POS: ",i,": \LR","Underflow detected!\OFF\n"}print
false(swOk)
}
++i,{nLen,i}le?,{swOk},and,jt(__PRINCIPAL__)
{swOk} do{
_tabulation(space),{"return 0;"}cat,push(res)
space -=5
{"}"}push(res)
name="", {"",".bf",filename},transform,mov(name), // bye bye ".bf"!
cname="", {name,".c"}cat,mov(cname), // hello <filename>.c!
{"\n"}tok sep // save array with newlines
{res,cname},save // save the array into the <filename>.c"
{" "}tok sep // "join" need this!
executable="", {"gcc ",cname," -o ",name} join(executable) // line to compile new filename
{executable}execv // do compile c program generated!
/* OPTIONAL: remove <filename>.c */
// {"rm ",cname}cat,execv
}
{"\LG","Compilation terminated "}
if({swOk}not)
{"\LR","with errors!\OFF\n"}
else
{"successfully!\OFF\n"}
end if
print
exit(0)
.locals
checkMove(simb,operator,code,bfprg)
c=1,
{cntMove},iif({operator}eqto("+"),1,-1),add,mov(cntMove)
__SUB_MOVE__:
++i,[i:i]get(sf),{simb}eq?
do{ ++c,
{cntMove},iif({operator}eqto("+"),1,-1),add,mov(cntMove)
jmp(__SUB_MOVE__)
}
_tabulation(space),{code}cat,{operator}cat,{"= "}cat,{c}xtostr,cat,{";"}cat
push(res)
--i
back
check(simb,operator,code,bfprg)
c=1,
__SUB__:
++i,[i:i]get(sf),{simb}eq? do{ ++c, jmp(__SUB__) }
_tabulation(space),{code}cat,{operator}cat,{"= "}cat,{c}xtostr,cat,{";"}cat
push(res)
--i
back
tabulation(space)
{" "}replyby(space)
back
</syntaxhighlight>
With the following input (holamundo.bf), passed as parameter:
<syntaxhighlight lang="bf">>++++++++[<+++++++++>-]<.>>+>+>++>[-]+<[>[->+<<++++>]<<]>.+++++++..+++.>>+++++++.<<<[[-]<[-]>]<+++++++++++++++.>>.+++.------.--------.>>+.>++++.</syntaxhighlight>
The follwoing ANSI C program is output:
<syntaxhighlight lang="c">
#include <stdio.h>
int main(){
int ptr=0, i=0, cell[7];
for( i=0; i<7; ++i) cell[i]=0;
ptr+= 1;
if(ptr>=7) perror("Program pointer overflow");
cell[ptr]+= 8;
while(cell[ptr])
{
ptr-= 1;
if(ptr<0) perror("Program pointer underflow");
cell[ptr]+= 9;
ptr+= 1;
if(ptr>=7) perror("Program pointer overflow");
cell[ptr]-= 1;
}
ptr-= 1;
if(ptr<0) perror("Program pointer underflow");
putchar(cell[ptr]);
ptr+= 2;
if(ptr>=7) perror("Program pointer overflow");
cell[ptr]+= 1;
ptr+= 1;
if(ptr>=7) perror("Program pointer overflow");
cell[ptr]+= 1;
ptr+= 1;
if(ptr>=7) perror("Program pointer overflow");
cell[ptr]+= 2;
ptr+= 1;
if(ptr>=7) perror("Program pointer overflow");
while(cell[ptr])
{
cell[ptr]-= 1;
}
cell[ptr]+= 1;
ptr-= 1;
if(ptr<0) perror("Program pointer underflow");
while(cell[ptr])
{
ptr+= 1;
if(ptr>=7) perror("Program pointer overflow");
while(cell[ptr])
{
cell[ptr]-= 1;
ptr+= 1;
if(ptr>=7) perror("Program pointer overflow");
cell[ptr]+= 1;
ptr-= 2;
if(ptr<0) perror("Program pointer underflow");
cell[ptr]+= 4;
ptr+= 1;
if(ptr>=7) perror("Program pointer overflow");
}
ptr-= 2;
if(ptr<0) perror("Program pointer underflow");
}
ptr+= 1;
if(ptr>=7) perror("Program pointer overflow");
putchar(cell[ptr]);
cell[ptr]+= 7;
putchar(cell[ptr]);
putchar(cell[ptr]);
cell[ptr]+= 3;
putchar(cell[ptr]);
ptr+= 2;
if(ptr>=7) perror("Program pointer overflow");
cell[ptr]+= 7;
putchar(cell[ptr]);
ptr-= 3;
if(ptr<0) perror("Program pointer underflow");
while(cell[ptr])
{
while(cell[ptr])
{
cell[ptr]-= 1;
}
ptr-= 1;
if(ptr<0) perror("Program pointer underflow");
while(cell[ptr])
{
cell[ptr]-= 1;
}
ptr+= 1;
if(ptr>=7) perror("Program pointer overflow");
}
ptr-= 1;
if(ptr<0) perror("Program pointer underflow");
cell[ptr]+= 15;
putchar(cell[ptr]);
ptr+= 2;
if(ptr>=7) perror("Program pointer overflow");
putchar(cell[ptr]);
cell[ptr]+= 3;
putchar(cell[ptr]);
cell[ptr]-= 6;
putchar(cell[ptr]);
cell[ptr]-= 8;
putchar(cell[ptr]);
ptr+= 2;
if(ptr>=7) perror("Program pointer overflow");
cell[ptr]+= 1;
putchar(cell[ptr]);
ptr+= 1;
if(ptr>=7) perror("Program pointer overflow");
cell[ptr]+= 4;
putchar(cell[ptr]);
return 0;
}
</syntaxhighlight>
{{out}}
<pre>
Hello World!
</pre>
=={{header|AppleScript}}==
Outputs debug in a .txt file similar to that of [http://brainfuck.tk brainfuck.tk]
<syntaxhighlight lang="applescript">
set codeString to text returned of (display dialog "Enter BF code:" buttons "OK" default answer "")
set inputString to text returned of (display dialog "Enter input string" buttons "OK" default answer "")
Line 592 ⟶ 1,858:
display dialog strout
close access debug
</syntaxhighlight>
=={{header|Arturo}}==
<syntaxhighlight lang="rebol">;
; Brainf*ck compiler
; In Arturo
;
Tape: [0]
DataPointer: new 0
InstructionPointer: new 0
; Look for jumps in Code an register them
; in the Jumps table
precomputeJumps: function [][
vstack: new []
jumphash: new #[]
instrPointer: 0
while [instrPointer<CodeLength] [
command: get split Code instrPointer
if? command="[" -> 'vstack ++ instrPointer
else [
if command="]" [
target: last vstack
chop 'vstack
jumphash\[target]: instrPointer
jumphash\[instrPointer]: target
]
]
instrPointer: instrPointer+1
]
jumphash
]
; Check if current state is valid
StateIsValid: function [][
all? @[
0 =< DataPointer
DataPointer < size Tape
0 =< InstructionPointer
InstructionPointer < CodeLength
]
]
; Compile the program
interpret: function [].export:[DataPointer,InstructionPointer,Tape][
while [StateIsValid][
command: get split Code InstructionPointer
case [command=]
when? ["+"] -> Tape\[DataPointer]: Tape\[DataPointer]+1
when? ["-"] -> Tape\[DataPointer]: Tape\[DataPointer]-1
when? [">"] [
inc 'DataPointer
if DataPointer = size Tape -> Tape: Tape ++ 0
]
when? ["<"] -> dec 'DataPointer
when? ["."] -> prints to :string to :char Tape\[DataPointer]
when? [","][
inp: to :integer input ""
if inp=13 -> inp: 10
if inp=3 -> panic "something went wrong!"
set Tape DataPointer inp
]
when? ["["] ->
if 0 = get Tape DataPointer [ InstructionPointer: new get Jumps InstructionPointer ]
when? ["]"] ->
if 0 <> get Tape DataPointer [
InstructionPointer: new get Jumps InstructionPointer
]
inc 'InstructionPointer
]
]
Code: ""
if? 1>size arg -> Code: "++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>."
else -> Code: read arg\0
CodeLength: size Code
Jumps: precomputeJumps
interpret</syntaxhighlight>
{{in}}
<syntaxhighlight lang="bf">++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.</syntaxhighlight>
{{out}}
<pre>Hello World!</pre>
=={{header|AutoHotkey}}==
Line 600 ⟶ 1,961:
=={{header|AutoIt}}==
<
; A AutoIt Brainfuck Interpreter
; by minx
Line 733 ⟶ 2,094:
If $Open>0 Then Return SetError(2,0,$i)
Return 0
EndFunc</
=={{header|AWK}}==
Line 739 ⟶ 2,100:
Expects the program (not the program file) to be the first argument to the script. Cells don't wrap (trivial if desired) and the code and arena are unbounded.
<
bf=ARGV[1]; ARGV[1] = ""
compile(bf)
Line 820 ⟶ 2,181:
}
}
</syntaxhighlight>
{{out}}
Line 832 ⟶ 2,193:
Note that this implementation has no error checking.
<
r₁→P
r₂→I
Line 888 ⟶ 2,249:
End
r₁
Return</
'''Example'''
<
BF(Str1,0)</
'''Output'''
Line 902 ⟶ 2,263:
==={{header|Applesoft BASIC}}===
<
1 P = P + T : ON P < E GOTO 11 : O = 1E99
2 P = P - T : ON P > M GOTO 11 : O = 1E99
Line 942 ⟶ 2,303:
95 C$ = "++++++++[>++++[>++>+++>+++>+<<<<-]>+>->+>>+[<]<-]>>.>>---.+++++++..+++.>.<<-.>.+++.------.--------.>+.>++.+++."
98 L = LEN(C$)
99 GOTO</
==={{header|BaCon}}===
By the author of BaCon, Peter van Eerten.
<
REM Brainfuck interpreter
Line 1,033 ⟶ 2,394:
INCR cursor
WEND</
==={{header|BBC BASIC}}===
<
\ ">---.+++++++..+++.>.<<-.>.+++.------.--------.>+.>++.+++."
PROCbrainfuck(bf$)
Line 1,078 ⟶ 2,439:
NEXT
ENDPROC
</syntaxhighlight>
{{out}}
<pre>Hello World!</pre>
==={{header|Commodore BASIC}}===
{{trans|TRS-80 BASIC}}
Changed hello-world text to all-caps to avoid re-coding it all for PETSCII.
<syntaxhighlight lang="gwbasic>100 REM BRAINF*CK FOR COMMODORE BASIC
110 DB=0:REM SET TO 1 FOR DEBUGGING
120 P$=""
130 READ C$
140 P$=P$+C$
150 IF LEN(C$)<>0 THEN 130
160 REM PAIR UP BRACKETS INTO B%
170 DIM B%(LEN(P$))
180 REM TRACK OPEN BRACKETS IN O%
190 DIM O%(INT(LEN(P$)/2)):O=0
200 FOR I=1 TO LEN(P$)
210 : I$=MID$(P$,I,1)
220 : IF I$="[" THEN O%(O)=I:O=O+1
230 : IF I$<>"]" THEN 270
240 : IF O=0 THEN PRINT "UNMATCHED BRACKET AT"I". ABORTING.":END
250 : O=O-1:M=O%(O)
260 : B%(I)=M:B%(M)=I
270 NEXT I
280 IF O THEN PRINT "UNMATCHED BRACKETS AT EOF. ABORTING.":END
290 REM SET MS TO NUMBER OF MEMORY CELLS NEEDED.
300 REM THE BF SPEC REQUIRES 30000, WHICH WILL WORK ON C64 OR 48K+ PET.
310 AN UNEXPANDED VIC-20 WILL HANDLE 1000, A C-16 9000. THE DEMO ONLY NEEDS 4.
320 MS=4:DIM M%(MS/2-1):MP=0
330 REM FUNCTION TO READ BYTE AT CELL N
340 DEF FNMP(N)=INT(M%(INT(N/2)) / (1+255*(N AND 1))) AND 255
350 FOR I=1 TO LEN(P$)
360 : IF MP<0 OR MP>=MS THEN PRINT "ERROR: MP OUT OF RANGE AT"I:END
370 : IF DB THEN PRINT "IP:"I"("I$") MP: "MP"("FNMP(MP)")"
380 : I$=MID$(P$,I,1)
390 : IF I$<>"[" THEN 420
400 : IF FNMP(MP)=0 THEN I=B%(I)
410 : GOTO 530
420 : IF I$<>"]" THEN 450
430 : IF FNMP(MP) THEN I=B%(I)
440 : GOTO 530
450 : IF I$="<" THEN MP=MP-1:GOTO 530
460 : IF I$=">" THEN MP=MP+1:GOTO 530
470 : IF I$="-" THEN V=FNMP(MP)-1:GOTO 560
480 : IF I$="+" THEN V=FNMP(MP)+1:GOTO 560
490 : IF I$="." THEN PRINTCHR$(FNMP(MP));:GOTO 530
500 : IF I$<>"," THEN 530
510 : GET K$:IF K$="" THEN 510
520 : V=ASC(K$):GOTO 560
530 NEXT I
540 END
550 REM UPDATE CELL AT MP WITH VALUE IN V
560 M=INT(MP/2):O=M%(M):V=V AND 255
570 N0=(O AND -256)+V
580 N1=(V*256+(O AND 255))
590 M%(M) = (MP AND 1)*N1 - ((MP AND 1)=0)*N0
600 GOTO 530
610 REM HELLO, WORLD PROGRAM
620 DATA "+++++++++[>++++++++<-]>."
630 DATA "---."
640 DATA "+++++++..+++."
650 DATA ">>++++[<+++++++++++>-]<."
660 DATA ">++++[<--->-]<."
670 DATA "<++++++++."
680 DATA "--------."
690 DATA "+++."
700 DATA "------."
710 DATA "--------."
720 DATA ">>[++][<+++++++>-]<+."
730 DATA ">++++++++++."
740 DATA ""</syntaxhighlight>
{{Out}}
<pre>HELLO, WORLD!</pre>
==={{header|FreeBASIC}}===
<syntaxhighlight lang="freebasic">
' Intérprete de brainfuck
' FB 1.05.0 Win64
'
Const BF_error_memoria_saturada As Integer = 2
Const BF_error_memoria_insuficiente As Integer = 4
Const BF_error_codigo_saturado As Integer = 8
Const BF_error_desbordamiento_codigo As Integer = 16
Dim BFcodigo As String = ">++++++++++[>+++>+++++++>++++++++++>+++++++++++>++++++++++++>++++++++++++++++[<]>-]>>>>>>+.<<<<++.>>+.---.<---.<<++.>>>+.>---.<+.<+++.>+.<<<+."
Dim codigo_error As Integer
Function EjecutarBF (BFcodigo As String, tammem As Uinteger) As Integer
Dim As String memoria = String(tammem, 0)
Dim As Uinteger puntero_instrucciones, puntero_datos
Dim As Integer nivel_de_alcance
For puntero_instrucciones = 0 To Len(BFcodigo)
Select Case Chr(BFcodigo[puntero_instrucciones])
Case ">"
puntero_datos += 1
If (puntero_datos > tammem - 1) Then Return BF_error_memoria_saturada
Case "<"
puntero_datos -= 1
If (puntero_datos > tammem - 1) Then Return BF_error_memoria_insuficiente
Case "+"
memoria[puntero_datos] += 1
Case "-"
memoria[puntero_datos] -= 1
Case "."
Print Chr(memoria[puntero_datos]);
Case ","
memoria[puntero_datos] = Asc(Input(1))
Case "["
If (memoria[puntero_datos] = 0) Then
Dim nivel_antiguo As Uinteger = nivel_de_alcance
nivel_de_alcance += 1
Do Until (nivel_de_alcance = nivel_antiguo)
puntero_instrucciones += 1
If (puntero_instrucciones > Len(BFcodigo) - 1) Then Return BF_error_codigo_saturado
Select Case Chr(BFcodigo[puntero_instrucciones])
Case "["
nivel_de_alcance += 1
Case "]"
nivel_de_alcance -= 1
End Select
Loop
Else
nivel_de_alcance += 1
End If
Continue For
Case "]"
If (memoria[puntero_datos] = 0) Then
nivel_de_alcance -= 1
Continue For
Else
Dim nivel_antiguo As Integer = nivel_de_alcance
nivel_de_alcance -= 1
Do Until (nivel_de_alcance = nivel_antiguo)
puntero_instrucciones -= 1
If (puntero_instrucciones > Len(BFcodigo) - 1) Then Return BF_error_desbordamiento_codigo
Select Case Chr(BFcodigo[puntero_instrucciones])
Case "["
nivel_de_alcance += 1
Case "]"
nivel_de_alcance -= 1
End Select
Loop
End If
Continue For
Case Else
Continue For
End Select
Next puntero_instrucciones
Return -1
End Function
Cls
codigo_error = EjecutarBF(BFcodigo, 1024)
If codigo_error Then
Sleep
Else
Print "codigo de error: " & codigo_error
End If
End
</syntaxhighlight>
{{out}}
<pre>
íHola mundo!
</pre>
==={{header|GW-BASIC}}===
<syntaxhighlight lang="gwbasic">10 REM BRAINFK INTERPRETER FOR GW-BASIC
20 INPUT "File to open? ",INFILE$
30 DIM TAPE(10000): REM memory is 10000 long
40 DIM PRG$(5000): REM programs can be 5000 symbols long
50 PRG$ = ""
60 OPEN(INFILE$) FOR INPUT AS #1
70 S = 0 : REM instruction pointer
80 WHILE NOT EOF(1)
90 LINE INPUT #1, LIN$
100 FOR P = 1 TO LEN(LIN$)
110 C$=MID$(LIN$,P,1)
120 IF C$="+" OR C$="-" OR C$="." OR C$="," OR C$ = "<" OR C$=">" OR C$="[" OR C$="]" THEN S=S+1:PRG$(S)=C$
130 NEXT P
140 WEND
150 PRLEN = S
160 REM ok, the program has been read in. now set up the variables
170 P = 0 : REM tape pointer
180 S = 1 : REM instruction pointer
190 K = 0 : REM bracket counter
200 WHILE S<=PRLEN: REM as long as there are still instructions to come
210 IF INKEY$="Q" THEN END
220 IF PRG$(S) = "+" THEN GOSUB 320
230 IF PRG$(S) = "-" THEN GOSUB 350
240 IF PRG$(S) = ">" THEN GOSUB 380
250 IF PRG$(S) = "<" THEN GOSUB 420
260 IF PRG$(S) = "." THEN GOSUB 460
270 IF PRG$(S) = "," THEN GOSUB 490
280 IF PRG$(S) = "[" THEN GOSUB 650 ELSE IF PRG$(S) = "]" THEN GOSUB 550
290 S = S + 1
300 WEND
310 END
320 REM the + instruction
330 TAPE(P) = TAPE(P) + 1
340 RETURN
350 REM the - instruction
360 TAPE(P) = TAPE(P)-1
370 RETURN
380 REM the > instruction
390 P = P + 1
400 IF P > 10000 THEN P = P - 10000 : REM circular tape, because why not?
410 RETURN
420 REM the < instruction
430 P = P - 1
440 IF P < 0 THEN P = P + 10000
450 RETURN
460 REM the . instruction
470 PRINT CHR$(TAPE(P));
480 RETURN
490 REM the , instruction
500 BEEP : REM use the beep as a signal that input is expected
510 G$ = INKEY$
520 IF G$ = "" THEN GOTO 510
530 TAPE(P) = ASC(G$)
540 RETURN
550 REM the ] instruction
560 IF TAPE(P)=0 THEN RETURN : REM do nothing
570 K = 1 : REM otherwise it's some bracket counting
580 WHILE K > 0
590 S = S - 1
600 IF S = 0 THEN PRINT "Backtrack beyond start of program!" : END
610 IF PRG$(S) = "]" THEN K = K + 1
620 IF PRG$(S) = "[" THEN K = K - 1
630 WEND
640 RETURN
650 REM the [ instruction
660 IF TAPE(P)<> 0 THEN RETURN
670 K = 1
680 WHILE K>0
690 S = S + 1
700 IF S>PRLEN THEN PRINT "Advance beyond end of program!" : END
710 IF PRG$(S) = "]" THEN K = K - 1
720 IF PRG$(S) = "[" THEN K = K + 1
730 WEND
740 RETURN</syntaxhighlight>
{{out}}Tested with the [[Factorial#Brainf.2A.2A.2A|factorial code]].
<pre>
File to open? FACTOR.BF
1
1
2
6
24
120
720
5040
40320
362880
</pre>
==={{header|PureBasic}}===
[[/PureBasic|Implementation in PureBasic]]
==={{header|TI-83 BASIC}}===
[[/TI-83 BASIC|Implementation in TI-83 BASIC]].
==={{header|TI-89 BASIC}}===
[[/TI-89 BASIC|Implementation in TI-89 Basic]].
==={{header|TRS-80 BASIC}}===
This should work in Level II BASIC on any TRS-80, even a Model I. However, allocating the full 30,000-cell memory tape requires 48K of RAM.
The default character set on the TRS-80 lacks square brackets; their positions are taken by ↑ and ← characters instead. The code below uses
square brackets, which will paste into emulators as the arrows; to type on a real machine the user will have to make the substitution manually.
To allow for programs that better resemble the standard visually, this interpreter also accepts parentheses as equivalent; that will break code containing
parentheticals in comments, however, so edit lines 340 and 370 to suit your needs.
<syntaxhighlight lang="gwbasic">100 REM BRAINF*CK FOR TRS-80 LEVEL II BASIC
103 DB=0:REM SET TO 1 FOR DEBUGGING
105 REM FIRST MAKE SURE WE HAVE ENOUGH STRING HEAP FOR PROGRAM
110 READ C$:C=LEN(C$):IF C>M THEN M=C
120 PS=PS+C
130 IF C THEN 110
135 REM ALLOCATE THE HEAP
140 CLEAR 2*(PS+M)
145 REM RE-READ PROGRAM, REMEMBERING IT THIS TIME
150 RESTORE
160 P$=""
170 READ C$
180 P$=P$+C$
190 IF LEN(C$)<>0 THEN 170
195 REM PAIR UP BRACKETS INTO B%
200 DIM B%(LEN(P$))
205 REM TRACK OPEN BRACKETS IN O%
210 DIM O%(INT(LEN(P$)/2)):O=0
220 FOR I=1 TO LEN(P$)
230 : I$=MID$(P$,I,1)
240 : IF I$="(" OR I$="[" THEN O%(O)=I:O=O+1
250 : IF I$<>")" AND I$<>"]" THEN 290
260 : IF O=0 THEN PRINT "UNMATCHED BRACKET AT"I". ABORTING.":END
270 : O=O-1:M=O%(O)
280 : B%(I)=M:B%(M)=I
290 NEXT I
300 IF O THEN PRINT "UNMATCHED BRACKETS AT EOF. ABORTING.":END
303 REM SET MS TO NUMBER OF MEMORY CELLS NEEDED
305 REM THE BF SPEC REQUIRES 30000, WHICH DOES WORK ON A SYSTEM WITH 48K RAM.
307 REM THE DEMO HELLO-WORLD PROGRAM ONLY REQUIRES 4 CELLS.
310 MS=4:DIM M%(MS/2-1):MP=0
313 REM FUNCTION TO READ BYTE AT CELL N
315 DEF FNMP(N)=INT(M%(INT(N/2)) / (1+255*(N AND 1))) AND 255
320 FOR I=1 TO LEN(P$)
323 : IF MP<0 OR MP>=MS THEN PRINT "ERROR: MP OUT OF RANGE AT"I:END
327 : IF DB THEN PRINT "IP:"I"("I$") MP:"MP"("FNMP(MP)")"
330 : I$=MID$(P$,I,1)
340 : IF I$<>"(" AND I$<>"[" THEN 370
350 : IF FNMP(MP)=0 THEN I=B%(I)
360 : GOTO 480
370 : IF I$<>")" AND I$<>"]" THEN 400
380 : IF FNMP(MP) THEN I=B%(I)
390 : GOTO 480
400 : IF I$="<" THEN MP=MP-1:GOTO 480
410 : IF I$=">" THEN MP=MP+1:GOTO 480
420 : IF I$="-" THEN V=FNMP(MP)-1:GOTO 500
430 : IF I$="+" THEN V=FNMP(MP)+1:GOTO 500
440 : IF I$="." THEN ?CHR$(FNMP(MP));:GOTO 480
450 : IF I$<>"," THEN 480
460 : K$=INKEY$:IF K$="" THEN 460
470 : V=ASC(K$):GOTO 500
480 NEXT I
490 END
495 REM UPDATE CELL AT MP WITH VALUE IN V
500 M=INT(MP/2):O=M%(M):V=V AND 255
510 N0=(O AND -256)+V
520 N1=(V*256+(O AND 255))
530 M%(M) = (MP AND 1)*N1 - ((MP AND 1)=0)*N0
540 GOTO 480
545 REM HELLO, WORLD PROGRAM
570 DATA "+++++++++[>++++++++<-]>."
580 DATA "<+++++[>+++++<-]>++++."
590 DATA "+++++++..+++."
600 DATA ">>++++[<+++++++++++>-]<."
610 DATA ">++++[<--->-]<."
620 DATA "<++++++++."
630 DATA "--------."
640 DATA "+++."
650 DATA "------."
660 DATA "--------."
670 DATA ">>[++][<+++++++>-]<+."
680 DATA ">++++++++++."
690 DATA ""</syntaxhighlight>
{{Out}}
<pre>Hello, world!</pre>
==={{header|ZX Spectrum Basic}}===
The bracket loop could be accelerated to prevent searching the string every time, but it runs.
<syntaxhighlight lang="zxbasic">10 GO SUB 1000
20 LET e=LEN p$
30 LET a$=p$(ip)
40 IF a$=">" THEN LET dp=dp+1
50 IF a$="<" THEN LET dp=dp-1
60 IF a$="+" THEN LET d(dp)=d(dp)+1
70 IF a$="-" THEN LET d(dp)=d(dp)-1
80 IF a$="." THEN PRINT CHR$ d(dp);
90 IF a$="," THEN INPUT d(dp)
100 IF a$="[" THEN GO SUB 500
110 IF a$="]" THEN LET bp=bp-1: IF d(dp)<>0 THEN LET ip=b(bp)-1
120 LET ip=ip+1
130 IF ip>e THEN PRINT "eof": STOP
140 GO TO 30
499 REM match close
500 LET bc=1: REM bracket counter
510 FOR x=ip+1 TO e
520 IF p$(x)="[" THEN LET bc=bc+1
530 IF p$(x)="]" THEN LET bc=bc-1
540 IF bc=0 THEN LET b(bp)=ip: LET be=x: LET x=e: REM bc will be 0 once all the subnests have been counted over
550 IF bc=0 AND d(dp)=0 THEN LET ip=be: LET bp=bp-1
560 NEXT x
570 LET bp=bp+1
580 RETURN
999 REM initialisation
1000 DIM d(100): REM data stack
1010 LET dp=1: REM data pointer
1020 LET ip=1: REM instruction pointer
1030 DIM b(30): REM bracket stack
1040 LET bp=1: REM bracket pointer
1050 LET p$="++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>+++++.": REM program, marginally modified from Wikipedia; outputs CHR$ 13 at the end instead of CHR$ 10 as ZX Spectrum Basic handles the carriage return better than the line feed
1060 RETURN</syntaxhighlight>
{{out}}
<pre>Hello World!
eof
9 STOP statement, 130:3</pre>
{{omit from|GUISS}}
=={{header|BCPL}}==
<syntaxhighlight lang="bcpl">get "libhdr"
manifest
$( bfeof = 0
$)
let reads(v) be
$( let ch = ?
v%0 := 0
ch := rdch()
until ch = '*N' do
$( v%0 := v%0 + 1
v%(v%0) := ch
ch := rdch()
$)
$)
let contains(str, ch) = valof
$( for i = 1 to str%0 do
if ch = str%i then resultis true
resultis false
$)
let readbf(file, v) = valof
$( let i, ch = 1, ?
let curin = input()
v%0 := 0
selectinput(file)
ch := rdch()
until ch = endstreamch do
$( if contains("+-<>.,[]", ch) then
$( v%i := ch
i := i + 1
$)
ch := rdch()
$)
v%i := 0
endread()
selectinput(curin)
resultis i + 1
$)
let bfout(ch) be wrch(ch=10 -> '*N', ch)
let bfin() = valof
$( let ch = rdch()
resultis ch = endstreamch -> bfeof, ch
$)
let scan(v, i, dir) = valof
$( let d = 1
until d = 0 do
$( i := i + dir
if v%i = 0 then
$( writes("Unbalanced brackets*N")
resultis 0
$)
if v%i = '[' then d := d + dir
if v%i = ']' then d := d - dir
$)
resultis i
$)
let run(v, m) be
$( let i = 1
until v%i = 0 do
$( switchon v%i into
$( case '+': v%m := v%m + 1 ; endcase
case '-': v%m := v%m - 1 ; endcase
case '>': m := m + 1 ; endcase
case '<': m := m - 1 ; endcase
case '.': bfout(v%m) ; endcase
case ',': v%m := bfin() ; endcase
case '[':
if v%m = 0 then i := scan(v, i, 1)
if i = 0 then return
endcase
case ']':
unless v%m = 0 do i := scan(v, i, -1)
if i = 0 then return
endcase
$)
i := i + 1
$)
$)
let start() be
$( let fname = vec 63
let file = ?
writes("Filename? ")
reads(fname)
file := findinput(fname)
test file = 0 then
writes("Cannot open file.*N")
else
$( let mvec = getvec(maxvec())
let m = readbf(file, mvec)
run(mvec, m)
freevec(mvec)
$)
$)</syntaxhighlight>
{{out}}
<pre>Filename? hello.bf
Hello World!</pre>
=={{header|Binary Lambda Calculus}}==
The following 224-byte program
<pre>0000000 44 51 a1 01 84 55 d5 02 b7 70 30 22 ff 32 f0 00
0000020 bf f9 85 7f 5e e1 6f 95 7f 7d ee c0 e5 54 68 00
0000040 58 55 fd fb e0 45 57 fd eb fb f0 b6 f0 2f d6 07
0000060 e1 6f 73 d7 f1 14 bc c0 0b ff 2e 1f a1 6f 66 17
0000100 e8 5b ef 2f cf ff 13 ff e1 ca 34 20 0a c8 d0 0b
0000120 99 ee 1f e5 ff 7f 5a 6a 1f ff 0f ff 87 9d 04 d0
0000140 ab 00 05 db 23 40 b7 3b 28 cc c0 b0 6c 0e 74 10
0000160 2b 2b 2b 2b 2b 2b 2b 2b 2b 2b 5b 3e 2b 2b 2b 2b
0000200 2b 2b 2b 3e 2b 2b 2b 2b 2b 2b 2b 2b 2b 2b 3e 2b
0000220 2b 2b 3e 2b 3c 3c 3c 3c 2d 5d 3e 2b 2b 2e 3e 2b
0000240 2e 2b 2b 2b 2b 2b 2b 2b 2e 2e 2b 2b 2b 2e 3e 2b
0000260 2b 2e 3c 3c 2b 2b 2b 2b 2b 2b 2b 2b 2b 2b 2b 2b
0000300 2b 2b 2b 2e 3e 2e 2b 2b 2b 2e 2d 2d 2d 2d 2d 2d
0000320 2e 2d 2d 2d 2d 2d 2d 2d 2d 2e 3e 2b 2e 3e 2e 5d</pre>
consists of the 112-byte brainfuck interpreter https://github.com/tromp/AIT/blob/master/bf.blc8 followed by the 112-byte brainfuck hello world program
<pre>++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.]</pre>
and produces output
<pre>Hello World!
</pre>
=={{header|Brainf***}}==
Brain**** in Brain**** Yey!
Credits to Frans, NYYRIKKI, Daniel B Cristofani for the code.
Frans:
"I started to think about a BF interpreter written in BF, and because I did not want to write BF code directly, I started with writing a C program that could generate BF code for often used constructs. After some experimentation, I decided to implement a direct execution mode (making use of a define), so that I didn't have to go through the generate-interpret cycle. This resulted in the BF interpreter in BF generation program. If the macro symbol EXECUTE is not defined, this program when executed generates a BF interpreter in BF. This BF interpreter expects as input a BF program terminated with an exclamation mark, followed by the input for the program to be interpreted. I by no means claim that this BF interpreter in BF is the shortest possible. (Actually, NYYRIKKI wrote a much short one and Daniel B. Cristofani an even shorter one.)
The BF interpreter in BF (when filtered through a comment remover) looks like:"
<syntaxhighlight lang="brainf***">
>>>,[->+>+<<]>>[-<<+>>]>++++[<++++++++>-]<+<[->>+>>+<<<<]>>>>[-<<<<+>>
>>]<<<[->>+>+<<<]>>>[-<<<+>>>]<<[>[->+<]<[-]]>[-]>[[-]<<<<->-<[->>+>>+
<<<<]>>>>[-<<<<+>>>>]<<<[->>+>+<<<]>>>[-<<<+>>>]<<[>[->+<]<[-]]>[-]>]<
<<<[->>+<<]>[->+<]>[[-]<<<[->+>+<<]>>[-<<+>>]>++++++[<+++++++>-]<+<[->
>>+>+<<<<]>>>>[-<<<<+>>>>]<<<[->+>>+<<<]>>>[-<<<+>>>]<[<[->>+<<]>[-]]<
[-]>>[[-]<<<<->-<[->>>+>+<<<<]>>>>[-<<<<+>>>>]<<<[->+>>+<<<]>>>[-<<<+>
>>]<[<[->>+<<]>[-]]<[-]>>]<<<<[->>>+<<<]>[->>+<<]>+>[<->[-]]<[<<<<+>>>
>[-]]<<<[->+>+<<]>>[-<<+>>]>+++++[<+++++++++>-]<<[->>>+>+<<<<]>>>>[-<<
<<+>>>>]<<<[->+>>+<<<]>>>[-<<<+>>>]<[<[->>+<<]>[-]]<[-]>>[[-]<<<<->-<[
->>>+>+<<<<]>>>>[-<<<<+>>>>]<<<[->+>>+<<<]>>>[-<<<+>>>]<[<[->>+<<]>[-]
]<[-]>>]<<<<[->>>+<<<]>[->>+<<]>+>[<->[-]]<[<<<<++>>>>[-]]<<<[->+>+<<]
>>[-<<+>>]>++++++[<++++++++++>-]<<[->>>+>+<<<<]>>>>[-<<<<+>>>>]<<<[->+
>>+<<<]>>>[-<<<+>>>]<[<[->>+<<]>[-]]<[-]>>[[-]<<<<->-<[->>>+>+<<<<]>>>
>[-<<<<+>>>>]<<<[->+>>+<<<]>>>[-<<<+>>>]<[<[->>+<<]>[-]]<[-]>>]<<<<[->
>>+<<<]>[->>+<<]>+>[<->[-]]<[<<<<+++>>>>[-]]<<<[->+>+<<]>>[-<<+>>]>+++
+++[<++++++++++>-]<++<[->>>+>+<<<<]>>>>[-<<<<+>>>>]<<<[->+>>+<<<]>>>[-
<<<+>>>]<[<[->>+<<]>[-]]<[-]>>[[-]<<<<->-<[->>>+>+<<<<]>>>>[-<<<<+>>>>
]<<<[->+>>+<<<]>>>[-<<<+>>>]<[<[->>+<<]>[-]]<[-]>>]<<<<[->>>+<<<]>[->>
+<<]>+>[<->[-]]<[<<<<++++>>>>[-]]<<<[->+>+<<]>>[-<<+>>]>+++++[<+++++++
++>-]<+<[->>>+>+<<<<]>>>>[-<<<<+>>>>]<<<[->+>>+<<<]>>>[-<<<+>>>]<[<[->
>+<<]>[-]]<[-]>>[[-]<<<<->-<[->>>+>+<<<<]>>>>[-<<<<+>>>>]<<<[->+>>+<<<
]>>>[-<<<+>>>]<[<[->>+<<]>[-]]<[-]>>]<<<<[->>>+<<<]>[->>+<<]>+>[<->[-]
]<[<<<<+++++>>>>[-]]<<<[->+>+<<]>>[-<<+>>]>++++[<+++++++++++>-]<<[->>>
+>+<<<<]>>>>[-<<<<+>>>>]<<<[->+>>+<<<]>>>[-<<<+>>>]<[<[->>+<<]>[-]]<[-
]>>[[-]<<<<->-<[->>>+>+<<<<]>>>>[-<<<<+>>>>]<<<[->+>>+<<<]>>>[-<<<+>>>
]<[<[->>+<<]>[-]]<[-]>>]<<<<[->>>+<<<]>[->>+<<]>+>[<->[-]]<[<<<<++++++
>>>>[-]]<<<[->+>+<<]>>[-<<+>>]>+++++++[<+++++++++++++>-]<<[->>>+>+<<<<
]>>>>[-<<<<+>>>>]<<<[->+>>+<<<]>>>[-<<<+>>>]<[<[->>+<<]>[-]]<[-]>>[[-]
<<<<->-<[->>>+>+<<<<]>>>>[-<<<<+>>>>]<<<[->+>>+<<<]>>>[-<<<+>>>]<[<[->
>+<<]>[-]]<[-]>>]<<<<[->>>+<<<]>[->>+<<]>+>[<->[-]]<[<<<<+++++++>>>>[-
]]<<<[->+>+<<]>>[-<<+>>]>+++++++[<+++++++++++++>-]<++<[->>>+>+<<<<]>>>
>[-<<<<+>>>>]<<<[->+>>+<<<]>>>[-<<<+>>>]<[<[->>+<<]>[-]]<[-]>>[[-]<<<<
->-<[->>>+>+<<<<]>>>>[-<<<<+>>>>]<<<[->+>>+<<<]>>>[-<<<+>>>]<[<[->>+<<
]>[-]]<[-]>>]<<<<[->>>+<<<]>[->>+<<]>+>[<->[-]]<[<<<<++++++++>>>>[-]]<
<<<[->>+>+<<<]>>>[-<<<+>>>]<[<<<[->>>>>>>>>+<+<<<<<<<<]>>>>>>>>[-<<<<<
<<<+>>>>>>>>]<<<<<<<[->>>>>>>>>+<<+<<<<<<<]>>>>>>>[-<<<<<<<+>>>>>>>]>[
<[->>>>>+<<<<<]>[->>>>>+<<<<<]>[->>>>>+<<<<<]>>>+>-]>>[-]<[->+<]<<[[-<
<<<<+>>>>>]<<<<<-]<<<<<<<<+>[-]>>[-]]<,[->+>+<<]>>[-<<+>>]>++++[<+++++
+++>-]<+<[->>+>>+<<<<]>>>>[-<<<<+>>>>]<<<[->>+>+<<<]>>>[-<<<+>>>]<<[>[
->+<]<[-]]>[-]>[[-]<<<<->-<[->>+>>+<<<<]>>>>[-<<<<+>>>>]<<<[->>+>+<<<]
>>>[-<<<+>>>]<<[>[->+<]<[-]]>[-]>]<<<<[->>+<<]>[->+<]>]<<<<<[-][->>>>>
>>>>+<<<<<<+<<<]>>>[-<<<+>>>]>>>>>>[<[->>>>>+<<<<<]>[->>>>>+<<<<<]>>>>
+>-]>>[[-<+<+>>]<<[->>+<<]>[-<+>[<->[-]]]<[[-]<[->+>+<<]>>[-<<+>>]<<[[
-<<<<<+>>>>>]>[-<<<<<+>>>>>]<<<<<<-]<<<<<<<<[-]>>>>>>>>>[-<<<<<<<<<+>>
>>>>>>>]<<<<<<<<<<[->>>>>>>>>>+<+<<<<<<<<<]>>>>>>>>>[-<<<<<<<<<+>>>>>>
>>>]>[<[->>>>>+<<<<<]>[->>>>>+<<<<<]>>>>+>-]>>>+<<<<[[-<<<<<+>>>>>]<<<
<<-]<<<<<<<<+[->>>>>>>>>+<<<<<<+<<<]>>>[-<<<+>>>]>>>>>>[<[->>>>>+<<<<<
]>[->>>>>+<<<<<]>>>>+>-][-]]>>[-<+<+>>]<<[->>+<<]>[-[-<+>[<->[-]]]]<[[
-]<[->+>+<<]>>[-<<+>>]<<[[-<<<<<+>>>>>]>[-<<<<<+>>>>>]<<<<<<-]<<<<<<<<
[-]>>>>>>>>>[-<<<<<<<<<+>>>>>>>>>]<<<<<<<<<<[->>>>>>>>>>+<+<<<<<<<<<]>
>>>>>>>>[-<<<<<<<<<+>>>>>>>>>]>[<[->>>>>+<<<<<]>[->>>>>+<<<<<]>>>>+>-]
>>>-<<<<[[-<<<<<+>>>>>]<<<<<-]<<<<<<<<+[->>>>>>>>>+<<<<<<+<<<]>>>[-<<<
+>>>]>>>>>>[<[->>>>>+<<<<<]>[->>>>>+<<<<<]>>>>+>-][-]]>>[-<+<+>>]<<[->
>+<<]>[-[-[-<+>[<->[-]]]]]<[[-]<[->+>+<<]>>[-<<+>>]<<[[-<<<<<+>>>>>]>[
-<<<<<+>>>>>]<<<<<<-]<<<<<<<<[-]>>>>>>>>>[-<<<<<<<<<+>>>>>>>>>]<<<<<<<
<<<->+[->>>>>>>>>+<<<<<<+<<<]>>>[-<<<+>>>]>>>>>>[<[->>>>>+<<<<<]>[->>>
>>+<<<<<]>>>>+>-][-]]>>[-<+<+>>]<<[->>+<<]>[-[-[-[-<+>[<->[-]]]]]]<[[-
]<[->+>+<<]>>[-<<+>>]<<[[-<<<<<+>>>>>]>[-<<<<<+>>>>>]<<<<<<-]<<<<<<<<[
-]>>>>>>>>>[-<<<<<<<<<+>>>>>>>>>]<<<<<<<<<<+>+[->>>>>>>>>+<<<<<<+<<<]>
>>[-<<<+>>>]>>>>>>[<[->>>>>+<<<<<]>[->>>>>+<<<<<]>>>>+>-][-]]>>[-<+<+>
>]<<[->>+<<]>[-[-[-[-[-<+>[<->[-]]]]]]]<[[-]<[->+>+<<]>>[-<<+>>]<<[[-<
<<<<+>>>>>]>[-<<<<<+>>>>>]<<<<<<-]<<<<<<<<[-]>>>>>>>>>[-<<<<<<<<<+>>>>
>>>>>]<<<<<<<<<<[->>>>>>>>>>+<+<<<<<<<<<]>>>>>>>>>[-<<<<<<<<<+>>>>>>>>
>]>[<[->>>>>+<<<<<]>[->>>>>+<<<<<]>>>>+>-]>>>.<<<<[[-<<<<<+>>>>>]<<<<<
-]<<<<<<<<+[->>>>>>>>>+<<<<<<+<<<]>>>[-<<<+>>>]>>>>>>[<[->>>>>+<<<<<]>
[->>>>>+<<<<<]>>>>+>-][-]]>>[-<+<+>>]<<[->>+<<]>[-[-[-[-[-[-<+>[<->[-]
]]]]]]]<[[-]<[->+>+<<]>>[-<<+>>]<<[[-<<<<<+>>>>>]>[-<<<<<+>>>>>]<<<<<<
-]<<<<<<<<[-]>>>>>>>>>[-<<<<<<<<<+>>>>>>>>>]<<<<<<<<<<[->>>>>>>>>>+<+<
<<<<<<<<]>>>>>>>>>[-<<<<<<<<<+>>>>>>>>>]>[<[->>>>>+<<<<<]>[->>>>>+<<<<
<]>>>>+>-]>>>,<<<<[[-<<<<<+>>>>>]<<<<<-]<<<<<<<<+[->>>>>>>>>+<<<<<<+<<
<]>>>[-<<<+>>>]>>>>>>[<[->>>>>+<<<<<]>[->>>>>+<<<<<]>>>>+>-][-]]>>[-<+
<+>>]<<[->>+<<]>[-[-[-[-[-[-[-<+>[<->[-]]]]]]]]]<[[-]<[->+>+<<]>>[-<<+
>>]<<[[-<<<<<+>>>>>]>[-<<<<<+>>>>>]<<<<<<-]<<<<<<<<[-]>>>>>>>>>[-<<<<<
<<<<+>>>>>>>>>]<<<<<<<<<<[->>>>>>>>>>+<+<<<<<<<<<]>>>>>>>>>[-<<<<<<<<<
+>>>>>>>>>]>[<[->>>>>+<<<<<]>[->>>>>+<<<<<]>>>>+>-]>>>[-<<<+>+>>]<<[->
>+<<]<<[[-<<<<<+>>>>>]>[-<<<<<+>>>>>]<<<<<<-]>[-<<<<<<+>>>>>>]>+<<<<<<
<[>>>>>>>-<<<<<<<[-]]<<<[->>>>>>>>>+<<<<<<+<<<]>>>[-<<<+>>>]>>>>>>[<[-
>>>>>+<<<<<]>[->>>>>+<<<<<]>[->>>>>+<<<<<]>>>+>-]>[[-]<+[<[->>>>>+<<<<
<]>[->>>>>+<<<<<]>>>>+>>>[->>+<<<+>]<[->+<]>>>[-[-[-[-[-[-[-<<<+>>>[<<
<->>>[-]]]]]]]]]<<<[<+>[-]]>[->>+<<<+>]<[->+<]>>>[-[-[-[-[-[-[-[-<<<+>
>>[<<<->>>[-]]]]]]]]]]<<<[<->[-]]<]>[-]]<<[->>>>>+<<<<<]>>>>>+>[-]]>>[
-<+<+>>]<<[->>+<<]>[-[-[-[-[-[-[-[-<+>[<->[-]]]]]]]]]]<[[-][-]<[->+>+<
<]>>[-<<+>>]<<[[-<<<<<+>>>>>]>[-<<<<<+>>>>>]<<<<<<-]<<<<<<<<[-]>>>>>>>
>>[-<<<<<<<<<+>>>>>>>>>]<<<<<<<<<<[->>>>>>>>>>+<+<<<<<<<<<]>>>>>>>>>[-
<<<<<<<<<+>>>>>>>>>]>[<[->>>>>+<<<<<]>[->>>>>+<<<<<]>>>>+>-]>>>[-<<<+>
+>>]<<[->>+<<]<<[[-<<<<<+>>>>>]>[-<<<<<+>>>>>]<<<<<<-]>[-<<<<<<+>>>>>>
]<<<<<<[->>>>>>>+<<<<<<<]<<<[->>>>>>>>>+<<<<<<+<<<]>>>[-<<<+>>>]>>>>>>
[<[->>>>>+<<<<<]>[->>>>>+<<<<<]>[->>>>>+<<<<<]>>>+>-]>[[-]<+[<[-<<<<<+
>>>>>]>[-<<<<<+>>>>>]<<<<<<->>>[->>+<<<+>]<[->+<]>>>[-[-[-[-[-[-[-<<<+
>>>[<<<->>>[-]]]]]]]]]<<<[<->[-]]>[->>+<<<+>]<[->+<]>>>[-[-[-[-[-[-[-[
-<<<+>>>[<<<->>>[-]]]]]]]]]]<<<[<+>[-]]<]>[-]]<<[->>>>>+<<<<<]>>>>>+>[
-]]>>]
</syntaxhighlight>
NYYRIKKI:
"Hi,
I saw your Brain**** interpreter for Brain**** and it encouraged me to write my own version of it. I now write to you as I thought, you might be interested about it.
I wanted to write as fast version as possible so I wrote it directly with Brain****. Here is a list of key tricks, that I used to get maximum performance:
* I used loader routine, that removes comments before executing and converts BF code to internal format. In the internal format numbers 1-8 are used for commands and zero is used to terminate execution (code before line split) This is because handling small numbers is much more effective than handling large numbers in BF.
*I used special IF (x)=0 stucture like this: >+<[>-]>[THEN >] to avoid slow byte copying loops. (Command backup etc.)
*I used 3 bytes for each program element to get maximum speed. Using less would have caused program it self get more slow and complex and using more would have slowed down memory seek. For program memory I used 2 bytes for each element.
Data is not transferred between memory and program. In "[" command I only move Z flag. (Value in memory is more likely to be NZ and "0" is faster to move than "1")
This program works same way as yours. Only difference is, that program termination character is ":" instead of "!"
No more explaining... here is the code:"
<syntaxhighlight lang="brainf***">
>>>+[,>+++++++[<------>-]<[->+>+<<]>>[-<<+>>]<->+<[>-<[-]]>[-<<[-]++++
+>>>>>]<<[->+>+<<]>>[-<<+>>]<-->+<[>-<[-]]>[-<<[-]++++++++>>>>>]<<[->+
>+<<]>>[-<<+>>]<--->+<[>-<[-]]>[-<<[-]++++++>>>>>]<<[->+>+<<]>>[-<<+>>
]<---->+<[>-<[-]]>[-<<[-]+++++++>>>>>]<<[->+>+<<]>>[-<<+>>]++++++[<---
>-]+<[>-<[-]]>[-<<[-]++++>>>>>]<<[->+>+<<]>>[-<<+>>]+++++[<---->-]+<[>
-<[-]]>[-<<[-]+++>>>>>]<<[->+>+<<]>>[-<<+>>]+++++++[<------->-]+<[>-<[
-]]>[-<<[-]+>>>>>]<<[->+>+<<]>>[-<<+>>]+++++++[<------->-]<-->+<[>-<[-
]]>[-<<[-]++>>>>>]<++++[<---->-]<]<<<[<<<]>>>
[-->+<[>-]>[>]<<++>[-<<<<
<+[>-->+<[>-]>[-<<+>>>]<<+>+<[>-]>[-<<->>>]<<+<[-<<<+>>>]<<<]>>>>>]<->
+<[>-]>[>]<<+>[-<->>>[>>>]>[->+>>+<<<]>[-<+>]>>[-[->>+<<]+>>]+>[->+<]>
[-<+>>>[-]+<<]+>>[-<<->>]<<<<[->>[-<<+>>]<<<<]>>[-<<<<<+>>>>>]<<<<<<<[
>>[-<<<+>>>]<<<<<]+>>[>-->+<[>-]>[-<<->>>]<<+>+<[>-]>[-<<+>>>]<<+<[->>
>+<<<]>>>]<]<--->+<[>-]>[->>[>>>]>+<<<<[<<<]>>]<<->+<[>-]>[->>[>>>]>-<
<<<[<<<]>>]<<->+<[>-]>[->>[>>>]>[->+>>+<<<]>[-<+>]>>[-[->>+<<]+>>]+>+<
[-<<]<<<<<[<<<]>>]<<->+<[>-]>[->>[>>>]>[->+>>+<<<]>[-<+>]>>[-[->>+<<]+
>>]+>-<[-<<]<<<<<[<<<]>>]<<->+<[>-]>[->>[>>>]>[->+>>+<<<]>[-<+>]>>[-[-
>>+<<]+>>]+>.<[-<<]<<<<<[<<<]>>]<<->+<[>-]>[->>[>>>]>[->+>>+<<<]>[-<+>
]>>[-[->>+<<]+>>]+>,<[-<<]<<<<<[<<<]>>]<<++++++++>>>]
</syntaxhighlight>
Daniel B. Cristofani
<syntaxhighlight lang="brainf***">
>>>+[[-]>>[-]++>+>+++++++[<++++>>++<-]++>>+>+>+++++[>++>++++++<<-]+>>>,<++[[>[
->>]<[>>]<<-]<[<]<+>>[>]>[<+>-[[<+>-]>]<[[[-]<]++<-[<+++++++++>[<->-]>>]>>]]<<
]<]<[[<]>[[>]>>[>>]+[<<]<[<]<+>>-]>[>]+[->>]<<<<[[<<]<[<]+<<[+>+<<-[>-->+<<-[>
+<[>>+<<-]]]>[<+>-]<]++>>-->[>]>>[>>]]<<[>>+<[[<]<]>[[<<]<[<]+[-<+>>-[<<+>++>-
[<->[<<+>>-]]]<[>+<-]>]>[>]>]>[>>]>>]<<[>>+>>+>>]<<[->>>>>>>>]<<[>.>>>>>>>]<<[
>->>>>>]<<[>,>>>]<<[>+>]<<[+<<]<]
[input a brain**** program and its input, separated by an exclamation point.
Daniel B Cristofani (cristofdathevanetdotcom)
http://www.hevanet.com/cristofd/brainfuck/]
</syntaxhighlight>
Links:
[[http://www.iwriteiam.nl/Ha_bf_inter.html]]
[[http://www.iwriteiam.nl/Ha_vs_bf_inter.html]]
[[http://www.hevanet.com/cristofd/dbfi.b]]
Franco C. Bartolabac,
a 12 y/o boi.
=={{header|Brat}}==
Line 1,088 ⟶ 3,155:
=={{header|Burlesque}}==
<
".""X"r~"-""\/^^{vvvv}c!!!-.256.%{vvvv}c!sa\/"r~"+""\/^^{vvvv}c!!!+.
256.%{vvvv}c!sa\/"r~"[""{"r~"]""}{\/^^{vvvv}c!!!}w!"r~">""+."r~"<""
-."r~"X""\/^^{vvvv}c!!!L[+]\/+]\/+]^^3\/.+1RAp^\/+]\/[-1RA^^-]\/[-\/
"r~"\'\'1 128r@{vv0}m[0"\/.+pse!vvvv<-sh
</syntaxhighlight>
However, this implementation does not support input.
Also, output is visible only after the brainfuck program terminated.
This is due to the limitation that Burlesque does not have actual I/O.
=={{header|C}}==
Line 1,112 ⟶ 3,179:
=={{header|Clojure}}==
<
(def ^:dynamic *input*)
Line 1,187 ⟶ 3,254:
(println *output*)
(println (apply str (map char *output*)))))
</syntaxhighlight>
<
{:ptr 4, :cells {4 10, 3 33, 2 100, 1 87, 0 0}}
[72 101 108 108 111 32 87 111 114 108 100 33 10]
Line 1,194 ⟶ 3,261:
nil
</syntaxhighlight>
The alternate implementation at [[Execute Brain****/Clojure]] showcases a rather different approach.
=={{header|CLU}}==
<syntaxhighlight lang="clu">tape = cluster is new, left, right, get_cell, set_cell
ac = array[char]
rep = record [
cells: ac,
index: int
]
new = proc () returns (cvt)
t: rep := rep${
cells: ac$predict(0, 30000),
index: 0
}
ac$addh(t.cells, '\000')
return(t)
end new
left = proc (t: cvt)
t.index := t.index - 1
if t.index < ac$low(t.cells) then ac$addl(t.cells, '\000') end
end left
right = proc (t: cvt)
t.index := t.index + 1
if t.index > ac$high(t.cells) then ac$addh(t.cells, '\000') end
end right
get_cell = proc (t: cvt) returns (int)
return (char$c2i(t.cells[t.index]) // 256)
end get_cell
set_cell = proc (t: cvt, i: int)
t.cells[t.index] := char$i2c(i // 256)
end set_cell
end tape
program = cluster is parse, fetch, jump
loop_jump = struct[from, to: int]
alj = array[loop_jump]
slj = sequence[loop_jump]
rep = struct [
loops: slj,
code: string
]
parse = proc (s: string) returns (cvt) signals (bad_loops)
ac = array[char]
prog: ac := ac$predict(1, string$size(s))
loops: alj := alj$[]
loop_stack: array[int] := array[int]$[]
for c: char in string$chars(s) do
if string$indexc(c, "+-<>,.[]") = 0 then continue end
ac$addh(prog, c)
if c = '[' then
array[int]$addh(loop_stack, ac$high(prog))
elseif c = ']' then
here: int := ac$high(prog)
there: int := array[int]$remh(loop_stack)
except when bounds: signal bad_loops end
alj$addh(loops, loop_jump${from: here, to: there})
alj$addh(loops, loop_jump${from: there, to: here})
end
end
if ~array[int]$empty(loop_stack) then signal bad_loops end
return (rep${loops: slj$a2s(loops), code: string$ac2s(prog)})
end parse
fetch = proc (p: cvt, i: int) returns (char) signals (bounds)
return (p.code[i]) resignal bounds
end fetch
jump = proc (p: cvt, i: int) returns (int) signals (not_found)
for j: loop_jump in slj$elements(p.loops) do
if j.from = i then return (j.to) end
end
signal not_found
end jump
end program
brainf = cluster is make, run
rep = struct [
prog: program,
mem: tape,
inp, out: stream
]
make = proc (p: program, i, o: stream) returns (cvt)
return (rep${
prog: p,
inp: i,
out: o,
mem: tape$new()
})
end make
read = proc (p: rep) returns (int)
return (char$c2i(stream$getc(p.inp)))
except when end_of_file:
return (0)
end
end read
write = proc (p: rep, c: int)
stream$putc(p.out, char$i2c(c))
end write
run = proc (p: cvt)
ip: int := 1
while true do
op: char := p.prog[ip] except when bounds: break end
if op = '+' then p.mem.cell := p.mem.cell + 1
elseif op = '-' then p.mem.cell := p.mem.cell - 1
elseif op = '>' then tape$right(p.mem)
elseif op = '<' then tape$left(p.mem)
elseif op = ',' then p.mem.cell := read(p)
elseif op = '.' then write(p, p.mem.cell)
elseif op = '[' cand p.mem.cell = 0 then
ip := program$jump(p.prog, ip)
elseif op = ']' cand p.mem.cell ~= 0 then
ip := program$jump(p.prog, ip)
end
ip := ip + 1
end
end run
end brainf
read_whole_stream = proc (s: stream) returns (string)
chars: array[char] := array[char]$predict(1, 4096)
while true do
array[char]$addh(chars, stream$getc(s))
except when end_of_file: break end
end
return (string$ac2s(chars))
end read_whole_stream
start_up = proc ()
pi: stream := stream$primary_input()
po: stream := stream$primary_output()
stream$puts(po, "Filename? ")
fname: file_name := file_name$parse(stream$getl(pi))
file: stream := stream$open(fname, "read")
code: string := read_whole_stream(file)
stream$close(file)
prog: program := program$parse(code)
interp: brainf := brainf$make(prog, pi, po)
brainf$run(interp)
end start_up </syntaxhighlight>
{{out}}
<pre>$ cat hello.bf
++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.
$ ./brainf
Filename? hello.bf
Hello World!</pre>
=={{header|COBOL}}==
[[/COBOL|Implementation in COBOL]].
=={{header|Comefrom0x10}}==
This interpreter takes a command line argument with the path to a Brain**** program. It uses strings as storage, so storage is unbounded on both sides of the pointer, but behavior is undefined for cell values lower than zero or higher than 0x10ffff.
<syntaxhighlight lang="cf0x10">pointer_alpha = 1/0
pointer_numeric = 1/0
tape_behind = ''
tape_ahead = 1/0
tape_pos = 0 # only for debugging
array_behind = 1/0
array_ahead = ''
set_tape_ahead = array_ahead
array_ahead = 1/0
#
shift
comefrom if array_ahead is array_ahead
cdr = 1/0
cdr = array_ahead
shift_tail = cdr
new_cell
comefrom shift if shift_tail is ''
itoa = 0
shift_tail = itoa
car = 1/0
car = array_ahead
array_behind = car array_behind
done = shift_tail
array_ahead = shift_tail
comefrom shift if array_ahead is done
set_pointer_alpha = 1/0
set_pointer_alpha
comefrom if set_pointer_alpha
atoi = set_pointer_alpha
cdr = tape_ahead
set_tape_ahead = set_pointer_alpha cdr
set_pointer_alpha = 1/0
set_tape_ahead = 1/0
set_pointer_vals
comefrom if set_tape_ahead
tape_ahead = set_tape_ahead
car = tape_ahead
pointer_alpha = car
atoi = pointer_alpha
pointer_numeric = atoi
set_tape_ahead = 1/0
pointer_change = 1/0
change_pointer_val
comefrom if pointer_change
car = tape_ahead
cdr = tape_ahead
itoa = pointer_numeric + pointer_change
set_tape_ahead = itoa cdr
pointer_change = 1/0
file = 0 # initialize to something other than undefined so jump from file works when read fails
read_path = argv
error_reading_program
comefrom file if file + 0 is 0
'Error: cannot read Brainfuck program at "' read_path '"'
''
program_loaded
comefrom file if file is file
program_behind = ''
program_ahead = file
run
comefrom program_loaded
opcode = 1/0
opcode_numeric = 1/0
in_buffer = '' # cf0x10 stdin is line-buffered
jumping = 0
moving = 1
comefrom run
comefrom execute if opcode_numeric is 0
''
execute
comefrom run if moving
# can be useful for debugging:
#program_ahead moving ':' jumping '@' tape_pos ':' pointer_numeric
car = program_ahead
atoi = car
opcode_numeric = atoi
opcode = car
opcode = 1/0
#
program_forward
comefrom execute if moving > 0
array_behind = program_behind
array_ahead = 1/0
array_ahead = program_ahead
program_behind = array_behind
program_ahead = array_ahead
forward_jump
comefrom execute if opcode is '['
jump
comefrom forward_jump if pointer_numeric is 0
jumping = jumping + 1
moving = 1
match_brace
comefrom forward_jump if jumping < 0
jumping = jumping + 1
stop_jump
comefrom match_brace if jumping is 0
moving = 1
program_backward
comefrom execute if moving < 0
array_behind = program_ahead
array_ahead = 1/0
array_ahead = program_behind
program_behind = array_ahead
program_ahead = array_behind
backward_jump
comefrom execute if opcode is ']'
jump
comefrom backward_jump if pointer_numeric > 0
jumping = jumping - 1
moving = -1
match_brace
comefrom backward_jump if jumping > 0
jumping = jumping - 1
stop_jump
comefrom match_brace if jumping is 0
moving = 1
op
comefrom execute if opcode
moving = 1
do_op = opcode
comefrom op if jumping
#
forward
comefrom op if do_op is '>'
tape_pos = tape_pos + 1
array_ahead = 1/0
array_behind = tape_behind
array_ahead = tape_ahead
tape_behind = array_behind
set_tape_ahead = array_ahead
backward
comefrom op if do_op is '<'
tape_pos = tape_pos - 1
array_ahead = 1/0
array_behind = tape_ahead
array_ahead = tape_behind
tape_behind = array_ahead
set_tape_ahead = array_behind
increment
comefrom op if do_op is '+'
pointer_change = 1
decrement
comefrom op if do_op is '-'
pointer_change = -1
print
comefrom op if do_op is '.'
pointer_alpha...
read
comefrom op if do_op is ','
#
cdr = 1/0
cdr = in_buffer
car = in_buffer
set_pointer_alpha = car
cdr = in_buffer
in_buffer = cdr
comefrom stdin if stdin + 0 is 0
#
block_for_input
comefrom read if cdr is ''
stdin = ''
in_buffer = stdin
cdr = in_buffer
comefrom stdin if stdin + 0 is 0</syntaxhighlight>
=={{header|Common Lisp}}==
Line 1,209 ⟶ 3,624:
[[/D|Implementation in D]].
=={{header|Delphi}}==
{{libheader| Winapi.Windows}}
{{libheader| System.SysUtils}}
{{Trans|Pascal}}
Fix of [[#Pascal]] to run in Delphi.
<syntaxhighlight lang="delphi">
program Execute_Brain;
{$APPTYPE CONSOLE}
uses
Winapi.Windows,
System.SysUtils;
const
DataSize = 1024; // Size of Data segment
MaxNest = 1000; // Maximum nesting depth of []
function Readkey: Char;
var
InputRec: TInputRecord;
NumRead: Cardinal;
KeyMode: DWORD;
StdIn: THandle;
begin
StdIn := GetStdHandle(STD_INPUT_HANDLE);
GetConsoleMode(StdIn, KeyMode);
SetConsoleMode(StdIn, 0);
repeat
ReadConsoleInput(StdIn, InputRec, 1, NumRead);
if (InputRec.EventType and KEY_EVENT <> 0) and InputRec.Event.KeyEvent.bKeyDown then
begin
if InputRec.Event.KeyEvent.AsciiChar <> #0 then
begin
Result := InputRec.Event.KeyEvent.UnicodeChar;
Break;
end;
end;
until FALSE;
SetConsoleMode(StdIn, KeyMode);
end;
procedure ExecuteBF(Source: string);
var
Dp: pByte; // Used as the Data Pointer
DataSeg: Pointer; // Start of the DataSegment (Cell 0)
Ip: pChar; // Used as instruction Pointer
LastIp: Pointer; // Last adr of code.
JmpStack: array[0..MaxNest - 1] of pChar; // Stack to Keep track of active "[" locations
JmpPnt: Integer; // Stack pointer ^^
JmpCnt: Word; // Used to count brackets when skipping forward.
begin
// Set up then data segment
getmem(DataSeg, dataSize);
Dp := DataSeg;
// fillbyte(dp^,dataSize,0);
FillChar(Dp^, DataSize, 0);
// Set up the JmpStack
JmpPnt := -1;
// Set up Instruction Pointer
Ip := @Source[1];
LastIp := @Source[length(Source)];
if Ip = nil then
exit;
// Main Execution loop
repeat { until Ip > LastIp }
case Ip^ of
'<':
dec(Dp);
'>':
inc(Dp);
'+':
inc(Dp^);
'-':
dec(Dp^);
'.':
write(chr(Dp^));
',':
Dp^ := ord(ReadKey);
'[':
if Dp^ = 0 then
begin
// skip forward until matching bracket;
JmpCnt := 1;
while (JmpCnt > 0) and (Ip <= LastIp) do
begin
inc(Ip);
case Ip^ of
'[':
inc(JmpCnt);
']':
dec(JmpCnt);
#0:
begin
Writeln('Error brackets don''t match');
halt;
end;
end;
end;
end
else
begin
// Add location to Jump stack
inc(JmpPnt);
JmpStack[JmpPnt] := Ip;
end;
']':
if Dp^ > 0 then
// Jump Back to matching [
Ip := JmpStack[JmpPnt]
else // Remove Jump from stack
dec(JmpPnt);
end;
inc(Ip);
until Ip > LastIp;
freemem(DataSeg, dataSize);
end;
const
HelloWorldWiki = '++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>' +
'---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.';
pressESCtoCont = '>[-]+++++++[<++++++++++>-]<->>[-]+++++++[<+++++++++++' +
'+>-]<->>[-]++++[<++++++++>-]+>[-]++++++++++[<++++++++' +
'++>-]>[-]++++++++[<++++++++++++++>-]<.++.+<.>..<<.<<.' +
'-->.<.>>.>>+.-----.<<.[<<+>>-]<<.>>>>.-.++++++.<++++.' +
'+++++.>+.<<<<++.>+[>+<--]>++++...';
waitForEsc = '[-]>[-]++++[<+++++++>-]<->[-]>+[[-]<<[>+>+<<-]' + '>>[<' +
'<+>>-],<[->-<]>]';
begin
// Execute "Hello World" example from Wikipedia
ExecuteBF(HelloWorldWiki);
// Print text "press ESC to continue....." and wait for ESC to be pressed
ExecuteBF(pressESCtoCont + waitForEsc);
end.</syntaxhighlight>
=={{header|dodo0}}==
<
clojure('count', 1) -> size
clojure('nth', 2) -> charAt
Line 1,454 ⟶ 4,013:
#Execute the program instructions
program(buffer, input) -> buffer, input
exit()</
Execution:
<pre>
Line 1,464 ⟶ 4,023:
=={{header|E}}==
[[/E|Implementation in E]].
=={{header|EasyLang}}==
<syntaxhighlight>
proc exec code$ . .
len mem[] 100
dp = 1
code$[] = strchars code$
ip = 1
while ip <= len code$[]
if dp > len mem[]
len mem[] len mem[] + 100
.
if dp < 1
print "programm error"
return
.
c$ = code$[ip]
if c$ = "+"
mem[dp] += 1
elif c$ = "-"
mem[dp] -= 1
elif c$ = ">"
dp += 1
elif c$ = "<"
dp -= 1
elif c$ = "."
write strchar mem[dp]
elif c$ = ","
print "input not implemented"
elif c$ = "["
if mem[dp] = 0
br = 1
repeat
ip += 1
if code$[ip] = "["
br += 1
elif code$[ip] = "]"
br -= 1
.
until br = 0
.
else
br[] &= ip
.
elif c$ = "]"
ip = br[len br[]] - 1
len br[] -1
.
ip += 1
.
.
func syntax code$ .
for i to len code$
h$ = substr code$ i 1
if h$ = "["
br += 1
elif h$ = "]"
br -= 1
.
if br < 0
return 0
.
.
return if br = 0
.
repeat
inp$ = input
until inp$ = ""
code$ &= inp$
.
if syntax code$ <> 1
print "syntax error"
return
.
exec code$
#
input_data
++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>
---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.
</syntaxhighlight>
=={{header|Elena}}==
Line 1,470 ⟶ 4,111:
=={{header|Erlang}}==
[[/Erlang|Implementation in Erlang]].
=={{header|F_Sharp|F#}}==
[[/F Sharp|Implementation in F#]].
=={{header|Factor}}==
Factor comes with a Brainf*** interpreter. See the implementation [https://github.com/factor/factor/blob/master/extra/brainfuck/brainfuck.factor here].
{{works with|Factor|0.99 2020-07-03}}
<syntaxhighlight lang="factor">USE: brainf***
"++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++." run-brainf***</syntaxhighlight>
{{out}}
<pre>
Hello World!
</pre>
=={{header|Forth}}==
Line 1,480 ⟶ 4,135:
The source employs F90 so as to gain the convenience of a service routine SEEK contained within RUN that thereby has access to the PROG and the instruction pointer - though these could have been passed as additional parameters. The main idea is that the expression can fit on one line and special code is not used for the two cases. The STORE array of cells is represented as an array of CHARACTER*1 variables rather than a CHARACTER*n single variable. This means that an element is addressed as STORE(i), rather than STORE(i:i), and that STORE = CHAR(0) initialises the whole array to zero. If it were CHARACTER*n, then only the first character would be zero, all subsequent would be blanks. It is not clear what size a cell represents, but a single character suffices for the trial run. For usage that involves arithmetic, the ICHAR and CHAR functions are needed which work on values of 0:255. The cell array could be declared INTEGER*1 instead, which would allow arithmetic without sacrifices on the altar of type checking. Such a variable in two's complement has values of -128:127 however with only addition and subtraction supported this doesn't matter - the bit patterns are the same as for unsigned integers. Larger integer sizes are possible if required, but would require changes to the READ and WRITE statements because A1 format works at the high-order end of a multi-byte variable.
The PROG variable could also be regarded as an array of single characters, but such an array is not a suitable candidate for a text literal such as initialises HELLOWORLD.<
INTEGER MSG,KBD
CONTAINS !A twisted interpreter.
Line 1,492 ⟶ 4,147:
DO WHILE(I.LE.LEN(PROG)) !Off the end yet?
C = PROG(I:I) !Load the opcode fingered by I.
I = I + 1 !Advance one. The classic.
SELECT CASE(C) !Now decode the instruction.
CASE(">"); D = D + 1 !Move the data finger one place right.
CASE("<"); D = D
CASE("
CASE("-"); STORE(D) = CHAR(ICHAR(STORE(D)) - 1) !Subtract one.
CASE("
CASE("
CASE
!Do nothing.
END
END DO !See what comes
1 FORMAT (A1,$) !One character, no advance to the next line.
Line 1,555 ⟶ 4,202:
CALL RUN(HELLOWORLD,STORE) !Have a go.
END !Enough.</
Output:
<pre>
Line 1,568 ⟶ 4,215:
Since the increment and decrement instructions are often repeated, it is simple enough to scan ahead and count up the repetitions via a function (that also manipulates its environment), and convert a sequence of operations into a single operation. Thus, this is an ''optimising'' Brain*uck compiler!
The source involves adding a subroutine to the module and an extended main line for testing: <
Converts the Brain*uck in PROG into the equivalent furrytran source...
CHARACTER*(*) PROG !The Brain*uck source.
Line 1,670 ⟶ 4,317:
OPEN (F,FILE="BrainFort.for",STATUS="REPLACE",ACTION="WRITE")
CALL BRAINFORT(HELLOWORLD,30000,KBD,MSG,F)
END !Enough.</
And the output is...<
Code: ++++++++[>++++[>++>+++>+++>+<<<<-] >+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.
CHARACTER*1 STORE(30000)
Line 1,738 ⟶ 4,385:
STORE(D) = CHAR(ICHAR(STORE(D)) + 2)
WRITE (6,'(A1,$)') STORE(D)
END</
Which, when compiled and run, produces...
<pre>
Hello World!
</pre>
In a transcription error, I included a space in the Brain*uck code, which was of course ignored by the interpreter. The compiler initially spat out<
IF (ICHAR(STORE(D)).NE.0) GO TO 3</
=={{header|
<syntaxhighlight lang="furor">
argc 3 < { ."Usage: furor brainfuck.upu brainfuckpgmfile\n" }{
2 argv getfile // dup #s print free
sto bfpgm
100000 mem dup maximize sto bfmem // Memóriaallokáció a brainfuck memóriaterület számára
tick sto startingtick
sbr §brainfuck
NL
tick @startingtick #g - ."Time = " print ." tick\n"
@bfmem free // A lefoglalt munkamemória felszabadítása
}
end
// ===================================================
brainfuck:
#g @bfpgm~ !{ rts } // Ha nulla a brainfuck progi hossza, semmit se kell csinálni.
zero p zero m // Indexregiszterek lenullázása (inicializálás)
((( @p @bfpgm~ < )
§jumpingtable "+-<>[].,"
@[]bfpgm @p // Az épp aktuális brainfuck utasítás kódja
switch // Ugrás a megfelelő brainfuck funkció rutinjára
____: inc p (<) // default action
_3c_: @m !{ rts } dec m goto §____ // <
_3e_: @m @bfmem~ >= { rts } inc m goto §____ // >
_2b_: #c @[++]bfmem @m #g goto §____ // +
_2d_: #c @[--]bfmem @m #g goto §____ // -
_2c_: @bfmem @m getchar [^] goto §____
_2e_: @[]bfmem @m printchar goto §____
_5b_: @[]bfmem @m then §____
zero d @p ++ @bfpgm~ {||
{} []@bfpgm '[ == { inc d {<} }
{} []@bfpgm '] == { @d !{ {+} sto p {>} } dec d }
|} (<)
_5d_: zero d 1 @p {|| {-} []@bfpgm '] == { inc d {<} }
{-} []@bfpgm '[ == { @d !{ {} !sum p {>} } dec d }
|} (<)
)) rts
// ===================================================
{ „startingtick” }
{ „bfpgm” }
{ „bfmem” }
{ „p” /* index az épp végrehajtandó brainfuck mnemonikra */ }
{ „m” /* index a brainfuck memóriaterületre */ }
{ „d” /* munkaváltozó */ }
// ========================================
jumpingtable:
// + - < > [ ] . ,
§_2b_ §_2d_ §_3c_ §_3e_ §_5b_ §_5d_ §_2e_ §_2c_
</syntaxhighlight>
Yet another solution:
<syntaxhighlight lang="furor">
###sysinclude stringextra.uh
argc 3 < { ."Usage: furor brainfuck.upu brainfuckpgmfile\n" }{
2 argv getfile
sto bfpgm
bfpgm '< >><<
bfpgm '> >><<
100000 mem dup maximize sto bfmem // Memóriaallokáció a brainfuck memóriaterület számára
tick sto startingtick
sbr §brainfuck
NL
tick @startingtick #g - ."Time = " print ." tick\n"
@bfmem free // A lefoglalt munkamemória felszabadítása
}
end
// ===================================================
brainfuck:
#g @bfpgm~ !{ rts } // Ha nulla a brainfuck progi hossza, semmit se kell csinálni.
zero p zero m // Indexregiszterek lenullázása (inicializálás)
((( @p @bfpgm~ < )
@p *2 [#n]@bfpgm // Az épp aktuális brainfuck utasítás kódja
§jumpingtable[] [goto] // Ugrás a megfelelő brainfuck funkció rutinjára
____: inc p (<)
_3c_: @m !{ rts } @[]bfpgm @p 32 >> !sum m goto §____ // <
_3e_: @m @bfmem~ >= { rts } @[]bfpgm @p 32 >> sum m goto §____ // >
_2b_: #c @[++]bfmem @m #g goto §____ // +
_2d_: #c @[--]bfmem @m #g goto §____ // -
_2c_: @bfmem @m getchar [^] goto §____
_2e_: @[]bfmem @m printchar goto §____
_5b_: @[]bfmem @m then §____
zero d @p ++ @bfpgm {~|
@@ '[ == { inc d {<} }
@@ '] == { @d !{ {+} sto p {>} } dec d }
|} (<)
_5d_: zero d 1 @p {|| {-} []@bfpgm '] == { inc d {<} }
{-} []@bfpgm '[ == { @d !{ {} !sum p {>} } dec d }
|} (<)
)) rts
// ===================================================
{ „startingtick” }
{ „bfpgm” }
{ „bfmem” }
{ „p” /* index az épp végrehajtandó brainfuck mnemonikra */ }
{ „m” /* index a brainfuck memóriaterületre */ }
{ „d” /* munkaváltozó */ }
// ========================================
jumpingtable:
// 00 01 02 03 04 05 06 07 08 09 0a 0b 0c 0d 0e 0f
/* 00 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 01 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 02 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §_2b_ §_2c_ §_2d_ §_2e_ §____
/* 03 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §_3c_ §____ §_3e_ §____
/* 04 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 05 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §_5b_ §____ §_5d_ §____ §____
/* 06 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 07 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 08 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 09 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 0a */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 0b */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 0c */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 0d */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 0e */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 0f */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
</syntaxhighlight>
=={{header|Peri}}==
<syntaxhighlight lang="peri">
###sysinclude standard.uh
###sysinclude args.uh
###sysinclude str.uh
###sysinclude io.uh
#g argc 3 < { ."Usage: peri brainfuck02.upu brainfuckfile\n" }{
2 argv getfile
sto bfpgm
tick sto startingtick
@bfpgm '< >><<
@bfpgm '> >><<
@bfpgm '+ >><<
@bfpgm '- >><<
100000 mem dup maximize sto bfmem // Memóriaallokáció a brainfuck memóriaterület számára
sbr §brainfuck
NL
tick @startingtick #g - ."Time = " print ." tick\n"
@bfmem inv mem // A lefoglalt munkamemória felszabadítása
}
end
// ===================================================
brainfuck:
#g bfpgm~ inv { rts } // Ha nulla a brainfuck progi hossza, semmit se kell csinálni.
zero pp zero mm // Indexregiszterek lenullázása (inicializálás)
mainloop:
@pp bfpgm~ >= { rts }
@bfpgm @pp [] // Az épp aktuális brainfuck utasítás kódja
$ffffffff &
goto §jumpingtable[] // Ugrás a megfelelő brainfuck funkció rutinjára
____: ++() pp goto §mainloop
_3c_: @mm inv { rts } @bfpgm @pp [] 32 >> inv sum mm goto §____ // <
_3e_: @mm bfmem~ >= { rts } @bfpgm @pp [] 32 >> sum mm goto §____ // >
_2b_: @bfmem @mm [] @bfpgm @pp [] 32 >> #c + goto §minusba // +
_2d_: @bfmem @mm [] @bfpgm @pp [] 32 >> #c - minusba: @bfmem @mm inv rot inv [] #g goto §____ // -
_2c_: @bfmem @mm getchar inv [] goto §____
_2e_: @bfmem @mm [] printchar goto §____
_5b_: @bfmem @mm [] then §____
zero dd @pp ++ bfpgm~ {{ ,
@bfpgm {{}} [] '[ == { ++() dd {{<}} }
@bfpgm {{}} [] '] == { @dd inv { {{+}} sto pp {{>}} } --() dd }
}} goto §mainloop
_5d_: zero dd 1 @pp {{ , @bfpgm {{-}} [] '] == { ++() dd {{<}} }
@bfpgm {{-}} [] '[ == { @dd inv { {{}} inv sum pp {{>}} } --() dd }
}} goto §mainloop
// ===================================================
{ „startingtick” }
{ „bfpgm” }
{ „bfmem” }
{ „pp” /* index az épp végrehajtandó brainfuck mnemonikra */ }
{ „mm” /* index a brainfuck memóriaterületre */ }
{ „dd” /* munkaváltozó */ }
// ========================================
jumpingtable:
// 00 01 02 03 04 05 06 07 08 09 0a 0b 0c 0d 0e 0f
/* 00 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 01 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 02 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §_2b_ §_2c_ §_2d_ §_2e_ §____
/* 03 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §_3c_ §____ §_3e_ §____
/* 04 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 05 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §_5b_ §____ §_5d_ §____ §____
/* 06 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 07 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 08 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 09 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 0a */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 0b */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 0c */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 0d */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 0e */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 0f */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
</syntaxhighlight>
Yet another solution:
<syntaxhighlight lang="peri">
###sysinclude standard.uh
###sysinclude args.uh
###sysinclude str.uh
###sysinclude io.uh
#g argc 3 < { ."Usage: peri brainfuck02.upu brainfuckfile\n" }{
2 argv getfile
sto bfpgm
tick sto startingtick
@bfpgm '< >><<
@bfpgm '> >><<
@bfpgm '+ >><<
@bfpgm '- >><<
100000 mem dup maximize sto bfmem // Memóriaallokáció a brainfuck memóriaterület számára
sbr §brainfuck
NL
tick @startingtick #g - ."Time = " print ." tick\n"
@bfmem inv mem // A lefoglalt munkamemória felszabadítása
}
end
// ===================================================
brainfuck:
#g bfpgm~ inv { rts } // Ha nulla a brainfuck progi hossza, semmit se kell csinálni.
zero pp zero mm // Indexregiszterek lenullázása (inicializálás)
switchlabel:
switch "<>+-,.[]" §_3c_ §_3e_ §_2b_ §_2d_ §_2c_ §_2e_ §_5b_ §_5d_
mainloop:
safe case#c bfpgm[pp] §rtslabel // Ugrás a megfelelő brainfuck funkció rutinjára
____: ++() pp goto §mainloop
_3c_: safe bfpgm[pp] §rtslabel hilo inv sum mm goto §____ // <
_3e_: safe bfpgm[pp] §rtslabel hilo sum mm goto §____ // >
_2b_: bfpgm[pp] hilo safe sum#c bfmem[mm] §safelabel goto §____ // +
_2d_: bfpgm[pp] hilo safe inv sum#c bfmem[mm] §safelabel goto §____ // -
_2c_: getchar safe inv bfmem[mm] §rtslabel goto §____
_2e_: safe bfmem[mm] §rtslabel printchar goto §____
_5b_: safe bfmem[mm] §rtslabel then §____
switch "[]" §lbl5b0 §lbl5b1
zero dd @pp ++ bfpgm {~ ,
{~?~} case
{~<~}
lbl5b0: ++() dd {~<~}
lbl5b1: @dd inv { {~+~} sto pp goto §switchlabel } --() dd
~} goto §switchlabel
_5d_: switch "[]" §lbl5d0 §lbl5d1
zero dd 1 @pp {{ ,
bfpgm[{{-}}] case
{{<}}
lbl5d1: ++() dd {{<}}
lbl5d0: @dd inv { {{}} inv sum pp goto §switchlabel } --() dd
}} goto §switchlabel
rtslabel: rts
safelabel: ."Wrong program!" end
// ===================================================
{ „startingtick” }
{ „bfpgm” }
{ „bfmem” }
{ „pp” /* index az épp végrehajtandó brainfuck mnemonikra */ }
{ „mm” /* index a brainfuck memóriaterületre */ }
{ „dd” /* munkaváltozó */ }
// ===================================================
</syntaxhighlight>
=={{header|GAP}}==
<
Brainfuck := function(prog)
local pointer, stack, leftcells, rightcells, instr, stackptr, len,
Line 1,851 ⟶ 4,762:
# 3
# 5
# 8</
=={{header|Go}}==
Fixed size data store, no bounds checking.
<
import "fmt"
Line 1,908 ⟶ 4,820:
}
}
}</
{{out}}
<pre>
Line 1,916 ⟶ 4,828:
=={{header|Groovy}}==
<
def program = '', memory = [:]
Line 1,922 ⟶ 4,834:
def execute() {
while (instructionPointer < program.size())
switch(program[instructionPointer++]) {
case '>': dataPointer++; break;
case '<': dataPointer--; break;
case '+': memory[dataPointer] = memoryValue + 1; break
case '-': memory[dataPointer] = memoryValue - 1; break
case ',': memory[dataPointer] = System.in.read(); break
case '.': print String.valueOf(Character.toChars(
case '[': handleLoopStart(); break
case ']': handleLoopEnd(); break
}
}
Line 1,941 ⟶ 4,852:
if (memoryValue) return
int depth = 1
while (instructionPointer < program.size())
switch(program[instructionPointer++]) {
case '[': depth++; break
case ']': if (!(--depth)) return
}
throw new IllegalStateException('Could not find matching end bracket')
}
Line 1,955 ⟶ 4,865:
while (instructionPointer >= 0) {
switch(program[--instructionPointer]) {
case ']': depth++; break
case '[': if (!(--depth)) return; break
}
}
throw new IllegalStateException('Could not find matching start bracket')
}
}</
Testing:
<
{{out}}
<pre>Hello World!</pre>
Line 1,978 ⟶ 4,888:
[[/J|Implementation in J]].
=={{header|Janet}}==
[[/Janet|Implementation in Janet]].
=={{header|Java}}==
[[/Java|Implementation in Java]].
Another implementation:
<syntaxhighlight lang="java">import java.io.IOException;
public class Interpreter {
public final static int MEMORY_SIZE = 65536;
private final char[] memory = new char[MEMORY_SIZE];
private int dp;
private int ip;
private int border;
private void reset() {
for (int i = 0; i < MEMORY_SIZE; i++) {
memory[i] = 0;
}
ip = 0;
dp = 0;
}
private void load(String program) {
if (program.length() > MEMORY_SIZE - 2) {
throw new RuntimeException("Not enough memory.");
}
reset();
for (; dp < program.length(); dp++) {
memory[dp] = program.charAt(dp);
}
// memory[border] = 0 marks the end of instructions. dp (data pointer) cannot move lower than the
// border into the program area.
border = dp;
dp += 1;
}
public void execute(String program) {
load(program);
char instruction = memory[ip];
while (instruction != 0) {
switch (instruction) {
case '>':
dp++;
if (dp == MEMORY_SIZE) {
throw new RuntimeException("Out of memory.");
}
break;
case '<':
dp--;
if (dp == border) {
throw new RuntimeException("Invalid data pointer.");
}
break;
case '+':
memory[dp]++;
break;
case '-':
memory[dp]--;
break;
case '.':
System.out.print(memory[dp]);
break;
case ',':
try {
// Only works for one byte characters.
memory[dp] = (char) System.in.read();
} catch (IOException e) {
throw new RuntimeException(e);
}
break;
case '[':
if (memory[dp] == 0) {
skipLoop();
}
break;
case ']':
if (memory[dp] != 0) {
loop();
}
break;
default:
throw new RuntimeException("Unknown instruction.");
}
instruction = memory[++ip];
}
}
private void skipLoop() {
int loopCount = 0;
while (memory[ip] != 0) {
if (memory[ip] == '[') {
loopCount++;
} else if (memory[ip] == ']') {
loopCount--;
if (loopCount == 0) {
return;
}
}
ip++;
}
if (memory[ip] == 0) {
throw new RuntimeException("Unable to find a matching ']'.");
}
}
private void loop() {
int loopCount = 0;
while (ip >= 0) {
if (memory[ip] == ']') {
loopCount++;
} else if (memory[ip] == '[') {
loopCount--;
if (loopCount == 0) {
return;
}
}
ip--;
}
if (ip == -1) {
throw new RuntimeException("Unable to find a matching '['.");
}
}
public static void main(String[] args) {
Interpreter interpreter = new Interpreter();
interpreter.execute(">++++++++[-<+++++++++>]<.>>+>-[+]++>++>+++[>[->+++<<+++>]<<]>-----.>->+++..+++.>-.<<+[>[+>+]>>]<--------------.>>.+++.------.--------.>+.>+.");
}
}</syntaxhighlight>
=={{header|JavaScript}}==
Line 1,987 ⟶ 5,045:
[[/JavaScript|Implementation in JavaScript]].
=={{header|Jsish}}==
Part of the Jsi source kit unit tests. bf code from Hello World/text task entry.
<syntaxhighlight lang="javascript">/*
* javascript bf interpreter
* by wenxichang@163.com
*/
function execute(code)
{
var mem = new Array(30000);
var sp = 10000;
var opcode = new String(code);
var oplen = opcode.length;
var ip = 0;
var loopstack = new Array();
var output = "";
for (var i = 0; i < 30000; ++i) mem[i] = 0;
while (ip < oplen) {
switch(opcode[ip]) {
case '+':
mem[sp]++;
break;
case '-':
mem[sp]--;
break;
case '>':
sp++;
break;
case '<':
sp--;
break;
case '.':
if (mem[sp] != 10 && mem[sp] != 13) {
output = output + Util.fromCharCode(mem[sp]);
} else {
puts(output);
output = "";
}
break;
case ',':
var s = console.input();
if (!s) exit(0);
mem[sp] = s.charCodeAt(0);
break;
case '[':
if (mem[sp]) {
loopstack.push(ip);
} else {
for (var k = ip, j = 0; k < oplen; k++) {
opcode[k] == '[' && j++;
opcode[k] == ']' && j--;
if (j == 0) break;
}
if (j == 0) ip = k;
else {
puts("Unmatched loop");
return false;
}
}
break;
case ']':
ip = loopstack.pop() - 1;
break;
default:
break;
}
ip++;
}
return true;
};
if (Interp.conf('unitTest') > 0) execute('
++++++++++[>+>+++>++++>+++++++ >++++++++>+++++++++>++++++++++>+++++++++
++>++++++++++++<<<<<<<<<-]>>>>+.>>>>+..<.<++++++++.>>>+.<<+.<<<<++++.<+
+.>>>+++++++.>>>.+++.<+++++++.--------.<<<<<+.<+++.---.
');</syntaxhighlight>
{{out}}
<pre>prompt$ jsish --U bf.jsi
Goodbye, World!
</pre>
=={{header|Julia}}==
{{works with|Julia|0.6}}
{{trans|Python}}
<syntaxhighlight lang="julia">using DataStructures
function execute(src)
pointers = Dict{Int,Int}()
stack = Int[]
for (ptr, opcode) in enumerate(src)
if opcode == '[' push!(stack, ptr) end
if opcode == ']'
if isempty(stack)
src = src[1:ptr]
break
end
sptr = pop!(stack)
pointers[ptr], pointers[sptr] = sptr, ptr
end
end
if ! isempty(stack) error("unclosed loops at $stack") end
tape = DefaultDict{Int,Int}(0)
cell, ptr = 0, 1
while ptr ≤ length(src)
opcode = src[ptr]
if opcode == '>' cell += 1
elseif opcode == '<' cell -= 1
elseif opcode == '+' tape[cell] += 1
elseif opcode == '-' tape[cell] -= 1
elseif opcode == ',' tape[cell] = Int(read(STDIN, 1))
elseif opcode == '.' print(STDOUT, Char(tape[cell]))
elseif (opcode == '[' && tape[cell] == 0) ||
(opcode == ']' && tape[cell] != 0) ptr = pointers[ptr]
end
ptr += 1
end
end
const src = """\
>++++++++[<+++++++++>-]<.>>+>+>++>[-]+<[>[->+<<++++>]<<]>.+++++++..+++.>
>+++++++.<<<[[-]<[-]>]<+++++++++++++++.>>.+++.------.--------.>>+.>++++."""
execute(src)</syntaxhighlight>
{{out}}
<pre>Hello World!</pre>
=={{header|Kotlin}}==
{{trans|Groovy}}
<
class Brainf__k(val prog: String,
private val mem = IntArray(memSize)
private var ip = 0
Line 2,040 ⟶ 5,229:
val prog = "++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>."
Brainf__k(prog, 10).execute()
}</
{{out}}
Line 2,051 ⟶ 5,240:
Expects the program to be the first argument, compiles to bytecode (without optimization), uses a 1MB array of cells (and wraps), includes some rudimentary compiler diagnostics.
<
include "sys.m"; sys: Sys;
Line 2,153 ⟶ 5,342:
}
}
</syntaxhighlight>
{{out}}
Line 2,168 ⟶ 5,357:
[[/Lua|Implementation in Lua]].
===Simple meta-implementation using <code>load</code>===
<syntaxhighlight lang="lua">local funs = {
['>'] = 'ptr = ptr + 1; ',
['<'] = 'ptr = ptr - 1; ',
['+'] = 'mem[ptr] = mem[ptr] + 1; ',
['-'] = 'mem[ptr] = mem[ptr] - 1; ',
['['] = 'while mem[ptr] ~= 0 do ',
[']'] = 'end; ',
['.'] = 'io.write(string.char(mem[ptr])); ',
[','] = 'mem[ptr] = (io.read(1) or "\\0"):byte(); ',
}
local prog = [[
local mem = setmetatable({}, { __index = function() return 0 end})
local ptr = 1
]]
local source = io.read('*all')
for p = 1, #source do
local snippet = funs[source:sub(p,p)]
if snippet then prog = prog .. snippet end
end
load(prog)()</syntaxhighlight>
BTW very fast, considering how simple it is.
=={{header|M2000 Interpreter}}==
<syntaxhighlight lang="m2000 interpreter">
Module Checkit {
\\ Brain**** Compiler
Escape Off
\\ no Esc function so we can use Ctrl+Z when input characters to terminate BF
\\ ctrl+c open dialog for exit - by default in console mode
Const skipmonitor as boolean=true, output as boolean=True
Const ob$="{",cb$="}"
Gosub CallOne
\\ We use a group object with events.
Group WithEvents BF=BrainF()
Function BF_monitor {
\\ Event functions have same scope as the module where belong
If skipmonitor Then exit
Read New pc, mem
Print pc, mem
Print "Press space bar": While Key$<>" " {}
}
Function BF_newline {
If not skipmonitor then Print "newline" : exit
if output then Print
}
Function BF_print {
Read New c$
If not skipmonitor then Print "character:";c$ : exit
if output then Print c$;
}
Program$ = {++++++[>++++++++++++<-]>.
>++++++++++[>++++++++++<-]>+.
+++++++..+++.>++++[>+++++++++++<-]>.
<+++[>----<-]>.<<<<<+++[>+++++<-]>.
>>.+++.------.--------.>>+.
}
Report Program$
ExecBF(Program$)
End
Sub ExecBF(Code$)
ClearMem()
code$=filter$(code$, " "+chr$(10)+chr$(13))
code$<=replace$(".","@", code$)
code$<=replace$("-","-.D()", code$)
code$<=replace$("+","-.A()", code$)
code$<=replace$("<","-.L()", code$)
code$<=replace$(">","-.R()", code$)
code$<=replace$("@","-.P()", code$)
code$<=replace$("[","-.S("+ob$,code$)
code$<=replace$("]",cb$+")",code$)
code$<=replace$(",","-.K()", code$)
Rem : Print code$
BF.Eval code$
Print
End Sub
Sub ClearMem()
Dim cMem(1 to 30000)=0
For BF {
.Pc=1
.Zero=True
.Mem()=cMem()
}
End Sub
CallOne:
Class BrainF {
events "monitor", "newline", "print"
Dim Mem()
Pc=1, Zero as Boolean=True
Module UpdateZero {
.Zero<=.Mem(.Pc)=0
call event "monitor", .pc, .Mem(.pc)
}
Function A { \\ +
.Mem(.Pc)++
.UpdateZero
}
Function D { \\ -
.Mem(.Pc)--
.UpdateZero
}
Function R { \\ >
If .Pc=30000 Then Error "Upper Bound Error"
.Pc++
.UpdateZero
}
Function L { \\ <
If .Pc=1 Then Error "Lower Bound Error"
.Pc--
.UpdateZero
}
Function P { \\ .
Select Case .Mem(.Pc)
Case >31
Call Event "print", Chr$(.Mem(.Pc))
Case 10
Call Event "newline"
End Select
}
Function K { \\ ,
.Mem(.Pc)=Asc(Key$)
\\ ctrl+z for exit
If .Mem(.Pc)=26 Then Error "Finished"
.UpdateZero
}
Function S { \\ [
If .Zero then =0: exit
Read newEval$
Do {ret=Eval(newEval$)} until .Zero
}
Module Eval {
ret=eval(Letter$)
}
}
Return
}
Checkit
</syntaxhighlight>
=={{header|Mathematica}} / {{header|Wolfram Language}}==
<syntaxhighlight lang="text">bf[program_, input_] :=
Module[{p = Characters[program], pp = 0, m, mp = 0, bc = 0,
instr = StringToStream[input]},
Line 2,191 ⟶ 5,531:
While[bc < 0, pp--; Switch[p[[pp]], "[", bc++, "]", bc--]]]]];
Close[instr];];
bf[program_] := bf[program, ""]</
Example:
<syntaxhighlight lang="text">bf["++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.
<<+++++++++++++++.>.+++.------.--------.>+.>."]</
{{out}}
Line 2,204 ⟶ 5,544:
[[/Modula-3|Implementation in Modula-3]].
=={{header|Nanoquery}}==
<syntaxhighlight lang="nanoquery">// nanoquery has no function to get just a character
// so we have to implement our own
def get_char()
c = ""
while len(c)=0
c = input()
end
return c[0]
end
// a function to handle fatal errors
def fatal_error(errtext)
println "%" + errtext
println "usage: " + args[1] + " [filename.bf]"
exit
end
// get a filename from the command line and read the file in
fname = null
source = null
try
fname = args[2]
source = new(Nanoquery.IO.File, fname).readAll()
catch
fatal_error("error while trying to read from specified file")
end
// start with one hundred cells and the pointer at 0
cells = {0} * 100
ptr = 0
// loop through the instructions
loc = 0
while loc < len(source)
instr = source[loc]
if instr = ">"
ptr += 1
if ptr = len(cells)
cells.append(0)
end
else if instr = "<"
ptr -= 1
if ptr < 0
ptr = 0
end
else if instr = "+"
cells[ptr] += 1
else if instr = "-"
cells[ptr] -= 1
else if instr = "."
print chr(cells[ptr])
else if instr = ","
cells[ptr] = ord(get_char())
else if instr = "["
if cells[ptr] = 0
while source[loc] != "]"
loc += 1
end
end
else if instr = "]"
if cells[ptr] != 0
while source[loc] != "["
loc -= 1
end
end
else
// do nothing
end
loc += 1
end</syntaxhighlight>
=={{header|Never}}==
<syntaxhighlight lang="never">
record BFI
{
cmd : char;
next : BFI;
jmp : BFI;
}
record MEM
{
val : int;
next : MEM;
prev : MEM;
}
func compile(prog : string) -> BFI
{
var i = 0;
var n = BFI;
var p = BFI;
var j = BFI;
var pgm = BFI;
for (i = 0; i < length(prog); i = i + 1) {
n = BFI('0', nil, nil);
if (p != nil) {
p.next = n
} else {
pgm = n
};
n.cmd = prog[i];
p = n;
if (prog[i] == '[') {
n.jmp = j;
j = n;
0
} else if (prog[i] == ']') {
n.jmp = j;
j = j.jmp;
n.jmp.jmp = n;
0
} else {
0
}
};
pgm
}
func exec(pgm : BFI) -> int
{
var m = MEM(0, nil, nil);
var n = BFI;
for (n = pgm; n != nil; n = n.next) {
if (n.cmd == '+') {
m.val = m.val + 1
} else if (n.cmd == '-') {
m.val = m.val - 1
} else if (n.cmd == '.') {
printc(chr(m.val));
0
} else if (n.cmd == ',') {
m.val = read()
} else if (n.cmd == '[') {
if (m.val == 0) {
n = n.jmp;
0
} else {
0
}
} else if (n.cmd == ']') {
if (m.val != 0) {
n = n.jmp;
0
} else {
0
}
} else if (n.cmd == '<') {
m = m.prev;
0
} else if (n.cmd == '>') {
if (m.next == nil) {
m.next = MEM(0, nil, nil);
m.next.prev = m;
0
} else {
0
};
m = m.next;
0
} else {
0
}
};
0
}
func run(prog : string) -> int
{
var pgm = BFI;
pgm = compile(prog);
exec(pgm);
0
}
func main() -> int
{
/* Hello World! */
run("++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.");
0
}
</syntaxhighlight>
=={{header|NewLISP}}==
<syntaxhighlight lang="newlisp">
; This module translates a string containing a
; Brainf*** program into a list of NewLISP expressions.
; Attempts to optimize consecutive +, -, > and < operations
; as well as bracket loops.
; Create a namespace and put the following definitions in it
(context 'BF)
; If BF:quiet is true, BF:run will return the output of the
; Brainf*** program
(define quiet)
; If BF:show-timing is true, the amount of milliseconds spent
; in 'compiling' (actually translating) and running the
; resulting program will be shown
(define show-timing true)
; The Brainf*** program as a string of characters
(define src "")
; Checks for correct pairs of brackets
(define (well-formed?)
(let (p 0)
(dostring (i src (> 0 p))
(case i
("[" (++ p))
("]" (-- p))))
(zero? p)))
; Translate the Brainf*** command into S-expressions
(define (_compile)
(let ((prog '())
; Translate +
(incr '(++ (tape i) n))
; Translate -
(decr '(-- (tape i) n))
; Translate .
(emit (if quiet
'(push (char (tape i)) result -1)
'(print (char (tape i)))))
; Translate ,
(store '(setf (tape i) (read-key)))
; Check for loop condition
(over? '(zero? (tape i)))
; Current character of the program
(m)
; Find how many times the same character occurs
(rep (fn ((n 1))
(while (= m (src 0))
(++ n)
(pop src))
n)))
; Traverse the program and translate recursively
(until (or (empty? src) (= "]" (setq m (pop src))))
(case m
(">" (push (list '++ 'i (rep)) prog -1))
("<" (push (list '-- 'i (rep)) prog -1))
("+" (push (expand incr '((n (rep))) true) prog -1))
("-" (push (expand decr '((n (rep))) true) prog -1))
("." (push emit prog -1))
("," (push store prog -1))
("[" (push (append (list 'until over?)
(_compile))
prog -1))))
prog))
(define (compile str , tim code)
(setq src (join
(filter (fn (x)
(member x '("<" ">" "-" "+"
"." "," {[} {]})))
(explode str))))
; Throw an error if the program is ill-formed
(unless (well-formed?)
(throw-error "Unbalanced brackets in Brainf*** source string"))
(setq tim (time (setq code (cons 'begin (_compile)))))
(and show-timing (println "Compilation time: " tim))
code)
; Translate and run
; Tape size is optional and defaults to 30000 cells
(define (run str (size 30000))
(let ((tape (array size '(0)))
(i 0)
(result '())
(tim 0)
(prog (compile str)))
(setq tim (time (eval prog)))
(and show-timing (println "Execution time: " tim))
(and quiet (join result))))
; test - run it with (BF:test)
(define (test)
(run "++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>."))
; to interpret a string of Brainf*** code, use (BF:run <string>)
; to interpret a Brainf*** code file, use (BF:run (read-file <path-to-file>))
</syntaxhighlight>
=={{header|Nim}}==
<
var
Line 2,237 ⟶ 5,882:
inc i
discard run()</
{{out}}
If given in input the string <code>++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.</code>, output is:
<pre>Hello World!
</pre>
=={{header|Objeck}}==
<
@program : String;
@ip : Int; @dp : Int;
New(program : String, size : Int) {
Line 2,251 ⟶ 5,901:
function : Main(args : String[]) ~ Nil {
if(args → Size() = 2) {
};
}
Line 2,265 ⟶ 5,914:
label '-': { @mem[@dp] := @mem[@dp] - 1; }
label '.': { value := @mem[@dp] → As(Char); value → Print(); }
label ',': { @mem[@dp] := Read(); }
label '[': { JumpForward(); }
label ']': { JumpBack(); }
Line 2,278 ⟶ 5,927:
while(@ip < @program → Size()) {
instr := @program → Get(@ip);
if(instr = ']') {
}
else if(instr = '[') { depth += 1; };
@ip += 1;
};
"*** Unbalanced jump ***" → ErrorLine(
Runtime → Exit(1);
};
}
Line 2,289 ⟶ 5,942:
if(@mem[@dp] <> 0) {
while(@ip > 0) {
@ip -= 1
if(instr = '[') {
depth -= 1; if(depth = 0) { return; };
}
else if(instr = ']') { depth += 1; };
};
"*** Unbalanced jump ***" → ErrorLine(
Runtime → Exit(1);
};
}
method : Read() ~
in := IO.Console → ReadString();
if(
return
}
}</
=={{header|OCaml}}==
Line 2,309 ⟶ 5,966:
=={{header|Ol}}==
<syntaxhighlight lang="scheme">
(define (bf program stack-length)
(let ((program (string-append program "]")); end
(program-counter 0)
(stack (make-
(stack-pointer 0))
(letrec ((skip (lambda (PC sp in)
(let loop ((pc PC) (sp sp) (in in))
(let ((ch (string-ref program pc))
(pc (+ pc 1)))
(case ch
(#\] (list pc sp in))
(#\[ (apply loop (skip pc sp in)))
(else
(loop pc sp in)))))))
(step (lambda (PC SP IN)
(let loop ((pc PC) (sp SP) (in IN))
(let ((ch (string-ref program pc))
(pc (+ pc 1)))
(case ch
(#\] (list (- PC 1) sp in)) ; the end
(#\[ (if (eq? (
(apply loop (skip pc sp in))
(apply loop (step pc sp in))))
(#\+ (set-ref! stack sp (mod (+ (
(loop pc sp in))
(#\- (set-ref! stack sp (
(loop pc sp in))
(#\> (loop pc (+ sp 1) in))
(#\< (loop pc (- sp 1) in))
(#\. (display (
(loop pc sp in))
(
((pair? in)
(set-ref! stack sp (car in))
(loop pc sp (cdr in)))
((null? in)
(set-ref! stack sp 0)
(loop pc sp in))
(else
(this (force in))))))
(else ; skip any invalid character
(loop pc sp in))))))))
(step 0 0 (port->bytestream stdin)))))
</syntaxhighlight>
{{Out}}
<pre>
> (bf "++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>." 30000) ; (print "Hello World!")
Hello World!
> (bf ">>++++[<++++[<++++>-]>-]<<." 30000) ; (display "@")
@
@
> (bf ">>++++[<++++[<++++>-]>-]<<.[-]++++++++++." 30000) ; this time (print "@")
@
; brainfuck interpreter in brainfuck (c) Daniel B Cristofani (cristofdathevanetdotcom)
; use stdin to input a brainfuck program and its input, separated by an exclamation point.
;
; provided program makes +2 to every character and print the line,
; ^D means pressing "Ctrl+D" (an 4, or EOT, or end-of-xmit ANSI control character).
> (bf ">>>+[[-]>>[-]++>+>+++++++[<++++>>++<-]++>>+>+>+++++[>++>++++++<<-]+>>>,<++[[>[
->>]<[>>]<<-]<[<]<+>>[>]>[<+>-[[<+>-]>]<[[[-]<]++<-[<+++++++++>[<->-]>>]>>]]<<
]<]<[[<]>[[>]>>[>>]+[<<]<[<]<+>>-]>[>]+[->>]<<<<[[<<]<[<]+<<[+>+<<-[>-->+<<-[>
+<[>>+<<-]]]>[<+>-]<]++>>-->[>]>>[>>]]<<[>>+<[[<]<]>[[<<]<[<]+[-<+>>-[<<+>++>-
[<->[<<+>>-]]]<[>+<-]>]>[>]>]>[>>]>>]<<[>>+>>+>>]<<[->>>>>>>>]<<[>.>>>>>>>]<<[
>->>>>>]<<[>,>>>]<<[>+>]<<[+<<]<]" 30000)
>,[>,]<[+<]>[----.>]!Khoor#Eudlqixfn$^D
Hello Brainfuck!
</pre>
=={{header|PARI/GP}}==
A case statement would have been really useful here...
<
prog=Vec(Str(prog));
my(codeptr,ptr=1,v=vector(1000),t);
Line 2,397 ⟶ 6,087:
)
)
};</
=={{header|Pascal}}==
<syntaxhighlight lang="pascal">
program rcExceuteBrainF;
Line 2,497 ⟶ 6,188:
end.
</syntaxhighlight>
=={{header|Perl}}==
Line 2,503 ⟶ 6,194:
[[/Perl|Implementation in Perl]].
===Actually compile the Brain****===
<syntaxhighlight lang="perl">#!/usr/bin/perl
my %code = split ' ', <<'END';
> $ptr++
< $ptr--
+ $memory[$ptr]++
- $memory[$ptr]--
, $memory[$ptr]=ord(getc)
. print(chr($memory[$ptr]))
[ while($memory[$ptr]){
]
END
my ($ptr, @memory) = 0;
eval join ';', map @code{ /./g }, <>;</syntaxhighlight>
=={{header|Phix}}==
<!--<syntaxhighlight lang="phix">(phixonline)-->
<span style="color: #008080;">procedure</span> <span style="color: #000000;">bfi</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">pgm</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">jumptable</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">pgm</span><span style="color: #0000FF;">)),</span>
<span style="color: #000000;">loopstack</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{},</span>
<span style="color: #000000;">data</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">10</span><span style="color: #0000FF;">)</span> <span style="color: #000080;font-style:italic;">-- size??</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">skip</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">ch</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">loopstart</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">pc</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">dp</span>
<span style="color: #000080;font-style:italic;">--
-- compile (pack/strip comments and link jumps)
--</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">pgm</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">ch</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">pgm</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">switch</span> <span style="color: #000000;">ch</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">case</span> <span style="color: #008000;">'['</span><span style="color: #0000FF;">:</span> <span style="color: #000000;">loopstack</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">loopstack</span><span style="color: #0000FF;">,</span><span style="color: #000000;">i</span><span style="color: #0000FF;">-</span><span style="color: #000000;">skip</span><span style="color: #0000FF;">);</span>
<span style="color: #000000;">pgm</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">-</span><span style="color: #000000;">skip</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">ch</span><span style="color: #0000FF;">;</span>
<span style="color: #008080;">case</span> <span style="color: #008000;">']'</span><span style="color: #0000FF;">:</span> <span style="color: #000000;">loopstart</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">loopstack</span><span style="color: #0000FF;">[$];</span>
<span style="color: #000000;">loopstack</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">loopstack</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">..-</span><span style="color: #000000;">2</span><span style="color: #0000FF;">];</span>
<span style="color: #000000;">jumptable</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">-</span><span style="color: #000000;">skip</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">loopstart</span><span style="color: #0000FF;">;</span>
<span style="color: #000000;">jumptable</span><span style="color: #0000FF;">[</span><span style="color: #000000;">loopstart</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">-</span><span style="color: #000000;">skip</span><span style="color: #0000FF;">;</span>
<span style="color: #008080;">fallthrough</span>
<span style="color: #008080;">case</span> <span style="color: #008000;">'+'</span><span style="color: #0000FF;">,</span><span style="color: #008000;">'-'</span><span style="color: #0000FF;">,</span><span style="color: #008000;">'<'</span><span style="color: #0000FF;">,</span><span style="color: #008000;">'>'</span><span style="color: #0000FF;">,</span><span style="color: #008000;">','</span><span style="color: #0000FF;">,</span><span style="color: #008000;">'.'</span><span style="color: #0000FF;">:</span> <span style="color: #000000;">pgm</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">-</span><span style="color: #000000;">skip</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">ch</span><span style="color: #0000FF;">;</span>
<span style="color: #008080;">default</span><span style="color: #0000FF;">:</span> <span style="color: #000000;">skip</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">switch</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">loopstack</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span> <span style="color: #0000FF;">?</span><span style="color: #000000;">9</span><span style="color: #0000FF;">/</span><span style="color: #000000;">0</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">pgm</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">pgm</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">..-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">-</span><span style="color: #000000;">skip</span><span style="color: #0000FF;">]</span>
<span style="color: #000080;font-style:italic;">--
-- main execution loop
--</span>
<span style="color: #000000;">pc</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span>
<span style="color: #000000;">dp</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">pc</span><span style="color: #0000FF;"><=</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">pgm</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">ch</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">pgm</span><span style="color: #0000FF;">[</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">switch</span> <span style="color: #000000;">ch</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">case</span> <span style="color: #008000;">'>'</span><span style="color: #0000FF;">:</span> <span style="color: #000000;">dp</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span> <span style="color: #008080;">if</span> <span style="color: #000000;">dp</span><span style="color: #0000FF;">></span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">data</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span> <span style="color: #000000;">dp</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">case</span> <span style="color: #008000;">'<'</span><span style="color: #0000FF;">:</span> <span style="color: #000000;">dp</span> <span style="color: #0000FF;">-=</span> <span style="color: #000000;">1</span> <span style="color: #008080;">if</span> <span style="color: #000000;">dp</span><span style="color: #0000FF;"><</span><span style="color: #000000;">1</span> <span style="color: #008080;">then</span> <span style="color: #000000;">dp</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">data</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">case</span> <span style="color: #008000;">'+'</span><span style="color: #0000FF;">:</span> <span style="color: #000000;">data</span><span style="color: #0000FF;">[</span><span style="color: #000000;">dp</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">case</span> <span style="color: #008000;">'-'</span><span style="color: #0000FF;">:</span> <span style="color: #000000;">data</span><span style="color: #0000FF;">[</span><span style="color: #000000;">dp</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">-=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">case</span> <span style="color: #008000;">','</span><span style="color: #0000FF;">:</span> <span style="color: #000000;">data</span><span style="color: #0000FF;">[</span><span style="color: #000000;">dp</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">platform</span><span style="color: #0000FF;">()=</span><span style="color: #004600;">JS</span><span style="color: #0000FF;">?</span><span style="color: #008000;">'?'</span><span style="color: #0000FF;">:</span><span style="color: #7060A8;">getc</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">))</span>
<span style="color: #008080;">case</span> <span style="color: #008000;">'.'</span><span style="color: #0000FF;">:</span> <span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">data</span><span style="color: #0000FF;">[</span><span style="color: #000000;">dp</span><span style="color: #0000FF;">])</span>
<span style="color: #008080;">case</span> <span style="color: #008000;">'['</span><span style="color: #0000FF;">:</span> <span style="color: #008080;">if</span> <span style="color: #000000;">data</span><span style="color: #0000FF;">[</span><span style="color: #000000;">dp</span><span style="color: #0000FF;">]=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span> <span style="color: #000000;">pc</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">jumptable</span><span style="color: #0000FF;">[</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">case</span> <span style="color: #008000;">']'</span><span style="color: #0000FF;">:</span> <span style="color: #008080;">if</span> <span style="color: #000000;">data</span><span style="color: #0000FF;">[</span><span style="color: #000000;">dp</span><span style="color: #0000FF;">]!=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span> <span style="color: #000000;">pc</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">jumptable</span><span style="color: #0000FF;">[</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">default</span><span style="color: #0000FF;">:</span> <span style="color: #0000FF;">?</span><span style="color: #000000;">9</span><span style="color: #0000FF;">/</span><span style="color: #000000;">0</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">switch</span>
<span style="color: #000000;">pc</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">bf</span><span style="color: #0000FF;">=</span><span style="color: #008000;">"++++++++[>++++[>++>++++>+++>+<<<<-]>++>->+>>+[<]<-]>>.>>.+.<.>>.<<<++.>---------.>------.<----.++++++++.>>+.>++.+++."</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">fb</span><span style="color: #0000FF;">=</span><span style="color: #008000;">"++++++++[>++++[>++>++++>+++>+<<<<-]>++>->+>>+[<]<-]>>.>>.+.<.>>.<<<+++.>---.>------.++++++++.<--.>>+.>++.+++.,"</span>
<span style="color: #000000;">bfi</span><span style="color: #0000FF;">(</span><span style="color: #000000;">bf</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">bfi</span><span style="color: #0000FF;">(</span><span style="color: #000000;">fb</span><span style="color: #0000FF;">)</span>
<!--</syntaxhighlight>-->
{{out}}
<pre>
Line 2,567 ⟶ 6,274:
=={{header|PHP}}==
<
function brainfuck_interpret(&$s, &$_s, &$d, &$_d, &$i, &$_i, &$o) {
do {
Line 2,619 ⟶ 6,326:
$inp = '123';
print brainfuck( $code, $inp );
</syntaxhighlight>
=={{header|PicoLisp}}==
Line 2,625 ⟶ 6,332:
of a single cell initially, and grows automatically in both directions. The
value in each cell is unlimited.
<
(de compile (File)
Line 2,672 ⟶ 6,379:
(while (cadr Data) # Find beginning of data
(setq Data @) )
(filter prog Data '(T NIL .)) ) ) # Return data space</
{{out}}
<pre>: (compile "hello.bf")
Line 2,714 ⟶ 6,421:
===Dynamic solution===
Dynamic and unlimited. Unwraping cells. Checking syntax.
<
(let S NIL
(make
Line 2,771 ⟶ 6,478:
-----.[-]>++++++++[<++++>- ]<+.[-]++++++++++." ) )
(bye)</
=={{header|PL/M}}==
This program is written to run under CP/M. The BF program is read from the file
given on the command line.
<syntaxhighlight lang="plm">100H:
/* CP/M BDOS CALLS */
BDOS: PROCEDURE (FN, ARG) BYTE;
DECLARE FN BYTE, ARG ADDRESS;
GO TO 5;
END BDOS;
READ$CHAR: PROCEDURE BYTE; RETURN BDOS(1, 0); END READ$CHAR;
WRITE$CHAR: PROCEDURE (CHAR); DECLARE CHAR BYTE;
CHAR = BDOS(2, CHAR); END WRITE$CHAR;
PRINT: PROCEDURE (STRING); DECLARE STRING ADDRESS;
STRING = BDOS(9, STRING); END PRINT;
OPEN$FILE: PROCEDURE (FCB) BYTE; DECLARE FCB ADDRESS;
RETURN BDOS(15, FCB); END OPEN$FILE;
READ$FILE: PROCEDURE (FCB, ADDR) BYTE;
DECLARE (FCB, ADDR) ADDRESS, FOO BYTE;
FOO = BDOS(26, ADDR);
RETURN BDOS(20, FCB);
END READ$FILE;
EXIT: PROCEDURE; MEMORY(0) = BDOS(0,0); END EXIT;
/* TOP OF AVAILABLE MEMORY IN CP/M */
DECLARE MTPTR ADDRESS INITIAL (6), MEM$TOP BASED MTPTR ADDRESS;
/* FILE GIVEN ON COMMAND LINE */
DECLARE FCB1 LITERALLY '5CH';
/* PRINT ERROR AND EXIT */
ERROR: PROCEDURE (STRING);
DECLARE STRING ADDRESS;
CALL PRINT(STRING);
CALL EXIT;
END ERROR;
/* OPEN FILE */
IF OPEN$FILE(FCB1) = 0FFH THEN
CALL ERROR(.'CANNOT OPEN INPUT FILE$');
/* READ FILE BLOCK BY BLOCK */
DECLARE MP ADDRESS, M BASED MP BYTE;
MEMORY(0) = 26;
MP = .MEMORY + 1;
DO WHILE READ$FILE(FCB1, MP) <> 1;
MP = MP + 128;
END;
M = 26; /* TERMINATE WITH EOF */
MP = MP + 1;
/* CLEAR THE REST OF MEMORY */
DECLARE X ADDRESS;
DO X = 0 TO MEM$TOP-MP-1;
M(X) = 0;
END;
/* BRAINF*** I/O WITH CR/LF TRANSLATION */
BF$WRITE: PROCEDURE (CHAR);
DECLARE CHAR BYTE;
IF CHAR = 10 THEN CALL WRITE$CHAR(13);
CALL WRITE$CHAR(CHAR);
END BF$WRITE;
BF$READ: PROCEDURE BYTE;
DECLARE EOF$REACHED BYTE INITIAL (0), CH BYTE;
IF EOF$REACHED THEN RETURN 0;
CH = READ$CHAR;
IF CH = 13 THEN RETURN 10;
ELSE IF CH = 26 THEN DO;
EOF$REACHED = 1;
RETURN 0;
END;
ELSE RETURN CH;
END BF$READ;
/* EXECUTE COMMANDS */
DECLARE IP ADDRESS, I BASED IP BYTE;
DECLARE EOF$REACHED BYTE INITIAL (0), DEPTH ADDRESS;
DECLARE BRACKET$ERR DATA ('MISMATCHED BRACKETS$');
DECLARE B$OPEN LITERALLY '91', B$CLOSE LITERALLY '93';
IP = .MEMORY + 1;
DO WHILE I <> 26;
IF I = '+' THEN M = M + 1;
ELSE IF I = '-' THEN M = M - 1;
ELSE IF I = '>' THEN MP = MP + 1;
ELSE IF I = '<' THEN MP = MP - 1;
ELSE IF I = '.' THEN CALL BF$WRITE(M);
ELSE IF I = ',' THEN M = BF$READ;
ELSE IF I = B$OPEN AND M = 0 THEN DO;
DEPTH = 1;
DO WHILE DEPTH > 0;
IP = IP + 1;
IF I = B$OPEN THEN DEPTH = DEPTH + 1;
ELSE IF I = B$CLOSE THEN DEPTH = DEPTH - 1;
ELSE IF I = 26 THEN CALL ERROR(.BRACKET$ERR);
END;
END;
ELSE IF I = B$CLOSE AND M <> 0 THEN DO;
DEPTH = 1;
DO WHILE DEPTH > 0;
IP = IP - 1;
IF I = B$OPEN THEN DEPTH = DEPTH - 1;
ELSE IF I = B$CLOSE THEN DEPTH = DEPTH + 1;
ELSE IF I = 26 THEN CALL ERROR(.BRACKET$ERR);
END;
END;
IP = IP + 1;
END;
CALL EXIT;
EOF</syntaxhighlight>
=={{header|Pointless}}==
<syntaxhighlight lang="pointless">-- Code based on
-- https://github.com/allisio/pointless/blob/master/lib/examples/brainfuck.ptls
output =
iterate(run, vm)
|> takeUntil(isFinished)
|> map(vm => vm.outVal)
|> filter(notEq(None))
|> map(char)
|> printElems
----------------------------------------------------------
vm = VM {
ip = 0
dp = 0
data = zeroArray(1000)
inVals = map(ord, readLines)
outVal = None
}
----------------------------------------------------------
-- "hello.bf" contains brainf*** hello world code
ops = toArray(readFile("hello.bf"))
----------------------------------------------------------
run(vm) = vm |> clearOutput |> eval |> advance
advance(vm) = vm with $.ip += 1
isFinished(vm) = vm.ip >= length(ops)
clearOutput(vm) = vm with $.outVal = None
----------------------------------------------------------
jumps = getJumps(0, [], {})
getJumps(i, stack, jumps) = cond {
case (i == length(ops)) jumps
case (ops[i] == "[")
getJumps(i + 1, [i] ++ stack, jumps)
case (ops[i] == "]")
getJumps(i + 1, tail(stack), jumps with {
$[i] = head(stack)
$[head(stack)] = i
})
else getJumps(i + 1, stack, jumps)
}
----------------------------------------------------------
eval(vm) = cond {
case (op == ">") vm with $.dp += 1
case (op == "<") vm with $.dp -= 1
case (op == "+") vm with $.data[vm.dp] += 1
case (op == "-") vm with $.data[vm.dp] -= 1
case (op == ".") vm with $.outVal = byte
case (op == ",") vm with {
$.data[vm.dp] = head(vm.inVals)
$.inVals = tail(vm.inVals)
}
case (op == "[")
if byte != 0 then vm
else (vm with $.ip = jumps[vm.ip])
case (op == "]")
if byte == 0 then vm
else (vm with $.ip = jumps[vm.ip])
else vm
} where {
op = ops[vm.ip]
byte = vm.data[vm.dp]
}</syntaxhighlight>
=={{header|Potion}}==
{{incorrect|Potion|
Example fails this test due to incorrect loop implementation: <
>->+++..+++.>-.<<+[>[+>+]>>]<--------------.>>.+++.------.--------.>+.>+.</
Tape is infinite length to the right. Cells use default Potion integer type.
<syntaxhighlight lang="text"># Where `code` is a string.
bf = (code) :
tape = (0)
Line 2,797 ⟶ 6,704:
.
.
.</
=={{header|
Features: Ignores comments (non brainf*** characters), Can run as command, or from file, no limit on memory.
<syntaxhighlight lang="prolog">/******************************************
Starting point, call with program in atom.
*******************************************/
brain(Program) :-
atom_chars(Program, Instructions),
process_bf_chars(Instructions).
brain_from_file(File) :- % or from file...
read_file_to_codes(File, Codes, []),
maplist(char_code, Instructions, Codes),
process_bf_chars(Instructions).
process_bf_chars(Instructions) :-
phrase(bf_to_pl(Code), Instructions, []),
Code = [C|_],
instruction(C, Code, mem([], [0])), !.
/********************************************
DCG to parse the bf program into prolog form
*********************************************/
bf_to_pl([]) --> [].
bf_to_pl([loop(Ins)|Next]) --> loop_start, bf_to_pl(Ins), loop_end, bf_to_pl(Next).
bf_to_pl([Ins|Next]) --> bf_code(Ins), bf_to_pl(Next).
bf_to_pl(Ins) --> [X], { \+ member(X, ['[',']',>,<,+,-,'.',',']) }, bf_to_pl(Ins). % skip non bf characters
loop_start --> ['['].
loop_end --> [']'].
bf_code(next_addr) --> ['>'].
bf_code(prev_addr) --> ['<'].
bf_code(inc_caddr) --> ['+'].
bf_code(dec_caddr) --> ['-'].
bf_code(out_caddr) --> ['.'].
bf_code(in_caddr) --> [','].
/**********************
Instruction Processor
***********************/
instruction([], _, _).
instruction(I, Code, Mem) :-
mem_instruction(I, Mem, UpdatedMem),
next_instruction(Code, NextI, NextCode),
!, % cuts are to force tail recursion, so big programs will run
instruction(NextI, NextCode, UpdatedMem).
% to loop, add the loop code to the start of the program then execute
% when the loop has finished it will reach itself again then can retest for zero
instruction(loop(LoopCode), Code, Mem) :-
caddr(Mem, X),
dif(X, 0),
append(LoopCode, Code, [NextI|NextLoopCode]),
!,
instruction(NextI, [NextI|NextLoopCode], Mem).
instruction(loop(_), Code, Mem) :-
caddr(Mem, 0),
next_instruction(Code, NextI, NextCode),
!,
instruction(NextI, NextCode, Mem).
% memory is stored in two parts:
% 1. a list with the current address and everything after it
% 2. a list with the previous memory in reverse order
mem_instruction(next_addr, mem(Mb, [Caddr]), mem([Caddr|Mb], [0])).
mem_instruction(next_addr, mem(Mb, [Caddr,NextAddr|Rest]), mem([Caddr|Mb], [NextAddr|Rest])).
mem_instruction(prev_addr, mem([PrevAddr|RestOfPrev], Caddrs), mem(RestOfPrev, [PrevAddr|Caddrs])).
% wrap instructions at the byte boundaries as this is what most programmers expect to happen
mem_instruction(inc_caddr, MemIn, MemOut) :- caddr(MemIn, 255), update_caddr(MemIn, 0, MemOut).
mem_instruction(inc_caddr, MemIn, MemOut) :- caddr(MemIn, Val), succ(Val, IncVal), update_caddr(MemIn, IncVal, MemOut).
mem_instruction(dec_caddr, MemIn, MemOut) :- caddr(MemIn, 0), update_caddr(MemIn, 255, MemOut).
mem_instruction(dec_caddr, MemIn, MemOut) :- caddr(MemIn, Val), succ(DecVal, Val), update_caddr(MemIn, DecVal, MemOut).
% input and output
mem_instruction(out_caddr, Mem, Mem) :- caddr(Mem, Val), char_code(Char, Val), write(Char).
mem_instruction(in_caddr, MemIn, MemOut) :-
get_single_char(Code),
char_code(Char, Code),
write(Char),
map_input_code(Code,MappedCode),
update_caddr(MemIn, MappedCode, MemOut).
% need to map the newline if it is not a proper newline character (system dependent).
map_input_code(13,10) :- nl.
map_input_code(C,C).
% The value at the current address
caddr(mem(_, [Caddr]), Caddr).
caddr(mem(_, [Caddr,_|_]), Caddr).
% The updated value at the current address
update_caddr(mem(BackMem, [_]), Caddr, mem(BackMem, [Caddr])).
update_caddr(mem(BackMem, [_,M|Mem]), Caddr, mem(BackMem, [Caddr,M|Mem])).
% The next instruction, and remaining code
next_instruction([_], [], []).
next_instruction([_,NextI|Rest], NextI, [NextI|Rest]).</syntaxhighlight>
{{out}}
<pre>
?- brain('++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.').
Hello World!
true
</pre>
=={{header|Python}}==
[[/Python|Implementation in Python]].
=={{header|Quackery}}==
<syntaxhighlight lang="quackery"> [ stack ] is switch.arg ( --> [ )
[ switch.arg put ] is switch ( x --> )
[ switch.arg release ] is otherwise ( --> )
[ switch.arg share != iff ]else[ done
otherwise ]'[ do ]done[ ] is case ( x --> )
[ dip tuck unrot poke swap ] is poketape ( [ n n --> [ n )
[ 1+ over size over = if [ dip [ 0 join ] ] ] is stepright ( [ n --> [ n )
[ dup 0 = iff [ 0 rot join swap ] else [ 1 - ] ] is stepleft ( [ n --> [ n )
[ 2dup peek 1 + poketape ] is increment ( [ n --> [ n )
[ 2dup peek 1 - poketape ] is decrement ( [ n --> [ n )
[ 2dup peek emit ] is print ( [ n --> [ n )
[ temp take dup $ "" = iff 0 else behead
swap temp put poketape ] is getchar ( [ n --> [ n )
[ 2dup peek 0 = ] is zero ( [ n --> [ n b )
[ temp put $ "" swap witheach
[ switch
[ char > case [ $ "stepright " join ]
char < case [ $ "stepleft " join ]
char + case [ $ "increment " join ]
char - case [ $ "decrement " join ]
char . case [ $ "print " join ]
char , case [ $ "getchar " join ]
char [ case [ $ "[ zero if done " join ]
char ] case [ $ "zero until ] " join ]
otherwise ( ignore ) ] ]
0 nested 0 rot quackery temp release 2drop ] is brainf*** ( $ $ --> )</syntaxhighlight>
{{out}}
Testing <code>brainf***</code> in Quackery shell with Brainf*** code from [[Reverse a string#Brainf***]].
<pre>/O> $ "[-]>,[>,]<[.<]" $ "!sdrawkcab siht tnirP" brainf***
...
Print this backwards!</pre>
=={{header|R}}==
Unfortunately doesn't support the "," operator.
<syntaxhighlight lang="r">
bf <- function(code) {
instructions <- strsplit(code, "")[[1]]
tape <- c()
visited <- c()
pset <- function(n) {
if (n %in% visited)
p <<- n
else {
visited[length(visited)+1] <<- n
tape[as.character(n)] <<- 0
pset(n)
}
}
bracket <- function(b1, b2, x) {
nest <- 1
j <- i + x
while (nest != 0) {
if (instructions[j] == b1)
nest <- nest + 1
if (instructions[j] == b2)
nest <- nest - 1
j <- j + x
}
i <<- j
}
pset(0)
i <- 1
while (i <= length(instructions)) {
p_ <- as.character(p)
c <- instructions[i]
switch(c,
">" = pset(p + 1),
"<" = pset(p - 1),
"+" = tape[p_] <- tape[p_] + 1,
"-" = tape[p_] <- tape[p_] - 1,
"." = cat(intToUtf8(tape[p_])),
# TODO: IMPLEMENT ","
"[" = if (tape[p_] == 0) {
bracket("[", "]", 1)
i <- i - 1 # off by one error
},
"]" = bracket("]", "[", -1))
i <- i + 1
}
}
bf("++++++++++[>+>+++>+++++++>++++++++++<<<<-]>>>++.>+.+++++++..+++.<<++.>+++++++++++++++.>.+++.------.--------.<<+.<.")
</syntaxhighlight>
To run:
<pre>
R -s --vanilla < bf.r
</pre>
=={{header|Racket}}==
Line 2,814 ⟶ 6,935:
As an appetizer this runs in Racket as is:
<
#lang planet dyoo/bf
++++++[>++++++++++++<-]>.
Line 2,821 ⟶ 6,942:
<+++[>----<-]>.<<<<<+++[>+++++<-]>.
>>.+++.------.--------.>>+.
</syntaxhighlight>
=={{header|
(formerly Perl 6)
See [[Execute_Brain****/Raku]].
=={{header|Rebol}}==
Works with Rebol3
<syntaxhighlight lang="rebol">
REBOL [Title: "Brainfuck interpreter"]
tape: make object! [
pos: 1
data: [0]
inc: does [
data/:pos: data/:pos + 1
]
dec: does [
data/:pos: data/:pos - 1
]
advance: does [
pos: pos + 1
if (length? data) <= pos [
append data 0
]
]
devance: does [
if pos > 1 [
pos: pos - 1
]
]
get: does [
data/:pos
]
]
brainfuck: make object! [
data: string!
code: ""
init: func [instr] [
self/data: instr
]
bracket-map: func [text] [
leftstack: []
bm: make map! []
pc: 1
for i 1 (length? text) 1 [
c: text/:i
if not find "+-<>[].," c [
continue
]
if c == #"[" [
append leftstack pc
]
if c == #"]" & ((length? leftstack) > 0) [
left: last leftstack
take/last leftstack
append bm reduce [left pc]
append bm reduce [pc left]
]
append code c
pc: pc + 1
]
return bm
]
run: function [] [
pc: 0
tp: make tape []
bm: bracket-map self/data
while [pc <= (length? code)] [
switch/default code/:pc [
#"+" [tp/inc]
#"-" [tp/dec]
#">" [tp/advance]
#"<" [tp/devance]
#"[" [if tp/get == 0 [
pc: bm/:pc
]]
#"]" [if tp/get != 0 [
pc: bm/:pc
]]
#"." [prin to-string to-char tp/get]
] []
pc: pc + 1
]
print newline
]
]
bf: make brainfuck []
bf/init input
bf/run
</syntaxhighlight>
=={{header|Refal}}==
<syntaxhighlight lang="refal">$ENTRY Go {
, <Arg 1>: e.File
, <ReadFile 1 e.File>: e.Source
, <ParseBF e.Source>: {
F e.Error = <Prout e.Error>;
T e.Prog = <RunProgram e.Prog>;
};
};
ReadFile {
s.Chan e.File = <Open 'r' s.Chan e.File>
<ReadFile (s.Chan)>;
(s.Chan), <Get s.Chan>: {
0 = <Close s.Chan>;
e.Line = <SanitizeBF e.Line> <ReadFile (s.Chan)>
};
}
SanitizeBF {
= ;
s.C e.X, '+-<>.,[]': e.L s.C e.R = s.C <SanitizeBF e.X>;
s.C e.X = <SanitizeBF e.X>;
};
ParseBF {
e.X, <CheckLoops e.X>: {
T = T <ParseLoops () () e.X>;
e.Err = e.Err;
};
};
CheckLoops {
(0) = T;
(s.N) = F 'Mismatched [';
(0) ']' e.X = F 'Mismatched ]';
(s.N) '[' e.X = <CheckLoops (<+ s.N 1>) e.X>;
(s.N) ']' e.X = <CheckLoops (<- s.N 1>) e.X>;
(s.N) s.I e.X = <CheckLoops (s.N) e.X>;
e.X = <CheckLoops (0) e.X>;
};
ParseLoops {
(e.X) (e.C) = e.X e.C;
(e.R) (e.Cur) '[' e.Prog = <ParseLoops (e.R (e.Cur)) () e.Prog>;
(e.R (e.Last)) (e.Cur) ']' e.Prog = <ParseLoops (e.R) (e.Last (e.Cur)) e.Prog>;
(e.R) (e.Cur) s.Instr e.Prog = <ParseLoops (e.R) (e.Cur s.Instr) e.Prog>;
}
RunProgram {
e.Prog, (() 0 ()): t.Tape,
(() ()): t.IObuf,
(t.Tape t.IObuf): t.State,
<RunBF t.State e.Prog>: (t.TapeOut t.IObufOut),
t.IObufOut: ((e.In) (e.Out)),
e.Out: {
= ;
e.X = <Prout e.X>;
};
};
RunBF {
t.State = t.State;
t.State t.Step e.Prog = <RunBF <StepBF t.State t.Step> e.Prog>;
};
StepBF {
(t.Tape t.IObuf) '+' = (<TapeF Inc t.Tape> t.IObuf);
(t.Tape t.IObuf) '-' = (<TapeF Dec t.Tape> t.IObuf);
(t.Tape t.IObuf) '<' = (<TapeLeft t.Tape> t.IObuf);
(t.Tape t.IObuf) '>' = (<TapeRight t.Tape> t.IObuf);
t.State ',' = <BFIn t.State>;
t.State '.' = <BFOut t.State>;
t.State (e.Loop), t.State: ((t.L 0 t.R) t.IObuf) = t.State;
t.State (e.Loop), <RunBF t.State e.Loop>: t.Newstate = <StepBF t.Newstate (e.Loop)>;
};
TapeLeft {
((e.L s.N) s.C (e.R)) = ((e.L) s.N (s.C e.R));
(() s.C (e.R)) = (() 0 (s.C e.R));
};
TapeRight {
((e.L) s.C (s.N e.R)) = ((e.L s.C) s.N (e.R));
((e.L) s.C ()) = ((e.L s.C) 0 ());
};
TapeF {
s.F ((e.L) s.C (e.R)) = ((e.L) <Mu s.F s.C> (e.R));
};
BFIn {
(t.Tape t.IObuf), t.Tape: (t.L s.C t.R),
t.IObuf: (t.In t.Out),
t.In: {
(s.Char e.Rest), (t.L s.Char t.R): t.Newtape,
((e.Rest) t.Out): t.NewIO
= (t.Newtape t.NewIO);
(), <Card>: {
0 = ((t.L 0 t.R) t.IObuf);
e.Line = <BFIn (t.Tape ((<Ord e.Line> 10) t.Out))>;
};
};
};
BFOut {
(t.Tape t.IObuf), t.Tape: (t.L s.C t.R),
t.IObuf: (t.In t.Out),
s.C: {
10, t.Out: (e.Line) = <Prout <Chr e.Line>> (t.Tape (t.In ()));
s.C, t.Out: (e.Line) = (t.Tape (t.In (e.Line s.C)));
};
};
Inc { s.X = <Mod <+ 1 s.X> 256>; };
Dec { s.X = <Mod <+ 255 s.X > 256>; };</syntaxhighlight>
{{out}}
<pre>$ cat hello.bf
++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.
$ refgo bf hello.bf
Hello World!</pre>
=={{header|REXX}}==
The REXX code is original, but the BRAINF░CK program was modified from the example given in Wikipedia:  
<
@.=0 /*initialize the infinite "tape". */
p =0 /*the "tape" cell pointer. */
Line 2,883 ⟶ 7,215:
if ?=='[' then do; c=c-1; if c==0 then return k+1; end
end /*k*/
return k</
'''output''' when using the default program as input:
<pre>
Hello World!
</pre>
=={{header|RPL}}==
« 3000 DUP { } + 0 CON 'Tape' STO "" 'StdOut' STO 1
{ « 1 + »
« 1 - »
« 'Tape' OVER DUP2 GET 1 + PUT »
« 'Tape' OVER DUP2 GET 1 - PUT »
« StdOut 'Tape' 3 PICK GET CHR + 'StdOut' STO »
« 'Tape' OVER '''DO UNTIL''' KEY '''END''' PUT »
« '''IF''' 'Tape' OVER GET NOT '''THEN'''
1 CF
'''DO''' pgm pptr 1 + DUP 'pptr' STO DUP SUB
'''IF''' DUP "" == OVER "]" == OR '''THEN''' 1 SF '''END'''
'''UNTIL''' 1 FS? '''END END''' »
« '''IF''' 'Tape' OVER GET '''THEN'''
1 CF
'''DO''' pgm pptr 1 - DUP 'pptr' STO DUP SUB
'''IF''' DUP "" == '''THEN''' 1 SF pgm SIZE 'pptr' STO '''END'''
'''IF''' "[" == '''THEN''' 1 SF '''END'''
'''UNTIL''' 1 FS? '''END END''' »
}
→ pgm mmax pptr code
« 1
'''DO''' "><+-.,[]" pgm pptr DUP SUB POS
'''IF''' DUP '''THEN''' code SWAP GET EVAL '''ELSE''' DROP '''END'''
pptr 1 + 'pptr' STO
'''UNTIL''' DUP NOT OVER mmax > OR pptr pgm SIZE > OR '''END'''
DROP StdOut
{ 'Tape' 'StdOut'} PURGE
» » '<span style="color:blue">BRAIN</span>' STO
"++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>." <span style="color:blue">BRAIN</span>
{{out}}
<pre>
1: "Hello world!"
</pre>
Line 2,895 ⟶ 7,263:
=={{header|Rust}}==
<
use std::env;
use std::fs::File;
Line 2,993 ⟶ 7,361:
pc += 1;
}
}</
=={{header|Scala}}==
<syntaxhighlight lang="scala">
import scala.annotation._
trait Func[T] {
val zero: T
def inc(t: T): T
def dec(t: T): T
def in: T
def out(t: T): Unit
}
object ByteFunc extends Func[Byte] {
override val zero: Byte = 0
override def inc(t: Byte) = ((t + 1) & 0xFF).toByte
override def dec(t: Byte) = ((t - 1) & 0xFF).toByte
override def in: Byte = readByte
override def out(t: Byte) { print(t.toChar) }
}
case class Tape[T](left: List[T], cell: T, right: List[T])(implicit func: Func[T]) {
private def headOf(list:List[T]) = if (list.isEmpty) func.zero else list.head
private def tailOf(list:List[T]) = if (list.isEmpty) Nil else list.tail
def isZero = cell == func.zero
def execute(ch: Char) = (ch: @switch) match {
case '+' => copy(cell = func.inc(cell))
case '-' => copy(cell = func.dec(cell))
case '<' => Tape(tailOf(left), headOf(left), cell :: right)
case '>' => Tape(cell :: left, headOf(right), tailOf(right))
case '.' => func.out(cell); this
case ',' => copy(cell = func.in)
case '[' | ']' => this
case _ => error("Unexpected token: " + ch)
}
}
object Tape {
def empty[T](func: Func[T]) = Tape(Nil, func.zero, Nil)(func)
}
class Brainfuck[T](func:Func[T]) {
def execute(p: String) {
val prog = p.replaceAll("[^\\+\\-\\[\\]\\.\\,\\>\\<]", "")
@tailrec def braceMatcher(pos: Int, stack: List[Int], o2c: Map[Int, Int]): Map[Int,Int] =
if(pos == prog.length) o2c else (prog(pos): @switch) match {
case '[' => braceMatcher(pos + 1, pos :: stack, o2c)
case ']' => braceMatcher(pos + 1, stack.tail, o2c + (stack.head -> pos))
case _ => braceMatcher(pos + 1, stack, o2c)
}
val open2close = braceMatcher(0, Nil, Map())
val close2open = open2close.map(_.swap)
@tailrec def ex(pos:Int, tape:Tape[T]): Unit =
if(pos < prog.length) ex((prog(pos): @switch) match {
case '[' if tape.isZero => open2close(pos)
case ']' if ! tape.isZero => close2open(pos)
case _ => pos + 1
}, tape.execute(prog(pos)))
println("---running---")
ex(0, Tape.empty(func))
println("\n---done---")
}
}
</syntaxhighlight>
=={{header|Scheme}}==
Line 3,001 ⟶ 7,437:
=={{header|Seed7}}==
<
const proc: brainF (in string: source, inout file: input, inout file: output) is func
Line 3,053 ⟶ 7,489:
begin
brainF("++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.");
end func;</
{{out}}
Line 3,061 ⟶ 7,497:
Original source [http://seed7.sourceforge.net/algorith/puzzles.htm#brainf7].
=={{header|SETL}}==
<syntaxhighlight lang="setl">program brainfuck;
if command_line(1) = om then
print("error: no program file given");
stop;
end if;
if (f := open(command_line(1), "r")) = om then
print("error: cannot open file");
stop;
end if;
[pgm, loopmap] := read_program(f);
close(f);
mem_left := [];
mem_right := [];
mem_cur := 0;
pc := 1;
loop while pc <= #pgm do
case pgm(pc) of
("+"): mem_cur +:= 1;
mem_cur mod:= 256;
("-"): mem_cur -:= 1;
mem_cur mod:= 256;
(">"): mem_left with:= mem_cur;
mem_cur frome mem_right;
mem_cur ?:= 0;
("<"): mem_right with:= mem_cur;
mem_cur frome mem_left;
mem_cur ?:= 0;
("."): putchar(char mem_cur);
(","): mem_cur := ichar (getchar ? '\x00');
("["): if mem_cur = 0 then pc := loopmap(pc); end if;
("]"): if mem_cur /= 0 then pc := loopmap(pc); end if;
end case;
pc +:= 1;
end loop;
proc read_program(f);
pgm := [];
loop doing ch := getc(f); while ch /= om do
if ch in "+-<>.,[]" then
pgm with:= ch;
end if;
end loop;
stack := [];
loopmap := {};
loop for i in [1..#pgm] do
case pgm(i) of
("["):
stack with:= i;
("]"):
j frome stack;
if j=om then
print("mismatched brackets");
stop;
end if;
loopmap(i) := j;
loopmap(j) := i;
end case;
end loop;
if stack /= [] then
print("mismatched brackets");
stop;
end if;
return [pgm, loopmap];
end proc;
end program;</syntaxhighlight>
{{out}}
<pre>$ cat hello.bf
++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.
$ setl brainfuck.setl hello.bf
Hello World!</pre>
=={{header|Sidef}}==
{{trans|Perl}}
<
define eof_val = -1;
define unbalanced_exit_code = 1;
Line 3,111 ⟶ 7,625:
commands{code[cmd]}.run;
cmd++;
}</
=={{header|Standard ML}}==
Line 3,119 ⟶ 7,633:
=={{header|Swift}}==
<
let valids = [">", "<", "+", "-", ".", ",", "[", "]"] as Set<Character>
Line 3,247 ⟶ 7,761:
while ip != numChars {
tick()
}</
=={{header|
[[/
=={{header|UNIX Shell}}==
{{works with|Bourne Again SHell}}
<syntaxhighlight lang="bash">#!/usr/bin/env bash
# BrainF*** interpreter in bash
if (( ! $# )); then
printf >&2 'Usage: %s program-file\n' "$0"
exit 1
fi
# load the program
exec 3<"$1"
program=()
while IFS= read -r line <&3; do
mapfile -t instr < <(tr -cd '[]<>.,+-' <<<"$line" | sed $'s/./&\\\n/g')
program+=("${instr[@]}")
done
exec 3<&-
# parse loops
loops=()
matches=()
for pc in "${!program[@]}"; do
instr=${program[pc]}
if [[ $instr == '[' ]]; then
loops=("$pc" "${loops[@]}")
elif [[ $instr == ']' ]]; then
matches[$pc]=${loops[0]}
matches[${loops[0]}]=$pc
loops=(${loops[@]:1})
fi
done
# execute program
memory=(0)
mp=0
pc=0
while (( pc < ${#program[@]} )); do
instr=${program[pc]}
(( pc+=1 ))
mem=${memory[mp]}
case "$instr" in
'[') if (( ! mem )); then (( pc=${matches[pc-1]}+1 )); fi;;
']') if (( mem )); then (( pc=${matches[pc-1]}+1 )); fi;;
+) memory[mp]=$(( (mem + 1) % 256 ));;
-) memory[mp]=$(( (mem - 1) % 256 ));;
'>') (( mp+=1 )); if (( mp >= ${#memory[@]} )); then memory+=(0); fi;;
'<') (( mp-=1 )); if (( mp < 0 )); then memory=(0 "${memory[@]}"); mp=0; fi;;
.) printf %b $(printf '\\%03o' "$mem");;
,) read -n1 c; memory[mp]=$(LC_CTYPE=C printf '%d' "'$c");;
esac
done</syntaxhighlight>
Sample run:
<pre>$ bash bf.bash <(echo '>++++++++[<+++++++++>-]<.>>+>+>++>[-]+<[>[->+<<++++>]<<]>.+++++++..+++.>>+++++++.<<<[[-]<[-]>]<+++++++++++++++.>>.+++.------.--------.>>+.>++++.')</pre>
{{Out}}
<pre>Hello World!</pre>
=={{header|VBScript}}==
{{trans|PHP}}
<
'VBScript Implementation
Line 3,338 ⟶ 7,904:
">+++++++.<<<[[-]<[-]>]<+++++++++++++++.>>.+++.------.--------.>>+.>++++."
inpstr = ""
WScript.StdOut.Write BFuck(code, inpstr)</
{{Out}}
<pre>C:\>cscript /nologo brainf.vbs
Line 3,344 ⟶ 7,910:
C:\></pre>
=={{header|V (Vlang)}}==
{{incomplete|V (Vlang)|The input `,` section isn't implemented correctly}}
{{trans|go}}
<syntaxhighlight lang="v (vlang)">fn main() {
// example program is current Brain**** solution to
// Hello world/Text task. only requires 10 bytes of data store!
bf(10, '++++++++++[>+>+++>++++>+++++++>++++++++>+++++++++>++
++++++++>+++++++++++>++++++++++++<<<<<<<<<-]>>>>+.>>>
>+..<.<++++++++.>>>+.<<+.<<<<++++.<++.>>>+++++++.>>>.+++.
<+++++++.--------.<<<<<+.<+++.---.')
}
fn bf(d_len int, code string) {
mut ds := []u8{len: d_len} // data store
mut dp := 0 // data pointer
for ip := 0; ip < code.len; ip++ {
match code[ip] {
`>` {
dp++
}
`<` {
dp--
}
`+` {
ds[dp]++
}
`-` {
ds[dp]--
}
`.` {
print(ds[dp].ascii_str())
}
`,` {
//fmt.Scanf("%c", &ds[dp])
ds[dp] = -1 //TODO
}
`[` {
if ds[dp] == 0 {
for nc := 1; nc > 0; {
ip++
if code[ip] == `[` {
nc++
} else if code[ip] == `]` {
nc--
}
}
}
}
`]` {
if ds[dp] != 0 {
for nc := 1; nc > 0; {
ip--
if code[ip] == `]` {
nc++
} else if code[ip] == `[` {
nc--
}
}
}
}
else {}
}
}
}</syntaxhighlight>
{{out}}
<pre>Goodbye, World!</pre>
=={{header|Wren}}==
{{trans|Kotlin}}
<syntaxhighlight lang="wren">import "io" for Stdin
class Brainf__k {
construct new(prog, memSize) {
_prog = prog
_memSize = memSize
_mem = List.filled(memSize, 0)
_ip = 0
_dp = 0
}
memVal_ { (_dp >= 0 && _dp < _memSize) ? _mem[_dp] : 0 }
execute() {
while (_ip < _prog.count) {
var cmd = _prog[_ip]
_ip = _ip + 1
if (cmd == ">") {
_dp = _dp + 1
} else if (cmd == "<") {
_dp = _dp - 1
} else if (cmd == "+") {
_mem[_dp] = memVal_ + 1
} else if (cmd == "-") {
_mem[_dp] = memVal_ - 1
} else if (cmd == ",") {
_mem[_dp] = Stdin.readByte()
} else if (cmd == ".") {
System.write(String.fromByte(memVal_))
} else if (cmd == "[") {
handleLoopStart_()
} else if (cmd == "]") {
handleLoopEnd_()
}
}
}
handleLoopStart_() {
if (memVal_ != 0) return
var depth = 1
while (_ip < _prog.count) {
var cmd = _prog[_ip]
_ip = _ip + 1
if (cmd == "[") {
depth = depth + 1
} else if (cmd == "]") {
depth = depth - 1
if (depth == 0) return
}
}
Fiber.abort("Could not find matching end bracket.")
}
handleLoopEnd_() {
var depth = 0
while (_ip >= 0) {
_ip = _ip - 1
var cmd = _prog[_ip]
if (cmd == "]") {
depth = depth + 1
} else if (cmd == "[") {
depth = depth - 1
if (depth == 0) return
}
}
Fiber.abort("Could not find matching start bracket.")
}
}
var prog = "++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>."
Brainf__k.new(prog, 10).execute()</syntaxhighlight>
{{out}}
<pre>
Hello World!
</pre>
=={{header|x86 Assembly}}==
[[/x86_Assembly|Implementation in x86]]
=={{header|XBS}}==
This method uses the newsyntax feature, which allows you to extend language syntax from with-in the code.
<syntaxhighlight lang="xbs">#>
newsyntax
@in:PE
@token:bf
@PE:"function(Stack){
this.TestNext(Stack,\"Paren\",\"TK_POPEN\");
this.Move(Stack,2);
let Check = function(t,v){
return AST.IsPreciseToken(Stack.Token,t,v);
}
let Write = function(v){
AST.ChunkWrite(Stack,v);
}
this.OpenChunk(Stack);
while(!this.IsPreciseToken(Stack.Token,\"Paren\",\"TK_PCLOSE\")){
if(Check(\"None\",\"TK_DOT\")){
Write(\"output\");
}else if(Check(\"None\",\"TK_COMMA\")){
Write(\"input\");
}else if(Check(\"Operator\",\"TK_ADD\")){
Write(\"inc\");
}else if(Check(\"Operator\",\"TK_SUB\")){
Write(\"deinc\");
}else if(Check(\"Compare\",\"TK_GT\")){
Write(\"meminc\");
}else if(Check(\"Compare\",\"TK_LT\")){
Write(\"memdeinc\");
}else if(Check(\"Brace\",\"TK_IOPEN\")){
this.OpenChunk(Stack);
}else if(Check(\"Brace\",\"TK_ICLOSE\")){
this.CloseChunk(Stack);
}
this.Next(Stack);
}
this.CloseChunk(Stack);
if(!this.CheckNext(Stack,\"None\",\"TK_LINEEND\")&&!this.CheckNext(Stack,\"None\",\"TK_COMMA\")){
this.Next(Stack);
this.ChunkWrite(Stack,this.ParseExpression(Stack));
}
}"
@Interpret:"function(AST,Token){
let BF = Token[3];
let Chunk = BF[0];
let Input = BF[1];
if(Input){
Input=this.Parse(AST,Input);
}
let IPos=0;
let Memory = [],MemPos=0;
let UpdateMemory = function(){
if(Memory[MemPos]===undefined){
Memory[MemPos]=0;
}
}
let Read = function(v){
if(v==\"output\"){
AST.LibGlobals.log(Memory[MemPos]);
}else if(v==\"input\"){
Memory[MemPos]=Input.charCodeAt(IPos)||0;
IPos++;
}else if(v==\"inc\"){
UpdateMemory();
Memory[MemPos]++;
}else if(v==\"deinc\"){
UpdateMemory();
Memory[MemPos]--;
}else if(v==\"meminc\"){
MemPos++;
UpdateMemory();
}else if(v==\"memdeinc\"){
MemPos--;
UpdateMemory();
}else if(v instanceof Array){
UpdateMemory();
while(Memory[MemPos]!=0){
for(let vv of v){
Read(vv);
}
UpdateMemory();
}
}
}
UpdateMemory();
for(let v of Chunk){
Read(v);
}
UpdateMemory();
return Memory[MemPos];
}"
<#
set x = bf ( + + + > + + [ < + > - ] < );
log(x);</syntaxhighlight>
{{out}}
<pre>
5
</pre>
=={{header|zkl}}==
<
const CELLS=0d30_000;
if(Void==pgm.span("[","]")){ println("Mismatched brackets"); return(); }
Line 3,378 ⟶ 8,190:
} // while
}catch(IndexError){} // read past end of tape == end of program
}</
<
bf("++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++.."
"+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.");
Line 3,405 ⟶ 8,217:
// rot13
bf(File("rot13.b").read(),"This is a test 123");</
{{out}}
<pre>
Line 3,435 ⟶ 8,247:
http://www.hevanet.com/cristofd/brainfuck/]
</pre>
| |||