Execute Brain****/PureBasic

From Rosetta Code
Revision as of 17:15, 3 June 2010 by rosettacode>Demivec (Added PureBasic)
(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Execute Brain****/PureBasic is an implementation of Brainf***. Other implementations of Brainf***.
Execute Brain****/PureBasic is part of RCBF. You may find other members of RCBF at Category:RCBF.
Translation of: BASIC

Uses an integer cell size and memory size is allowed to grow as needed. <lang PureBasic>Procedure displayEndingMsg()

 Print(#CRLF$ + #CRLF$ + "Press ENTER to exit")
 Input()
 CloseConsole()
 End

EndProcedure

Procedure displayErrorThenEnd(msg.s)

 PrintN(msg)
 displayEndingMsg()

EndProcedure

Macro bracketSearch(drx = 1) ;drx = -1 to search backwards

 bktCnt = drx ;start count with the current bracket
 ;count nested loops till matching one is found
 Repeat 
   i + drx ;move the code pointer
   If Mid(code$, i, 1) = "]"
     bktCnt - 1
   ElseIf Mid(code$, i, 1) = "["
     bktCnt + 1
   EndIf 
 Until bktCnt = 0

EndMacro

If Not OpenConsole()

 MessageRequester("Error", "Unable to open console.")
 End

EndIf

Define memsize = 1000 ;this may grow as needed Define instChars$ = "+-<>.,[]" ;valid characters Define ptr = 0 ;memory pointer

Print("Filename (blank to use std in)...? ") filename$ = Input() If filename$ = ""

 Repeat
   line$ = Input()
   source$ = source$ + line$
 Until line$ = ""

Else

 OpenFile(1, filename$)
 Repeat
   line$ = ReadString(1)
   source$ = source$ + line$
 Until Eof(1)
 CloseFile(1)

EndIf

remove non-code and validate number of brackets

bktCnt = 0 For i = 1 To Len(source$)

 char$ = Mid(source$, i, 1)
 ;validate instruction character
 If FindString(instChars$, char$, 1)
   code$ + char$
   ;count brackets
   Select char$
     Case "["
       bktCnt + 1
     Case "]"
       bktCnt - 1
   EndSelect
 EndIf

Next

If bktCnt ;mismatched brackets

 displayErrorThenEnd("Uneven brackets")

EndIf

Dim memory(memsize) ;use integer cell size Define inLine$ = "" ;input buffer For i = 1 To Len(code$) ;loop through the code

 Select Mid(code$, i, 1) ;examine the current instruction
   Case "+"
     memory(ptr) + 1
   Case "-"
     memory(ptr) - 1
   Case "."
     Print(Chr(memory(ptr)))
   Case ","
     If inLine$ = "": inLine$ = Input(): EndIf ;buffer input
     memory(ptr) = Asc(Left(inLine$, 1))       ;store first char off the buffer
     inLine$ = Mid(inLine$, 2)                 ;delete first char from the buffer
   Case ">"
     ptr + 1
     If ptr > memsize
       memsize + 1000
       Redim memory.b(memsize)
     EndIf
   Case "<"
     ptr - 1
     If ptr < 0 
       displayErrorThenEnd("Memory pointer out of range")
     EndIf
   Case "["
     If memory(ptr) = 0 
       bracketSearch()
     EndIf
   Case "]"
     If memory(ptr) <> 0 
       bracketSearch(-1)
     EndIf
 EndSelect

Next displayEndingMsg()</lang>