Home

Add

Edit

With Linenumbers

Code in Textfield

Download

'###########################################################################################
#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 += 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 -= 1
                
            Case 62 '>
                TMemPtr += 1
                If TMemC < TMemPtr Then
                    TMemC = TMemPtr
                    Redim Preserve TMemD(1 To TMemC) As Integer
                End If
                
            Case 91 '[
                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 -= 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 0