Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
 
FAQFAQ   SuchenSuchen   MitgliederlisteMitgliederliste   BenutzergruppenBenutzergruppen  RegistrierenRegistrieren
ProfilProfil   Einloggen, um private Nachrichten zu lesenEinloggen, um private Nachrichten zu lesen   LoginLogin
Zur Begleitseite des Forums / Chat / Impressum
Aktueller Forenpartner:

BrainF*ck Interpreter

 
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Allgemeine Fragen zu QBasic.
Vorheriges Thema anzeigen :: Nächstes Thema anzeigen  
Autor Nachricht
X0X



Anmeldungsdatum: 11.03.2013
Beiträge: 2

BeitragVerfasst am: 11.03.2013, 17:57    Titel: BrainF*ck Interpreter Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden
ThePuppetMaster



Anmeldungsdatum: 18.02.2007
Beiträge: 1749
Wohnort: [JN58JR] DeltaLabs.de

BeitragVerfasst am: 12.03.2013, 15:45    Titel: Antworten mit Zitat

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 ][ DeltaLab's ][ ToOFlo ][ BGB-Movie ]
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
ThePuppetMaster



Anmeldungsdatum: 18.02.2007
Beiträge: 1749
Wohnort: [JN58JR] DeltaLabs.de

BeitragVerfasst am: 12.03.2013, 16:28    Titel: Antworten mit Zitat

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:
Code:
+++++++


kann durch
Code:
7+


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 ][ DeltaLab's ][ ToOFlo ][ BGB-Movie ]
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
ThePuppetMaster



Anmeldungsdatum: 18.02.2007
Beiträge: 1749
Wohnort: [JN58JR] DeltaLabs.de

BeitragVerfasst am: 12.03.2013, 17:46    Titel: Antworten mit Zitat

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 ][ DeltaLab's ][ ToOFlo ][ BGB-Movie ]
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
X0X



Anmeldungsdatum: 11.03.2013
Beiträge: 2

BeitragVerfasst am: 14.03.2013, 18:40    Titel: Antworten mit Zitat

Danke, das teste ich erstmal.
Leider ist mein I-Net PC kaputt, werd aber baldmöglichst rückmeldung geben.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
Beiträge der letzten Zeit anzeigen:   
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Allgemeine Fragen zu QBasic. Alle Zeiten sind GMT + 1 Stunde
Seite 1 von 1

 
Gehe zu:  
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.

 Impressum :: Datenschutz