Execute Brain****/PureBasic

From Rosetta Code
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.
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(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()