Home

Add

Edit

Without Linenumbers

Code in Textfield

Download

  1. '###########################################################################################
    
  2. #LANG "qb"
    
  3. 
    
  4. 
    
  5. 
    
  6. '###########################################################################################
    
  7. Const TDebug = 0
    
  8. 
    
  9. 
    
  10. 
    
  11. '###########################################################################################
    
  12. Dim Shared TAppData As String
    
  13. Dim Shared TAppLen As Integer
    
  14. Dim Shared TMemD() As Integer
    
  15. Dim Shared TMemC As Integer
    
  16. Dim Shared TMemPtr As Integer
    
  17. 
    
  18. Dim Shared TStackD() As Integer
    
  19. Dim Shared TStackPtr As Integer
    
  20. Dim Shared TStackC As Integer
    
  21. 
    
  22. 
    
  23. 
    
  24. '###########################################################################################
    
  25. 'Programm-daten laden und optimieren (Alles was kein Befehl ist, ignorieren)
    
  26. Open "test_qb.bf" For Binary As #1
    
  27. Dim T As String
    
  28. Dim X As Integer
    
  29. Dim Max As Integer
    
  30. T = " "
    
  31. Max = Lof(1)
    
  32. Do
    
  33.     X += 1
    
  34.     If X > Max Then Exit Do
    
  35.     Get #1, X, T
    
  36.     Select Case Asc(T)
    
  37.         Case 43, 44, 45, 46, 49, 50, 51, 52, 53, 54, 55, 56, 57, 60, 62, 91, 93
    
  38.             TAppData = TAppData + T
    
  39.     End Select
    
  40. Loop
    
  41. Close #1
    
  42. 
    
  43. TAppLen = Len(TAppData)
    
  44. If TAppLen <= 0 Then Print "No programmdata found!": End 0
    
  45. 
    
  46. 'Programm-Stack vorbereiten
    
  47. TMemC = 1
    
  48. Redim Preserve TMemD(1 To TMemC) As Integer
    
  49. TMemPtr = TMemC
    
  50. 
    
  51. TStackPtr = 1
    
  52. TStackC = TStackPtr
    
  53. Redim Preserve TStackD(1 To TStackC) As Integer
    
  54. TStackD(TStackPtr) = 1
    
  55. 
    
  56. 'run
    
  57. Dim TAppPtr As Integer
    
  58. Dim TLoop As Integer
    
  59. Do
    
  60.     If TDebug = 1 Then Print "RUN FROM:" & TStackD(TStackPtr)
    
  61.     TLoop = 0
    
  62.     'Program verarbeiten
    
  63.     TAppPtr = TStackD(TStackPtr)
    
  64.     Do
    
  65.         If TStackD(TStackPtr) >= TAppLen Then End 0
    
  66.         If TDebug = 1 Then Print " EXECUTE:"; TStackD(TStackPtr); " | "; Asc(Mid$(TAppData, TStackD(TStackPtr), 1))
    
  67.         Select Case Asc(Mid$(TAppData, TStackD(TStackPtr), 1))
    
  68.             Case 43 '+
    
  69.                 If TMemPtr <= 0 Then Print "Memory access error!": End -2
    
  70.                 TMemD(TMemPtr) = TMemD(TMemPtr) + 1
    
  71.                 
    
  72.             Case 44 ',
    
  73.                 If TMemPtr <= 0 Then Print "Memory access error!": End -2
    
  74.                 Input TMemD(TMemPtr)
    
  75.                 
    
  76.             Case 45 '-
    
  77.                 If TMemPtr <= 0 Then Print "Memory access error!": End -2
    
  78.                 TMemD(TMemPtr) = TMemD(TMemPtr) - 1
    
  79.                 
    
  80.             Case 46 '.
    
  81.                 If TMemPtr <= 0 Then Print "Memory access error!": End -2
    
  82.                 Print Chr$(TMemD(TMemPtr));
    
  83.                 
    
  84.             Case 49 To 57 '1 to 9 = wiederholt den nachfolgenden Befehl 1-9 mal
    
  85.                 TLoop = Asc(Mid$(TAppData, TStackD(TStackPtr), 1)) - 48
    
  86.                 If TDebug = 1 Then Print "LOOP:" & TLoop
    
  87.                 TStackD(TStackPtr) = TStackD(TStackPtr) + 1
    
  88.                 
    
  89.             Case 60 '<
    
  90.                 TMemPtr -= 1
    
  91.                 
    
  92.             Case 62 '>
    
  93.                 TMemPtr += 1
    
  94.                 If TMemC < TMemPtr Then
    
  95.                     TMemC = TMemPtr
    
  96.                     Redim Preserve TMemD(1 To TMemC) As Integer
    
  97.                 End If
    
  98.                 
    
  99.             Case 91 '[
    
  100.                 TStackPtr += 1
    
  101.                 If TStackPtr > TStackC Then
    
  102.                     TStackC = TStackPtr
    
  103.                     Redim Preserve TStackD(1 To TStackC) As Integer
    
  104.                 End If
    
  105.                 TStackD(TStackPtr) = TStackD(TStackPtr - 1) + 1
    
  106.                 Exit Do
    
  107.                 
    
  108.             Case 93 ']
    
  109.                 If TMemPtr <= 0 Then Print "Memory access error!": End -2
    
  110.                 If TMemD(TMemPtr) = 0 Then
    
  111.                     If TDebug = 1 Then Print "RETURN TO:"; TStackD(TStackPtr)
    
  112.                     TStackPtr -= 1
    
  113.                     If TStackPtr <= 0 Then Print "Stack access error!": End -3
    
  114.                     TStackD(TStackPtr) = TStackD(TStackPtr + 1) + 1
    
  115.                     Exit Do
    
  116.                 End If
    
  117.                 TStackD(TStackPtr) = TAppPtr - 1
    
  118.                 
    
  119.         End Select
    
  120.         If TLoop = 0 Then
    
  121.             TStackD(TStackPtr) = TStackD(TStackPtr) + 1
    
  122.         Else: TLoop = TLoop - 1
    
  123.         End If
    
  124.     Loop
    
  125. Loop
    
  126. End 0
    
  127. 
    
  128.