dm Simple VM

'DM++ Virutal Machine Alpha 1
Option Explicit
 
'Registers
Private Registers(8) As Integer
 
'vm stuff
Private Enum EOpCodes
    RET = 0
    PUSH
    POP
    IADD
    ISUB
    IMUL
    IDIV
    ISTORE
    ILOAD
    IPRINT
End Enum
 
Private Const MAX_CODE = 100
Private progcode(MAX_CODE) As Integer
Private pCodeCnt As Integer
Private PC As Integer
Private Opcode As EOpCodes
 
'Stack start code
Private a_stack(100) As Integer
Private StkPc As Integer
 
Private Function StackTop() As Integer
    If (StkPc < 0) Then StkPc = 0
    StackTop = a_stack(StkPc)
End Function
 
Private Sub sPop()
    StkPc = (StkPc - 1)
End Sub
 
Private Sub sPush(item As Integer)
    If (StkPc < 0) Then StkPc = 0
    a_stack(StkPc) = item
    StkPc = (StkPc + 1)
End Sub
 
'End of stack code
 
'Start of vm
Private Sub ResetVM()
    PC = 0
    StkPc = 0
    Erase a_stack
    Erase progcode
End Sub
 
Private Sub VM()
Dim value1 As Integer
Dim value2 As Integer
Dim RegAddr As Integer
 
    While (PC < pCodeCnt)
        'Get byte.
        Opcode = progcode(PC)
        
        Select Case Opcode
            Case EOpCodes.PUSH
                PC = (PC + 1)
                Call sPush(progcode(PC))
            Case EOpCodes.IADD
                Call sPop
                value1 = StackTop()
                Call sPop
                value2 = StackTop()
                'Push back the answer
                Call sPush(value1 + value2)
            Case EOpCodes.ISUB
                Call sPop
                value1 = StackTop()
                Call sPop
                value2 = StackTop()
                'Push back the answer
                Call sPush(value2 - value1)
            Case EOpCodes.IMUL
                Call sPop
                value1 = StackTop()
                Call sPop
                value2 = StackTop()
                'Push back the answer
                Call sPush(value1 * value2)
            Case EOpCodes.ISTORE
                PC = (PC + 1)
                'Store in regsiter get addr
                RegAddr = progcode(PC)
                'Store value into register.
                Call sPop
                Registers(RegAddr) = StackTop
            Case EOpCodes.ILOAD
                PC = (PC + 1)
                'Get register address.
                RegAddr = progcode(PC)
                'Get value
                'Push onto the stack.
                Call sPush(Registers(RegAddr))
            Case EOpCodes.IPRINT
                'Get top of stack
                Call sPop
                Call MsgBox("Stack Top = " & CInt(StackTop()))
            Case EOpCodes.RET
                'Close
                Call Unload(frmmain)
        End Select
        
        'INC Program Counter
        PC = (PC + 1)
    Wend
    
End Sub
'End of vm
 
Private Sub EmitCode(code As Integer)
    progcode(pCodeCnt) = code
    pCodeCnt = (pCodeCnt + 1)
End Sub
 
Private Sub cmdExit_Click()
    Call Unload(Me)
End Sub
 
Private Sub cmdRun_Click()
    'Simple PUSH,ADD Print example
    'PUSH 10
    'PUSH 10
    'IADD
    'IPRINT
    'RET
    
    Call EmitCode(PUSH)
    Call EmitCode(10)
    Call EmitCode(PUSH)
    Call EmitCode(16)
    Call EmitCode(IADD)
    Call EmitCode(IPRINT)
    Call EmitCode(RET)
    'Run VM
    Call VM
    
    'Example register demo Push,Store,Load
    'PUSH 16
    'ISTORE 1
    'ILOAD 1
    'PUSH 2
    'IADD
    'PRINTI
    
    'Emit test program registers
    Call EmitCode(PUSH)
    Call EmitCode(16)
    Call EmitCode(ISTORE)
    Call EmitCode(1)        'Set Regsiter 1 stack top value
    Call EmitCode(ILOAD)    'Get register 1
    Call EmitCode(1)
    Call EmitCode(PUSH)
    Call EmitCode(2)
    'Add 2 to the value on the stack
    Call EmitCode(IADD)
    Call EmitCode(IPRINT)
    Call EmitCode(RET)
    'Run VM
    Call VM
End Sub