Planet Source Code Jumbo …e CD Visual Basic 1 to 7/5_2007-2008.ISO/data/Zips/X86_32_Bit209604122008.psc/Editor/ASMBler.cls

Text File | 2008-01-02 | 67KB | 1,858 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ASMBler"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit


' 32 Bit X86 Assembler
'
' Arne Elster 2007 / 2008


' TODO:
'       * support for instructions like 2-IMUL
'       * more complex expressions for all arguments
'       * Unsigned values (only possible with hex)


Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    pDst As Any, pSrc As Any, ByVal cBytes As Long _
)


Private Const IMAGE_NUMBEROF_DIRECTORY_ENTRIES  As Long = 16&
Private Const IMAGE_SIZEOF_SHORT_NAME           As Long = 8&
Private Const IMAGE_NT_OPTIONAL_HDR32_MAGIC     As Long = &H10B&
Private Const IMAGE_DOS_HDR16_MAGIC             As Long = &H5A4D&
Private Const IMAGE_DOS_HDR32_MAGIC             As Long = &H4550&
Private Const IMAGE_FILE_MACHINE_I386           As Long = &H14C&

Private Const DOS_CODE_RELOCATIONS As String = _
        "0E1FBA0E00B409CD21B8014CCD21546869732070726" & _
        "F6772616D2063616E6E6F742062652072756E20696E" & _
        "20444F53206D6F64652E0D0D0A2400000000000000"

Private Const MEM_SECTION_SIZE  As Long = 4096
Private Const FILE_SECTION_SIZE As Long = 512

Private Const CHAR_SPACE        As Long = 32
Private Const CHAR_LINEFEED     As Long = 10
Private Const CHAR_CARRIAGE     As Long = 13

Private Const CHAR_QUOTE        As Long = 34
Private Const CHAR_STOP         As Long = 46
Private Const CHAR_SEMICOLON    As Long = 59
Private Const CHAR_COLON        As Long = 58
Private Const CHAR_PLUS         As Long = 43
Private Const CHAR_MINUS        As Long = 45
Private Const CHAR_ASTERISK     As Long = 42
Private Const CHAR_AMPERSAND    As Long = 38
Private Const CHAR_SEPARATOR    As Long = 44
Private Const CHAR_UNDERSCORE   As Long = 95
Private Const CHAR_VERT_BAR     As Long = 124
Private Const CHAR_SHARP        As Long = 35

Private Const CHAR_BRACKET_L    As Long = 91
Private Const CHAR_BRACKET_R    As Long = 93
Private Const CHAR_PARENTH_L    As Long = 40
Private Const CHAR_PARENTH_R    As Long = 41

Private Const CHAR_NUMBER_0     As Long = 48
Private Const CHAR_NUMBER_9     As Long = 57

Private Const CHAR_ALPHA_UA     As Long = 65
Private Const CHAR_ALPHA_UZ     As Long = 90
Private Const CHAR_ALPHA_LA     As Long = 97
Private Const CHAR_ALPHA_LZ     As Long = 122

Private Const REG_COUNT         As Long = 24
Private Const MAX_PARAMETERS    As Long = 3
Private Const MAX_OPCODE_LEN    As Long = 4

Public Enum PESubsystem
    Subsystem_GUI = 2
    Subsystem_CUI = 3
End Enum

Private Enum SectionCharacteristics
    IMAGE_SCN_TYPE_NO_PAD = &H8&
    IMAGE_SCN_CNT_CODE = &H20&
    IMAGE_SCN_CNT_INITIALIZED_DATA = &H40&
    IMAGE_SCN_CNT_UNINITIALIZED_DATA = &H80&
    IMAGE_SCN_LNK_OTHER = &H100&
    IMAGE_SCN_LNK_INFO = &H200&
    IMAGE_SCN_LNK_REMOVE = &H800&
    IMAGE_SCN_LNK_COMDAT = &H1000&
    IMAGE_SCN_NO_DEFER_SPEC_EXC = &H4000&
    IMAGE_SCN_GPREL = &H8000&
    IMAGE_SCN_MEM_PURGEABLE = &H20000
    IMAGE_SCN_MEM_LOCKED = &H40000
    IMAGE_SCN_MEM_PRELOAD = &H80000
    IMAGE_SCN_LNK_NRELOC_OVFL = &H1000000
    IMAGE_SCN_MEM_DISCARDABLE = &H2000000
    IMAGE_SCN_MEM_NOT_CACHED = &H4000000
    IMAGE_SCN_MEM_NOT_PAGED = &H8000000
    IMAGE_SCN_MEM_SHARED = &H10000000
    IMAGE_SCN_MEM_EXECUTE = &H20000000
    IMAGE_SCN_MEM_READ = &H40000000
    IMAGE_SCN_MEM_WRITE = &H80000000
End Enum

Private Enum IMAGE_FILE_CHARACTERISTICS
    IMAGE_FILE_RELOCS_STRIPPED = &H1&
    IMAGE_FILE_EXECUTABLE_IMAGE = &H2&
    IMAGE_FILE_LINE_NUMS_STRIPPED = &H4&
    IMAGE_FILE_LOCAL_SYMS_STRIPPED = &H8&
    IMAGE_FILE_AGGRESSIVE_WS_TRIM = &H10&
    IMAGE_FILE_LARGE_ADDRESS_AWARE = &H20&
    IMAGE_FILE_16BIT_MACHINE = &H40&
    IMAGE_FILE_BYTES_REVERSED_LO = &H80&
    IMAGE_FILE_32BIT_MACHINE = &H100&
    IMAGE_FILE_DEBUG_STRIPPED = &H200&
    IMAGE_FILE_REMOVABLE_RUN_FROM_SWAP = &H400&
    IMAGE_FILE_NET_RUN_FROM_SWAP = &H800&
    IMAGE_FILE_SYSTEM = &H1000&
    IMAGE_FILE_DLL = &H2000&
    IMAGE_FILE_UP_SYSTEM_ONLY = &H4000&
    IMAGE_FILE_BYTES_REVERSED_HI = &H8000&
End Enum

Private Enum OptHeaderTbls
    ETableExport = 0
    ETableImport
    ETableResource
    ETableException
    ETableCertificate
    ETableRelocation
    ETableDebug
    ETableArchitecture
    ETableGlobalPtr
    ETableThreadStorage
    ETableLoadConfig
    ETableBoundImport
    ETableIAT
    ETableDelayImportDescriptor
    ETableCOMPlusRuntime
    ETableReserved
End Enum

Private Type ModRM
    Mod                         As Long
    rm                          As Long
    reg                         As Long
    Disp                        As Long
    DispSize                    As ParamSize
End Type

Private Type SIB
    sscale                      As Long
    index                       As Long
    base                        As Long
End Type

Private Type ASMLabel
    Name                        As String
    Instruction                 As Long
    Offset                      As Long
End Type

Private Type ASMExtern
    LibName                     As String
    Functions()                 As String
    FunctionCount               As Long
End Type

Private Type Pointer
    Registers(REG_COUNT - 1)    As Long
    UsedRegisters               As Long
    Displacement                As Long
    DispSize                    As ParamSize
End Type

Private Type PointerInfo
    TokenIndex                  As Long
    RegisterCount               As Long
    RegisterMultiples           As Boolean
    HasDisplacement             As Boolean
    DispSize                    As ParamSize
    ptr                         As Pointer
End Type

Private Type RawData
    size                        As ParamSize
    Values()                    As Long
    ValueCount                  As Long
End Type

Private Type ASMArgument
    TType                       As ParamType
    size                        As ParamSize
    Pointer                     As PointerInfo
    Register                    As ASMRegisters
    FPURegister                 As ASMFPURegisters
    MMRegister                  As ASMXMMRegisters
    SymbolIndex                 As Long
    Value                       As Long
End Type

Private Type ASMInstruction
    Mnemonic                    As String
    Segment                     As ASMSegmentRegs
    Args(MAX_PARAMETERS - 1)    As ASMArgument
    OpCodeIndex                 As Long
    ArgCount                    As Long
    size                        As Long
    Offset                      As Long
    flags                       As OpCodePrefixes
    Data                        As RawData
    Line                        As Long
    Section                     As String
End Type

Private Type Scanner
    Source()                    As Byte
    Length                      As Long
    Position                    As Long
    Line                        As Long
    LinePos                     As Long
    Section                     As String
    NextIsEOI                   As Boolean
    LastWasEOI                  As Boolean
    NextToken                   As ASMToken
    CurToken                    As ASMToken
End Type

Private Type IMAGE_IMPORT_DIRECTORY
    ImportLookupTable           As Long
    TimeDateStamp               As Long
    ForwardChain                As Long
    ModuleName                  As Long
    ImportAddressTable          As Long
End Type

Private Type IMAGE_DATA_DIRECTORY
    VirtualAddress              As Long
    size                        As Long
End Type

Private Type IMAGE_SECTION_HEADER
    SectionName(IMAGE_SIZEOF_SHORT_NAME - 1) As Byte
    VirtSizePhysAddr            As Long
    VirtualAddress              As Long
    SizeOfRawData               As Long
    PointerToRawData            As Long
    PointerToRelocations        As Long
    PointerToLinenumbers        As Long
    NumberOfRelocations         As Integer
    NumberOfLinenumbers         As Integer
    Characteristics             As Long
End Type

Private Type IMAGE_OPTIONAL_HEADER
    Magic                       As Integer
    MajorLinkerVersion          As Byte
    MinorLinkerVersion          As Byte
    SizeOfCode                  As Long
    SizeOfInitializedData       As Long
    SizeOfUninitializedData     As Long
    AddressOfEntryPoint         As Long
    BaseOfCode                  As Long
    BaseOfData                  As Long
    ImageBase                   As Long
    SectionAlignment            As Long
    FileAlignment               As Long
    MajorOperatingSystemVersion As Integer
    MinorOperatingSystemVersion As Integer
    MajorImageVersion           As Integer
    MinorImageVersion           As Integer
    MajorSubsystemVersion       As Integer
    MinorSubsystemVersion       As Integer
    Win32VersionValue           As Long
    SizeOfImage                 As Long
    SizeOfHeaders               As Long
    CheckSum                    As Long
    Subsystem                   As Integer
    DllCharacteristics          As Integer
    SizeOfStackReserve          As Long
    SizeOfStackCommit           As Long
    SizeOfHeapReserve           As Long
    SizeOfHeapCommit            As Long
    LoaderFlags                 As Long
    NumberOfRvaAndSizes         As Long
    DataDirectory(IMAGE_NUMBEROF_DIRECTORY_ENTRIES - 1)  As IMAGE_DATA_DIRECTORY
End Type

Private Type IMAGE_DOS_HEADER
    Magic                       As Integer
    BytesInLastPage             As Integer
    Pages                       As Integer
    Relocations                 As Integer
    ParagraphsInHeader          As Integer
    MinAlloc                    As Integer
    MaxAlloc                    As Integer
    InitialSS                   As Integer
    InitialSP                   As Integer
    CheckSum                    As Integer
    InitialIP                   As Integer
    InitialCS                   As Integer
    RelocationTableFileAddress  As Integer
    OverlayNumber               As Integer
    Reserved1(3)                As Integer
    OEMIdentifier               As Integer
    OEMInformation              As Integer
    Reserved2(9)                As Integer
    NewHeaderOffset             As Long
End Type

Private Type IMAGE_FILE_HEADER
    Machine                     As Integer
    NumberOfSections            As Integer
    TimeDateStamp               As Long
    PointerToSymbolTable        As Long
    NumberOfSymbols             As Long
    SizeOfOptionalHeader        As Integer
    Characteristics             As Integer
End Type

Private Type IMAGE_NT_HEADERS
    Signature                   As Long
    FileHeader                  As IMAGE_FILE_HEADER
    OptionalHeader              As IMAGE_OPTIONAL_HEADER
End Type

Private m_udtScanner            As Scanner

Private m_clsTokens()           As ASMToken
Private m_lngTokenCount         As Long
Private m_lngCurToken           As Long

Private m_udtLabels()           As ASMLabel
Private m_lngLabelCount         As Long

Private m_udtExtern()           As ASMExtern
Private m_lngExternCount        As Long

Private m_udtInstrs()           As ASMInstruction
Private m_lngInstrCount         As Long

Private m_strLastError          As String
Private m_strLastErrorSection   As String
Private m_lngLastErrLine        As Long

Private m_btOutput()            As Byte
Private m_lngOutSize            As Long
Private m_lngOutPos             As Long

Private m_udeSubsystem          As PESubsystem

Private m_blnWritePE            As Boolean
Private m_lngPECodeSize         As Long

Private m_lngBaseAddress        As Long


Private Sub Class_Initialize()
    InitInstructions
    m_udeSubsystem = Subsystem_CUI
End Sub


Public Property Get Subsystem() As PESubsystem
    Subsystem = m_udeSubsystem
End Property


Public Property Let Subsystem(ByVal lngVal As PESubsystem)
    m_udeSubsystem = lngVal
End Property


Public Property Get PEHeader() As Boolean
    PEHeader = m_blnWritePE
End Property


Public Property Let PEHeader(ByVal blnValue As Boolean)
    m_blnWritePE = blnValue
End Property


Public Property Get BaseAddress() As Long
    BaseAddress = m_lngBaseAddress
End Property


Public Property Let BaseAddress(ByVal lngVal As Long)
    m_lngBaseAddress = lngVal
    If m_lngBaseAddress < 0 Then Err.Raise 6, , "Image Base < 0 invalid"
End Property


Public Property Get LastErrorMessage() As String
    LastErrorMessage = m_strLastError
End Property


Public Property Get LastErrorSection() As String
    LastErrorSection = m_strLastErrorSection
End Property


Public Property Get LastErrorLine() As Long
    LastErrorLine = m_lngLastErrLine
End Property


Public Function GetOutput() As Byte()
    GetOutput = m_btOutput
End Function


Public Property Get OutputSize() As Long
    OutputSize = m_lngOutSize
End Property


' 1. tokenize the input string
' 2. collect all labels
' 3. find all instructions
' 4. find OpCodes for instructions
'    get their sizes and calculate label offsets
' 5. now that the label offsets are known,
'    finally parse pointers
' 6. write instructions to output
' 7. if in PE mode, write IAT (import address table)
Public Function Assemble( _
    strASM As String, _
    Optional ByVal OnlySize As Boolean = False _
) As Boolean

    ScannerInit strASM

    m_lngTokenCount = 0
    m_lngLabelCount = 0
    m_lngInstrCount = 0
    m_lngCurToken = 0
    m_lngOutSize = 0
    m_lngOutPos = 0
    m_lngExternCount = 0

    m_strLastError = ""
    m_lngLastErrLine = 0

    TokenizeInput

    If FindLabels() Then
        If ParseInstructions() Then
            If GetInstructionSizes() Then
                If OnlySize Then
                    Assemble = True
                Else
                    If ParsePointers() Then
                        If m_blnWritePE Then
                            If Not WritePEHeader() Then Exit Function
                        End If

                        If AssembleInstructions() Then
                            If m_blnWritePE Then
                                OutputJumpTo RoundToMinSize(OutputPosition)
                                WritePEImports
                            End If
                            Assemble = True
                        End If
                    End If
                End If
            End If
        End If
    End If
End Function


Private Sub WritePEImports()
    Dim lngRVAIAT   As Long
    Dim ntHdr       As IMAGE_NT_HEADERS
    Dim scHdr       As IMAGE_SECTION_HEADER

    Const SECTIONS = 2

    lngRVAIAT = RoundToSectionSize(Len(ntHdr) + Len(scHdr) * SECTIONS)
    lngRVAIAT = lngRVAIAT + RoundToSectionSize(m_lngPECodeSize)

    WriteIAT lngRVAIAT
    WriteIIDs lngRVAIAT
    WriteIAT lngRVAIAT
    WriteImportedNames
End Sub


Private Sub WriteImportedNames()
    Dim i       As Long
    Dim j       As Long

    For i = 0 To m_lngExternCount - 1
        For j = 0 To m_udtExtern(i).FunctionCount - 1
            OutputInteger 0
            WriteStr0Ev m_udtExtern(i).Functions(j)
        Next
        WriteStr0Ev m_udtExtern(i).LibName
    Next
End Sub


Private Sub WriteStr0Ev(ByVal strN As String)
    Dim btN()   As Byte

    btN = StrConv(strN & ChrW$(0), vbFromUnicode)
    OutputMem VarPtr(btN(0)), UBound(btN) + 1

    If (UBound(btN) + 1) Mod 2 = 1 Then
        OutputByte 0
    End If
End Sub


Private Sub WriteIIDs(ByVal base As Long)
    Dim i       As Long
    Dim j       As Long
    Dim im      As IMAGE_IMPORT_DIRECTORY
    Dim eim     As IMAGE_IMPORT_DIRECTORY

    For i = 0 To m_lngExternCount - 1
        With im
            .ModuleName = base + GetRelOfLibname(i)
            .ImportAddressTable = base + GetIATLibStart(i)
            .ImportLookupTable = base + GetILTLibStart(i)
        End With

        OutputMem VarPtr(im), Len(im)
    Next

    OutputMem VarPtr(eim), Len(eim)
End Sub


Private Sub WriteIAT(ByVal base As Long)
    Dim i   As Long
    Dim j   As Long

    For i = 0 To m_lngExternCount - 1
        For j = 0 To m_udtExtern(i).FunctionCount - 1
            OutputLong base + GetRelOfFncname(i, j)
        Next
        OutputLong 0
    Next
End Sub


' address of a function name in the imports section
' relative to the section's start
Private Function GetRelOfFncname(ByVal libdx As Long, ByVal fncidx As Long) As Long
    Dim i   As Long
    Dim j   As Long
    Dim sz  As Long
    Dim im  As IMAGE_IMPORT_DIRECTORY

    For i = 0 To m_lngExternCount - 1
        sz = sz + 4 * (m_udtExtern(i).FunctionCount + 1) * 2
        sz = sz + Len(im)
    Next
    If m_lngExternCount > 0 Then sz = sz + Len(im)

    For i = 0 To m_lngExternCount - 1
        For j = 0 To m_udtExtern(i).FunctionCount - 1
            If (i = libdx) And (j = fncidx) Then
                GetRelOfFncname = sz
                Exit Function
            Else
                sz = sz + 2 + EvenSize(Len(m_udtExtern(i).Functions(j)) + 1)
            End If
        Next
        sz = sz + EvenSize(Len(m_udtExtern(i).LibName) + 1)
    Next
End Function


' address of a library name in the imports section
' relative to the section's start
Private Function GetRelOfLibname(ByVal index As Long) As Long
    Dim i   As Long
    Dim j   As Long
    Dim sz  As Long
    Dim im  As IMAGE_IMPORT_DIRECTORY

    For i = 0 To m_lngExternCount - 1
        sz = sz + 4 * (m_udtExtern(i).FunctionCount + 1) * 2
        sz = sz + Len(im)
    Next
    If m_lngExternCount > 0 Then sz = sz + Len(im)

    For i = 0 To m_lngExternCount - 1
        For j = 0 To m_udtExtern(i).FunctionCount - 1
            sz = sz + 2 + EvenSize(Len(m_udtExtern(i).Functions(j)) + 1)
        Next

        If i <> index Then
            sz = sz + EvenSize(Len(m_udtExtern(i).LibName) + 1)
        Else
            Exit For
        End If
    Next

    GetRelOfLibname = sz
End Function


Private Function WritePEHeader() As Boolean
    Dim mzHdr   As IMAGE_DOS_HEADER
    Dim ntHdr   As IMAGE_NT_HEADERS
    Dim scHdr   As IMAGE_SECTION_HEADER
    Dim sdHdr   As IMAGE_SECTION_HEADER
    Dim impTbl  As IMAGE_IMPORT_DIRECTORY
    Dim lngImp  As Long
    Dim btDOS() As Byte

    Const SECTIONS = 2

    If GetLabelIndex("MAIN") = -1 Then
        SetError "Entrypoint ""Main"" not found.", 0, ""
        Exit Function
    End If

    lngImp = GetNeededImportsSize()
    If lngImp = 0 Then lngImp = 1

    With mzHdr
        .Magic = IMAGE_DOS_HDR16_MAGIC
        .BytesInLastPage = 144
        .Pages = 3
        .ParagraphsInHeader = 4
        .MaxAlloc = &HFFFF
        .InitialSP = &HB8
        .RelocationTableFileAddress = &H40
        .NewHeaderOffset = Len(mzHdr) + 64
    End With

    With ntHdr
        .Signature = IMAGE_DOS_HDR32_MAGIC

        With .FileHeader
            .Machine = IMAGE_FILE_MACHINE_I386
            .NumberOfSections = SECTIONS
            .SizeOfOptionalHeader = Len(ntHdr.OptionalHeader)
            .Characteristics = IMAGE_FILE_RELOCS_STRIPPED Or IMAGE_FILE_LINE_NUMS_STRIPPED Or _
                               IMAGE_FILE_LOCAL_SYMS_STRIPPED Or IMAGE_FILE_EXECUTABLE_IMAGE Or _
                               IMAGE_FILE_32BIT_MACHINE Or IMAGE_FILE_DEBUG_STRIPPED Or _
                               IMAGE_FILE_REMOVABLE_RUN_FROM_SWAP Or IMAGE_FILE_NET_RUN_FROM_SWAP
        End With

        With .OptionalHeader
            .Magic = IMAGE_NT_OPTIONAL_HDR32_MAGIC
            .SizeOfCode = RoundToMinSize(m_lngPECodeSize)
            .SizeOfInitializedData = RoundToMinSize(lngImp)
            .BaseOfCode = RoundToSectionSize(Len(ntHdr) + Len(scHdr) * SECTIONS)
            .BaseOfData = .BaseOfCode + RoundToSectionSize(.SizeOfCode)
            .AddressOfEntryPoint = m_udtLabels(GetLabelIndex("MAIN")).Offset - m_lngBaseAddress
            .ImageBase = m_lngBaseAddress
            .SectionAlignment = MEM_SECTION_SIZE
            .FileAlignment = FILE_SECTION_SIZE
            .MajorOperatingSystemVersion = 4
            .MajorSubsystemVersion = 4
            .SizeOfImage = .BaseOfData + RoundToSectionSize(lngImp)
            .SizeOfHeaders = GetPEHeaderSize()
            .Subsystem = m_udeSubsystem
            .SizeOfStackReserve = &H100000
            .SizeOfStackCommit = &H1000
            .SizeOfHeapReserve = &H100000
            .SizeOfHeapCommit = &H1000
            .NumberOfRvaAndSizes = 16

            With .DataDirectory(ETableImport)
                .VirtualAddress = ntHdr.OptionalHeader.BaseOfCode + _
                                  RoundToSectionSize(ntHdr.OptionalHeader.SizeOfCode) + _
                                  GetNeededIATSize()

                .size = Len(impTbl)
            End With

            With .DataDirectory(ETableIAT)
                .VirtualAddress = ntHdr.OptionalHeader.BaseOfCode + _
                                  RoundToSectionSize(ntHdr.OptionalHeader.SizeOfCode)

                .size = GetNeededIATSize()
            End With
        End With
    End With

    With scHdr
        WriteSectionName scHdr, ".text"
        .VirtSizePhysAddr = m_lngPECodeSize
        .VirtualAddress = ntHdr.OptionalHeader.BaseOfCode
        .SizeOfRawData = RoundToMinSize(m_lngPECodeSize)
        .PointerToRawData = GetPEHeaderSize()
        .Characteristics = IMAGE_SCN_CNT_CODE Or _
                           IMAGE_SCN_MEM_EXECUTE Or _
                           IMAGE_SCN_MEM_READ Or _
                           IMAGE_SCN_MEM_WRITE
    End With

    With sdHdr
        WriteSectionName sdHdr, ".rdata"
        .VirtSizePhysAddr = lngImp
        .VirtualAddress = ntHdr.OptionalHeader.BaseOfData
        .SizeOfRawData = RoundToMinSize(lngImp)
        .PointerToRawData = scHdr.PointerToRawData + scHdr.SizeOfRawData
        .Characteristics = IMAGE_SCN_MEM_READ Or _
                           IMAGE_SCN_MEM_WRITE
    End With

    btDOS = HexToByte(DOS_CODE_RELOCATIONS)

    OutputMem VarPtr(mzHdr), Len(mzHdr)
    OutputMem VarPtr(btDOS(0)), UBound(btDOS) + 1
    OutputMem VarPtr(ntHdr), Len(ntHdr)
    OutputMem VarPtr(scHdr), Len(scHdr)
    OutputMem VarPtr(sdHdr), Len(sdHdr)

    OutputJumpTo RoundToMinSize(OutputPosition)

    WritePEHeader = True
End Function


Private Sub WriteSectionName(sc As IMAGE_SECTION_HEADER, ByVal strName As String)
    Dim i   As Long

    For i = 1 To Len(strName)
        sc.SectionName(i - 1) = Asc(Mid$(strName, i, 1))
    Next
End Sub


Private Function GetPEHeaderSize() As Long
    Dim mzHdr   As IMAGE_DOS_HEADER
    Dim ntHdr   As IMAGE_NT_HEADERS
    Dim scHdr   As IMAGE_SECTION_HEADER

    Const SECTIONS = 2

    GetPEHeaderSize = RoundToMinSize(Len(mzHdr) + 64 + Len(ntHdr) + Len(scHdr) * SECTIONS)
End Function


' every instruction has prefixes (opt), an opcode and arguments (opt).
' write them to the output
Private Function AssembleInstructions() As Boolean
    Dim i       As Long
    Dim lngSz   As Long

    For i = 0 To m_lngInstrCount - 1
        lngSz = m_lngOutPos

        If m_udtInstrs(i).Data.size <> BitsUnknown Then
            If Not RawDataOut(m_udtInstrs(i).Data) Then Exit Function
        Else
            InstructionOutPrefixes m_udtInstrs(i)
            InstructionOutOpCode m_udtInstrs(i)
            If Not InstructionOutArgs(m_udtInstrs(i)) Then Exit Function
        End If

        lngSz = m_lngOutPos - lngSz
        If lngSz <> m_udtInstrs(i).size Then Err.Raise 123, , "invalid size after output"
    Next

    AssembleInstructions = True
End Function


' db, dw, dd strings
Private Function RawDataOut(Data As RawData) As Boolean
    Dim i   As Long

    For i = 0 To Data.ValueCount - 1
        OutputBytes Data.Values(i), Data.size
    Next

    RawDataOut = True
End Function


' write arguments to output (modR/M, SIB, Pointers, ...)
' SIB is only written when a pointer has more then 2 registers
' or multiples of a register, or when ESP is used.
Private Function InstructionOutArgs(udtInstr As ASMInstruction) As Boolean
    Dim i               As Long
    Dim j               As Long

    Dim udtModRM        As ModRM
    Dim blnModRM        As Boolean
    Dim blnSIBNeeded    As Boolean

    Dim lngImmVal()     As Long
    Dim udeImmSize()    As ParamSize
    Dim lngImmValCnt    As Long
    Dim blnImmVal       As Boolean

    Dim lngDisplacement As Long
    Dim udeDispSize     As ParamSize
    Dim blnDisplacement As Boolean

    Dim lngSIBPtrIdx    As Long

    Dim blnGotXMMReg    As Boolean
    Dim lngMMVal        As Long

    With Instructions(udtInstr.OpCodeIndex)
        blnModRM = .ModRM
        If .RegOpExt > -1 Then
            udtModRM.reg = .RegOpExt
            blnGotXMMReg = True
        End If
    End With

    For i = 0 To udtInstr.ArgCount - 1
        With Instructions(udtInstr.OpCodeIndex).Parameters(i)
            If Not .Forced Then

                If (.PType = ParamImm) Or (.PType = ParamRel) Then
                    ' an instruction can have multiple immediates
                    ReDim Preserve lngImmVal(lngImmValCnt) As Long
                    ReDim Preserve udeImmSize(lngImmValCnt) As ParamSize

                    If udtInstr.Args(i).TType = ParamImm Then
                        lngImmVal(lngImmValCnt) = udtInstr.Args(i).Value
                    ElseIf udtInstr.Args(i).TType = ParamRel Then
                        lngImmVal(lngImmValCnt) = m_udtLabels(udtInstr.Args(i).SymbolIndex).Offset
                    End If

                    If .PType = ParamRel Then
                        ' if a relative value is needed, make the immediate
                        ' relative to the end of the current instruction
                        lngImmVal(lngImmValCnt) = lngImmVal(lngImmValCnt) - (udtInstr.Offset + udtInstr.size)
                    End If

                    If (SizesForInt(lngImmVal(lngImmValCnt)) And .size) = 0 Then
                        SetError "Relative value too big for instruction", udtInstr.Line, udtInstr.Section
                        Exit Function
                    End If

                    udeImmSize(lngImmValCnt) = .size
                    lngImmValCnt = lngImmValCnt + 1
                    blnImmVal = True

                ElseIf .PType = ParamReg Then
                    ' register must be put to ModR/M, else it would be "forced"
                    udtModRM.reg = ModRMRegNum(udtInstr.Args(i).Register)

                ElseIf .PType = ParamMM Then
                    Select Case udtInstr.Args(i).MMRegister
                        Case MM0, XMM0: lngMMVal = 0
                        Case MM1, XMM1: lngMMVal = 1
                        Case MM2, XMM2: lngMMVal = 2
                        Case MM3, XMM3: lngMMVal = 3
                        Case MM4, XMM4: lngMMVal = 4
                        Case MM5, XMM5: lngMMVal = 5
                        Case MM6, XMM6: lngMMVal = 6
                        Case MM7, XMM7: lngMMVal = 7
                    End Select

                    If blnGotXMMReg Then
                        udtModRM.Mod = 3
                        udtModRM.rm = lngMMVal
                    Else
                        udtModRM.reg = lngMMVal
                        blnGotXMMReg = True
                    End If

                ElseIf (.PType = (ParamMem Or ParamReg)) Or _
                       (.PType = (ParamMem Or ParamMM)) Or _
                       (.PType = ParamMem) Then

                    If (.PType = ParamMem) And (Not blnModRM) Then
                        ' !#! cann there also be more than one per instruction? !#!
                        lngDisplacement = udtInstr.Args(i).Pointer.ptr.Displacement
                        udeDispSize = Bits32
                        blnDisplacement = True
                    Else
                        If udtInstr.Args(i).TType = ParamMem Then
                            Select Case udtInstr.Args(i).Pointer.RegisterCount
                                Case 0:
                                    ' no reigster in the pointer, only displacement possible
                                    If udtInstr.Args(i).Pointer.HasDisplacement Then
                                        udtModRM.Disp = udtInstr.Args(i).Pointer.ptr.Displacement
                                        udtModRM.DispSize = Bits32
                                        udtModRM.Mod = 0
                                        udtModRM.rm = 5
                                    End If

                                Case 1:
                                    ' 1 Register in the pointer, can be encoded with ModR/M
                                    ' if its not ESP or a multiple (reg*2/3/4/5/8/9)
                                    If udtInstr.Args(i).Pointer.HasDisplacement Then
                                        udtModRM.Disp = udtInstr.Args(i).Pointer.ptr.Displacement
                                        udtModRM.DispSize = udtInstr.Args(i).Pointer.ptr.DispSize
                                        Select Case udtModRM.DispSize
                                            Case Bits8:     udtModRM.Mod = 1
                                            Case Else:      udtModRM.Mod = 2
                                        End Select
                                    Else
                                        udtModRM.Mod = 0
                                    End If

                                    For j = 0 To REG_COUNT - 1
                                        If udtInstr.Args(i).Pointer.ptr.Registers(j) Then
                                            If udtInstr.Args(i).Pointer.ptr.Registers(j) > 1 Then
                                                blnSIBNeeded = True
                                                lngSIBPtrIdx = i
                                            Else
                                                Select Case IdxToReg(j)
                                                    Case RegEAX: udtModRM.rm = 0
                                                    Case RegECX: udtModRM.rm = 1
                                                    Case RegEDX: udtModRM.rm = 2
                                                    Case RegEBX: udtModRM.rm = 3
                                                    Case RegEBP: udtModRM.rm = 5
                                                    Case RegESI: udtModRM.rm = 6
                                                    Case RegEDI: udtModRM.rm = 7
                                                    Case RegESP: blnSIBNeeded = True
                                                                 lngSIBPtrIdx = i
                                                End Select
                                            End If

                                            Exit For
                                        End If
                                    Next

                                Case 2:
                                    ' 2 registers, SIB needed
                                    If udtInstr.Args(i).Pointer.HasDisplacement Then
                                        udtModRM.Disp = udtInstr.Args(i).Pointer.ptr.Displacement
                                        udtModRM.DispSize = udtInstr.Args(i).Pointer.ptr.DispSize
                                        Select Case udtModRM.DispSize
                                            Case Bits8:     udtModRM.Mod = 1
                                            Case Else:      udtModRM.Mod = 2
                                        End Select
                                    Else
                                        udtModRM.Mod = 0
                                    End If

                                    blnSIBNeeded = True
                                    lngSIBPtrIdx = i

                            End Select

                        ElseIf udtInstr.Args(i).TType = ParamReg Then
                            ' encode second register in ModR/M
                            udtModRM.Mod = 3
                            udtModRM.rm = ModRMRegNum(udtInstr.Args(i).Register)

                        ElseIf udtInstr.Args(i).TType = (ParamMem Or ParamExt) Then
                            lngDisplacement = udtInstr.Args(i).Pointer.ptr.Displacement
                            udeDispSize = Bits32
                            udtModRM.rm = 5
                            blnDisplacement = True

                        ElseIf udtInstr.Args(i).TType = ParamMM Then
                            Select Case udtInstr.Args(i).MMRegister
                                Case MM0, XMM0: udtModRM.rm = 0
                                Case MM1, XMM1: udtModRM.rm = 1
                                Case MM2, XMM2: udtModRM.rm = 2
                                Case MM3, XMM3: udtModRM.rm = 3
                                Case MM4, XMM4: udtModRM.rm = 4
                                Case MM5, XMM5: udtModRM.rm = 5
                                Case MM6, XMM6: udtModRM.rm = 6
                                Case MM7, XMM7: udtModRM.rm = 7
                            End Select
                            udtModRM.Mod = 3

                        End If
                    End If

                End If

            End If
        End With
    Next

    If blnSIBNeeded Then
        udtModRM.rm = 4
        If Not WriteSIB(udtInstr, udtModRM, udtInstr.Args(lngSIBPtrIdx).Pointer.ptr) Then
            Exit Function
        End If
    Else
        If blnModRM Then WriteModRM udtModRM
    End If

    If blnDisplacement Then OutputBytes lngDisplacement, udeDispSize
    If blnImmVal Then
        For i = 0 To lngImmValCnt - 1
            OutputBytes lngImmVal(i), udeImmSize(i)
        Next
    End If

    If Instructions(udtInstr.OpCodeIndex).Now3DByte > -1 Then
        OutputByte Instructions(udtInstr.OpCodeIndex).Now3DByte
    End If

    InstructionOutArgs = True
End Function


Private Function WriteSIB( _
    udtInstr As ASMInstruction, _
    rm As ModRM, _
    ptr As Pointer _
) As Boolean

    Dim udtSIB          As SIB
    Dim udeReg(1)       As ASMRegisters
    Dim lngRegCnt(1)    As Long
    Dim lngScale        As Long
    Dim lngBase         As Long
    Dim i               As Long
    Dim j               As Long

    ' find the used registers
    For i = 0 To REG_COUNT - 1
        If ptr.Registers(i) Then
            udeReg(j) = IdxToReg(i)
            lngRegCnt(j) = ptr.Registers(i)
            j = j + 1
        End If
    Next

    ' determine the scale register (can have a multiple)
    If lngRegCnt(0) >= 1 And lngRegCnt(1) = 1 Then
        lngScale = 0
    ElseIf lngRegCnt(1) >= 1 And lngRegCnt(0) = 1 Then
        lngScale = 1
    End If
    ' the base register is the other one ;)
    lngBase = 1 - lngScale

    If (ptr.UsedRegisters = 1) And (lngRegCnt(0) = 1) Then
        ' olny one register used which isn't a multiple
        udtSIB.sscale = 0
        udtSIB.index = 4

        Select Case udeReg(0)
            Case RegEAX:    udtSIB.base = 0
            Case RegECX:    udtSIB.base = 1
            Case RegEDX:    udtSIB.base = 2
            Case RegEBX:    udtSIB.base = 3
            Case RegESP:    udtSIB.base = 4  ' <= all the others encodable in ModR/M
            Case RegEBP:    udtSIB.base = 5
            Case RegESI:    udtSIB.base = 6
            Case RegEDI:    udtSIB.base = 7
        End Select

    Else

        If (ptr.UsedRegisters = 1) And (lngRegCnt(0) > 1) Then
            ' one register which is a multiple
            If lngRegCnt(0) = 2 Or _
               lngRegCnt(0) = 3 Or _
               lngRegCnt(0) = 5 Or _
               lngRegCnt(0) = 9 Then

                If lngRegCnt(0) = 2 Then
                    udtSIB.sscale = 0
                Else
                    udtSIB.sscale = GetFirstSetBitIdx(lngRegCnt(0) - 1)
                End If

                Select Case udeReg(0)
                    Case RegEAX:    udtSIB.index = 0:   udtSIB.base = 0
                    Case RegECX:    udtSIB.index = 1:   udtSIB.base = 1
                    Case RegEDX:    udtSIB.index = 2:   udtSIB.base = 2
                    Case RegEBX:    udtSIB.index = 3:   udtSIB.base = 3
                    Case RegESI:    udtSIB.index = 6:   udtSIB.base = 6
                    Case RegEDI:    udtSIB.index = 7:   udtSIB.base = 7
                    Case RegEBP:    udtSIB.index = 5:   udtSIB.base = 5
                                    rm.Mod = 1
                    Case Else:
                        SetError "invalid multiple of a register in SIB", udtInstr.Line, udtInstr.Section
                        Exit Function
                End Select

            ElseIf lngRegCnt(0) = 4 Or lngRegCnt(0) = 8 Then
                ' if Mod of ModR/M byte would be > 0 here
                ' EBP+sbyte/sdword would be encoded, too
                rm.Mod = 0
                udtSIB.base = 5
                udtSIB.sscale = GetFirstSetBitIdx(lngRegCnt(0))

                Select Case udeReg(0)
                    Case RegEAX:    udtSIB.index = 0
                    Case RegECX:    udtSIB.index = 1
                    Case RegEDX:    udtSIB.index = 2
                    Case RegEBX:    udtSIB.index = 3
                    Case RegEBP:    udtSIB.index = 5
                    Case RegESI:    udtSIB.index = 6
                    Case RegEDI:    udtSIB.index = 7
                    Case Else:
                        SetError "invalid multiples of register in SIB", udtInstr.Line, udtInstr.Section
                        Exit Function
                End Select

            Else
                SetError "invalid multiples of register in SIB", udtInstr.Line, udtInstr.Section
                Exit Function

            End If

        ElseIf ptr.UsedRegisters = 2 Then
            ' 2 register in pointer

            Select Case lngRegCnt(lngScale)
                Case 1, 2, 4, 8:
                Case Else:
                    SetError "Possible multiples of scale register: 1, 2, 4, 8", udtInstr.Line, udtInstr.Section
                    Exit Function
            End Select

            If lngRegCnt(lngBase) <> 1 Then
                SetError "Base register mustn't have a multiple", udtInstr.Line, udtInstr.Section
                Exit Function
            End If

            ' ESP can only be encoded in the base, so it can't be the scale.
            ' Same thing for EBP, but the other way.
            If (lngRegCnt(lngScale) = 1) And (lngRegCnt(lngBase)) = 1 Then
                If (udeReg(lngScale) = RegESP) Or (udeReg(lngBase) = RegEBP) Then
                    lngScale = lngBase
                    lngBase = 1 - lngScale
                End If
            End If

            udtSIB.sscale = GetFirstSetBitIdx(lngRegCnt(lngScale))

            Select Case udeReg(lngScale)
                Case RegEAX:    udtSIB.index = 0
                Case RegECX:    udtSIB.index = 1
                Case RegEDX:    udtSIB.index = 2
                Case RegEBX:    udtSIB.index = 3
                Case RegEBP:    udtSIB.index = 5
                Case RegESI:    udtSIB.index = 6
                Case RegEDI:    udtSIB.index = 7
                Case Else:
                    SetError "invalid scale register", udtInstr.Line, udtInstr.Section
                    Exit Function
            End Select

            Select Case udeReg(lngBase)
                Case RegEAX:    udtSIB.base = 0
                Case RegECX:    udtSIB.base = 1
                Case RegEDX:    udtSIB.base = 2
                Case RegEBX:    udtSIB.base = 3
                Case RegESP:    udtSIB.base = 4
                Case RegEBP:    udtSIB.base = 5
                Case RegESI:    udtSIB.base = 6
                Case RegEDI:    udtSIB.base = 7
                Case Else:
                    SetError "invalid base register", udtInstr.Line, udtInstr.Section
                    Exit Function
            End Select
        End If
    End If

    OutputByte (rm.Mod * &H40) Or (rm.reg * &H8) Or rm.rm
    OutputByte (udtSIB.sscale * &H40) Or (udtSIB.index * &H8) Or udtSIB.base
    If rm.DispSize <> BitsUnknown Then OutputBytes rm.Disp, rm.DispSize

    WriteSIB = True
End Function


Private Function ModRMRegNum(ByVal reg As ASMRegisters) As Long
    Select Case reg
        Case RegAL, RegAX, RegEAX:  ModRMRegNum = 0
        Case RegCL, RegCX, RegECX:  ModRMRegNum = 1
        Case RegDL, RegDX, RegEDX:  ModRMRegNum = 2
        Case RegBL, RegBX, RegEBX:  ModRMRegNum = 3
        Case RegAH, RegSP, RegESP:  ModRMRegNum = 4
        Case RegCH, RegBP, RegEBP:  ModRMRegNum = 5
        Case RegDH, RegSI, RegESI:  ModRMRegNum = 6
        Case RegBH, RegDI, RegEDI:  ModRMRegNum = 7
    End Select
End Function


Private Sub WriteModRM(rm As ModRM)
    OutputByte (rm.Mod * &H40) Or (rm.reg * &H8) Or rm.rm
    If rm.DispSize <> BitsUnknown Then OutputBytes rm.Disp, rm.DispSize
End Sub


Private Sub InstructionOutOpCode(udtInstr As ASMInstruction)
    Dim i As Long

    With Instructions(udtInstr.OpCodeIndex)
        For i = 0 To .OpCodeLen - 1
            OutputByte .OpCode(i)
        Next
    End With
End Sub


Private Sub InstructionOutPrefixes(udtInstr As ASMInstruction)
    With Instructions(udtInstr.OpCodeIndex)
        If (.Prefixes And PrefixFlgOperandSizeOverride) Then _
            OutputByte PREFIX_OPERAND_SIZE_OVERRIDE
        If (.Prefixes And PrefixFlgAddressSizeOverride) Then _
            OutputByte PREFIX_ADDRESS_SIZE_OVERRIDE
        If (.Prefixes And PrefixFlgBranchNotTaken) Then _
            OutputByte PREFIX_BRANCH_NOT_TAKEN
        If (.Prefixes And PrefixFlgBranchTaken) Then _
            OutputByte PREFIX_BRANCH_TAKEN
    End With

    With udtInstr
        If (.flags And PrefixFlgLock) Then _
            OutputByte PREFIX_LOCK
        If (.flags And PrefixFlgRep) Then _
            OutputByte PREFIX_REP
        If (.flags And PrefixFlgRepne) Then _
            OutputByte PREFIX_REPNE
    End With

    Select Case udtInstr.Segment
        Case SegCS: OutputByte PREFIX_SEGMENT_CS
        Case SegDS: OutputByte PREFIX_SEGMENT_DS
        Case SegES: OutputByte PREFIX_SEGMENT_ES
        Case SegFS: OutputByte PREFIX_SEGMENT_FS
        Case SegGS: OutputByte PREFIX_SEGMENT_GS
        Case SegSS: OutputByte PREFIX_SEGMENT_SS
    End Select
End Sub


Private Sub OutputMem(ByVal ptr As Long, ByVal Bytes As Long)
    If m_lngOutPos + Bytes > m_lngOutSize Then
        Err.Raise 123456, , "not enough space in output array"
    End If

    CopyMemory m_btOutput(m_lngOutPos), ByVal ptr, Bytes
    m_lngOutPos = m_lngOutPos + Bytes
End Sub


Private Sub OutputJumpTo(ByVal lngVal As Long)
    If (lngVal >= m_lngOutSize) Or (lngVal < 0) Then
        Err.Raise 123456, , "new position out of bounds"
    End If

    m_lngOutPos = lngVal
End Sub


Private Property Get OutputPosition() As Long
    OutputPosition = m_lngOutPos
End Property


Private Sub OutputBytes(ByVal Value As Long, ByVal size As ParamSize)
    Select Case size
        Case Bits8:     OutputByte Value
        Case Bits16:    OutputInteger Value
        Case Bits32:    OutputLong Value
        Case Else:      Err.Raise 123456, , "invalid size"
    End Select
End Sub


Private Sub OutputByte(ByVal Value As Long)
    If Value < 0 Then
        m_btOutput(m_lngOutPos) = CByte(Value + 256)    ' Signed Byte
    Else
        m_btOutput(m_lngOutPos) = CByte(Value)
    End If

    m_lngOutPos = m_lngOutPos + 1
End Sub


Private Sub OutputInteger(ByVal Value As Long)
    CopyMemory m_btOutput(m_lngOutPos), Value, 2
    m_lngOutPos = m_lngOutPos + 2
End Sub


Private Sub OutputLong(ByVal Value As Long)
    CopyMemory m_btOutput(m_lngOutPos), Value, 4
    m_lngOutPos = m_lngOutPos + 4
End Sub


Private Function ParsePointers() As Boolean
    Dim i   As Long
    Dim j   As Long

    For i = 0 To m_lngInstrCount - 1
        For j = 0 To m_udtInstrs(i).ArgCount - 1
            With m_udtInstrs(i).Args(j)
                If .TType = ParamMem Then
                    m_lngCurToken = .Pointer.TokenIndex
                    If Not ParsePointer(.Pointer.ptr) Then Exit Function
                End If
            End With
        Next
    Next

    ParsePointers = True
End Function


Private Function ParsePointer(ptr As Pointer) As Boolean
    Dim lngSgn      As Long
    Dim lngTms      As Long
    Dim lngVal      As Long
    Dim i           As Long
    Dim lngReg      As Long
    Dim blnReg      As Boolean

    If Not Match(TokenBracketLeft) Then
        SetError """["" expected", Token.Line, Token.Section
        Exit Function
    End If

    If Match(TokenOpAdd) Then
        lngSgn = 1
    ElseIf Match(TokenOpSub) Then
        lngSgn = -1
    Else
        lngSgn = 1
    End If

    Do
        lngTms = 1
        blnReg = False

        Do
            Select Case Token.TType
                Case TokenRegister:
                    blnReg = True
                    lngReg = RegToIdx(RegStrToReg(Token.Content))
                    Match TokenRegister
                Case TokenValue:
                    lngTms = lngTms * Token.Value
                    Match TokenValue
                Case TokenSymbol:
                    lngTms = lngTms * m_udtLabels(GetLabelIndex(Token.Content)).Offset
                    Match TokenSymbol
            End Select
        Loop While Match(TokenOpMul)

        If blnReg Then
            ptr.Registers(lngReg) = ptr.Registers(lngReg) + lngSgn * lngTms
        Else
            ptr.Displacement = ptr.Displacement + lngSgn * lngTms
        End If

        If Match(TokenOpAdd) Then
            lngSgn = 1
        ElseIf Match(TokenOpSub) Then
            lngSgn = -1
        Else
            Exit Do
        End If
    Loop

    If Not Match(TokenBracketRight) Then
        SetError """]"" expected", Token.Line, Token.Section
    Else
        ParsePointer = True
    End If
End Function


Private Function GetInstructionSizes() As Boolean
    Dim i           As Long
    Dim j           As Long
    Dim k           As Long
    Dim size        As Long
    Dim lngImpSz    As Long
    Dim blnFoundI   As Boolean

    For i = 0 To m_lngInstrCount - 1                ' all instructions in the source
        If m_udtInstrs(i).Data.size <> BitsUnknown Then
            With m_udtInstrs(i)
                .size = .Data.ValueCount * .Data.size \ 8
            End With
        Else
            blnFoundI = False

            For j = 0 To InstructionCount - 1       ' all known instructions
                If StrComp(m_udtInstrs(i).Mnemonic, Instructions(j).Mnemonic, vbTextCompare) = 0 Then
                    blnFoundI = True

                    If CompareInstrs(m_udtInstrs(i), Instructions(j)) Then
                        ' OpCode length + all used prefixes, ModR/M Byte
                        size = Instructions(j).OpCodeLen + _
                               BitCount(Instructions(j).Prefixes Or m_udtInstrs(i).flags) + _
                               Abs(m_udtInstrs(i).Segment <> SegUnknown) + _
                               Abs(Instructions(j).ModRM) + _
                               Abs(Instructions(j).Now3DByte > -1)

                        ' immediates, displacement, SIB byte
                        If Instructions(j).ParamCount > 0 Then
                            For k = 0 To Instructions(j).ParamCount - 1
                                With Instructions(j).Parameters(k)
                                    If Not .Forced Then

                                        Select Case .PType

                                            Case ParamImm, ParamRel:
                                                size = size + .size \ 8 ' Imm

                                            Case ParamMem Or ParamReg, ParamMem:
                                                If Not Instructions(j).ModRM And .PType = ParamMem Then
                                                    size = size + 4     ' Imm
                                                Else
                                                    If m_udtInstrs(i).Args(k).Pointer.HasDisplacement Then
                                                        size = size + m_udtInstrs(i).Args(k).Pointer.DispSize \ 8
                                                    End If

                                                    If m_udtInstrs(i).Args(k).Pointer.RegisterCount = 2 Or _
                                                       m_udtInstrs(i).Args(k).Pointer.RegisterMultiples Then
                                                        size = size + 1 ' SIB
                                                    End If
                                                End If

                                        End Select

                                    End If
                                End With
                            Next
                        End If

                        m_udtInstrs(i).OpCodeIndex = j
                        m_udtInstrs(i).size = size
                        Exit For
                    End If
                End If
            Next

            If j = InstructionCount Then
                If blnFoundI Then
                    SetError "invalid arguments", m_udtInstrs(i).Line, m_udtInstrs(i).Section
                Else
                    SetError "unknown instruction: " & m_udtInstrs(i).Mnemonic, m_udtInstrs(i).Line, m_udtInstrs(i).Section
                End If

                Exit Function
            End If
        End If
    Next

    FillInOffsets
    If m_blnWritePE Then
        m_lngPECodeSize = m_lngOutSize

        lngImpSz = GetNeededImportsSize()
        If lngImpSz = 0 Then
            m_lngOutSize = RoundToMinSize(GetPEHeaderSize()) + _
                           RoundToMinSize(m_lngPECodeSize) + _
                           RoundToMinSize(1)
        Else
            m_lngOutSize = RoundToMinSize(GetPEHeaderSize()) + _
                           RoundToMinSize(m_lngPECodeSize) + _
                           RoundToMinSize(lngImpSz)
        End If

        FillInIAT RoundToSectionSize(GetPEHeaderSize()) + _
                  RoundToSectionSize(m_lngPECodeSize)
    End If

    ReDim m_btOutput(m_lngOutSize - 1) As Byte

    GetInstructionSizes = True
End Function


' calculate label- and instructionoffsets
Private Sub FillInOffsets()
    Dim i           As Long
    Dim j           As Long
    Dim lngPEOffset As Long

    If m_blnWritePE Then
        lngPEOffset = RoundToSectionSize(GetPEHeaderSize)
    End If

    For i = 0 To m_lngInstrCount - 1
        m_udtInstrs(i).Offset = m_lngOutSize + m_lngBaseAddress + lngPEOffset
        m_lngOutSize = m_lngOutSize + m_udtInstrs(i).size

        If j < m_lngLabelCount Then
            If m_udtLabels(j).Instruction = i Then
                m_udtLabels(j).Offset = m_udtInstrs(i).Offset
                j = j + 1
            End If
        End If
    Next

    If j < m_lngLabelCount Then
        With m_udtInstrs(m_lngInstrCount - 1)
            For j = j To m_lngLabelCount - 1
                m_udtLabels(j).Offset = .Offset
            Next
        End With
    End If
End Sub


' calculate jump addresses for imported functions
Private Sub FillInIAT(ByVal reladdr As Long)
    Dim i           As Long
    Dim j           As Long
    Dim k           As Long
    Dim libidx      As Long
    Dim fncidx      As Long

    For i = 0 To m_lngInstrCount - 1
        For j = 0 To m_udtInstrs(i).ArgCount - 1
            If (m_udtInstrs(i).Args(j).TType And ParamExt) Then
                libidx = (m_udtInstrs(i).Args(j).SymbolIndex \ &H10000) And &HFFFF&
                fncidx = m_udtInstrs(i).Args(j).SymbolIndex And &HFFFF&
                m_udtInstrs(i).Args(j).Pointer.ptr.Displacement = GetExternRelOfFnc(libidx, fncidx, reladdr)
            End If
        Next
    Next
End Sub


' compare parsed instruction with one of the instruction set
Private Function CompareInstrs( _
    src As ASMInstruction, _
    comp As Instruction _
) As Boolean

    Dim i   As Long

    If src.ArgCount = comp.ParamCount Then
        For i = 0 To src.ArgCount - 1
            ' imm and rel should be treated equal
            With comp.Parameters(i)
                If (.PType And src.Args(i).TType) = 0 Then
                    If Not (.PType = ParamImm And src.Args(i).TType = ParamRel) Then
                        If Not (.PType = ParamRel And src.Args(i).TType = ParamImm) Then
                            Exit Function
                        End If
                    End If
                End If
            End With

            If comp.Parameters(i).Forced Then
                Select Case comp.Parameters(i).PType
                    Case ParamReg:
                        If src.Args(i).Register <> comp.Parameters(i).Register Then
                            Exit Function
                        End If
                    Case ParamSTX:
                        If src.Args(i).FPURegister <> comp.Parameters(i).FPURegister Then
                            Exit Function
                        End If
                    Case ParamImm:
                        If src.Args(i).Value <> comp.Parameters(i).Value Then
                            Exit Function
                        End If
                End Select
            Else
                If comp.Parameters(i).PType = ParamMem Then
                    If Not comp.ModRM Then
                        If src.Args(i).Pointer.RegisterCount > 0 Then
                            ' instruction mustn't have registers in the pointer
                            ' because ModR/M isn't allowed for it
                            Exit Function
                        End If
                    End If
                ElseIf (comp.Parameters(i).PType And ParamMM) Then
                    If IsDefinite(comp.Parameters(i).MMRegister) Then
                        If comp.Parameters(i).MMRegister <> src.Args(i).MMRegister Then
                            Exit Function
                        End If
                    Else
                        If src.Args(i).TType = ParamMem Then
                            If (comp.Parameters(i).PType And ParamMem) = 0 Then
                                Exit Function
                            End If
                        Else
                            If (comp.Parameters(i).MMRegister And src.Args(i).MMRegister) = 0 Then
                                Exit Function
                            End If
                        End If
                    End If
                End If
            End If

            If (comp.Parameters(i).size And src.Args(i).size) = 0 Then
                If comp.Parameters(i).size <> BitsUnknown Then
                    Exit Function
                End If
            End If
        Next

        CompareInstrs = True
    End If
End Function


' collect labels
Private Function FindLabels() As Boolean
    Dim i           As Long
    Dim lngInstrCnt As Long

    For i = 1 To m_lngTokenCount - 2
        If m_clsTokens(i).TType = TokenSymbol Then
            If m_clsTokens(i + 1).TType = TokenOpColon Then
                If GetLabelIndex(m_clsTokens(i).Content) > -1 Then
                    SetError "ambigious names: " & m_clsTokens(i).Content, m_clsTokens(i).Line, m_clsTokens(i).Section
                    Exit Function
                End If
                AddLabel m_clsTokens(i).Content, lngInstrCnt
            End If
        ElseIf m_clsTokens(i).TType = TokenOperator Then
            lngInstrCnt = lngInstrCnt + 1
        ElseIf m_clsTokens(i).TType = TokenRawData Then
            lngInstrCnt = lngInstrCnt + 1
        End If
    Next

    FindLabels = True
End Function


' skips labels because they're already collected
Private Function ParseInstructions() As Boolean
    If Not Match(TokenBeginOfInput) Then
        SetError "Unknown error occured while starting parsing", 0, ""
    Else
        Do While Token.TType <> TokenEndOfInput
            Select Case Token.TType

                Case TokenExtern:
                    If m_blnWritePE Then
                        Match TokenExtern
                        If Not ParseExtern() Then Exit Do
                    Else
                        SetError "Externs only allowed in PE mode", Token.Line, Token.Section
                        Exit Function
                    End If

                Case TokenSymbol:
                    Match TokenSymbol
                    If Not Match(TokenOpColon) Then
                        SetError """:"" expected after label ID", Token.Line, Token.Section
                        Exit Do
                    End If

                Case TokenOperator, TokenKeyword:
                    If Not ParseInstruction Then Exit Do

                Case TokenRawData:
                    If Not ParseRawData Then Exit Do

                Case Else:
                    If Token.TType <> TokenEndOfInstruction Then
                        SetError "Unexpected symbol: " & Token.Content, Token.Line, Token.Section
                        Exit Do
                    End If

            End Select

            If Not Match(TokenEndOfInstruction) Then
                SetError "Unexpected end", Token.Line, Token.Section
                Exit Do
            Else
                ParseInstructions = Token.TType = TokenEndOfInput
            End If
        Loop
    End If
End Function


Private Function AddExtern(ByVal lib As String, ByVal fnc As String) As Boolean
    Dim i   As Long
    Dim j   As Long

    AddExtern = True

    For i = 0 To m_lngExternCount - 1
        If StrComp(m_udtExtern(i).LibName, lib, vbTextCompare) = 0 Then
            For j = 0 To m_udtExtern(i).FunctionCount - 1
                If StrComp(m_udtExtern(i).Functions(j), fnc, vbTextCompare) = 0 Then
                    Exit Function
                End If
            Next

            With m_udtExtern(i)
                ReDim Preserve .Functions(.FunctionCount) As String
                .Functions(.FunctionCount) = fnc
                .FunctionCount = .FunctionCount + 1
            End With
            Exit Function
        End If
    Next

    If i = m_lngExternCount Then
        ReDim Preserve m_udtExtern(m_lngExternCount) As ASMExtern

        With m_udtExtern(m_lngExternCount)
            .LibName = lib

            ReDim .Functions(0) As String
            .Functions(0) = fnc
            .FunctionCount = 1
        End With

        m_lngExternCount = m_lngExternCount + 1
    End If
End Function


Private Function ParseExtern() As Boolean
    Dim strLib  As String
    Dim strFnc  As String

    If Token.TType <> TokenString Then
        SetError "Expected: string identifier for library name", Token.Line, Token.Section
        Exit Function
    Else
        strLib = Token.Content
        Match TokenString

        If Not Match(TokenSeparator) Then
            SetError "Libraryname and functionname have to be seperated through a "",""", Token.Line, Token.Section
            Exit Function
        Else
            If Token.TType <> TokenSymbol Then
                SetError "Expected: Name of the exporte function", Token.Line, Token.Section
                Exit Function
            Else
                strFnc = Token.Content
                Match TokenSymbol

                If GetLabelIndex(strFnc) > -1 Then
                    SetError "Name not unique", Token.Line, Token.Section
                Else
                    ParseExtern = AddExtern(strLib, strFnc)
                End If
            End If
        End If
    End If
End Function


Private Function ParseRawData() As Boolean
    Dim udtInstr    As ASMInstruction
    Dim i           As Long
    Dim lngLen      As Long
    Dim lngTemp     As Long

    Select Case UCase$(Token.Content)
        Case "DB":  udtInstr.Data.size = Bits8
        Case "DW":  udtInstr.Data.size = Bits16
        Case "DD":  udtInstr.Data.size = Bits32
    End Select
    Match TokenRawData

    With udtInstr.Data
        Do
            Select Case Token.TType
                Case TokenValue:
                    ReDim Preserve .Values(.ValueCount) As Long
                    .Values(.ValueCount) = Token.Value
                    .ValueCount = .ValueCount t - 1
            End If
            End If
                                 e _ame of SSSSSSS     tInstr.D        Xibidx, fncidx, reladdr)
       ea
        Do
      Ed If
      Xibidx,fTse "DW":  udtI               Case Else:
                        SetErrorse 2:
      Xibidx,fTse "DW":  udtI i = 0 To  udtI i = 0 ToD             uda

Private Function ParlngInstrCnt + 1
        End If
    Next
      .Functions(.Fun
            udeReg(j) = IdxToReg(i)
            lngRegCnt(j) = ptr.Registers(i)
            j = j + 1
        End If
    Next

    ' determine the scale register (can have a multiple)
    If lngRegCnt(0) >= 1 And lngRegCnt(1) = 1 Then
        lnCnt    ttr.Us If lngRegCnt(0) >= 1         EArgsX  ReDim .Fun.Section
                Else
         uda

PenSs(j), fnc, vbTextCompare) = 0 Th( (.Prefixes And PrefixFlgBranc                Else
         uda

PenSs(j), fnc, vbTextComparqn  ttr.Us8f
        E0

P    End Select
    Match Token

 Register Th          As Long
    Dim j               As L       If mUs8fhave to be seperated If oonits16
     A               Else
  Lib, strFn Sellse
  Lib,
        m_lngExternCount = m_lH          Exit Function
             ernCount = m_ltCompare) = 0 Th( (.Prefixes  = meg(lngScale) = RegESP) Or (udeRegon
As ASMInstruction
    Eare) = 0 Th( (.Prefixeb _amuOfInput
            End If
        Loop
    End If
End Function


Private FunR  lngRegCnt(j) =kenSeparator) Then
            SetErroG        uda =
    Eare) qate Fut>Ss0t>Ss0t>Ss0t>Ss0t>Ss0t>gESP) Or (udeRegon
P    End Select
    Match Token

 Register Th          A     A             e _ame ofse
      eReg(j)iSetEsCkenOpColon Then
             j (.Prefixeb _amuOfInput
            End If
         ooniT    j (fAs L   End If
 register (can havv            ernCountount "r    Ifs0t>gESP) Or (udeR9 L         End If
uuctionCount Then
        <Pd SelecREFIX_SEs8ngExternCoun
                If GetLabel           Ifc
                  If GetLabel    DArgs(j).SymbolInde  .Functions(.Funs
             ernCount = m1  .Functions(.Fuat            e _ame ofse
      eR1
    If    Matc    End I     e GetLFuat            e _ame ofse
      eR1
    If    Matc    End I     e GetLFuan
            With m_udtInstrs(i)a
        Do
                 ,                udtSIB.sscale = GetFirstSetBitIdx(loken.TTle _ame ofse
      eRElseIf Match(TokenOpSub) Then
           egon
As ASMX:    udtSIB.base = 2
          m j       eExtern((((((((((((((((((    egoncale = GetFirstS                  ' instructioFrnCountount "r    m j       eExtern((((((((((((((((((    "B FunstructioFrnCoe
                strFnc = Token.Content
      )
            ln             udtSIB.sscale =nRR1
    If    Matc  Content
      )
            ent = ptr.4d