|
Das deutsche QBasic- und FreeBASIC-Forum Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
Autor |
Nachricht |
X0X
Anmeldungsdatum: 11.03.2013 Beiträge: 2
|
Verfasst am: 11.03.2013, 17:57 Titel: BrainF*ck Interpreter |
|
|
Moin.
Ich Programmiere gerade einen BF Interpreter.
2 Probleme treten auf,
(1. Das binaere Einlesen erzeugt falsche Werte. EDIT erledigt)
2. Mir fällt nicht ein wie ich die Schleife gestallten soll.
Code: |
Der Code:
CLS
DIM A(10000)
X=1
OPEN "BFTST.dat" FOR BINARY AS #1
DO
GET #1,X,Ky
X=X+1
K$=STR$(INT(Kz))
SELECT CASE K$
CASE ">": J=J+1 'Zeiger um 1 erhöen
CASE "<": J=J -1 'Zeiger um 1 verringern
CASE "+": A(J)=A(J)+1 'Pointer um 1 erhöen
CASE "-" : A(J)=A(J) -1 'Pointer um 1 verringern
CASE "." : PRINT CHR$(A(J)) 'Zeichen auf Bildschirm
CASE "," : INPUT B$:A(J)=ASC(B$):I=ASC(B$) 'Zeichen einlesen
CASE "[" : 'Schleifen anfang
CASE "]" : 'Schleifen ende
CASE CHR$(27): EXIT DO 'Ende des Programms
END SELECT
LOOP
end
|
Dank an alle die mir helfen können! |
|
Nach oben |
|
|
ThePuppetMaster
Anmeldungsdatum: 18.02.2007 Beiträge: 1837 Wohnort: [JN58JR]
|
Verfasst am: 12.03.2013, 15:45 Titel: |
|
|
FreeBASIC APP
Code: | '###########################################################################################
Const TDebug = 0
'###########################################################################################
Dim Shared TAppData as String
Dim Shared TAppLen as UInteger
Dim Shared TMemD() as Integer
Dim Shared TMemC as Integer
Dim Shared TMemPtr as Integer
'###########################################################################################
Function App_Run(V_FromPtr as UInteger) as UInteger
If TDebug = 1 Then Print "RUN FROM:" & V_FromPtr
Dim TAppPtr as UInteger = V_FromPtr
'Program verarbeiten
Do
If TAppPtr >= TAppLen Then Exit Do
If TDebug = 1 Then Print " EXECUTE:" & TAppPtr & " | " & TAppData[TAppPtr]
Select Case TAppData[TAppPtr]
Case 43 '+
If TMemPtr <= 0 Then Print "Memory access error!": End -2
TMemD(TMemPtr) += 1
Case 44 ',
If TMemPtr <= 0 Then Print "Memory access error!": End -2
Input TMemD(TMemPtr)
Case 45 '-
If TMemPtr <= 0 Then Print "Memory access error!": End -2
TMemD(TMemPtr) -= 1
Case 46 '.
If TMemPtr <= 0 Then Print "Memory access error!": End -2
Print Chr(TMemD(TMemPtr));
Case 60 '<
TMemPtr -= 1
Case 62 '>
TMemPtr += 1
If TMemC < TMemPtr Then
TMemC = TMemPtr
Redim Preserve TMemD(1 to TMemC) as Integer
End If
Case 91 '[
TAppPtr = App_Run(TAppPtr + 1)
Case 93 ']
If TMemPtr <= 0 Then Print "Memory access error!": End -2
If TMemD(TMemPtr) = 0 Then
If TDebug = 1 Then Print "RETURN TO:" & TAppPtr
Return TAppPtr
End If
TAppPtr = V_FromPtr - 1
End Select
TAppPtr += 1
Loop
Return 0
End Function
'###########################################################################################
Sub App_Load()
'Programm-daten laden
Dim TFN as Integer = FreeFile
If Open("test.bf" For Binary as #TFN) <> 0 Then Print "Can't open source file!": End -1
Dim T as String = Space(LOF(TFN))
If Get(#TFN, 1, T) <> 0 Then Print "Can't read data from file!": End -1
Close #TFN
If T = "" Then Print "No data found!": End 0
'Programmdaten optimieren (Alles was kein Befehl ist, löschen)
For X as UInteger = 0 to Len(T) - 1
Select Case T[X]
Case 43 to 46, 60, 62, 91, 93: TAppData += Chr(T[X])
End Select
Next
TAppLen = Len(TAppData)
If TAppLen <= 0 Then Print "No programmdata found!": End 0
'Programm-Stack vorbereiten
TMemC = 1
Redim Preserve TMemD(1 to TMemC) as Integer
TMemPtr = TMemC
End Sub
'###########################################################################################
App_Load()
App_Run(0)
End 0 |
DEMO-Source:
Code: | ++++++++++
[
>+++++++>++++++++++>+++>+<<<<-
] Schleife zur Vorbereitung der Textausgabe
>++. Ausgabe von 'H'
>+. Ausgabe von 'e'
+++++++. 'l'
. 'l'
+++. 'o'
>++. Leerzeichen
<<+++++++++++++++. 'W'
>. 'o'
+++. 'r'
------. 'l'
--------. 'd'
>+. '!'
>. Zeilenvorschub
+++. Wagenrücklauf
|
MfG
TPM _________________ [ WebFBC ][ OPS ][ ToOFlo ][ Wiemann.TV ] |
|
Nach oben |
|
|
ThePuppetMaster
Anmeldungsdatum: 18.02.2007 Beiträge: 1837 Wohnort: [JN58JR]
|
Verfasst am: 12.03.2013, 16:28 Titel: |
|
|
Hier noch ne erweiterte Optimierung für obriges Programm:
Code: | '###########################################################################################
Function App_Run(V_FromPtr as UInteger) as UInteger
If TDebug = 1 Then Print "RUN FROM:" & V_FromPtr
Dim TAppPtr as UInteger = V_FromPtr
Dim TLoop as Integer = 0
'Program verarbeiten
Do
If TAppPtr >= TAppLen Then Exit Do
If TDebug = 1 Then Print " EXECUTE:" & TAppPtr & " | " & TAppData[TAppPtr]
Select Case TAppData[TAppPtr]
Case 43 '+
If TMemPtr <= 0 Then Print "Memory access error!": End -2
TMemD(TMemPtr) += 1
Case 44 ',
If TMemPtr <= 0 Then Print "Memory access error!": End -2
Input TMemD(TMemPtr)
Case 45 '-
If TMemPtr <= 0 Then Print "Memory access error!": End -2
TMemD(TMemPtr) -= 1
Case 46 '.
If TMemPtr <= 0 Then Print "Memory access error!": End -2
Print Chr(TMemD(TMemPtr));
Case 49 to 57 '1 to 9 = wiederholt den nachfolgenden Befehl 1-9 mal
TLoop = TAppData[TAppPtr] - 48
If TDebug = 1 Then Print "LOOP:" & TLoop
TAppPtr += 1
Case 60 '<
TMemPtr -= 1
Case 62 '>
TMemPtr += 1
If TMemC < TMemPtr Then
TMemC = TMemPtr
Redim Preserve TMemD(1 to TMemC) as Integer
End If
Case 91 '[
TAppPtr = App_Run(TAppPtr + 1)
Case 93 ']
If TMemPtr <= 0 Then Print "Memory access error!": End -2
If TMemD(TMemPtr) = 0 Then
If TDebug = 1 Then Print "RETURN TO:" & TAppPtr
Return TAppPtr
End If
TAppPtr = V_FromPtr - 1
End Select
If TLoop = 0 Then
TAppPtr += 1
Else: TLoop -= 1
End If
Loop
Return 0
End Function |
Fügt die Befehle 1 bis 9 hinzu, welche dazu führen, das der nachfolgende Befehl 1 bis 9 mal wiederholt wird.
Beispiel:
kann durch
ersetzt werden.
DEMO (selbiges wie im obrigem demo)
Code: | 9++
[
>7+>9++>3+>+4<-
] Schleife zur Vorbereitung der Textausgabe
>++. Ausgabe von 'H'
>+. Ausgabe von 'e'
7+. 'l'
. 'l'
3+. 'o'
>++. Leerzeichen
<<9+6+. 'W'
>. 'o'
3+. 'r'
6-. 'l'
8-. 'd'
>+. '!'
>. Zeilenvorschub
2+. Wagenrücklauf
|
MfG
TPM _________________ [ WebFBC ][ OPS ][ ToOFlo ][ Wiemann.TV ] |
|
Nach oben |
|
|
ThePuppetMaster
Anmeldungsdatum: 18.02.2007 Beiträge: 1837 Wohnort: [JN58JR]
|
Verfasst am: 12.03.2013, 17:46 Titel: |
|
|
Hier noch ne QB Version. (PS: QB is doof)
Code: | '###########################################################################################
#lang "qb"
'###########################################################################################
Const TDebug = 0
'###########################################################################################
Dim Shared TAppData as String
Dim Shared TAppLen as Integer
Dim Shared TMemD() as Integer
Dim Shared TMemC as Integer
Dim Shared TMemPtr as Integer
Dim Shared TStackD() as Integer
Dim Shared TStackPtr as Integer
Dim Shared TStackC as Integer
'###########################################################################################
'Programm-daten laden und optimieren (Alles was kein Befehl ist, ignorieren)
Open "test_qb.bf" For Binary as #1
Dim T as String
Dim X as Integer
Dim Max as Integer
T = " "
Max = Lof(1)
Do
X = X + 1
If X > Max Then Exit Do
Get #1, X, T
Select Case Asc(T)
Case 43, 44, 45, 46, 49, 50, 51, 52, 53, 54, 55, 56, 57, 60, 62, 91, 93
TAppData = TAppData + T
End Select
Loop
Close #1
TAppLen = Len(TAppData)
If TAppLen <= 0 Then Print "No programmdata found!": End 0
'Programm-Stack vorbereiten
TMemC = 1
Redim Preserve TMemD(1 to TMemC) as Integer
TMemPtr = TMemC
TStackPtr = 1
TStackC = TStackPtr
Redim Preserve TStackD(1 to TStackC) as Integer
TStackD(TStackPtr) = 1
'run
Dim TAppPtr as Integer
Dim TLoop as Integer
Do
If TDebug = 1 Then Print "RUN FROM:"; TStackD(TStackPtr)
TLoop = 0
'Program verarbeiten
TAppPtr = TStackD(TStackPtr)
Do
If TStackD(TStackPtr) >= TAppLen Then End 0
If TDebug = 1 Then Print " EXECUTE:"; TStackD(TStackPtr); " | "; Asc(Mid$(TAppData, TStackD(TStackPtr), 1))
Select Case Asc(Mid$(TAppData, TStackD(TStackPtr), 1))
Case 43 '+
If TMemPtr <= 0 Then Print "Memory access error!": End -2
TMemD(TMemPtr) = TMemD(TMemPtr) + 1
Case 44 ',
If TMemPtr <= 0 Then Print "Memory access error!": End -2
Input TMemD(TMemPtr)
Case 45 '-
If TMemPtr <= 0 Then Print "Memory access error!": End -2
TMemD(TMemPtr) = TMemD(TMemPtr) - 1
Case 46 '.
If TMemPtr <= 0 Then Print "Memory access error!": End -2
Print Chr$(TMemD(TMemPtr));
Case 49 to 57 '1 to 9 = wiederholt den nachfolgenden Befehl 1-9 mal
TLoop = Asc(Mid$(TAppData, TStackD(TStackPtr), 1)) - 48
If TDebug = 1 Then Print "LOOP:"; TLoop
TStackD(TStackPtr) = TStackD(TStackPtr) + 1
Case 60 '<
TMemPtr = TMemPtr - 1
Case 62 '>
TMemPtr = TMemPtr + 1
If TMemC < TMemPtr Then
TMemC = TMemPtr
Redim Preserve TMemD(1 to TMemC) as Integer
End If
Case 91 '[
TStackPtr = TStackPtr + 1
If TStackPtr > TStackC Then
TStackC = TStackPtr
Redim Preserve TStackD(1 to TStackC) as Integer
End If
TStackD(TStackPtr) = TStackD(TStackPtr - 1) + 1
Exit Do
Case 93 ']
If TMemPtr <= 0 Then Print "Memory access error!": End -2
If TMemD(TMemPtr) = 0 Then
If TDebug = 1 Then Print "RETURN TO:"; TStackD(TStackPtr)
TStackPtr = TStackPtr - 1
If TStackPtr <= 0 Then Print "Stack access error!": End -3
TStackD(TStackPtr) = TStackD(TStackPtr + 1) + 1
Exit Do
End If
TStackD(TStackPtr) = TAppPtr - 1
End Select
If TLoop = 0 Then
TStackD(TStackPtr) = TStackD(TStackPtr) + 1
Else: TLoop = TLoop - 1
End If
Loop
Loop
End |
EDIT: QB Portirungsfehler im Source behoben. (THX Sebastian)
MfG
TPM _________________ [ WebFBC ][ OPS ][ ToOFlo ][ Wiemann.TV ] |
|
Nach oben |
|
|
X0X
Anmeldungsdatum: 11.03.2013 Beiträge: 2
|
Verfasst am: 14.03.2013, 18:40 Titel: |
|
|
Danke, das teste ich erstmal.
Leider ist mein I-Net PC kaputt, werd aber baldmöglichst rückmeldung geben. |
|
Nach oben |
|
|
|
|
Du kannst keine Beiträge in dieses Forum schreiben. Du kannst auf Beiträge in diesem Forum nicht antworten. Du kannst deine Beiträge in diesem Forum nicht bearbeiten. Du kannst deine Beiträge in diesem Forum nicht löschen. Du kannst an Umfragen in diesem Forum nicht mitmachen.
|
|