english version "1.0" identify "xyz" #: This module implements a microcontroller assembler op:odes. module opcodes import address bogus character errors format logical out_stream program set string system types vector unsigned #: Some routines for constructing expressions: procedure bit_addr takes data_address expression bit_number unsigned returns expression #: This procedure will create and return a bit address expression #, consisting of {data_address} and {bit_number}. program:: program := ?? binary :@= create@binary(data_address, d(bit_number)) expression :@= allocate@expression() expression.bit_address := binary return expression procedure chr takes character string returns expression #: This procedure will create and return a character expression #, containing the first character of {character}. assert character.size = 1 program:: program := ?? expression :@= allocate@expression() expression.character := character[0] return expression procedure code_addr takes code_address unsigned returns expression #: This procedure will create and return an address expression #, containing {code_address}. program:: program := ?? expression :@= allocate@expression() expression.code_address := code_address return expression procedure d takes decimal unsigned returns expression #: This procedure will create and return a decimal expression #, containing {decimal}. program:: program := ?? expression :@= allocate@expression() expression.decimal := decimal return expression procedure data_addr takes data_address unsigned returns expression #: This procedure will create and return an address expression #, containing {data_address}. program:: program := ?? expression :@= allocate@expression() expression.data_address := data_address return expression procedure h takes hexadecimal unsigned returns expression #: This procedure will create and return a hexadecimal expression #, containing {hexadecimal}. program:: program := ?? expression :@= allocate@expression() expression.hexadecimal := hexadecimal return expression procedure o takes octal unsigned returns expression #: This procedure will create and return a hexadecimal expression #, containing {octal}. program:: program := ?? expression :@= allocate@expression() expression.octal := octal return expression procedure s takes symbol_name string returns expression #: This procedure will create and return a symbol expression #, containing the symbol named {symbol_name}. program:: program := ?? expression :@= allocate@expression() symbol :@= program.symbol_table[symbol_name] expression.symbol := symbol return expression #: {expression} routines: procedure add@expression takes expression1 expression expression2 expression returns expression #: This procedure will return an expression that represents the #, addition of {expression1} to {expression2}. program:: program := ?? binary :@= create@binary(expression1, expression2) expression :@= allocate@expression() expression.add := binary return expression procedure value_get@expression takes expression expression returns value #: This procedure will return the {value} of {expression}. program:: program := ?? value:: value := ?? extract expression tag add:: binary := add left :@= add.expression1.value right :@= add.expression2.value extract left tag code_address:: unsigned := code_address extract right tag constant:: unsigned := constant value :@= allocate@value() value.code_address := code_address + constant default #FIXME: This is an error: assert false tag constant:: unsigned := constant extract right tag code_address:: unsigned := code_address value :@= allocate@value() value.code_address := code_address + constant tag data_address:: unsigned := data_address value :@= allocate@value() value.data_address := data_address + constant default #FIXME: This is an error: assert false tag data_address:: unsigned := data_address extract right tag constant:: unsigned := constant value :@= allocate@value() value.data_address := data_address + constant default #FIXME: This is an error: assert false default #FIXME: This is an error. assert false value := left tag bit_address:: binary := bit_address left :@= bit_address.expression1.value right :@= bit_address.expression2.value extract left tag data_address:: unsigned := data_address extract right tag constant:: unsigned := constant value :@= allocate@value() value.bit_address := create@bit_address(data_address, constant) default #FIXME: This is an error: assert false default #FIXME: This is an error: assert false tag character:: character := character value :@= allocate@value() value.constant := unsigned_convert@(character) tag code_address:: unsigned := code_address value :@= allocate@value() value.code_address := code_address tag data_address:: unsigned := data_address value :@= allocate@value() value.data_address := data_address tag decimal:: unsigned := decimal value :@= allocate@value() value.constant := decimal tag hexadecimal:: unsigned := hexadecimal value :@= allocate@value() value.constant := hexadecimal tag octal:: unsigned := octal value :@= allocate@value() value.constant := octal tag string:: string := string value :@= allocate@value() value.string := string tag subtract:: binary := subtract left :@= add.expression1.value right :@= add.expression2.value extract left tag code_address1:: unsigned := code_address extract right tag constant2:: unsigned := constant if code_address < constant #FIXME: This is an error: assert false else value :@= allocate@value() value.code_address := code_address1 - constant2 tag code_address2:: unsigned := code_address if code_address1 > code_address2 value.constant := code_address1 - code_address2 else #FIXME: This is an error: assert false default #FIXME: This is an error: assert false tag data_address1:: unsigned := data_address extract right tag constant2:: unsigned := constant if data_address < constant #FIXME: This is an error: assert false else value :@= allocate@value() value.data_address := data_address1 + constant2 tag data_address2:: unsigned := data_address if data_address1 > data_address2 value.constant := data_address1 - data_address2 else #FIXME: This is an error: assert false default #FIXME: This is an error: assert false default #FIXME: This is an error. assert false value := left tag symbol:: symbol := symbol value := symbol.value if value == ?? #FIXME: This is an error: assert false return value procedure buffer_append@expression takes expression expression buffer string returns_nothing #: This procedure will append {expression} to {buffer}. extract expression tag add:: binary := add operator_buffer_append@(add, "+", buffer) tag bit_address:: bit_address := bit_address data_address :@= bit_address.data_address bit_number :@= bit_address.bit_number unsigned_append@(buffer, data_address, 10, "", "", 0, "", "", false) buffer_append@(". ", buffer) unsigned_append@(buffer, bit_number, 10, "", "", 0, "", "", false) tag code_address:: unsigned := code_address unsigned_append@(buffer, code_address, 16, "0x", "", 0, "", "", false) tag character:: character := character buffer_append@("#", buffer) if is_printing@(character) buffer_append@("'", buffer) buffer_append@(character, buffer) buffer_append@("'", buffer) else unsigned_append@(buffer, unsigned_convert@(character), 10, "", "", 0, "", "", false) tag data_address:: unsigned := data_address unsigned_append@(buffer, data_address, 16, "0x", "", 0, "", "", false) tag decimal:: unsigned := decimal unsigned_append@(buffer, decimal, 10, "#", "", 0, "", "", false) tag hexadecimal:: unsigned := hexadecimal unsigned_append@(buffer, hexadecimal, 16, "#0x", "", 0, "", "", false) tag octal:: unsigned := octal buffer_append@("#", buffer) unsigned_append@(buffer, octal, 8, "0", "", 0, "", "", false) tag string:: string := string buffer_append@('"', buffer) buffer_append@(string, buffer) #FIXME: should be more careful! buffer_append@('"', buffer) tag subtract:: binary := subtract operator_buffer_append@(subtract, "-", buffer) tag symbol:: symbol := symbol buffer_append@(symbol, buffer) procedure subtract@expression takes expression1 expression expression2 expression returns expression #: This procedure will return an expression that represents the #, addition of {expression1} to {expression2}. program:: program := ?? binary :@= create@binary(expression1, expression2) expression :@= allocate@expression() expression.subtract := binary return expression #: {assembler} routines: procedure address_process@assembler takes assembler assembler address expression returns_nothing #: This procedure will process emit a 2-bytes of 16-bit address. value :@= address.value extract value tag code_address:: unsigned := code_address byte_process@(assembler, (code_address >> 8)) byte_process@(assembler, code_address & 255) default error@(assembler, 0, 'Address must specify a code address') procedure absolute_process@assembler takes assembler assembler opcode_value unsigned address expression returns_nothing #: This procedure will process emit a 2-byte instruction with #, an 11-bit address value :@= address.value extract value tag code_address:: unsigned := code_address byte_process@(assembler, ((code_address >> 8) << 5) | opcode_value) byte_process@(assembler, code_address & 255) default error@(assembler, 0, 'Absolute address must be a code address') procedure arithmetic_process@assembler takes assembler assembler expression expression opcode_base unsigned returns_nothing #: This procedure will process an arithmetic opcode using {assembler} #, with a base of {opcode_base} and an expression of {expression} value :@= expression.value extract value tag data_address:: unsigned := data_address byte_process@(assembler, opcode_base | 0x05) data_address_process@(assembler, data_address) tag constant:: unsigned := constant byte_process@(assembler, opcode_base | 0x04) constant_process@(assembler, constant) tag ri:: unsigned := ri byte_process@(assembler, opcode_base | 0x06 | ri) tag rn:: unsigned := rn byte_process@(assembler, opcode_base | 0x08 | rn) default error@(assembler, 2, 'An arithmentic opcode must end with @Ri, Rn, #k, or direct') procedure bit_process@assembler takes assembler assembler bit expression returns_nothing #: This procedure will process emit {bit} using {assembler}. value :@= bit.value extract value tag bit_address:: bit_address := bit_address bit_number :@= bit_address.bit_number if bit_number > 7 error@assembler1[unsigned](assembler, 0, 'Bad bit number of %d%', bit_number) data_address :@= bit_address.data_address if 0x20 <= data_address && data_address < 0x30 # Bit address in the first 128 bits: byte_process@(assembler, (data_address - 0x20) | bit_number) else_if 0x80 <= data_address && data_address < 0x100 && data_address & 7 = 0 # Bit address in the second 128 bits: byte_process@(assembler, data_address | bit_number) else error@assembler1[unsigned](assembler, 1, 'Data address of 0x%x% is not allowed in a bit address', data_address) default debug_stream :@= assembler.debug_stream put@("bit_value.type=", debug_stream) print@(value.type, debug_stream) put@("\n\", debug_stream) error@(assembler, 1, 'Bad bit address') procedure byte_process@assembler takes assembler assembler byte unsigned returns_nothing #: This procedure will process emit {byte} using {assembler}. byte :&= 255 program_counter :@= assembler.program_counter assembler.memory_image[program_counter] := byte listing_stream :@= assembler.listing_stream if assembler.pass = 2 && listing_stream !== ?? buffer :@= assembler.buffer byte_count :@= assembler.byte_count if byte_count = 0 unsigned_append@(buffer, program_counter, 16, "", " ", 5, "0", "", false) unsigned_append@(buffer, byte, 16, "", " ", 3, "0", "", false) byte_count :+= 1 assembler.byte_count :+= byte_count program_counter :+= 1 assembler.program_counter := program_counter procedure constant_process@assembler takes assembler assembler constant unsigned returns_nothing #: This procedure will process emit {constant} as an 8-bit constant #, using {assembler}. if constant > 255 error@assembler1[unsigned](assembler, 1, 'Constant (value=0x%x%) is greater than 255', constant) else byte_process@(assembler, constant) procedure create@assembler takes standard_out out_stream error_stream out_stream returns assembler #: This procedure will create and return a new {assembler} object. initialize assembler:: assembler := allocate@assembler() assembler.buffer := allocate@string() assembler.debug_stream := error_stream assembler.errors := create@errors(error_stream) assembler.error_buffer := allocate@string() assembler.error_stream := error_stream assembler.listing_stream := ?? assembler.out_stream := ?? assembler.memory_image := allocate@memory_image() assembler.program_counter := 0 assembler.standard_out := standard_out return assembler procedure data_address_process@assembler takes assembler assembler data_address unsigned returns_nothing #: This procedure will process emit a 1 byte 8-bit address. if data_address > 255 error@assembler1[unsigned](assembler, 1, 'Direct address (value=0x%x%) is greater than 255', data_address) else byte_process@(assembler, data_address) procedure direct_process@assembler takes assembler assembler address expression returns_nothing #: This procedure will process emit a 1 byte 8-bit address. value :@= address.value extract value tag data_address:: unsigned := data_address if data_address < 256 byte_process@(assembler, data_address) else error@assembler1[unsigned](assembler, 1, 'A direct data address is 0x%x% which greater than 0xff', data_address) default error@(assembler, 1, 'A direct address is required') procedure error@assembler takes assembler assembler bytes unsigned message string returns_nothing #: This procedure will output an error message of {message} for #, using {assembler}. {bytes} specifies how many bytes long #, the instruction is; use 0 if the error is not instruction #, specific. if assembler.pass = 2 error_announce@(assembler) format@errors1[unsigned](assembler.errors, message, 0) error_stream :@= assembler.error_stream put@("\n\", error_stream) flush@(error_stream) procedure error_pad@assembler takes assembler assembler bytes unsigned returns_nothing #: This procedure will pad the output stream with {bytes} bytes. loop while bytes != 0 byte_process@(assembler, 0) bytes :-= 1 procedure error_announce@assembler takes assembler assembler returns_nothing #: This procedure will will generate an error announce header #, for the current {statement} in {assembler}. listing_stream :@= assembler.listing_stream if listing_stream !== ?? flush@(listing_stream) out_stream :@= assembler.out_stream if out_stream !== ?? flush@(out_stream) statement :@= assembler.statement buffer :@= assembler.error_buffer trim@(buffer, 0) unsigned_append@(buffer, statement.line_number, 10, "", "*** ERROR *** ", 0, "", "", false) loop while buffer.size < 24 buffer_append@(" ", buffer) buffer_append@(statement.opcode, buffer) buffer_append@("\n\", buffer) put@(buffer, assembler.error_stream) procedure immediate_process@assembler takes assembler assembler expression expression returns_nothing #: This procedure will process {expression} as an immediate #, (constant) byte value and output it. value :@= expression.value extract value tag constant:: unsigned := constant if constant <= 0xff byte_process@(assembler, constant) else error@assembler1[unsigned](assembler, 1, 'Immediate (value=0x%x%) is greater than 255', constant) default error@(assembler, 1, 'Immediate value is not a constant') procedure immediate16_process@assembler takes assembler assembler expression expression returns_nothing #: This procedure will process {expression} as an immediate #, (constant) byte value and output it. value :@= expression.value extract value tag constant:: unsigned := constant if constant <= 0xffff byte_process@(assembler, constant >> 8) byte_process@(assembler, constant & 255) else error@assembler1[unsigned](assembler, 2, 'Immediate 16 (value=0x%x%) is greater than 0xffff', constant) default error@(assembler, 2, 'Immediate 16 needs to be a constant') procedure logical_process@assembler takes assembler assembler binary binary opcode_base unsigned bit_opcode unsigned returns_nothing #: This procedure will process an arithmetic opcode using {assembler} #, with a base of {opcode_base} and {binary} for expressions. If #, {bit_opcode} is non-zero, it is used for the "op C,bit" insturction #, opcode. Otherwise, it is an XOR which does not have a bit operation. expression1 :@= binary.expression1 expression2 :@= binary.expression2 value1 :@= expression1.value value2 :@= expression2.value bytes :@= 0 extract value1 tag a:: bogus := a arithmetic_process@(assembler, expression2, opcode_base) tag data_address:: unsigned := data_address extract value2 tag a:: bogus := a byte_process@(assembler, opcode_base | 0x02) direct_process@(assembler, expression1) tag constant:: unsigned := constant byte_process@(assembler, opcode_base | 0x03) direct_process@(assembler, expression1) immediate_process@(assembler, expression2) default error@(assembler, 2, 'op direct, ... must be followed by A or #k') tag c:: bogus := c if bit_opcode = 0 error@(assembler, 2, 'XOR C,bit is illegal') else extract value2 tag bit_address:: bit_address := bit_address byte_process@(assembler, bit_opcode) bit_process@(assembler, expression2) default error@(assembler, 2, 'op C, ... must be followed by bit') tag undefined:: bogus := undefined bytes :@= 0 extract value2 tag a:: bogus := a bytes := 2 tag constant:: unsigned := constant bytes := 3 default bytes := 0 error@(assembler, bytes, 'An arithmetic operation must start with A, C, or direct') default error@(assembler, 0, 'An arithmetic operation must start with A, C, or direct') procedure move_process@assembler takes assembler assembler binary binary returns_nothing #: This procedure will process a move opcode using {assembler} #, {binary} for expressions. error1:: string := ?? error2:: string := ?? expression1 :@= binary.expression1 expression2 :@= binary.expression2 value1 :@= expression1.value value2 :@= expression2.value bytes :@= 0 extract value1 tag a:: bogus := a extract value2 tag data_address2:: unsigned := data_address # MOV A, direct if data_address2 = 0xe0 # 0xe0 = ACC error1 := '"mov a,acc" is illegal' else byte_process@(assembler, 0xe5) direct_process@(assembler, expression2) tag constant2:: unsigned := constant # MOV A, immediate byte_process@(assembler, 0x74) immediate_process@(assembler, expression2) tag ri2:: unsigned := ri # MOV A, @Ri byte_process@(assembler, 0xe6 | ri2) tag rn2:: unsigned := rn # MOV A, Rn byte_process@(assembler, 0xe8 | rn2) default bytes := 2 error1 := 'direct, immediate, @Ri, Rn' error2 := 'mov a, ...' tag bit_address1:: bit_address := bit_address extract value2 tag c:: bogus := c # MOV bit, C byte_process@(assembler, 0x92) bit_process@(assembler, expression1) default bytes := 2 error1 := 'C' error2 := 'mov bit, ...' tag c:: bogus := c extract value2 tag bit_address2:: bit_address := bit_address # MOV C, bit byte_process@(assembler, 0xa2) bit_process@(assembler, expression2) default bytes := 2 error1 := 'bit' error2 := 'mov c, ...' tag data_address1:: unsigned := data_address extract value2 tag data_address2:: unsigned := data_address # MOV direct, direct byte_process@(assembler, 0x85) direct_process@(assembler, expression1) direct_process@(assembler, expression2) tag constant:: unsigned := constant # MOV direct, #immediate byte_process@(assembler, 0x75) direct_process@(assembler, expression1) immediate_process@(assembler, expression2) tag a:: bogus := a # MOV direct, A byte_process@(assembler, 0xf5) direct_process@(assembler, expression1) tag ri2:: unsigned := ri # MOV direct, @Ri byte_process@(assembler, 0x86 | ri2) direct_process@(assembler, expression1) tag rn2:: unsigned := rn # MOV direct, Rn byte_process@(assembler, 0x88 | rn2) direct_process@(assembler, expression1) default bytes := 3 error1 := 'direct, immediate, or register' error2 := 'mov direct, ...' tag ri1:: unsigned := ri extract value2 tag constant:: unsigned := constant # MOV Ri, #immediate byte_process@(assembler, 0x76 | ri1) immediate_process@(assembler, expression2) tag a:: bogus := a # MOV Ri, A byte_process@(assembler, 0xf6 | ri1) tag data_address2:: unsigned := data_address # MOV Ri, direct byte_process@(assembler, 0xa6 | ri1) direct_process@(assembler, expression2) default bytes := 2 error1 := 'direct, immediate, A' error2 := 'mov @Ri, ...' tag dptr:: bogus := dptr extract value2 tag constant2:: unsigned := constant # MOV DPTR, immediate16 ?? byte_process@(assembler, 0x90) immediate16_process@(assembler, expression2) default bytes := 3 error1 := 'immediate16' error2 := 'mov DPTR, ...' tag rn1:: unsigned := rn extract value2 tag data_address2:: unsigned := data_address # MOV Rn, direct byte_process@(assembler, 0xa8 | rn1) direct_process@(assembler, expression2) tag constant2:: unsigned := constant # MOV Rn, immediate byte_process@(assembler, 0x78 | rn1) immediate_process@(assembler, expression2) tag a:: bogus := a # MOV Rn, A byte_process@(assembler, 0xf8 | rn1) default bytes := 2 error1 := 'direct, immediate, A' error2 := 'mov Rn, ...' tag undefined:: bogus := undefined error1 := 'direct, immediate, or register' error2 := 'mov undefined, ...' extract value2 tag data_address2:: unsigned := data_address # MOV undefined, direct bytes := 3 tag constant:: unsigned := constant # MOV undefined, #immediate bytes := 3 tag a:: bogus := a # MOV undefined, A bytes := 2 tag ri2:: unsigned := ri # MOV undefined, @Ri bytes := 2 tag rn2:: unsigned := rn # MOV undefined, Rn bytes := 2 default bytes := 3 default error@(assembler, 0, 'First operand of MOV must be A, bit, C, direct, DPTR, @Ri, or Rn') if error1 !== ?? error@assembler2[string, string](assembler, bytes, '%ds% must be followed by %ds%!', error2, error1) procedure output_close@assembler takes assembler assembler out_stream out_stream returns_nothing #: This procedure will ensure that {out_stream} is properly #, closed (for a file) or flushed (for standard output.) if out_stream == assembler.standard_out flush@(out_stream) else close@(out_stream) procedure output_open@assembler takes assembler assembler file_name string file_type string returns out_stream #: This procedure will output an output file named {file_name}. #, If {file_name} is the empty string, ??@{out_stream} is returned. #, If {file_name} is a single hyphe (-), standard output is returned. #, In all other cases, an attempt is made to open {file_name} for #, writing. If the file is not successfully opened, an error #, message is generated that contains {file_type} in it and #, ??@{out_stream} is returned. # debug_stream :@= assembler.debug_stream # format@format2[string, string](debug_stream, # "output_open(%ds%, %ds%)\n\", file_name, file_type) if file_name = "" return ?? if file_name = "-" return assembler.standard_out out_stream :@= open@out_stream(file_name) if out_stream == ?? format@errors2[string, string](assembler.errors, 'Could not create the %s% file named %ds%!', file_type, file_name) return out_stream procedure opcode_process@assembler takes assembler assembler opcode opcode returns_nothing #: This procedure will process {opcode} for {assembler}. extract opcode tag add:: expression := add arithmetic_process@(assembler, add, 0x20) tag add_carry:: expression := add_carry arithmetic_process@(assembler, add_carry, 0x30) tag and:: binary := and logical_process@(assembler, and, 0x50, 0x82) tag and_not:: expression := and_not byte_process@(assembler, 0xb0) bit_process@(assembler, and_not) tag blank:: bogus := blank #FIXME: do_nothing !!! opcode := opcode tag byte:: expression := byte immediate_process@(assembler, byte) tag call_absolute:: expression := call_absolute absolute_process@(assembler, 0x11, call_absolute) tag call_long:: expression := call_long byte_process@(assembler, 0x12) address_process@(assembler, call_long) tag clear:: expression := clear value :@= clear.value extract value tag a:: bogus := a # CLR A byte_process@(assembler, 0xe4) tag bit_address:: bit_address := bit_address # CLR bit byte_process@(assembler, 0xc2) bit_process@(assembler, clear) tag c:: bogus := c # CLR C byte_process@(assembler, 0xc3) default error@(assembler, 2, 'CLR must be followed by A, bit, or C') tag comment:: string := comment #FIXME: do_nothing !!! opcode := opcode tag complement:: expression := complement value :@= complement.value extract value tag c:: bogus := c # CPL C byte_process@(assembler, 0xb3) tag bit_address:: bit_address := bit_address # CPL bit byte_process@(assembler, 0xb2) bit_process@(assembler, complement) tag a:: bogus := a # CPL A byte_process@(assembler, 0xf4) default error@(assembler, 2, 'CPL must be followed by A, bit, or C') tag decimal_adjust:: bogus := decimal_adjust byte_process@(assembler, 0xd4) tag decrement:: expression := decrement value :@= decrement.value extract value tag a:: bogus := a # DEC A byte_process@(assembler, 0x14) tag data_address:: unsigned := data_address # DEC direct byte_process@(assembler, 0x15) direct_process@(assembler, decrement) tag ri:: unsigned := ri # DEC @Ri byte_process@(assembler, 0x16 | ri) tag rn:: unsigned := rn # DEC Rn byte_process@(assembler, 0x18 | rn) default error@(assembler, 2, 'DEC must be followed by A, direct, @Ri, or Rn') tag divide:: bogus := divide byte_process@(assembler, 0x84) tag exchange:: expression := exchange value :@= exchange.value extract value tag data_address:: unsigned := data_address # XCH A,direct byte_process@(assembler, 0xc5) direct_process@(assembler, exchange) tag ri:: unsigned := ri # XCH A, @Ri byte_process@(assembler, 0xc6 | ri) tag rn:: unsigned := rn # XCH A, Rn byte_process@(assembler, 0xc8 | rn) default error@(assembler, 2, 'XCHD must specify A, @Rn, or Rn') tag exchange_nibble:: expression := exchange_nibble value :@= exchange_nibble.value extract value tag ri:: unsigned := ri # XCHD A, @Ri byte_process@(assembler, 0xd6 | ri) default error@(assembler, 1, 'XCHD must specify @Rn') tag end:: bogus := end #FIXME: do_nothing !!! opcode := opcode tag increment:: expression := increment value :@= increment.value extract value tag a:: bogus := a # INC A byte_process@(assembler, 0x04) tag data_address:: unsigned := data_address # INC direct byte_process@(assembler, 0x05) direct_process@(assembler, increment) tag dptr:: bogus := dptr # INC DPTR byte_process@(assembler, 0xa3) tag ri:: unsigned := ri # INC @Ri byte_process@(assembler, 0x06 | ri) tag rn:: unsigned := rn # INC Rn byte_process@(assembler, 0x08 | rn) default error@(assembler, 2, 'INC must be followed by A, direct, DPTR, @Ri, or Rn') tag jump_absolute:: expression := jump_absolute absolute_process@(assembler, 0x01, jump_absolute) tag jump_bit:: binary := jump_bit byte_process@(assembler, 0x20) bit_process@(assembler, jump_bit.expression1) relative_process@(assembler, jump_bit.expression2) tag jump_bit_clear:: binary := jump_bit_clear byte_process@(assembler, 0x10) bit_process@(assembler, jump_bit_clear.expression1) relative_process@(assembler, jump_bit_clear.expression2) tag jump_carry:: expression := jump_carry byte_process@(assembler, 0x40) relative_process@(assembler, jump_carry) tag jump_compare_not_equal:: trinary := jump_compare_not_equal expression1 :@= jump_compare_not_equal.expression1 expression2 :@= jump_compare_not_equal.expression2 expression3 :@= jump_compare_not_equal.expression3 value1 :@= expression1.value extract value1 tag a:: bogus := a value2 :@= expression2.value extract value2 tag data_address:: unsigned := data_address # CJNE A, direct, rel byte_process@(assembler, 0xb5) direct_process@(assembler, expression2) relative_process@(assembler, expression3) tag constant:: unsigned := constant # CJNE A, direct, rel byte_process@(assembler, 0xb4) immediate_process@(assembler, expression2) relative_process@(assembler, expression3) default error@(assembler, 3, 'Second argument to CJNE must be direct or #k') tag ri:: unsigned := ri # CJNE @Ri, #data, rel byte_process@(assembler, 0xb6 | ri) immediate_process@(assembler, expression2) relative_process@(assembler, expression3) tag rn:: unsigned := rn # CJNE Rn, #data, rel byte_process@(assembler, 0xb8 | rn) immediate_process@(assembler, expression2) relative_process@(assembler, expression3) default error@(assembler, 3, 'CJNE must be followed by A, @Ri, or Rn') tag jump_decrement_non_zero:: binary := jump_decrement_non_zero expression1 :@= jump_decrement_non_zero.expression1 expression2 :@= jump_decrement_non_zero.expression2 value1 :@= expression1.value extract value1 tag data_address:: unsigned := data_address # DJNZ direct, rel byte_process@(assembler, 0xd5) direct_process@(assembler, expression1) relative_process@(assembler, expression2) tag rn:: unsigned := rn # DJNZ Rn, rel byte_process@(assembler, 0xd8 | rn) relative_process@(assembler, expression2) default error@(assembler, 3, 'First argument to DJNZ must be direct or Rn') tag jump_indexed:: bogus := jump_indexed byte_process@(assembler, 0x73) tag jump_long:: expression := jump_long byte_process@(assembler, 0x02) address_process@(assembler, jump_long) tag jump_no_bit:: binary := jump_no_bit byte_process@(assembler, 0x30) bit_process@(assembler, jump_no_bit.expression1) relative_process@(assembler, jump_no_bit.expression2) tag jump_no_carry:: expression := jump_no_carry byte_process@(assembler, 0x50) relative_process@(assembler, jump_no_carry) tag jump_non_zero:: expression := jump_non_zero byte_process@(assembler, 0x70) relative_process@(assembler, jump_non_zero) tag jump_short:: expression := jump_short byte_process@(assembler, 0x80) relative_process@(assembler, jump_short) tag jump_zero:: expression := jump_zero byte_process@(assembler, 0x60) relative_process@(assembler, jump_zero) tag move:: binary := move move_process@(assembler, move) tag move_code_pointer:: bogus := move_code_pointer byte_process@(assembler, 0x93) tag move_code_pc:: bogus := move_code_pc byte_process@(assembler, 0x83) tag move_external:: binary := move_external expression1 :@= move_external.expression1 expression2 :@= move_external.expression2 value1 :@= expression1.value value2 :@= expression2.value extract value1 tag a:: bogus := a extract value2 tag dptr:: bogus := dptr # MOVX A, @dptr byte_process@(assembler, 0xe0) tag ri2:: unsigned := ri # MOVX A, @Ri byte_process@(assembler, 0xe2 | ri2) default error@(assembler, 1, 'MOVX A, ... must be followed by @DPTR or @Ri') tag dptr:: bogus := dptr extract value2 tag a:: bogus := a # MOVX @DPTR, A byte_process@(assembler, 0xf0) default error@(assembler, 1, 'MOVX @DPTR, ... must be followed by A') tag ri1:: unsigned := ri extract value2 tag a:: bogus := a # MOVX @Ri, A byte_process@(assembler, 0xf2 | ri1) default error@(assembler, 1, 'MOVX @Rn, ... must be followed by A') default error@(assembler, 1, 'MOVX must be followed by A, @DPTR, or @Rn') tag label:: expression := label extract label tag symbol:: symbol := symbol symbol.value.code_address := assembler.program_counter default error@(assembler, 0, 'A label must specify a symbolic name') tag multiply:: bogus := multiply byte_process@(assembler, 0xa4) tag nop:: bogus := nop byte_process@(assembler, 0x00) tag or:: binary := or logical_process@(assembler, or, 0x40, 0x72) tag or_not:: expression := or_not byte_process@(assembler, 0xa0) bit_process@(assembler, or_not) tag origin:: expression := origin value :@= origin.value extract value tag code_address:: unsigned := code_address assembler.program_counter := code_address default error@(assembler, 0, 'An org statement must specify a code address') tag push:: expression := push byte_process@(assembler, 0xc0) direct_process@(assembler, push) tag pop:: expression := pop byte_process@(assembler, 0xd0) direct_process@(assembler, pop) tag xreturn:: bogus := xreturn byte_process@(assembler, 0x22) tag return_interrupt:: bogus := return_interrupt byte_process@(assembler, 0x32) tag rotate_left:: bogus := rotate_left byte_process@(assembler, 0x23) tag rotate_left_carry:: bogus := rotate_left_carry byte_process@(assembler, 0x33) tag rotate_right:: bogus := rotate_right byte_process@(assembler, 0x03) tag rotate_right_carry:: bogus := rotate_right_carry byte_process@(assembler, 0x13) tag swap:: bogus := swap byte_process@(assembler, 0xc4) tag set_bit:: expression := set_bit value :@= set_bit.value extract value tag c:: bogus := c # SET C byte_process@(assembler, 0xd3) tag bit_address:: bit_address := bit_address # SET bit byte_process@(assembler, 0xd2) bit_process@(assembler, set_bit) default error@(assembler, 2, 'SET must be followed by C or bit') tag subtract_borrow:: expression := subtract_borrow arithmetic_process@(assembler, subtract_borrow, 0x90) tag word:: expression := word immediate16_process@(assembler, word) tag xor:: binary := xor logical_process@(assembler, xor, 0x60, 0) procedure process@assembler takes assembler assembler program program pass unsigned listing_stream out_stream returns_nothing #: This procedure will produce a listing of {program} to {listing_stream} #, using {program}. assembler.program_counter := 0 assembler.listing_stream := listing_stream assembler.pass := pass statements :@= program.statements size :@= statements.size index :@= 0 loop while index < size statement :@= statements[index] index :+= 1 statement_process@(assembler, statement) procedure relative_process@assembler takes assembler assembler address expression returns_nothing #: This procedure will emit a relative address byte for {address} #, using {assembler}. program_counter :@= assembler.program_counter + 1 value :@= address.value extract value tag code_address:: unsigned := code_address relative :@= 0 if code_address >= program_counter relative :@= code_address - program_counter if relative >= 128 error@assembler1[unsigned](assembler, 0, 'Attempting to jump %d% bytes forward (127 bytes is max.)', relative) relative := 127 assert 0 <= relative && relative <= 127 else_if code_address < program_counter relative :@= program_counter - code_address if relative > 128 error@assembler1[unsigned](assembler, 0, 'Attempting to jump %d% bytes backward (128 bytes is max.)', relative) relative := 128 relative := 256 - relative assert 128 <= relative && relative <= 255 byte_process@(assembler, relative) default error@(assembler, 1, 'Relative address must specify a code address') procedure statement_process@assembler takes assembler assembler statement statement returns_nothing #: This procedure will process {statement} using {assembler}. errors :@= assembler.errors errors_count :@= errors.count assembler.statement := statement opcode :@= statement.opcode listing_stream :@= assembler.listing_stream if listing_stream !== ?? buffer :@= assembler.buffer trim@(buffer, 0) # Output the line number: unsigned_append@(buffer, statement.line_number, 10, "", " ", 5, "", " ", false) assembler.byte_count := 0 opcode_process@(assembler, statement.opcode) loop while buffer.size < 24 buffer_append@(" ", buffer) switch opcode.type case label #FIXME: do_nothing buffer := buffer default buffer_append@(" ", buffer) buffer_append@(opcode, buffer) comment :@= statement.comment if comment !== ?? && comment != "" loop while buffer.size < 48 buffer_append@(" ", buffer) buffer_append@("; ", buffer) buffer_append@(comment, buffer) buffer_append@("\n\", buffer) if errors.count = errors_count put@(buffer, listing_stream) else opcode_process@(assembler, statement.opcode) #: {binary} routines: procedure buffer_append@binary takes binary binary buffer string returns_nothing #: This procedure will append {binary} to {buffer}. buffer_append@(binary.expression1, buffer) buffer_append@(", ", buffer) buffer_append@(binary.expression2, buffer) procedure create@binary takes expression1 expression expression2 expression returns binary #: This procedure will create and return a {binary} object #, containing {expression1} and {expression2}. initialize binary:: binary := allocate@binary() binary.expression1 := expression1 binary.expression2 := expression2 return binary procedure operator_buffer_append@binary takes binary binary operator string buffer string returns_nothing #: This procedure will append {binary} to {bufer} as two #, expressions separated by {operator}. buffer_append@("(", buffer) buffer_append@(binary.expression1, buffer) buffer_append@(operator, buffer) buffer_append@(binary.expression2, buffer) buffer_append@(")", buffer) #: {assembler1} routines: procedure error@assembler1[type1] takes assembler assembler bytes unsigned message string expression1 type1 returns_nothing needs procedure format@type1 takes type1, out_stream, string, unsigned returns_nothing #: This procedure will output an error message of {message} for #, using {assembler}. {message} is formatted to contain {expression1}. #, {bytes} is the number bytes for the instruction; use 0 if the #, error is not instruction specific. if assembler.pass = 2 error_announce@(assembler) format@errors1[type1](assembler.errors, message, expression1) error_stream :@= assembler.error_stream put@("\n\", error_stream) flush@(error_stream) error_pad@(assembler, bytes) #: {assembler2} routines: procedure error@assembler2[type1, type2] takes assembler assembler bytes unsigned message string expression1 type1 expression2 type2 returns_nothing needs procedure format@type1 takes type1, out_stream, string, unsigned returns_nothing procedure format@type2 takes type2, out_stream, string, unsigned returns_nothing #: This procedure will output an error message of {message} #, using {assembler}. {message} is formatted to contain #, {expression1} and {expression2}. {bytes} is the number #, bytes for the instruction; use 0 if the error is not #, instruction specific. if assembler.pass = 2 error_announce@(assembler) format@errors2[type1, type2](assembler.errors, message, expression1, expression2) error_stream :@= assembler.error_stream put@("\n\", error_stream) flush@(error_stream) error_pad@(assembler, bytes) #: {assembler3} routines: procedure error@assembler3[type1, type2, type3] takes assembler assembler bytes unsigned message string expression1 type1 expression2 type2 expression3 type3 returns_nothing needs procedure format@type1 takes type1, out_stream, string, unsigned returns_nothing procedure format@type2 takes type2, out_stream, string, unsigned returns_nothing procedure format@type3 takes type3, out_stream, string, unsigned returns_nothing #: This procedure will output an error message of {message} #, using {assembler}. {message} is formatted to contain #, {expression1}, {expression2}, and {expression3}. {bytes} is #, the number bytes for the instruction; use 0 if the error is #, not instruction specific. if assembler.pass = 2 error_announce@(assembler) format@errors3[type1, type2, type3](assembler.errors, message, expression1, expression2, expression3) error_stream :@= assembler.error_stream put@("\n\", error_stream) flush@(error_stream) error_pad@(assembler, bytes) #: {bit_address} routines: procedure create@bit_address takes data_address unsigned bit_number unsigned returns bit_address initialize bit_address:: bit_address := allocate@bit_address() bit_address.data_address := data_address bit_address.bit_number := bit_number return bit_address #: {opcode} routines: procedure buffer_append@opcode takes opcode opcode buffer string returns_nothing #: This procedure will append {opcode} to {buffer}. extract opcode tag add:: expression := add opcode_name_append("add", buffer) buffer_append@("a, ", buffer) buffer_append@(add, buffer) tag add_carry:: expression := add_carry opcode_name_append("adc", buffer) buffer_append@("a, ", buffer) buffer_append@(add_carry, buffer) tag and:: binary := and opcode_name_append("anl", buffer) buffer_append@(and, buffer) tag and_not:: expression := and_not opcode_name_append("anl", buffer) buffer_append@("c, /", buffer) buffer_append@(and_not, buffer) tag blank:: bogus := blank #FIXME: do_nothing!!! opcode := opcode tag byte:: expression := byte opcode_name_append("byte", buffer) buffer_append@(byte, buffer) tag call_absolute:: expression := call_absolute opcode_name_append("acall", buffer) buffer_append@(call_absolute, buffer) tag call_long:: expression := call_long opcode_name_append("lcall", buffer) buffer_append@(call_long, buffer) tag clear:: expression := clear opcode_name_append("clr", buffer) buffer_append@(clear, buffer) tag comment:: string := comment buffer_append@("; ", buffer) buffer_append@(comment, buffer) tag complement:: expression := complement opcode_name_append("cpl", buffer) buffer_append@(complement, buffer) tag decimal_adjust:: bogus := decimal_adjust opcode_name_append("da", buffer) tag decrement:: expression := decrement opcode_name_append("dec", buffer) buffer_append@(decrement, buffer) tag divide:: bogus := divide opcode_name_append("div", buffer) buffer_append@("ba", buffer) tag exchange:: expression := exchange opcode_name_append("xch", buffer) buffer_append@("a, ", buffer) buffer_append@(exchange, buffer) tag exchange_nibble:: expression := exchange_nibble opcode_name_append("xchd", buffer) buffer_append@(exchange_nibble, buffer) tag end:: bogus := end opcode_name_append("end", buffer) tag increment:: expression := increment opcode_name_append("inc", buffer) buffer_append@(increment, buffer) tag jump_absolute:: expression := jump_absolute opcode_name_append("ajmp", buffer) buffer_append@(jump_absolute, buffer) tag jump_bit:: binary := jump_bit opcode_name_append("jb", buffer) buffer_append@(jump_bit, buffer) tag jump_bit_clear:: binary := jump_bit_clear opcode_name_append("jbc", buffer) buffer_append@(jump_bit_clear, buffer) tag jump_carry:: expression := jump_carry opcode_name_append("jc", buffer) buffer_append@(jump_carry, buffer) tag jump_compare_not_equal:: trinary := jump_compare_not_equal opcode_name_append("cjne", buffer) buffer_append@(jump_compare_not_equal, buffer) tag jump_decrement_non_zero:: binary := jump_decrement_non_zero opcode_name_append("djnz", buffer) buffer_append@(jump_decrement_non_zero, buffer) tag jump_indexed:: bogus := jump_indexed opcode_name_append("jmp", buffer) buffer_append@("@a+dptr", buffer) tag jump_long:: expression := jump_long opcode_name_append("ljmp", buffer) buffer_append@(jump_long, buffer) tag jump_no_bit:: binary := jump_no_bit opcode_name_append("jnb", buffer) buffer_append@(jump_no_bit, buffer) tag jump_no_carry:: expression := jump_no_carry opcode_name_append("jnc", buffer) buffer_append@(jump_no_carry, buffer) tag jump_non_zero:: expression := jump_non_zero opcode_name_append("jnz", buffer) buffer_append@(jump_non_zero, buffer) tag jump_short:: expression := jump_short opcode_name_append("sjmp", buffer) buffer_append@(jump_short, buffer) tag jump_zero:: expression := jump_zero opcode_name_append("jz", buffer) buffer_append@(jump_zero, buffer) tag move:: binary := move opcode_name_append("mov", buffer) buffer_append@(move, buffer) tag move_code_pointer:: bogus := move_code_pointer opcode_name_append("movc", buffer) buffer_append@("a, @a+dptr", buffer) tag move_code_pc:: bogus := move_code_pc opcode_name_append("movc", buffer) buffer_append@("a, @a+pc", buffer) tag move_external:: binary := move_external opcode_name_append("movx", buffer) buffer_append@(move_external, buffer) tag label:: expression := label extract label tag symbol:: symbol := symbol buffer_append@(symbol.name, buffer) buffer_append@(":", buffer) default assert false tag multiply:: bogus := multiply opcode_name_append("mul", buffer) buffer_append@("ab", buffer) tag nop:: bogus := nop buffer_append@("nop", buffer) tag or:: binary := or opcode_name_append("orl", buffer) buffer_append@(or, buffer) tag or_not:: expression := or_not opcode_name_append("orl", buffer) buffer_append@("c, /", buffer) buffer_append@(or_not, buffer) tag origin:: expression := origin opcode_name_append("org", buffer) buffer_append@(origin, buffer) tag push:: expression := push opcode_name_append("push", buffer) buffer_append@(push, buffer) tag pop:: expression := pop opcode_name_append("pop", buffer) buffer_append@(pop, buffer) tag xreturn:: bogus := xreturn opcode_name_append("ret", buffer) buffer_append@("a", buffer) tag return_interrupt:: bogus := return_interrupt opcode_name_append("reti", buffer) buffer_append@("a", buffer) tag rotate_left:: bogus := rotate_left opcode_name_append("rl", buffer) buffer_append@("a", buffer) tag rotate_left_carry:: bogus := rotate_left_carry opcode_name_append("rlc", buffer) buffer_append@("a", buffer) tag rotate_right:: bogus := rotate_right opcode_name_append("rr", buffer) buffer_append@("a", buffer) tag rotate_right_carry:: bogus := rotate_right_carry opcode_name_append("rrc", buffer) buffer_append@("a", buffer) tag swap:: bogus := swap opcode_name_append("swap", buffer) buffer_append@("a", buffer) tag set_bit:: expression := set_bit opcode_name_append("setb", buffer) buffer_append@(set_bit, buffer) tag subtract_borrow:: expression := subtract_borrow opcode_name_append("subb", buffer) buffer_append@("a, ", buffer) buffer_append@(subtract_borrow, buffer) tag word:: expression := word opcode_name_append("word", buffer) buffer_append@(word, buffer) tag xor:: binary := xor opcode_name_append("xrl", buffer) buffer_append@(xor, buffer) #: {memory_image} routines: procedure clear@memory_image takes memory_image memory_image returns_nothing #: This procedure will clear out the contents of {memory_image}. uninitialized :@= memory_image.uninitialized bytes :@= memory_image.bytes size :@= bytes.size index :@= 0 loop while index < size bytes[index] := uninitialized index :+= 1 procedure create@memory_image takes_nothing returns memory_image #: This procedure will create and return an empty {memory} object. initialize memory_image:: memory_image := allocate@memory_image() memory_image.bytes := allocate@vector[unsigned]() memory_image.uninitialized := 0xffffffff return memory_image procedure fetch1@memory_image takes memory_image memory_image index unsigned returns unsigned #: This procedure will the {index}'th byte of {memory_image}. #, 0xffffffff is returned if the memory_image location was never #, initialized. uninitialized :@= memory_image.uninitialized bytes :@= memory_image.bytes size :@= bytes.size loop until index < size append@(bytes, uninitialized) size :+= 1 return bytes[index] procedure store1@memory_image takes memory_image memory_image index unsigned value unsigned returns_nothing #: This procedure will store {value} into the {index}'th byte of #, {memory_image}. uninitialized :@= memory_image.uninitialized bytes :@= memory_image.bytes size :@= bytes.size loop until index < size append@(bytes, uninitialized) size :+= 1 value :&= 255 bytes[index] := value #: {statement} routines: procedure create@statement takes line_number unsigned opcode opcode comment string returns statement #: This procedure will create and return a new {statement} object #, that contains {line_number}, {label}, {opcode}, and {comment}. initialize statement:: statement := allocate@statement() statement.line_number := line_number statement.opcode := opcode statement.comment := comment return statement procedure buffer_append@statement takes statement statement buffer string returns_nothing #: This procedure will output {statement} to {buffer}. opcode :@= statement.opcode extract opcode tag comment:: string := comment buffer_append@(" ; ", buffer) buffer_append@(comment, buffer) tag label:: expression := label buffer_append@(label, buffer) buffer_append@(":", buffer) default # Generic opcode: buffer_append@(" ", buffer) buffer_append@(opcode, buffer) comment :@= statement.comment if comment !== ?? && comment != "" loop while buffer.size < 24 buffer_append@(" ", buffer) buffer_append@("; ", buffer) buffer_append@(comment, buffer) buffer_append@("\n\", buffer) #: {symbol} routines: procedure buffer_append@symbol takes symbol symbol buffer string returns_nothing #: This procedure will append {symbol} to {buffer}. buffer_append@(symbol.name, buffer) procedure create@symbol takes name string returns symbol #: This procedure will create and return a new {symbol} object. value :@= allocate@value() value.undefined := ?? initialize symbol:: symbol := allocate@symbol() symbol.defined := false symbol.line_number := 0 symbol.name := name symbol.value := value return symbol procedure equal@symbol takes symbol1 symbol symbol2 symbol returns logical #: This proceudre will return {true} if {symbol1} has the same name #, as {symbol2}. return symbol1.name = symbol2.name procedure hash@symbol takes symbol symbol returns unsigned #: This procudure will return a hash value for {symbol}. return hash@(symbol.name) #: {symbol_table} routines: procedure bit_address_insert@symbol_table takes symbol_table symbol_table name string address unsigned number unsigned returns_nothing #: This procedure will insert {name} into {symbol_table} as a bit #, address with data address of {address} and a bit number of {number}. value :@= symbol_table[name].value extract value tag undefined:: bogus := undefined value.bit_address := create@bit_address(address, number) tag bit_address:: bit_address := bit_address if bit_address.data_address != address || bit_address.bit_number != number #FIXME: This is an error: assert false procedure create@symbol_table takes_nothing returns symbol_table #: This procedure will create and return a new {symbol_table} object. initialize symbol_table:: symbol_table := allocate@symbol_table() symbol_table.table := xcreate@set[symbol](100) symbol_table.symbol := allocate@symbol() symbol_table.symbols := allocate@vector[symbol]() return symbol_table procedure data_address_insert@symbol_table takes symbol_table symbol_table name string address unsigned returns_nothing #: This procedure will insert {name} into {symbol_table} as a #, data address with a value of {address}. value :@= symbol_table[name].value extract value tag undefined:: bogus := undefined value.data_address := address tag data_address:: unsigned := data_address if data_address != address #FIXME: This is an error: assert false procedure fetch1@symbol_table takes symbol_table symbol_table name string returns symbol #: This procedure will return the symbol associated with {name} #, from {symbol_table}. A new symbol is created if {name} is #, not already in {symbol_table}. {name} is assumed to be #, immutable; if it is not, a fresh immutable copy needs to #, be created by the caller and passed in. symbol :@= symbol_table.symbol symbol.name := name table :@= symbol_table.table symbol :@= table[symbol] if symbol == ?? symbol := create@symbol(name) assert !insert@(table, symbol) append@(symbol_table.symbols, symbol) return symbol #: {trinary} routines: procedure buffer_append@trinary takes trinary trinary buffer string returns_nothing #: This procedure will append {trinary} to {buffer}. buffer_append@(trinary.expression1, buffer) buffer_append@(", ", buffer) buffer_append@(trinary.expression2, buffer) buffer_append@(", ", buffer) buffer_append@(trinary.expression3, buffer) procedure create@trinary takes expression1 expression expression2 expression expression3 expression returns trinary #: This procedure will create and return a {trinary} object #, containing {expression1}, {expression2}, and {expression3} initialize trinary:: trinary := allocate@trinary() trinary.expression1 := expression1 trinary.expression2 := expression2 trinary.expression3 := expression3 return trinary #: Some stand-alone routines: procedure opcode_name_append takes opcode_name string buffer string returns_nothing #: This procedure wil append {opcode_name} to {buffer} and #, pad it will enough extra spaces so that a total of 8 #, spaces are appended. buffer_append@(opcode_name, buffer) count :@= 8 - opcode_name.size loop while count != 0 buffer_append@(" ", buffer) count :-= 1