Abstract

Dies ist ein kleiner Minirechner mit zwei Registern: ein Programmzähler pc und ein Akkumulator acc. Zwei VBA Programme interpretieren die unterschiedlichen Modi: ein direkter Modus - auch Kommandozeilen Modus genannt, und ein Programmmodus:

Minirechner

Das Beispielprogramm berechnet für zwei ganze Zahlen den größten gemeinsamen Teiler und das kleinste gemeinsame Vielfache.

Um das Beispielprogramm auszuführen, starten Sie den Minirechner wie folgt:

  1. Setzen Sie in der Kommandozeile mit bgn 1 oder bgn start (wenn Sie die Sprungmarke start gesetzt haben) den Startpunkt Ihres Programms.
  2. Gegebenenfalls können Sie mit dbg on oder dbg off in der Kommandozeile den Debug Modus ein- oder ausschalten.
  3. Mit srt in der Kommandozeile starten Sie Ihr Programm.

Debug Ausgabe des Beispielprogramms

Wenn Sie dbg on eingeben, bevor Sie das Beispielprogramm starten, erhalten Sie die Ausgabe:

Ausgabebereich:
Label 'start' := 1
Label 'ggt' := 8
Label 'ggt_intern' := 12
Label 'store' := 20
Label 'end_ggt' := 22
Label 'kgv' := 25
Label 'temp1' := 30
Label 'temp2' := 31
Label 'out_ggt' := 32
Label 'out_kgv' := 33
Label 'arg1' := 34
Label 'arg2' := 35
Label 'result_ggt' := 36
Label 'result_kgv' := 37
Unterprogrammaufruf 'ggt'. Rücksprung wurde auf Zeile 2 gesetzt. Stackindex 1.
Programmzähler wurde auf Zeile 8 gesetzt.
acc := 750
Argument in Zeile 30 wurde auf acc = 750 gesetzt.
acc := 1250
Argument in Zeile 31 wurde auf acc = 1250 gesetzt.
acc := 750
acc := acc - 1250
acc != 0 -> keine Verzweigung.
acc <= 0 -> keine Verzweigung.
acc := 1250
acc := acc - 750
Argument in Zeile 31 wurde auf acc = 500 gesetzt.
Verzweige nach ggt_intern.
Programmzähler wurde auf Zeile 12 gesetzt.
acc := 750
acc := acc - 500
acc != 0 -> keine Verzweigung.
acc > 0 -> verzweige nach store.
Programmzähler wurde auf Zeile 20 gesetzt.
Argument in Zeile 30 wurde auf acc = 250 gesetzt.
Verzweige nach ggt_intern.
Programmzähler wurde auf Zeile 12 gesetzt.
acc := 250
acc := acc - 500
acc != 0 -> keine Verzweigung.
acc <= 0 -> keine Verzweigung.
acc := 500
acc := acc - 250
Argument in Zeile 31 wurde auf acc = 250 gesetzt.
Verzweige nach ggt_intern.
Programmzähler wurde auf Zeile 12 gesetzt.
acc := 250
acc := acc - 250
acc = 0 -> verzweige nach end_ggt.
Programmzähler wurde auf Zeile 22 gesetzt.
acc := 250
Argument in Zeile 36 wurde auf acc = 250 gesetzt.
Unterprogrammrücksprung nach '2'. Stackindex 0.
Der größte gemeinsame Teiler ist:
250
Unterprogrammaufruf 'kgv'. Rücksprung wurde auf Zeile 5 gesetzt. Stackindex 1.
Programmzähler wurde auf Zeile 25 gesetzt.
acc := 750
acc := acc / 250
acc := acc * 1250
Argument in Zeile 37 wurde auf acc = 3750 gesetzt.
Unterprogrammrücksprung nach '5'. Stackindex 0.
Das kleinste gemeinsame Vielfache ist:
3750
Programmende erreicht in Zeile 7.

Der Kommandozeilen Interpreter - Worksheet_Change Programmcode

Dieser Code befindet sich im Sheet wsMain:

Bitte den Haftungsausschluss im Impressum beachten.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
'This implements the command line interpreter of the mini-calculator.
'Source (EN): http://www.sulprobil.de/minicalculator_en/
'Source (DE): http://www.berndplumhoff.de/minirechner_de/
'(C) (P) by Bernd Plumhoff  26-Dec-2023 PB V0.1
Dim s          As String
'Application.EnableEvents = False
If Target.Address = Range("Kommandozeile").Address Then
    s = Range("Kommandozeile")
    Select Case Left(s, 3)
    Case "srt"
        If pc = 0 Or pc = "" Then pc = 1
        Range("Meldung") = "Programm wird gestartet bei pc = " & pc
        Range("Meldung").Font.ColorIndex = xlCIGreen
        Call interpreter
    Case "bgn"
        s = Right(s, Len(s) - 4)
        pc = s
        Range("Meldung") = "pc := " & s
        Range("Meldung").Font.ColorIndex = xlCIGreen
    Case "dbg"
        s = Right(s, Len(s) - 4)
        Select Case s
        Case "on"
            dbg = True
            Range("Meldung") = "dbg := on"
            Range("Meldung").Font.ColorIndex = xlCIGreen
        Case "off"
            dbg = False
            Range("Meldung") = "dbg := off"
            Range("Meldung").Font.ColorIndex = xlCIGreen
        Case Else
            Range("Meldung") = "Ungültiger Debug Modus '" & s & "'"
            Range("Meldung").Font.ColorIndex = xlCIRed
        End Select
    Case Else
        Range("Meldung") = "Unbekannter Befehl '" & s & "'"
        Range("Meldung").Font.ColorIndex = xlCIRed
    End Select
End If
'Application.EnableEvents = True
End Sub

Der Programm Interpreter - Interpreter Programmcode

Dieser Code befindet sich im Modul General:

Bitte den Haftungsausschluss im Impressum beachten.

Option Explicit

'This implements the main program interpreter of the mini-calculator.
'Source (EN): http://www.sulprobil.de/minicalculator_en/
'Source (DE): http://www.berndplumhoff.de/minirechner_de/
'(C) (P) by Bernd Plumhoff  26-Dec-2023 PB V0.1

Public Enum xlCI 'Excel Color Index
: xlCIBlack = 1: xlCIWhite: xlCIRed: xlCIBrightGreen: xlCIBlue '1 - 5
: xlCIYellow: xlCIPink: xlCITurquoise: xlCIDarkRed: xlCIGreen '6 - 10
: xlCIDarkBlue: xlCIDarkYellow: xlCIViolet: xlCITeal: xlCIGray25 '11 - 15
: xlCIGray50: xlCIPeriwinkle: xlCIPlum: xlCIIvory: xlCILightTurquoise '16 - 20
: xlCIDarkPurple: xlCICoral: xlCIOceanBlue: xlCIIceBlue: xlCILightBrown '21 - 25
: xlCIMagenta2: xlCIYellow2: xlCICyan2: xlCIDarkPink: xlCIDarkBrown '26 - 30
: xlCIDarkTurquoise: xlCISeaBlue: xlCISkyBlue: xlCILightTurquoise2: xlCILightGreen '31 - 35
: xlCILightYellow: xlCIPaleBlue: xlCIRose: xlCILavender: xlCITan '36 - 40
: xlCILightBlue: xlCIAqua: xlCILime: xlCIGold: xlCILightOrange '41 - 45
: xlCIOrange: xlCIBlueGray: xlCIGray40: xlCIDarkTeal: xlCISeaGreen '46 - 50
: xlCIDarkGreen: xlCIGreenBrown: xlCIBrown: xlCIDarkPink2: xlCIIndigo '51 - 55
: xlCIGray80 '56
End Enum

Enum pcol 'Spalten in jeder Programmzeile
    pcol_zeile = 0                       'Zeilennummer
    pcol_label
    pcol_opcode
    pcol_argument
    pcol_kommentar
End Enum

Public dbg               As Boolean      'Debug Modus
Public i                 As Integer      'Ausgabebereich Index
Public pc                As Variant      'Programmzähler

Sub interpreter()
Dim b_end                As Boolean      'Programmzeile leer?
Dim p                    As Integer      'Programm Index
Dim r                    As Integer      'Unterprogramm Stack Index
Dim ustack(1 To 100)     As Integer      'Unterprogramm Stack
Dim acc                  As Long         'Akkumulator
Dim st                   As Object       'Symboltabelle (Labels)
Dim op                   As String       'OpCode
Dim s                    As String
Dim v                    As Variant

'Initialisierungen

Range("Ausgabebereich").Resize(65536).ClearContents
i = 0

If pc = "" Then
    pc = 1
    debug_ausgabe ("Programmzähler wurde auf 1 initialisiert.")
End If

'Lade Symboltabelle
Set st = CreateObject("Scripting.Dictionary")
p = 1
b_end = (Range("Programmcode").Offset(p, pcol_label) = "" And _
         Range("Programmcode").Offset(p, pcol_opcode) = "" And _
         Range("Programmcode").Offset(p, pcol_argument) = "")
Do Until b_end
    s = Range("Programmcode").Offset(p, pcol_label)
    If s <> "" Then
        If st.exists(s) Then
            Call debug_ausgabe("Identische Label '" & s & "' in Zeilen " & st(s) & " und " & p & ". Abbruch!", True)
            Exit Sub
        End If
        st(s) = p
        debug_ausgabe ("Label '" & s & "' := " & p)
    End If
    p = p + 1
    b_end = (Range("Programmcode").Offset(p, pcol_label) = "" And _
             Range("Programmcode").Offset(p, pcol_opcode) = "" And _
             Range("Programmcode").Offset(p, pcol_argument) = "")
Loop

'Interpretiere das Programm

Do

continue_do:

    If Not IsNumeric(pc) Then
        If st.exists(pc) Then
            pc = st(pc)
            debug_ausgabe ("Programmzähler wurde auf Zeile " & pc & " gesetzt.")
            
        Else
            Call debug_ausgabe("Programmzähler hat ungültiges Label '" & pc & "'. Abbruch!", True)
            Exit Sub
        End If
    End If
    
    op = Range("Programmcode").Offset(pc, pcol_opcode)
    Select Case op
    Case "add"
        v = Range("Programmcode").Offset(pc, pcol_argument)
        If Not IsNumeric(v) Then
            If st.exists(v) Then
                v = st(v)
            Else
                Call debug_ausgabe("Unbekanntes Argument '" & v & "' in Zeile " & pc & ". Abbruch!", True)
                Exit Sub
            End If
        End If
        acc = acc + Range("Programmcode").Offset(v, pcol_argument)
        debug_ausgabe ("acc := acc + " & Range("Programmcode").Offset(v, pcol_argument))
    Case "beq"
        If acc = 0 Then
            pc = Range("Programmcode").Offset(pc, pcol_argument)
            debug_ausgabe ("acc = 0 -> verzweige nach " & pc & ".")
            GoTo continue_do
        Else
            debug_ausgabe ("acc != 0 -> keine Verzweigung.")
        End If
    Case "bgr"
        If acc > 0 Then
            pc = Range("Programmcode").Offset(pc, pcol_argument)
            debug_ausgabe ("acc > 0 -> verzweige nach " & pc & ".")
            GoTo continue_do
        Else
            debug_ausgabe ("acc <= 0 -> keine Verzweigung.")
        End If
    Case "ble"
        If acc < 0 Then
            pc = Range("Programmcode").Offset(pc, pcol_argument)
            debug_ausgabe ("acc < 0 -> verzweige nach " & pc & ".")
            GoTo continue_do
        Else
            debug_ausgabe ("acc >= 0 -> keine Verzweigung.")
        End If
    Case "bsa"
        r = r + 1
        ustack(r) = pc + 1
        pc = Range("Programmcode").Offset(pc, pcol_argument)
        debug_ausgabe ("Unterprogrammaufruf '" & pc & _
            "'. Rücksprung wurde auf Zeile " & ustack(r) & _
            " gesetzt. Stackindex " & r & ".")
        GoTo continue_do
    Case "bun"
        pc = Range("Programmcode").Offset(pc, pcol_argument)
        debug_ausgabe ("Verzweige nach " & pc & ".")
        GoTo continue_do
    Case "cla"
        acc = 0
        debug_ausgabe ("acc := 0")
    Case "dac"
        acc = acc - 1
        debug_ausgabe ("acc := acc - 1")
    Case "div"
        v = Range("Programmcode").Offset(pc, pcol_argument)
        If Not IsNumeric(v) Then
            If st.exists(v) Then
                v = st(v)
            Else
                Call debug_ausgabe("Unbekanntes Argument '" & v & "' in Zeile " & pc & ". Abbruch!", True)
                Exit Sub
            End If
        End If
        acc = acc / Range("Programmcode").Offset(v, pcol_argument)
        debug_ausgabe ("acc := acc / " & Range("Programmcode").Offset(v, pcol_argument))
    Case "hlt"
        Call debug_ausgabe("Programmende erreicht in Zeile " & pc & ".", True)
        Exit Sub
    Case "iac"
        acc = acc + 1
        debug_ausgabe ("acc := acc + 1")
    Case "lda"
        v = Range("Programmcode").Offset(pc, pcol_argument)
        If Not IsNumeric(v) Then
            If st.exists(v) Then
                v = st(v)
            Else
                debug_ausgabe ("Unbekanntes Argument '" & v & "' in Zeile " & pc & ". Abbruch!")
                End
            End If
        End If
        acc = Range("Programmcode").Offset(v, pcol_argument)
        debug_ausgabe ("acc := " & acc)
    Case "mul"
        v = Range("Programmcode").Offset(pc, pcol_argument)
        If Not IsNumeric(v) Then
            If st.exists(v) Then
                v = st(v)
            Else
                debug_ausgabe ("Unbekanntes Argument '" & v & "' in Zeile " & pc & ". Abbruch!")
                End
            End If
        End If
        acc = acc * Range("Programmcode").Offset(v, pcol_argument)
        debug_ausgabe ("acc := acc * " & Range("Programmcode").Offset(v, pcol_argument))
    Case "out"
        v = Range("Programmcode").Offset(pc, pcol_argument)
        If Not IsNumeric(v) Then
            If st.exists(v) Then
                v = st(v)
            Else
                debug_ausgabe ("Unbekanntes Argument '" & v & "' in Zeile " & pc & ". Abbruch!")
                End
            End If
        End If
        Range("Ausgabebereich").Offset(i) = Range("Programmcode").Offset(v, pcol_argument)
        i = i + 1
    Case "ret"
        pc = ustack(r)
        r = r - 1
        debug_ausgabe ("Unterprogrammrücksprung nach '" & pc & _
            "'. Stackindex " & r & ".")
        GoTo continue_do
    Case "sta"
        v = Range("Programmcode").Offset(pc, pcol_argument)
        If Not IsNumeric(v) Then
            If st.exists(v) Then
                v = st(v)
            Else
                Call debug_ausgabe("Unbekanntes Argument '" & v & "' in Zeile " & pc & ". Abbruch!", True)
                Exit Sub
            End If
        End If
        Range("Programmcode").Offset(v, pcol_argument) = acc
        debug_ausgabe ("Argument in Zeile " & v & " wurde auf acc = " & acc & " gesetzt.")
    Case "sub"
        v = Range("Programmcode").Offset(pc, pcol_argument)
        If Not IsNumeric(v) Then
            If st.exists(v) Then
                v = st(v)
            Else
                Call debug_ausgabe("Unbekanntes Argument '" & v & "' in Zeile " & pc & ". Abbruch!", True)
                Exit Sub
            End If
        End If
        acc = acc - Range("Programmcode").Offset(v, pcol_argument)
        debug_ausgabe ("acc := acc - " & Range("Programmcode").Offset(v, pcol_argument))
    Case Else
        Call debug_ausgabe("Ungültiger OpCode '" & op & "' in Zeile " & pc & ". Abbruch!", True)
        Exit Sub
    End Select
    
    pc = pc + 1
    
    b_end = (Range("Programmcode").Offset(pc, pcol_label) = "" And _
             Range("Programmcode").Offset(pc, pcol_opcode) = "" And _
             Range("Programmcode").Offset(pc, pcol_argument) = "")
             
Loop Until b_end

End Sub

Sub debug_ausgabe(s As String, Optional force As Boolean = False)
If dbg Or force Then
    Range("Ausgabebereich").Offset(i) = s
    i = i + 1
End If
End Sub

Download

Bitte den Haftungsausschluss im Impressum beachten.

MiniRechner.xlsm [45 KB Excel Datei, ohne jegliche Gewährleistung]