Minicalculator (Excel/VBA) ·

Abstract

This is a Minicalculator with two registers: a program counter pc and an accumulator acc. Two VBA programs interprete two different modes: a command line mode, and a program mode:

Minicalculator

The sample program calculates for two positive integers the greatest common divisor (gcd) and the lowest common multiple (lcm).

In order to execute the sample program you need to:

Set the starting point point at command line with bgn 1 or with bgn start (if you have defined a corresponding label start).
For debugging purposes you can switch on (or off) debugging with dbg on (or dbg off) at command line.
With srt you will then start your program.

Debug Output of Sample Program

If you enter dbg on before you start the sample program you will get the output:

Output area:
Label 'start' := 1
Label 'gcd' := 8
Label 'gcd_intern' := 12
Label 'store' := 20
Label 'end_gcd' := 22
Label 'lcm' := 25
Label 'temp1' := 30
Label 'temp2' := 31
Label 'out_gcd' := 32
Label 'out_lcm' := 33
Label 'arg1' := 34
Label 'arg2' := 35
Label 'result_gcd' := 36
Label 'result_lcm' := 37
Subroutine call at 'gcd'. Return address set to 2. Stack index 1.
Program counter set to row 8.
acc := 750
Argument in row 30 set to acc = 750.
acc := 1250
Argument in row 31 set to acc = 1250.
acc := 750
acc := acc - 1250
acc != 0 -> no branch.
acc <= 0 -> no branch.
acc := 1250
acc := acc - 750
Argument in row 31 set to acc = 500.
Go to gcd_intern.
Program counter set to row 12.
acc := 750
acc := acc - 500
acc != 0 -> no branch.
acc > 0 -> go to store.
Program counter set to row 20.
Argument in row 30 set to acc = 250.
Go to gcd_intern.
Program counter set to row 12.
acc := 250
acc := acc - 500
acc != 0 -> no branch.
acc <= 0 -> no branch.
acc := 500
acc := acc - 250
Argument in row 31 set to acc = 250.
Go to gcd_intern.
Program counter set to row 12.
acc := 250
acc := acc - 250
acc = 0 -> go to end_gcd.
Program counter set to row 22.
acc := 250
Argument in row 36 set to acc = 250.
Subroutine returns to '2'. Stackindex 0.
Greatest common divisor is:
250
Subroutine call at 'lcm'. Return address set to 5. Stack index 1.
Program counter set to row 25.
acc := 750
acc := acc / 250
acc := acc * 1250
Argument in row 37 set to acc = 3750.
Subroutine returns to '5'. Stackindex 0.
Lowest common multiple is:
3750
Program end in row 7.

The Command Line Interpreter - Code Worksheet_Change

This code is in sheet wsMain:

Please read my Disclaimer.

Option Explicit

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

Private Sub Worksheet_Change(ByVal Target As Range)
'This implements the command line interpreter of the mini-calculator.
'Source (EN): http://www.sulprobil.com/minicalculator_en/
'Source (DE): http://www.bplumhoff.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("Command_line").Address Then
    s = Range("Command_line")
    Select Case Left(s, 3)
    Case "srt"
        If pc = 0 Or pc = "" Then pc = 1
        Range("Message") = "Program will be started at pc = " & pc
        Range("Message").Font.ColorIndex = xlCIGreen
        Call interpreter
    Case "bgn"
        s = Right(s, Len(s) - 4)
        pc = s
        Range("Message") = "pc := " & s
        Range("Message").Font.ColorIndex = xlCIGreen
    Case "dbg"
        s = Right(s, Len(s) - 4)
        Select Case s
        Case "on"
            dbg = True
            Range("Message") = "dbg := on"
            Range("Message").Font.ColorIndex = xlCIGreen
        Case "off"
            dbg = False
            Range("Message") = "dbg := off"
            Range("Message").Font.ColorIndex = xlCIGreen
        Case Else
            Range("Message") = "Illegal Debug Mode '" & s & "'"
            Range("Message").Font.ColorIndex = xlCIRed
        End Select
    Case Else
        Range("Message") = "Illegal Command '" & s & "'"
        Range("Message").Font.ColorIndex = xlCIRed
    End Select
End If
'Application.EnableEvents = True
End Sub

The Program Interpreter - Code Interpreter

This code is in module General:

Please read my Disclaimer.

Option Explicit

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

Enum pcol 'Spalten in jeder Programmzeile
    pool_row = 0                       'Zeilennummer
    pcol_label
    pcol_opcode
    pcol_argument
    pool_comment
End Enum

Public dbg               As Boolean      'Debug Modus
Public i                 As Integer      'Output_area 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("Output_area").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("Program_code").Offset(p, pcol_label) = "" And _
         Range("Program_code").Offset(p, pcol_opcode) = "" And _
         Range("Program_code").Offset(p, pcol_argument) = "")
Do Until b_end
    s = Range("Program_code").Offset(p, pcol_label)
    If s <> "" Then
        If st.exists(s) Then
            Call debug_ausgabe("Identical labels '" & s & "' in rows " & st(s) & " and " & p & ". Abort!", True)
            Exit Sub
        End If
        st(s) = p
        debug_ausgabe ("Label '" & s & "' := " & p)
    End If
    p = p + 1
    b_end = (Range("Program_code").Offset(p, pcol_label) = "" And _
             Range("Program_code").Offset(p, pcol_opcode) = "" And _
             Range("Program_code").Offset(p, pcol_argument) = "")
Loop

'Interprete the program

Do

continue_do:

    If Not IsNumeric(pc) Then
        If st.exists(pc) Then
            pc = st(pc)
            debug_ausgabe ("Program counter set to row " & pc & ".")
            
        Else
            Call debug_ausgabe("Program counter contains illegal label '" & pc & "'. Abort!", True)
            Exit Sub
        End If
    End If
    
    op = Range("Program_code").Offset(pc, pcol_opcode)
    Select Case op
    Case "add"
        v = Range("Program_code").Offset(pc, pcol_argument)
        If Not IsNumeric(v) Then
            If st.exists(v) Then
                v = st(v)
            Else
                Call debug_ausgabe("Unknown argument '" & v & "' in row " & pc & ". Abort!", True)
                Exit Sub
            End If
        End If
        acc = acc + Range("Program_code").Offset(v, pcol_argument)
        debug_ausgabe ("acc := acc + " & Range("Program_code").Offset(v, pcol_argument))
    Case "beq"
        If acc = 0 Then
            pc = Range("Program_code").Offset(pc, pcol_argument)
            debug_ausgabe ("acc = 0 -> go to " & pc & ".")
            GoTo continue_do
        Else
            debug_ausgabe ("acc != 0 -> no branch.")
        End If
    Case "bgr"
        If acc > 0 Then
            pc = Range("Program_code").Offset(pc, pcol_argument)
            debug_ausgabe ("acc > 0 -> go to " & pc & ".")
            GoTo continue_do
        Else
            debug_ausgabe ("acc <= 0 -> no branch.")
        End If
    Case "ble"
        If acc < 0 Then
            pc = Range("Program_code").Offset(pc, pcol_argument)
            debug_ausgabe ("acc < 0 -> go to " & pc & ".")
            GoTo continue_do
        Else
            debug_ausgabe ("acc >= 0 -> no branch.")
        End If
    Case "bsa"
        r = r + 1
        ustack(r) = pc + 1
        pc = Range("Program_code").Offset(pc, pcol_argument)
        debug_ausgabe ("Subroutine call at '" & pc & _
            "'. Return address set to " & ustack(r) & _
            ". Stack index " & r & ".")
        GoTo continue_do
    Case "bun"
        pc = Range("Program_code").Offset(pc, pcol_argument)
        debug_ausgabe ("Go to " & 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("Program_code").Offset(pc, pcol_argument)
        If Not IsNumeric(v) Then
            If st.exists(v) Then
                v = st(v)
            Else
                Call debug_ausgabe("Unknown argument '" & v & "' in row " & pc & ". Abort!", True)
                Exit Sub
            End If
        End If
        acc = acc / Range("Program_code").Offset(v, pcol_argument)
        debug_ausgabe ("acc := acc / " & Range("Program_code").Offset(v, pcol_argument))
    Case "hlt"
        Call debug_ausgabe("Program end in row " & pc & ".", True)
        Exit Sub
    Case "iac"
        acc = acc + 1
        debug_ausgabe ("acc := acc + 1")
    Case "lda"
        v = Range("Program_code").Offset(pc, pcol_argument)
        If Not IsNumeric(v) Then
            If st.exists(v) Then
                v = st(v)
            Else
                debug_ausgabe ("Unknown argument '" & v & "' in row " & pc & ". Abort!")
                End
            End If
        End If
        acc = Range("Program_code").Offset(v, pcol_argument)
        debug_ausgabe ("acc := " & acc)
    Case "mul"
        v = Range("Program_code").Offset(pc, pcol_argument)
        If Not IsNumeric(v) Then
            If st.exists(v) Then
                v = st(v)
            Else
                debug_ausgabe ("Unknown argument '" & v & "' in row " & pc & ". Abort!")
                End
            End If
        End If
        acc = acc * Range("Program_code").Offset(v, pcol_argument)
        debug_ausgabe ("acc := acc * " & Range("Program_code").Offset(v, pcol_argument))
    Case "out"
        v = Range("Program_code").Offset(pc, pcol_argument)
        If Not IsNumeric(v) Then
            If st.exists(v) Then
                v = st(v)
            Else
                debug_ausgabe ("Unknown argument '" & v & "' in row " & pc & ". Abort!")
                End
            End If
        End If
        Range("Output_area").Offset(i) = Range("Program_code").Offset(v, pcol_argument)
        i = i + 1
    Case "ret"
        pc = ustack(r)
        r = r - 1
        debug_ausgabe ("Subroutine returns to '" & pc & _
            "'. Stackindex " & r & ".")
        GoTo continue_do
    Case "sta"
        v = Range("Program_code").Offset(pc, pcol_argument)
        If Not IsNumeric(v) Then
            If st.exists(v) Then
                v = st(v)
            Else
                Call debug_ausgabe("Unknown argument '" & v & "' in row " & pc & ". Abort!", True)
                Exit Sub
            End If
        End If
        Range("Program_code").Offset(v, pcol_argument) = acc
        debug_ausgabe ("Argument in row " & v & " set to acc = " & acc & ".")
    Case "sub"
        v = Range("Program_code").Offset(pc, pcol_argument)
        If Not IsNumeric(v) Then
            If st.exists(v) Then
                v = st(v)
            Else
                Call debug_ausgabe("Unknown argument '" & v & "' in row " & pc & ". Abort!", True)
                Exit Sub
            End If
        End If
        acc = acc - Range("Program_code").Offset(v, pcol_argument)
        debug_ausgabe ("acc := acc - " & Range("Program_code").Offset(v, pcol_argument))
    Case Else
        Call debug_ausgabe("Ungültiger OpCode '" & op & "' in row " & pc & ". Abort!", True)
        Exit Sub
    End Select
    
    pc = pc + 1
    
    b_end = (Range("Program_code").Offset(pc, pcol_label) = "" And _
             Range("Program_code").Offset(pc, pcol_opcode) = "" And _
             Range("Program_code").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("Output_area").Offset(i) = s
    i = i + 1
End If
End Sub

Download

Please read my Disclaimer.

MiniCalculator.xlsm [49 KB Excel file, open and use at your own risk]