# === ASSEMBLER ======================================================
# The assembler converts text assembly code into dino bytecode.
DATA:
# OUT:
asm.Dinocode      is text

# INTERNALS:
asm.labels        is number vector
asm.tokens        is text vector
asm.tokens*       is number
asm.token         is text
asm.token.label?  is number
asm.label         is text
asm.address       is number
asm.pc            is number  # program counter
asm.addresses     is number vector
asm.chars         is text vector # character cache for lexing asm

asm.vars          is number vector
asm.vars*         is number
asm.tvars         is number vector
asm.tvars.next    is number

asm.segment.head  is text
asm.segment.code  is text
asm.segment.text  is text

# LOCALS:
asm*              is number
asm.i             is number
asm.x             is number
asm.t             is text
asm.size          is number
asm.char          is text
asm.prev          is text
asm.comment?      is number
asm.string?       is number
asm.newline       is number vector

asm.error           is text
asm.error.i         is number
asm.error.line      is number
asm.error.seen?     is number
asm.token.vector?   is number
asm.token.vector.i  is number

PROCEDURE:
store $A    in asm.addresses:"$A"
store $X    in asm.addresses:"$X"
store $Y    in asm.addresses:"$Y"
store $Z    in asm.addresses:"$Z"
store $C    in asm.addresses:"$C"
store $E    in asm.addresses:"$E"
store $I    in asm.addresses:"$I"
store $T    in asm.addresses:"$T"
store $SP   in asm.addresses:"$SP"
store $PC   in asm.addresses:"$PC"
store $AC   in asm.addresses:"$AC"

store @A    in asm.addresses:"@A"
store @X    in asm.addresses:"@X"
store @Y    in asm.addresses:"@Y"
store @T    in asm.addresses:"@T"
store @E    in asm.addresses:"@E"

store @ARGV in asm.addresses:"@ARGV"
store $ac   in asm.vars:"%ARGC"
store $E    in asm.vars:"%ERRORCODE"
store @E    in asm.tvars:"@ERRORTEXT"

store 1 in asm.newline:"\n"
store 1 in asm.newline:"\r"

store $OFFSET.VARS in asm.vars*
store $OFFSET.TVAR in asm.tvars.next
store $OFFSET.TLIT in c.Text*

# Prints an error and exits.
#  IN: asm.error
sub-procedure asm.error
    store 0 in asm.error.seen?
    store 0 in asm.error.line
    display "\e[31;1mAssembler error:\e[0m " asm.error
    while asm.error.i is less than asm.tokens* do
        if asm.error.i is equal to asm.pc then
            display "\e[33;1m" asm.tokens:asm.error.i "\e[0m "
            store 1 in asm.error.seen?
        else if $CODES:asm.tokens:asm.error.i is not equal to 0 then
            if asm.error.seen? is equal to 1 then
                break
            end if
            incr asm.error.line
            if asm.error.line is less than asm.tokens* then
                if asm.error.line is less than 10 then
                    display crlf " 0" asm.error.line " | "
                else if asm.error.line is less than 100 then
                    display crlf " " asm.error.line " | "
                else
                    display crlf asm.error.line " | "
                end if
            end if
            display asm.tokens:asm.error.i " "
        else if asm.tokens:asm.error.i is equal to "\"\\r\\n\"" then
            display "CRLF "
        else
            display asm.tokens:asm.error.i " "
        end if
        incr asm.error.i
    repeat
    exit
end sub-procedure

#  IN: asm.token
# OUT: asm.token.label?
sub-procedure asm.token.label?
    store length of asm.token in asm.x
    subtract 1 from asm.x in asm.x
    get character at asm.x from asm.token in asm.char
    store 0 in asm.token.label?
    if asm.char is equal to ":" then
        store 1 in asm.token.label?
    end if
end sub-procedure

#  IN: asm.token
# OUT: asm.token
sub-procedure asm.token.strip-trailing-colon
    store length of asm.token in asm*
    subtract 1 from asm* in asm*
    store 0 in asm.x
    store "" in asm.t
    while asm.x is less than asm* do
        get character at asm.x from asm.token in asm.char
        join asm.t and asm.char in asm.t
        add 1 and asm.x in asm.x
    repeat
    store asm.t in asm.token
end sub-procedure

# Convert tokens of ASM source code to memory address.
#  IN: asm.token
# OUT: asm.address
sub-procedure asm.token.to-address
    get character at 0 from asm.token in asm.char
    if asm.char is equal to "\"" then
        # text literal
        store asm.token in c.Text:c.Text*
        store c.Text* in asm.address
        add 1 and c.Text* in c.Text*
    else if asm.char is equal to "$" then
        # register
        store asm.addresses:asm.token in asm.address
    else if asm.char is equal to "@" then
        # text variable
        if asm.addresses:asm.token is not equal to 0 then
            store asm.addresses:asm.token in asm.address
        else if asm.tvars:asm.token is equal to 0 then
            store asm.tvars.next in asm.tvars:asm.token
            add 1 and asm.tvars.next in asm.tvars.next
            store asm.tvars:asm.token in asm.address
        else
            store asm.tvars:asm.token in asm.address
        end if
    else if asm.char is equal to "%" then
        # number variable
        if asm.vars:asm.token is equal to 0 then
            add 1 and asm.vars* in asm.vars*
            store asm.vars* in asm.vars:asm.token
        end if
        store asm.vars:asm.token in asm.address
    else
        # number or label
        # check for negative number
        if asm.char is equal to "-" then
            get character at 1 from asm.token in asm.char
        end if
        # number vs label
        store asm.char in digit?.in
        call digit?
        if digit? is equal to 1 then
            store asm.token in asm.address
        else
            store asm.labels:asm.token in asm.address
            subtract asm.pc from asm.address in asm.address
        end if
    end if
end sub-procedure

#  IN: asm.tokens
#      asm.tokens*
# OUT: asm.labels
sub-procedure asm.tokens.find-labels
    store 0 in asm.pc
    while asm.pc is less than asm.tokens* do
        store asm.tokens:asm.pc in asm.token
        call asm.token.label?
        if asm.token.label? is equal to 1 then
            call asm.token.strip-trailing-colon
            store asm.pc in asm.labels:asm.token
        end if
        add 1 and asm.pc in asm.pc
    repeat
end sub-procedure

# Converts text tokens to bytecode and text.
#  IN: asm.tokens
#      asm.tokens*
# OUT: c.Bytes
#      c.Bytes*
#      c.Text
#      c.Text*
sub-procedure asm.tokens.to-bytecode
    call asm.tokens.find-labels
    store 0 in asm.pc
    while asm.pc is less than asm.tokens* do
        store asm.tokens:asm.pc in asm.token
        if $CODES:asm.token is greater than 0 then
            store $CODES:asm.token in c.Bytes:c.Bytes*
            add 1 and c.Bytes* in c.Bytes*
            store $SIZES:$CODES:asm.token in asm.size
            if asm.size is greater than 0 then
                add 1 and asm.pc in asm.pc
                add asm.size and asm.pc in asm.size
                while asm.pc is less than asm.size do
                    store asm.tokens:asm.pc in asm.token
                    call asm.token.to-address
                    store asm.address in c.Bytes:c.Bytes*
                    add 1 and c.Bytes* in c.Bytes*
                    add 1 and asm.pc in asm.pc
                repeat
                continue
            end if
        else
            store length of asm.token in asm.x
            subtract 1 from asm.x in asm.x
            get character at asm.x from asm.token in asm.char

            if asm.char is equal to ":" then
                # label
                store 0 in c.Bytes:c.Bytes*
                add 1 and c.Bytes* in c.Bytes*
            else
                # number literals
                store asm.token in digit?.in
                call digit?
                if digit? is equal to 1 then
                    store asm.token in c.Bytes:c.Bytes*
                    add 1 and c.Bytes* in c.Bytes*
                else if asm.token is equal to "\r" then
                else if asm.token is equal to "\t" then
                else if asm.token is equal to " " then
                else if asm.token is equal to "\n" then
                else
                    join "unknown token: " and asm.token in asm.error
                    call asm.error
                end if
            end if
        end if

        add 1 and asm.pc in asm.pc
    repeat
end sub-procedure

# Converts a text of ASM source code to a text vector of tokens.
# Ignores comments and commas, upcases non-string tokens, strips
# extra whitespace, and supports strings with escaping.
#  IN: c.Asm
# OUT: asm.tokens
#      asm.tokens*
sub-procedure c.Input.to-tokens
    store length of c.Asm in asm*
    store 0 in asm.pc
    store 0 in asm.comment?
    store 0 in asm.string?
    store "" in asm.char
    store "" in asm.token
    store "" in asm.prev
    split c.Asm by "" in asm.chars

    while asm.pc is less than asm* do
        store asm.char in asm.prev
        store asm.chars:asm.pc in asm.char

        if asm.string? is equal to 1 then
            if asm.char is equal to "\"" then
                if asm.prev is equal to "\\" then
                    # quoted string
                    join asm.token and asm.char in asm.token
                else
                    # not quoted, end string token
                    join asm.token and asm.char in asm.token
                    store asm.token in asm.tokens:asm.tokens*
                    add 1 and asm.tokens* in asm.tokens*
                    store "" in asm.token
                    store 0 in asm.string?
                end if
            else
                # not a quote, add to token
                join asm.token and asm.char in asm.token
            end if
            add 1 and asm.pc in asm.pc
            continue
        end if

        # treat commas as spaces
        if asm.char is equal to "," then
            store " " in asm.char
        end if

        if asm.newline:asm.char is equal to 1 then
            # save token
            if asm.token is not equal to "" then
                store asm.token in asm.tokens:asm.tokens*
                add 1 and asm.tokens* in asm.tokens*
                store "" in asm.token
            end if
            store 0 in asm.comment?
        else if asm.char is equal to "\"" then
            # parse string
            store 1 in asm.string?
            store "\"" in asm.token
        else if asm.char is equal to ";" then
            # ignore comments
            store 1 in asm.comment?
        else if asm.char is equal to " " then
            if asm.token is not equal to "" then
                store asm.token in asm.tokens:asm.tokens*
                incr asm.tokens*
                store "" in asm.token
            end if
        else if asm.char is equal to "\t" then
            # ignore whitespace
        else if asm.comment? is equal to 0 then
            # all tokens are UPPER case
            store asm.char in upcase.letter
            call upcase-letter
            store upcase.letter in asm.char
            # add char to token
            join asm.token and asm.char in asm.token
        end if
        add 1 and asm.pc in asm.pc
    repeat
end sub-procedure

#  IN: c.Asm
# OUT: c.Bytes
#      c.Bytes*
sub-procedure asm.Compile
    call c.Input.to-tokens
    call asm.tokens.to-bytecode
end sub-procedure

#  IN: c.Asm
# OUT: asm.dinocode
sub-procedure asm.To-dinocode
    # L D P L char codes, version #
    store 0 in asm.i
    store "" in asm.segment.head
    while asm.i is less than $HEADER* do
        in asm.segment.head join asm.segment.head $HEADER:asm.i " "
        incr asm.i
    repeat

    store 0 in asm.pc
    store "" in asm.segment.code
    while asm.pc is less than c.Bytes* do
        store c.Bytes:asm.pc in asm.x
        if asm.x is less than 10 then
            if asm.x is greater than or equal to 0 then
                join asm.segment.code and "0" in asm.segment.code
            end if
        end if
        in asm.segment.code join asm.segment.code asm.x " "
        add 1 and asm.pc in asm.pc
    repeat

    # assemble text
    store "" in asm.segment.text
    store $OFFSET.TLIT in asm.x
    while asm.x is less than c.Text* do
        in asm.segment.text join asm.segment.text c.Text:asm.x " "
        add 1 and asm.x in asm.x
    repeat

    in asm.Dinocode join asm.segment.head asm.segment.code asm.segment.text
end sub-procedure

# Must be called after asm.compile.
#  IN: c.Text
sub-procedure asm.Print
    call asm.To-dinocode
    display asm.Dinocode crlf
end sub-procedure