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