bas_via.bas

VB写的一个IDE开发环境,支持脚本运行,内置了一个简单的编译器,可以直接生成EXE.. 推荐下载!

    CreateSection Name, ST, CH
    Terminator
    CodeBlock
End Sub
Sub DeclareVariable(Optional CurrentType As String, Optional Size As String, Optional FrameExpression As Boolean, Optional NoCodeBlock As Boolean)
    Dim FullName As String: Dim Value As Single: Dim Ident As String
    Ident = Identifier
    FullName = Switch(CurrentType = "", Ident, CurrentType <> "", CurrentType & "." & Ident)
    If IsSymbol("=") Then Symbol "=": Value = NumberExpression Else: Value = 0
    If IsSymbol("(") Then
        Symbol "("
        If Not IsSymbol(")") Then If CurrentFrame = "" Then ErrMessage "you cannot dimension the array outside of a frame. use "
        If UnsignedDeclare Then
            Select Case Size
                Case "byte": DeclareDataUnsignedByte FullName, CByte(Value)
                Case "word": DeclareDataUnsignedWord FullName, CInt(Value)
                Case Else: ErrMessage "invalid size "
            End Select
        Else
            Select Case Size
                Case "byte": DeclareDataByte FullName, CByte(Value)
                Case "word": DeclareDataWord FullName, CInt(Value)
                Case "dword": DeclareDataDWord FullName, CLng(Value)
                Case "single": DeclareDataSingle FullName, CSng(Value)
                Case Else: ErrMessage "invalid size "
            End Select
        End If
        ReserveArray FullName, NumberExpression
        Symbol ")"
    End If
    If FrameExpression = False Then
        If Not SymbolExists(FullName) Then
            If UnsignedDeclare Then
                Select Case Size
                    Case "byte": DeclareDataUnsignedByte FullName, CByte(Value)
                    Case "word": DeclareDataUnsignedWord FullName, CInt(Value)
                    Case Else: ErrMessage "invalid size "
                End Select
            Else
                Select Case Size
                    Case "byte": DeclareDataByte FullName, CByte(Value)
                    Case "word": DeclareDataWord FullName, CInt(Value)
                    Case "dword": DeclareDataDWord FullName, CLng(Value)
                    Case "single": DeclareDataSingle FullName, CSng(Value)
                    Case Else: ErrMessage "invalid size "
                End Select
            End If
        End If
        If IsSymbol(",") Then Symbol ",": DeclareVariable CurrentType, Size, FrameExpression: Exit Sub
        Terminator
    Else
        If Not SymbolExists(CurrentFrame & "." & FullName) Then
            Select Case Size
                Case "single": AddSymbol CurrentFrame & "." & FullName, 8 + (ArgCount * 4), 0, ST_LOCAL_SINGLE
                Case Else: AddSymbol CurrentFrame & "." & FullName, 8 + (ArgCount * 4), 0, ST_LOCAL_DWORD
            End Select
            AddFrameDeclare Ident
        End If
    End If
    If Not NoCodeBlock Then CodeBlock
End Sub
Sub DeclareLocal()
    Dim Ident As String
    Dim IdentII As String
    Dim Value As Variant
    Dim Space As Long
    Dim ArrayValue As Long
    Ident = Identifier
    IdentII = Identifier
    If CurrentFrame = "" Then ErrMessage "cannot declare local variable "
    If Ident = "byte" Or Ident = "word" Or Ident = "bool" Or Ident = "dword" Or Ident = "boolean" Then
        AddSymbol CurrentFrame & "." & IdentII, 8 + (ArgCount * 4), 0, ST_LOCAL_DWORD
        ArgCount = ArgCount + 1
    ElseIf Ident = "single" Then
        AddSymbol CurrentFrame & "." & IdentII, 8 + (ArgCount * 4), 0, ST_LOCAL_SINGLE
        ArgCount = ArgCount + 1
    ElseIf Ident = "string" Then
        If IsSymbol("[") Then
            Symbol "["
            Space = NumberExpression
            Symbol "]"
        Else
            Space = 256
        End If
        AddSymbol CurrentFrame & "." & IdentII, 8 + (ArgCount * 4), 0, ST_LOCAL_STRING
        eUniqueID = eUniqueID + 1
        DeclareDataString "Local.String" & eUniqueID, "", Space
        MovEAXAddress "Local.String" & eUniqueID
        AddCodeWord &H8589
        AddCodeDWord 8 + (ArgCount * 4)
        ArgCount = ArgCount + 1
    Else
        ErrMessage "expected identifier "
    End If
    Terminator
    CodeBlock
End Sub
Sub DeclareType()
    Dim Name As String
    Dim Ident As String
    Dim TypeSource As String
    ReDim Preserve Types(UBound(Types) + 1) As TYPE_TYPE
    Types(UBound(Types)).Name = Identifier
    Symbol "{"
    While Not IsSymbol("}")
        SkipBlank
        If IsIdent("string") Or IsIdent("dword") Or IsIdent("word") Or IsIdent("byte") Or IsIdent("bool") Or IsIdent("boolean") Or IsIdent("single") Then
            TypeSource = TypeSource & Identifier & " " & Identifier
            If IsSymbol("[") Then
                Symbol "[": TypeSource = TypeSource & "["
                TypeSource = TypeSource & NumberExpression & "]"
                Symbol "]"
            ElseIf IsSymbol("(") Then
                Symbol "(": TypeSource = TypeSource & "("
                Symbol ")": TypeSource = TypeSource & ")"
            End If
            TypeSource = TypeSource & ";"
            Terminator
            SkipBlank
        Else
            Ident = Identifier
            If IsType(Ident) Then
                TypeSource = TypeSource & Ident & " " & Identifier
                TypeSource = TypeSource & ";"
                TerminatorSub StatementLoop()
    Dim Ident As String
    Dim Mode As String
    Dim iID As Long
    iID = iID + lUniqueID
    lUniqueID = lUniqueID + 1
    Mode = Identifier
    If Mode = "until" Then
        Symbol "("
        Expression "$Intern.Compare.One"
        Expression "$Intern.Compare.Two"
        Symbol ")"
        AddSymbol "$loop" & iID, OffsetOf(".code"), Code, ST_LABEL
        Symbol "{"
        CodeBlock
        Symbol "}"
        ExprCompare "$Intern.Compare.One", "$Intern.Compare.Two"
        ChooseRelation iID, "$loop"
        AddSymbol "$loopout" & iID, OffsetOf(".code"), Code, ST_LABEL
    ElseIf Mode = "down" Or Mode = "" Then
        Symbol "("
        Expression
        PopECX
        If IsSymbol(",") Then Skip: Ident = Identifier
        Symbol ")"
        AddSymbol "$loop" & iID, OffsetOf(".code"), Code, ST_LABEL
        Symbol "{"
        CodeBlock
        Symbol "}": DecECX
        If Ident <> "" Then
            AddCodeWord &HD89: AddCodeFixup Ident
        End If
        AddCodeWord &HF983: AddCodeByte 0
        ExprJA "$loop" & iID
    ElseIf Mode = "up" Then
        AddCodeByte &HB9: AddCodeDWord 0
        Symbol "("
        Expression "$Intern.Count"
        If IsSymbol(",") Then Skip: Ident = Identifier
        Symbol ")"
        AddSymbol "$loop" & iID, OffsetOf(".code"), Code, ST_LABEL
        Symbol "{"
        CodeBlock
        Symbol "}": IncECX
        If Ident <> "" Then
            AddCodeWord &HD89: AddCodeFixup Ident
        End If
        AddCodeWord &HD3B: AddCodeFixup "$Intern.Count"
        ExprJL "$loop" & iID
    Else
        ErrMessage "expected loop "
    End If
    CodeBlock
End Sub
Sub StatementBytes()
    Dim Ident As String
    Dim bByte As Long
    Ident = Identifier
    Symbol "["
NextBytes:
    AddDataByte NumberExpression
    If IsSymbol("@") Then Position = Position + 1: AddSymbol Ident, OffsetOf(".data"), Data, ST_DWORD
    If IsSymbol(",") Then Position = Position + 1: GoTo NextBytes
    Symbol "]"
    Terminator
    CodeBlock
End Sub
Sub StatementDirect()
    Dim Ident As String
    Dim AddrIdent As String
    Dim Variable As String
    Symbol "["
    Ident = Identifier
NextDirect:
    If Ident = "single" Then
        AddCodeSingle CSng(NumberExpression)
    ElseIf Ident = "dword" Then
        AddCodeDWord CLng(NumberExpression)
    ElseIf Ident = "word" Then
        AddCodeWord LoWord(NumberExpression)
    ElseIf Ident = "byte" Then
        AddCodeByte LoByte(LoWord(NumberExpression))
    ElseIf Ident = "address" Then
        AddrIdent = Identifier
        AddCodeFixup AddrIdent
    Else
        ErrMessage "data type must be specified "
    End If
    SkipBlank
    If IsSymbol(",") Then Position = Position + 1: GoTo NextDirect
    Symbol "]"
    Terminator
    CodeBlock
End Sub
Sub EvalVariable(Name As String, Optional OnlySet As Boolean)
    SkipBlank
    If IsSymbol("(") Then
        SetArray Name
        Terminator
        CodeBlock
        Exit Sub
    End If
    If IsSymbol("=") Then
        Symbol "="
        Expression Name
    ElseIf IsSymbol("+") Then
        Symbol "+"
        If IsSymbol("+") Then
            Symbol "+"
            AddCodeWord &H5FF
            AddCodeFixup Name
        Else
            AddCodeWord &H581
            AddCodeFixup Name
            AddCodeDWord NumberExpression
        End If
    ElseIf IsSymbol("-") Then
        Symbol "-"
        If IsSymbol("-") Then
            Symbol "-"
            AddCodeWord &HDFF
            AddCodeFixup Name
        Else
            AddCodeWord &H2D81
            AddCodeFixup Name
            AddCodeDWord NumberExpression
        End If
    End If
    Terminator
    If Not OnlySet Then CodeBlock
End Sub
Sub EvalLocalVariable(Name As String, Optional OnlySet As Boolean)
    Dim iLabel As Long
    SkipBlank
    If IsSymbol("=") Then
        Symbol "="
        Expression
        PopEAX
    ElseIf IsSymbol("+") Then
        Symbol "+"
        AddCodeWord &H858B
        AddCodeDWord GetSymbolOffset(CurrentFrame & "." & Name)
        AddCodeByte &H5
        If IsSymbol("+") Then
            Symbol "+": AddCodeDWord &H1
        Else
            AddCodeDWord NumberExpression
        End If
    ElseIf IsSymbol("-") Then
        Symbol "-"
        AddCodeWord &H858B
        AddCodeDWord GetSymbolOffset(CurrentFrame & "." & Name)
        AddCodeByte &H2D
        If IsSymbol("-") Then
            Symbol "-": AddCodeDWord &H1
        Else
            AddCodeDWord NumberExpression
        End If
    End If
    AddCodeWord &H8589
    AddCodeDWord GetSymbolOffset(CurrentFrame & "." & Name)
    Terminator
    If Not OnlySet Then CodeBlock
End Sub
Sub StatementWith()
    WithIdent = Identifier
    Symbol "{"
        CodeBlock
    Symbol "}"
    WithIdent = ""
    CodeBlock
End Sub
Sub DeclareImport()
    Dim Ident As String
    Dim OIdent As String
    Dim FunctionName As String
    Dim FunctionAlias As String
    Dim Library As String
    Dim ParamCount As Long
    FunctionAlias = ""
    Ident = Identifier
    OIdent = Identifier
    If OIdent = "alias" Then
        FunctionAlias = Ident
        FunctionName = Identifier
        OIdent = Identifier
    Else
        FunctionAlias = Ident
        If OIdent = "ascii" Then
            OIdent = Identifier
            FunctionName = Ident & "A"
        ElseIf OIdent = "unicode" Then
            OIdent = Identifier
            FunctionName = Ident & "W"
        Else
            FunctionName = Ident
        End If
    End If
    If OIdent = "lib" Or OIdent = "library" Then
        Library = StringExpression
    Else
        ErrMessage "expected "
        Exit Sub
    End If
    If IsSymbol(",") Then
        Position = Position + 1: ParamCount = NumberExpression
    Else
        ParamCount = 0
    End If
    Terminator
    AddImport FunctionName, Library, ParamCount, FunctionAlias
    CodeBlock
End Sub
Sub AssignType(Ident As String, AsIdent As String)
    Dim i As Integer
    Dim ii As Integer
    Dim myType As String
    Dim myIdent As String
    Dim myLastPos As Long
    Terminator
    For i = 1 To UBound(Types)
        If Types(i).Name = AsIdent Then
            AddSymbol Ident, OffsetOf(".data"), Data, ST_TYPE
            InsertSource Types(i).Source & "}"
            LenIncludes = LenIncludes + Len(Types(i).Source)
            myType = Ident
            CurrentType = Ident
            TypesLeft = 0
            While Not IsSymbol("}")
                myIdent = Identifier
                If IsType(myIdent) Then
                    myType = myIdent
                    myIdent = Identifier
                    CurrentType = CurrentType & "." & myIdent
                    Terminator
                    For ii = 1 To UBound(Types)
                        If Types(ii).Name = myType Then
                            AddSymbol CurrentType, OffsetOf(".data"), Data, ST_TYPE
                            InsertSource Types(ii).Source & "}"
                            LenIncludes = LenIncludes + Len(Types(ii).Source)
                            TypesLeft = TypesLeft + 1
                        End If
                    Next ii
                Else
                    VariableBlock myIdent, False, True
                End If
                If Position = myLastPos Then ErrMessage "expected "
                If Position >= Len(Source) Then ErrMessage "expected "
                myLastPos = Position
                SkipBlank
                DoEvents
                If IsSymbol("}") And TypesLeft > 0 Then Skip: TypesLeft = TypesLeft - 1: CurrentType = Ident
            Wend
            If IsSymbol("}") Then Skip
            CurrentType = ""
            SkipBlank
            CodeBlock
        End If
    Next i
End Sub

                SkipBlank
            Else
                Symbol "}"
                Exit Sub
            End If
        End If
    Wend
    Types(UBound(Types)).Source = TypeSource
    Symbol "}"
    CodeBlock
End Sub