Option Explicit

                Dim Data_Error As Integer
                Dim err_var As String
                
                'Segmentos de datos, código, pila y extra
                Dim ds()            As Variant
                Dim cs()            As String
                Dim ss()            As String
                Dim es()            As Variant
                
                'Punteros de base
                Dim bp              As String
                
                'Nombre programa
                Dim program         As String
                Dim devices         As String

Private Sub Mn_Salir_Click()
    End
End Sub
Private Sub Mn_Nuevo_Click()
    On Local Error Resume Next
    'Limpiamos consolas de código y mnemotécnicos
    Me.txtConsola.Text = ""
    Me.List1.Clear
End Sub
Private Function parse(lin As String) As String()
    Dim arr()       As String
    Dim prs()       As String
    Dim itms        As Long
    Dim mnt()       As String
    Dim mbp         As Integer
    On Local Error Resume Next
    'Eliminar tabulaciones y espacios
    Do Until InStr(lin, vbTab) = 0
        lin = Mid(lin, 1, InStr(lin, vbTab) - 1) + Mid(lin, InStr(lin, vbTab) + 1)
    Loop
    Do Until InStr(lin, " ") = 0
        lin = Mid(lin, 1, InStr(lin, " ") - 1) + Mid(lin, InStr(lin, " ") + 1)
    Loop
    'Desmembrar comandos de la línea
    itms = 0
    Do Until InStr(lin, ";") = 0
        itms = itms + 1
        ReDim Preserve arr(1 To itms)
        arr(itms) = Mid(lin, 1, InStr(lin, ";"))
        lin = Mid(lin, InStr(lin, ";") + 1)
    Loop
    If itms = 0 Then
        ReDim arr(1 To 1)
        arr(1) = lin
        parse = mnemotecnicos(arr())
    Else
        parse = mnemotecnicos(arr())
    End If
End Function
Private Sub Mn_Compilar_Click()
    Dim arr()           As String
    Dim cmds()          As String
    Dim i               As Long, j As Long
    Dim objetos         As Long
    Dim errores         As Long
    On Local Error Resume Next
    'Iniciar objetos
    program = ""
    devices = ""
    objetos = 0
    errores = 0
    Erase es
    Erase ds
    Erase ss
    Me.List1.Clear
    'Desmemmbrar líneas de texto
    arr = Split(Me.txtConsola.Text, vbCrLf)
    For i = LBound(arr) To UBound(arr)
        cmds = parse(arr(i))
        For j = LBound(cmds) To UBound(cmds)
            objetos = objetos + 1
            If Left(cmds(j), 3) = "ERR" Then
                errores = errores + 1
                Me.List1.AddItem "Error en línea: " + CStr(i) + " :: " + Mid(cmds(j), 4)
            Else
                If Trim(cmds(j)) <> "" Then Me.List1.AddItem cmds(j)
            End If
        Next j
        'por seguridad destruimos array
        Erase cmds
    Next i
    'Informa final
    Me.List1.AddItem " "
    Me.List1.AddItem " INFORME DE PARSER"
    Me.List1.AddItem " ================="
    If program = "" Then
        Me.List1.AddItem "PROGRAM:<falta nombre aplicación>"
    Else
        Me.List1.AddItem "PROGRAM:" + program
        If devices = "" Then
            Me.List1.AddItem "DISPOSITIVOS:<ninguno>"
        Else
            Me.List1.AddItem "DISPOSITIVOS:" + devices
        End If
    End If
    Me.List1.AddItem "Objetos procesados: " + CStr(objetos)
    Me.List1.AddItem "Errores: " + CStr(errores)
End Sub

Private Function mnemotecnicos(arr() As String) As String()
    Dim m()         As String
    Dim mns         As Long
    Dim i           As Long
    Dim ptr         As Long
    On Local Error Resume Next
    mns = 0
    For i = LBound(arr) To UBound(arr)
        mns = mns + 1
        ReDim Preserve m(1 To mns)
        If InStr(arr(i), ";") = 0 Then
            'SENTENCIAS SIN TERMINADOR
            If Left(arr(i), 1) = "{" Or Left(arr(i), 2) = "{*" Then
                m(mns) = "[COMENTARIO]            "
            ElseIf Left(LCase(arr(i)), 3) = "if(" Then
                m(mns) = "[IF        ]"
                m(mns) = m(mns) + Mid(arr(i), 4)
                m(mns) = Left(m(mns), Len(m(mns)) - 1)
            ElseIf Left(LCase(arr(i)), 5) = "endif" Then
                m(mns) = "[ENDIF      ]"
            ElseIf Left(LCase(arr(i)), 7) = "elseif(" Then
                m(mns) = "[ELSEIF    ]"
            ElseIf Left(LCase(arr(i)), 7) = "program" Then
                If InStr(arr(i), "(") <> 0 Then
                    arr(i) = Mid(arr(i), 8)
                    program = Mid(arr(i), 1, InStr(arr(i), "(") - 1)
                    devices = Mid(arr(i), InStr(arr(i), "(") + 1)
                    devices = IIf(Right(devices, 1) = ")", Mid(devices, 1, Len(devices) - 1), devices)
                Else
                    program = Mid(arr(i), 8)
                    devices = ""
                End If
            Else
                If Trim(m(mns)) <> "" Then
                    m(mns) = "ERRError: Falta ';'"
                End If
            End If
        Else
            'SENTENCIAS CON TERMINADOR
            'Eliminamod el terminador ';'
            arr(i) = Left(arr(i), Len(arr(i)) - 1)
            If Left(LCase(arr(i)), 4) = "cons" Then
                m(mns) = "[CONST     ]"
                'Añadimos en el segmento extra
                ptr = UBound(es)
                ptr = ptr + 1
                ReDim es(1 To ptr + 1)
                es(ptr) = Mid(arr(i), InStr(arr(i), "=") + 1)
                'Agregamos el puntero del ESEGMENT que recoge el valor de la constante
                m(mns) = m(mns) + "ES:" + CStr(ptr)
            ElseIf Left(LCase(arr(i)), 3) = "var" Then
                m(mns) = "[VAR       ]"
                'Añadimos en el segmento extra
                ptr = UBound(ds)
                ptr = ptr + 1
                ReDim ds(1 To ptr + 1)
                ds(ptr) = Mid(arr(i), InStr(arr(i), "=") + 1)
                'Agregamos el puntero del DATASEGEMENT que recoge el valor de la variable
                m(mns) = m(mns) + "DS:" + CStr(ptr)
            Else
                If InStr(arr(i), "=") <> 0 Then
                    m(mns) = "[OPR       ]"
                    'Añadimos en el segmento stack
                    ptr = UBound(ss)
                    ptr = ptr + 1
                    ReDim ds(1 To ptr + 1)
                    ss(ptr) = Mid(arr(i), InStr(arr(i), "=") + 1)
                    'Agregamos el puntero del STACKSEGMENT que recoge la expresión
                    m(mns) = m(mns) + "SS:" + CStr(ptr)
                Else
                    m(mns) = "ERRError: Instrucción de sintáxis"
                End If
            End If
        End If
    Next i
    mnemotecnicos = m()
End Function