PureBoard

Verfasst: **15.06.2010 20:31**

Hallo,

mir war am Wochenende mal langweilig und da hab ich einfach mal einen kleinen BrainFuck Interpreter geschrieben und wollt euch den Source nicht vorenthalten. Er teilt sich in 2 Teile: Im 1. wird Code von unbekannten Zeichen befreit und in ein Array gepackt (was sicher noch schneller mit Pointern geht) und im 2. Teil wird dann der Code ausgeführt.

Source: http://files.freakybytes.net/pb/codes/BrainFuck.pb
Eintrag in meinem Blog: http://freakybytes.net/2010/06/brainfuck-interpreter/

Viel Spaß damit

Damit der Source auch in Board bleibt, wenn meine Seite mal weg ist, stell ich ihn nochmal hier rein.

Code: Alles auswählen

EnableExplicit

Prototype BrainFuck_OutCallback(char.c)

;-Für Debugzwecke
;#BrainFuck_Debug = #True

CompilerIf Defined(BrainFuck_Debug, #PB_Constant) = #False
  #BrainFuck_Debug = #False
CompilerEndIf

Macro BFDebug(__Text)
  CompilerIf #BrainFuck_Debug = #True
    Debug "BrainFuck> "+__Text
  CompilerEndIf
EndMacro

Procedure.s ParseBrainFuck(Array Source.c(1), Input$ = "", StartValue = 0, OutCallback.BrainFuck_OutCallback = 0)
  Protected NewList Cell.c(), NewList Loop.i()
  Protected Output$ = ""
  Protected x, InputLen, Depth
  
  AddElement(Cell()) : FirstElement(Cell())   ;Erste Zelle initialisieren
  
  For x = 0 To ArraySize(Source())
    Select Source(x)
      Case '<'    ;Eine Zelle zurück
        If Not PreviousElement(Cell())    ;Wenn bereits letzte Zelle aktiv ist
          ResetList(Cell())     ;Eine Zelle am Anfang hinzufügen
          AddElement(Cell()) : Cell() = StartValue
          BFDebug("Add Cell (first)")
        EndIf
        
      Case '>'    ;Eine Zelle vor
        If ListSize(Cell()) = ListIndex(Cell())+1   ;Wenn bereits letzte Zelle ausgewählt ist
          LastElement(Cell())   ;Eine Zelle am Ende hinzufügen
          AddElement(Cell()) : Cell() =  StartValue
          BFDebug("Add Cell (last)")
        Else
          NextElement(Cell())
        EndIf
        
      Case '+'    ;Zellenwert incrementieren
        Cell() + 1
        
      Case '-'    ;Zellenwert decrementieren
        Cell() - 1
        
      Case '.'    ;aktuellen Zellenwert als ASCII Character ausgeben
        BFDebug(" " + Chr(Cell()))
        If OutCallback
          OutCallback(Cell())
        EndIf
        Output$ + Chr(Cell())
        
      Case ','    ;erstes Zeichen des Input-Strings in die aktuelle Zelle einlesen
        InputLen = Len(Input$)
        If InputLen   ;Wenn ein InputString vorhanden ist
          Cell() = Asc(Left(Input$, 1))   ;Den ASCII-Wert des ersten Zeichens in die Zelle schreiben
          Input$ = Right(Input$, InputLen-1)    ;Dann den String vom ersten Zeichen befreien (damit nicht immer das selbe Zeichen eingelesen wird)
        Else
          Cell() = 0
        EndIf
        
      Case '['
        
        If Cell() <> 0   ;Wenn Zelle ungleich Null ist -> Schleife starten
          LastElement(Loop()) : AddElement(Loop())
          Loop() = x    ;Position des Schleifenbeginns speichern
          BFDebug("Beginn Loop")
        Else        ;Wenn Zelle gleich Null, an ihr Ende springen
          Depth = 0   ;Tiefe auf Null setzen
          
          For x = x+1 To ArraySize(Source())
            If Source(x) = '['    ;Eine weitere Schleife
              Depth + 1   ;Tiefe um 1 erhöhen
            ElseIf Source(x) = ']'    ;Ein Schleifenende
              If Depth = 0    ;Wenn äußere Schleife erreicht ist
                Break   ;Vorlauf beenden
              Else
                Depth - 1   ;Ansonsten Tiefe um 1 erhöhen
              EndIf
            EndIf
          Next
          
          If Not Depth = 0
            BFDebug("Syntax Error! ']' is missing!")
            ProcedureReturn ""
          EndIf
          
          BFDebug("Overjump Loop")
        EndIf
        
      Case ']'
        If Cell() <> 0   ;Wenn Zelle ungleich Null ist -> wieder an Schleifen Anfang springen
          LastElement(Loop())
          x = Loop()
          BFDebug("Repeat Loop")
        Else    ;Ansonsten
          DeleteElement(Loop()) : LastElement(Loop())   ;Schleife löschen
          BFDebug("Exit Loop")   ;und fortfahren
        EndIf
        
      Default
        BFDebug("Unkown Character: "+Chr(Source(x)))
        
    EndSelect
  Next
  
  ProcedureReturn Output$
  
EndProcedure

Procedure LexBrainFuck(source$, Array Source.c(1))  
  Protected Len = Len(source$)
  Protected Char$, RealLen = 0, x
  ReDim Source.c(Len)
  
  #BrainFuckChar$ = "<>+-[].,"
  
  For x = 1 To Len
    Char$ = Mid(source$, x, 1)
    If FindString(#BrainFuckChar$, Char$, 0)
      Source(RealLen) = Asc(Char$)
      RealLen + 1
    EndIf
  Next
  
  Debug "BrainFuck> LenDif = "+Str(Len - RealLen)
  ReDim Source.c(RealLen-1)
  ProcedureReturn RealLen
EndProcedure  

Define test$
Dim BF.c(0)

test$ = ""

; test$ + "   +++++++++++++++++++++++++++++++++++++++++++++++++++++   ."
; test$ + "<  ++++++++++++++++++++++++++++++++++++++++++++++++++++++  ."
; test$ + ">> +++++++++++++++++++++++++++++++++++++++++++++++++++++++ ."
; test$ + "<.<.>>."

; test$ + "++++++++++"
; test$ + " ["
; test$ + "    >+++++++>++++++++++>+++>+<<<<-"
; test$ + " ]                       // Schleife zur Vorbereitung der Textausgabe"
; test$ + " >++.                    // Ausgabe von 'H'"
; test$ + " >+.                     // Ausgabe von 'e'"
; test$ + " +++++++.                // 'l'"
; test$ + " .                       // 'l'"
; test$ + " +++.                    // 'o'"
; test$ + " >++.                    // Leerzeichen"
; test$ + " <<+++++++++++++++.      // 'W'"
; test$ + " >.                      // 'o'"
; test$ + " +++.                    // 'r'"
; test$ + " ------.                 // 'l'"
; test$ + " --------.               // 'd'"
; test$ + " >+.                     // '!'"
; test$ + " >.                      // Zeilenumbruch"

; test$ + ",[.,]"

;-99 Bottles of Beer
test$ + ">+++++++++[<+++++++++++>-]<[>[-]>[-]<<[>+>+<<-]>>[<<+>>-]>>>"
test$ + "[-]<<<+++++++++<[>>>+<<[>+>[-]<<-]>[<+>-]>[<<++++++++++>>>+<"
test$ + "-]<<-<-]+++++++++>[<->-]>>+>[<[-]<<+>>>-]>[-]+<<[>+>-<<-]<<<"
test$ + "[>>+>+<<<-]>>>[<<<+>>>-]>[<+>-]<<-[>[-]<[-]]>>+<[>[-]<-]<+++"
test$ + "+++++[<++++++<++++++>>-]>>>[>+>+<<-]>>[<<+>>-]<[<<<<<.>>>>>-"
test$ + "]<<<<<<.>>[-]>[-]++++[<++++++++>-]<.>++++[<++++++++>-]<++.>+"
test$ + "++++[<+++++++++>-]<.><+++++..--------.-------.>>[>>+>+<<<-]>"
test$ + ">>[<<<+>>>-]<[<<<<++++++++++++++.>>>>-]<<<<[-]>++++[<+++++++"
test$ + "+>-]<.>+++++++++[<+++++++++>-]<--.---------.>+++++++[<------"
test$ + "---->-]<.>++++++[<+++++++++++>-]<.+++..+++++++++++++.>++++++"
test$ + "++[<---------->-]<--.>+++++++++[<+++++++++>-]<--.-.>++++++++"
test$ + "[<---------->-]<++.>++++++++[<++++++++++>-]<++++.-----------"
test$ + "-.---.>+++++++[<---------->-]<+.>++++++++[<+++++++++++>-]<-."
test$ + ">++[<----------->-]<.+++++++++++..>+++++++++[<---------->-]<"
test$ + "-----.---.>>>[>+>+<<-]>>[<<+>>-]<[<<<<<.>>>>>-]<<<<<<.>>>+++"
test$ + "+[<++++++>-]<--.>++++[<++++++++>-]<++.>+++++[<+++++++++>-]<."
test$ + "><+++++..--------.-------.>>[>>+>+<<<-]>>>[<<<+>>>-]<[<<<<++"
test$ + "++++++++++++.>>>>-]<<<<[-]>++++[<++++++++>-]<.>+++++++++[<++"
test$ + "+++++++>-]<--.---------.>+++++++[<---------->-]<.>++++++[<++"
test$ + "+++++++++>-]<.+++..+++++++++++++.>++++++++++[<---------->-]<"
test$ + "-.---.>+++++++[<++++++++++>-]<++++.+++++++++++++.++++++++++."
test$ + "------.>+++++++[<---------->-]<+.>++++++++[<++++++++++>-]<-."
test$ + "-.---------.>+++++++[<---------->-]<+.>+++++++[<++++++++++>-"
test$ + "]<--.+++++++++++.++++++++.---------.>++++++++[<---------->-]"
test$ + "<++.>+++++[<+++++++++++++>-]<.+++++++++++++.----------.>++++"
test$ + "+++[<---------->-]<++.>++++++++[<++++++++++>-]<.>+++[<----->"
test$ + "-]<.>+++[<++++++>-]<..>+++++++++[<--------->-]<--.>+++++++[<"
test$ + "++++++++++>-]<+++.+++++++++++.>++++++++[<----------->-]<++++"
test$ + ".>+++++[<+++++++++++++>-]<.>+++[<++++++>-]<-.---.++++++.----"
test$ + "---.----------.>++++++++[<----------->-]<+.---.[-]<<<->[-]>["
test$ + "-]<<[>+>+<<-]>>[<<+>>-]>>>[-]<<<+++++++++<[>>>+<<[>+>[-]<<-]"
test$ + ">[<+>-]>[<<++++++++++>>>+<-]<<-<-]+++++++++>[<->-]>>+>[<[-]<"
test$ + "<+>>>-]>[-]+<<[>+>-<<-]<<<[>>+>+<<<-]>>>[<<<+>>>-]<>>[<+>-]<"
test$ + "<-[>[-]<[-]]>>+<[>[-]<-]<++++++++[<++++++<++++++>>-]>>>[>+>+"
test$ + "<<-]>>[<<+>>-]<[<<<<<.>>>>>-]<<<<<<.>>[-]>[-]++++[<++++++++>"
test$ + "-]<.>++++[<++++++++>-]<++.>+++++[<+++++++++>-]<.><+++++..---"
test$ + "-----.-------.>>[>>+>+<<<-]>>>[<<<+>>>-]<[<<<<++++++++++++++"
test$ + ".>>>>-]<<<<[-]>++++[<++++++++>-]<.>+++++++++[<+++++++++>-]<-"
test$ + "-.---------.>+++++++[<---------->-]<.>++++++[<+++++++++++>-]"
test$ + "<.+++..+++++++++++++.>++++++++[<---------->-]<--.>+++++++++["
test$ + "<+++++++++>-]<--.-.>++++++++[<---------->-]<++.>++++++++[<++"
test$ + "++++++++>-]<++++.------------.---.>+++++++[<---------->-]<+."
test$ + ">++++++++[<+++++++++++>-]<-.>++[<----------->-]<.+++++++++++"
test$ + "..>+++++++++[<---------->-]<-----.---.+++.---.[-]<<<]"

Debug test$

CompilerIf 1
  
  Define Output$
  
  OpenConsole()
  
  Procedure BFPrint(char.c)
    Print(Chr(char))
  EndProcedure

  LexBrainFuck(test$, BF())
  Output$ = ParseBrainFuck(BF(), "", 0, @BFPrint())
  Debug Output$

  Input()

CompilerElse
  
  Define x, cicle = 100, start = ElapsedMilliseconds(), stop
  Define time, onetime.d, result$
  
  ;-Speedtest
  cicle = 100
  start = ElapsedMilliseconds()
  For x = 0 To cicle
    LexBrainFuck(test$, BF())
    result$ = ParseBrainFuck(BF())
  Next
  stop = ElapsedMilliseconds()
  
  time = stop-start
  onetime = time/cicle
  
  MessageRequester("Ergebnis", "Gesamtzeit: "+Str(time)+"ms"+#CRLF$+"Zeit pro Durchlauf: "+StrD(onetime, 2)+"ms");+#CRLF$+#CRLF$+result$)
  
CompilerEndIf

End

Verfasst: **15.06.2010 21:31**

Da gab es auch mal einen Wettbewerb zu: Brainfuck Interpreter

Verfasst: **15.06.2010 22:21**

Danke für den Link...
Aber mein Interpreter ist nur für die "normale" BrainFuck Version, also 1D
vllt. mach ja noch was für 2D, wenn ich mal wieder Langeweile hab ^^

PureBoard

BrainFuck Interpreter

BrainFuck Interpreter

Re: BrainFuck Interpreter

Re: BrainFuck Interpreter