################################################################################
|
################################################################################
|
# uasm.pl : light8080 core microcode assembler
|
# uasm.pl : light8080 core microcode assembler
|
################################################################################
|
################################################################################
|
# Usage: perl uasm.pl <microcode file name> <command list>
|
# Usage: perl uasm.pl <microcode file name> <command list>
|
#
|
#
|
# The command list is a space-separated sequence of the following:
|
# The command list is a space-separated sequence of the following:
|
#
|
#
|
# -lst : Shows a listing of the assembled microinstructions next to their
|
# -lst : Shows a listing of the assembled microinstructions next to their
|
# assembler source lines. Not very useful because it does not show
|
# assembler source lines. Not very useful because it does not show
|
# assembler pragma, label or comment lines.
|
# assembler pragma, label or comment lines.
|
# -labels : Shows a list of all defined labels with their address and the
|
# -labels : Shows a list of all defined labels with their address and the
|
# number of times they are used.
|
# number of times they are used.
|
# -bitfields: Shows a list of all the different microinstructions generated,
|
# -bitfields: Shows a list of all the different microinstructions generated,
|
# plus the number of times they are used. Might be useful to encode
|
# plus the number of times they are used. Might be useful to encode
|
# the microinstructions and save rom bits.
|
# the microinstructions and save rom bits.
|
# -instructions: Shows a list of all defined instructions with the address their
|
# -instructions: Shows a list of all defined instructions with the address their
|
# microcode starts at.
|
# microcode starts at.
|
# -rom_bin : Shows a raw list of all the binary microinstructions.
|
# -rom_bin : Shows a raw list of all the binary microinstructions.
|
# -rom_vhdl : Shows a vhdl block containing the microcode rom declaration.
|
# -rom_vhdl : Shows a vhdl block containing the microcode rom declaration.
|
#
|
#
|
# If none of the above commands is given, the program just exits silently. Any
|
# If none of the above commands is given, the program just exits silently. Any
|
# unrecognized command is silently ignored.
|
# unrecognized command is silently ignored.
|
################################################################################
|
################################################################################
|
# Assembler format (informal definition, source is the ultimate reference!):
|
# Assembler format (informal definition, source is the ultimate reference!):
|
#
|
#
|
#<microinstruction line> :=
|
#<microinstruction line> :=
|
# [<label>] | (*1)
|
# [<label>] | (*1)
|
# <operand stage control> ; <ALU stage control> [; [<flag list>]] |
|
# <operand stage control> ; <ALU stage control> [; [<flag list>]] |
|
# JSR <destination address>|TJSR <destination address>
|
# JSR <destination address>|TJSR <destination address>
|
#
|
#
|
#<label> := {':' immediately followed by a common identifier}
|
#<label> := {':' immediately followed by a common identifier}
|
#<destination address> := {an identifier defined as label anywhere in the file}
|
#<destination address> := {an identifier defined as label anywhere in the file}
|
#<operand stage control> := <op_reg> = <op_src> | NOP
|
#<operand stage control> := <op_reg> = <op_src> | NOP
|
#<op_reg> := T1 | T2
|
#<op_reg> := T1 | T2
|
#<op_src> := <register> | DI | <IR register>
|
#<op_src> := <register> | DI | <IR register>
|
#<IR register> := {s}|{d}|{p}0|{p}1 (*3)
|
#<IR register> := {s}|{d}|{p}0|{p}1 (*3)
|
#<register> := _a|_b|_c|_d|_e|_h|_l|_f|_a|_ph|_pl|_x|_y|_z|_w|_sh|_sl|
|
#<register> := _a|_b|_c|_d|_e|_h|_l|_f|_a|_ph|_pl|_x|_y|_z|_w|_sh|_sl|
|
#<ALU stage control> := <alu_dst> = <alu_op> | NOP
|
#<ALU stage control> := <alu_dst> = <alu_op> | NOP
|
#<alu_dst> := <register> | DO
|
#<alu_dst> := <register> | DO
|
#<alu_op> := add|adc|sub|sbb| and|orl|not|xrl| rla|rra|rlca|rrca| aaa|
|
#<alu_op> := add|adc|sub|sbb| and|orl|not|xrl| rla|rra|rlca|rrca| aaa|
|
# t1|rst|daa|cpc|sec|psw
|
# t1|rst|daa|cpc|sec|psw
|
#<flag list> := <flag> [, <flag> ...]
|
#<flag list> := <flag> [, <flag> ...]
|
#<flag> := #decode|#di|#ei|#io|#auxcy|#clrt1|#halt|#end|#ret|#rd|#wr|#setacy
|
#<flag> := #decode|#di|#ei|#io|#auxcy|#clrt1|#halt|#end|#ret|#rd|#wr|#setacy
|
# #ld_al|#ld_addr|#fp_c|#fp_r|#fp_rc (*2)
|
# #ld_al|#ld_addr|#fp_c|#fp_r|#fp_rc|#clr_cy_ac (*2)
|
#
|
#
|
# *1 Labels appear alone by themselves in a line
|
# *1 Labels appear alone by themselves in a line
|
# *2 There are some restrictions on the flags that can be used together
|
# *2 There are some restrictions on the flags that can be used together
|
# *3 Registers are specified by IR field
|
# *3 Registers are specified by IR field
|
#
|
#
|
################################################################################
|
################################################################################
|
# ALU operations
|
# ALU operations
|
#
|
#
|
#Operation Encoding ALU result
|
#Operation Encoding ALU result
|
#===============================================================================
|
#===============================================================================
|
#ADD 001100 T2 + T1
|
#ADD 001100 T2 + T1
|
#ADC 001101 T2 + T1 + CY
|
#ADC 001101 T2 + T1 + CY
|
#SUB 001110 T2 - T1
|
#SUB 001110 T2 - T1
|
#SBB 001111 T2 – T1 - CY
|
#SBB 001111 T2 – T1 - CY
|
#AND 000100 T1 AND T2
|
#AND 000100 T1 AND T2
|
#ORL 000101 T1 OR T2
|
#ORL 000101 T1 OR T2
|
#NOT 000110 NOT T1
|
#NOT 000110 NOT T1
|
#XRL 000111 T1 XOR T2
|
#XRL 000111 T1 XOR T2
|
#RLA 000000 8080 RLC
|
#RLA 000000 8080 RLC
|
#RRA 000001 8080 RRC
|
#RRA 000001 8080 RRC
|
#RLCA 000010 8080 RAL
|
#RLCA 000010 8080 RAL
|
#RRCA 000011 8080 RAR
|
#RRCA 000011 8080 RAR
|
#T1 010111 T1
|
#T1 010111 T1
|
#RST 011111 8*IR(5..3), as per RST instruction
|
#RST 011111 8*IR(5..3), as per RST instruction
|
#DAA 101000 DAA T1 (but only after executing 2 in a row)
|
#DAA 101000 DAA T1 (but only after executing 2 in a row)
|
#CPC 101100 UNDEFINED (CY complemented)
|
#CPC 101100 UNDEFINED (CY complemented)
|
#SEC 101101 UNDEFINED (CY set)
|
#SEC 101101 UNDEFINED (CY set)
|
################################################################################
|
################################################################################
|
# Flags :
|
# Flags :
|
# --- Flags from group 1: use only one of these
|
# --- Flags from group 1: use only one of these
|
# #decode : Load address counter and IR with contents of data input lines,
|
# #decode : Load address counter and IR with contents of data input lines,
|
# thus starting opcode decoging.
|
# thus starting opcode decoging.
|
# #ei : Set interrupt enable register.
|
# #ei : Set interrupt enable register.
|
# #di : Reset interrupt enable register.
|
# #di : Reset interrupt enable register.
|
# #io : Activate io signal for 1st cycle.
|
# #io : Activate io signal for 1st cycle.
|
# #auxcy : Use aux carry instead of regular carry for this operation.
|
# #auxcy : Use aux carry instead of regular carry for this operation.
|
# #clrt1 : Clear T1 at the end of 1st cycle.
|
# #clrt1 : Clear T1 at the end of 1st cycle.
|
# #halt : Jump to microcode address 0x07 without saving return value.
|
# #halt : Jump to microcode address 0x07 without saving return value.
|
#
|
#
|
# --- Flags from group 2: use only one of these
|
# --- Flags from group 2: use only one of these
|
# #setacy : Set aux carry at the start of 1st cycle (used for ++).
|
# #setacy : Set aux carry at the start of 1st cycle (used for ++).
|
# #end : Jump to microinstruction address 3 after the present m.i.
|
# #end : Jump to microinstruction address 3 after the present m.i.
|
# #ret : Jump to address saved by the last JST or TJSR m.i.
|
# #ret : Jump to address saved by the last JST or TJSR m.i.
|
# #rd : Activate rd signal for the 2nd cycle.
|
# #rd : Activate rd signal for the 2nd cycle.
|
# #wr : Activate wr signal for the 2nd cycle.
|
# #wr : Activate wr signal for the 2nd cycle.
|
# --- Independent flags: no restrictions
|
# --- Independent flags: no restrictions
|
# #ld_al : Load AL register with register bank output as read by operation 1.
|
# #ld_al : Load AL register with register bank output as read by operation 1.
|
# (used in memory and io access).
|
# (used in memory and io access).
|
# #ld_addr : Load address register (H byte = register bank output as read by
|
# #ld_addr : Load address register (H byte = register bank output as read by
|
# operation 1, L byte = AL).
|
# operation 1, L byte = AL).
|
# Activate vma signal for 1st cycle.
|
# Activate vma signal for 1st cycle.
|
|
# #clr_acy : Instruction clears CY and AC flags. Use with #fp_rc.
|
# --- PSW update flags: use only one of these
|
# --- PSW update flags: use only one of these
|
# #fp_r : This instruction updates all PSW flags except for C.
|
# #fp_r : This instruction updates all PSW flags except for C.
|
# #fp_c : This instruction updates only the C flag in the PSW.
|
# #fp_c : This instruction updates only the C flag in the PSW.
|
# #fp_rc : This instruction updates all the flags in the PSW.
|
# #fp_rc : This instruction updates all the flags in the PSW.
|
################################################################################
|
################################################################################
|
# Read the design notes for a brief reference to the micromachine internal
|
# Read the design notes for a brief reference to the micromachine internal
|
# behavior, including implicit loads/erases.
|
# behavior, including implicit loads/erases.
|
################################################################################
|
################################################################################
|
|
|
$file = shift(@ARGV);
|
$file = shift(@ARGV);
|
|
|
open(INFO, $file) or die "unable to open file '$file'\n";
|
open(INFO, $file) or die "unable to open file '$file'\n";
|
@lines = <INFO>;
|
@lines = <INFO>;
|
close(INFO);
|
close(INFO);
|
|
|
$field2_nop = '0'.'0000'.'00'.'0'.'0'.'000000';
|
$field2_nop = '0'.'0000'.'00'.'0'.'0'.'000000';
|
$field2_jsr = '0'.'0000'.'00'.'0'.'0'.'000000';
|
$field2_jsr = '0'.'0000'.'00'.'0'.'0'.'000000';
|
|
|
%field1_ops =
|
%field1_ops =
|
( 'nop', '000'.'000'.'00000'.'00'.'0000'.$field2_nop,
|
( 'nop', '000'.'000'.'00000'.'00'.'0000'.$field2_nop,
|
'jsr', '000'.'010'.'00000'.'00'.'0000'.$field2_jsr,
|
'jsr', '000'.'010'.'00000'.'00'.'0000'.$field2_jsr,
|
'tjsr', '000'.'100'.'00000'.'00'.'0000'.$field2_jsr,
|
'tjsr', '000'.'100'.'00000'.'00'.'0000'.$field2_jsr,
|
|
|
't1 = {s}', '000'.'000'.'00101'.'01'.'0000'.$field2_nop,
|
't1 = {s}', '000'.'000'.'00101'.'01'.'0000'.$field2_nop,
|
't1 = {d}', '000'.'000'.'00101'.'10'.'0000'.$field2_nop,
|
't1 = {d}', '000'.'000'.'00101'.'10'.'0000'.$field2_nop,
|
't1 = {p}0', '000'.'000'.'00101'.'11'.'0000'.$field2_nop,
|
't1 = {p}0', '000'.'000'.'00101'.'11'.'0000'.$field2_nop,
|
't1 = {p}1', '000'.'000'.'00101'.'11'.'0001'.$field2_nop,
|
't1 = {p}1', '000'.'000'.'00101'.'11'.'0001'.$field2_nop,
|
't1 = di', '000'.'000'.'00100'.'00'.'0000'.$field2_nop,
|
't1 = di', '000'.'000'.'00100'.'00'.'0000'.$field2_nop,
|
't1 = _b', '000'.'000'.'00101'.'00'.'0000'.$field2_nop,
|
't1 = _b', '000'.'000'.'00101'.'00'.'0000'.$field2_nop,
|
't1 = _c', '000'.'000'.'00101'.'00'.'0001'.$field2_nop,
|
't1 = _c', '000'.'000'.'00101'.'00'.'0001'.$field2_nop,
|
't1 = _d', '000'.'000'.'00101'.'00'.'0010'.$field2_nop,
|
't1 = _d', '000'.'000'.'00101'.'00'.'0010'.$field2_nop,
|
't1 = _e', '000'.'000'.'00101'.'00'.'0011'.$field2_nop,
|
't1 = _e', '000'.'000'.'00101'.'00'.'0011'.$field2_nop,
|
't1 = _h', '000'.'000'.'00101'.'00'.'0100'.$field2_nop,
|
't1 = _h', '000'.'000'.'00101'.'00'.'0100'.$field2_nop,
|
't1 = _l', '000'.'000'.'00101'.'00'.'0101'.$field2_nop,
|
't1 = _l', '000'.'000'.'00101'.'00'.'0101'.$field2_nop,
|
't1 = _a', '000'.'000'.'00101'.'00'.'0111'.$field2_nop,
|
't1 = _a', '000'.'000'.'00101'.'00'.'0111'.$field2_nop,
|
't1 = _f', '000'.'000'.'00101'.'00'.'0110'.$field2_nop,
|
't1 = _f', '000'.'000'.'00101'.'00'.'0110'.$field2_nop,
|
't1 = _ph', '000'.'000'.'00101'.'00'.'1000'.$field2_nop,
|
't1 = _ph', '000'.'000'.'00101'.'00'.'1000'.$field2_nop,
|
't1 = _pl', '000'.'000'.'00101'.'00'.'1001'.$field2_nop,
|
't1 = _pl', '000'.'000'.'00101'.'00'.'1001'.$field2_nop,
|
't1 = _x', '000'.'000'.'00101'.'00'.'1010'.$field2_nop,
|
't1 = _x', '000'.'000'.'00101'.'00'.'1010'.$field2_nop,
|
't1 = _y', '000'.'000'.'00101'.'00'.'1011'.$field2_nop,
|
't1 = _y', '000'.'000'.'00101'.'00'.'1011'.$field2_nop,
|
't1 = _z', '000'.'000'.'00101'.'00'.'1100'.$field2_nop,
|
't1 = _z', '000'.'000'.'00101'.'00'.'1100'.$field2_nop,
|
't1 = _w', '000'.'000'.'00101'.'00'.'1101'.$field2_nop,
|
't1 = _w', '000'.'000'.'00101'.'00'.'1101'.$field2_nop,
|
't1 = _sh', '000'.'000'.'00101'.'00'.'1110'.$field2_nop,
|
't1 = _sh', '000'.'000'.'00101'.'00'.'1110'.$field2_nop,
|
't1 = _sl', '000'.'000'.'00101'.'00'.'1111'.$field2_nop,
|
't1 = _sl', '000'.'000'.'00101'.'00'.'1111'.$field2_nop,
|
|
|
't2 = {s}', '000'.'000'.'00011'.'01'.'0000'.$field2_nop,
|
't2 = {s}', '000'.'000'.'00011'.'01'.'0000'.$field2_nop,
|
't2 = {d}', '000'.'000'.'00011'.'10'.'0000'.$field2_nop,
|
't2 = {d}', '000'.'000'.'00011'.'10'.'0000'.$field2_nop,
|
't2 = {p}0', '000'.'000'.'00011'.'11'.'0000'.$field2_nop,
|
't2 = {p}0', '000'.'000'.'00011'.'11'.'0000'.$field2_nop,
|
't2 = {p}1', '000'.'000'.'00011'.'11'.'0001'.$field2_nop,
|
't2 = {p}1', '000'.'000'.'00011'.'11'.'0001'.$field2_nop,
|
't2 = di', '000'.'000'.'00010'.'00'.'0000'.$field2_nop,
|
't2 = di', '000'.'000'.'00010'.'00'.'0000'.$field2_nop,
|
't2 = _b', '000'.'000'.'00011'.'00'.'0000'.$field2_nop,
|
't2 = _b', '000'.'000'.'00011'.'00'.'0000'.$field2_nop,
|
't2 = _c', '000'.'000'.'00011'.'00'.'0001'.$field2_nop,
|
't2 = _c', '000'.'000'.'00011'.'00'.'0001'.$field2_nop,
|
't2 = _d', '000'.'000'.'00011'.'00'.'0010'.$field2_nop,
|
't2 = _d', '000'.'000'.'00011'.'00'.'0010'.$field2_nop,
|
't2 = _e', '000'.'000'.'00011'.'00'.'0011'.$field2_nop,
|
't2 = _e', '000'.'000'.'00011'.'00'.'0011'.$field2_nop,
|
't2 = _h', '000'.'000'.'00011'.'00'.'0100'.$field2_nop,
|
't2 = _h', '000'.'000'.'00011'.'00'.'0100'.$field2_nop,
|
't2 = _l', '000'.'000'.'00011'.'00'.'0101'.$field2_nop,
|
't2 = _l', '000'.'000'.'00011'.'00'.'0101'.$field2_nop,
|
't2 = _a', '000'.'000'.'00011'.'00'.'0111'.$field2_nop,
|
't2 = _a', '000'.'000'.'00011'.'00'.'0111'.$field2_nop,
|
't2 = _f', '000'.'000'.'00011'.'00'.'0110'.$field2_nop,
|
't2 = _f', '000'.'000'.'00011'.'00'.'0110'.$field2_nop,
|
't2 = _ph', '000'.'000'.'00011'.'00'.'1000'.$field2_nop,
|
't2 = _ph', '000'.'000'.'00011'.'00'.'1000'.$field2_nop,
|
't2 = _pl', '000'.'000'.'00011'.'00'.'1001'.$field2_nop,
|
't2 = _pl', '000'.'000'.'00011'.'00'.'1001'.$field2_nop,
|
't2 = _x', '000'.'000'.'00011'.'00'.'1010'.$field2_nop,
|
't2 = _x', '000'.'000'.'00011'.'00'.'1010'.$field2_nop,
|
't2 = _y', '000'.'000'.'00011'.'00'.'1011'.$field2_nop,
|
't2 = _y', '000'.'000'.'00011'.'00'.'1011'.$field2_nop,
|
't2 = _z', '000'.'000'.'00011'.'00'.'1100'.$field2_nop,
|
't2 = _z', '000'.'000'.'00011'.'00'.'1100'.$field2_nop,
|
't2 = _w', '000'.'000'.'00011'.'00'.'1101'.$field2_nop,
|
't2 = _w', '000'.'000'.'00011'.'00'.'1101'.$field2_nop,
|
't2 = _sh', '000'.'000'.'00011'.'00'.'1110'.$field2_nop,
|
't2 = _sh', '000'.'000'.'00011'.'00'.'1110'.$field2_nop,
|
't2 = _sl', '000'.'000'.'00011'.'00'.'1111'.$field2_nop
|
't2 = _sl', '000'.'000'.'00011'.'00'.'1111'.$field2_nop
|
|
|
);
|
);
|
|
|
|
|
$re_field1 = "(".join('|',keys %field1_ops).")";
|
$re_field1 = "(".join('|',keys %field1_ops).")";
|
$re_field1 =~ s/\[/\\\[/g;
|
$re_field1 =~ s/\[/\\\[/g;
|
$re_field1 =~ s/\]/\\\]/g;
|
$re_field1 =~ s/\]/\\\]/g;
|
|
|
%field2_ops =
|
%field2_ops =
|
( 'add', '001100',
|
( 'add', '001100',
|
'adc', '001101',
|
'adc', '001101',
|
'sub', '001110',
|
'sub', '001110',
|
'sbb', '001111',
|
'sbb', '001111',
|
|
|
'and', '000100',
|
'and', '000100',
|
'orl', '000110',
|
'orl', '000110',
|
'not', '000111',
|
'not', '000111',
|
'xrl', '000101',
|
'xrl', '000101',
|
|
|
'rla', '000000',
|
'rla', '000000',
|
'rra', '000001',
|
'rra', '000001',
|
'rlca', '000010',
|
'rlca', '000010',
|
'rrca', '000011',
|
'rrca', '000011',
|
|
|
'aaa', '111000',
|
'aaa', '111000',
|
|
|
't1', '010111',
|
't1', '010111',
|
'rst', '011111',
|
'rst', '011111',
|
'daa', '101000',
|
'daa', '101000',
|
'cpc', '101100',
|
'cpc', '101100',
|
'sec', '101101',
|
'sec', '101101',
|
'psw', '110000'
|
'psw', '110000'
|
);
|
);
|
|
|
|
|
$re_f2_ops = "(".join('|',keys %field2_ops).")";
|
$re_f2_ops = "(".join('|',keys %field2_ops).")";
|
$re_f2_ops =~ s/\[/\\\[/g;
|
$re_f2_ops =~ s/\[/\\\[/g;
|
$re_f2_ops =~ s/\]/\\\]/g;
|
$re_f2_ops =~ s/\]/\\\]/g;
|
|
|
# 'parse' command line flags into a string
|
# 'parse' command line flags into a string
|
$cmdline = join ':', @ARGV;
|
$cmdline = join ':', @ARGV;
|
|
|
$num_line = 0;
|
$num_line = 0;
|
$addr = 0;
|
$addr = 0;
|
|
|
%labels = (); # <label, address>
|
%labels = (); # <label, address>
|
@label_uses = (); # <label, [addresses in which it's used]>
|
@label_uses = (); # <label, [addresses in which it's used]>
|
@undefined_targets = (); # array of <label, address in which it's used>
|
@undefined_targets = (); # array of <label, address in which it's used>
|
$num_errors = 0;
|
$num_errors = 0;
|
|
|
@bitfields = ();
|
@bitfields = ();
|
|
|
@rom = ();
|
@rom = ();
|
@asm = ();
|
@asm = ();
|
@errors = ();
|
@errors = ();
|
@num_lines = ();
|
@num_lines = ();
|
|
|
%asm_to_uaddr = (); # opcode asm -> uaddress
|
%asm_to_uaddr = (); # opcode asm -> uaddress
|
%uaddr_to_asm = (); # uaddress -> opcode asm
|
%uaddr_to_asm = (); # uaddress -> opcode asm
|
|
|
%uaddr_to_pattern = (); # uaddress -> pattern
|
%uaddr_to_pattern = (); # uaddress -> pattern
|
%pattern_to_uaddr = (); # pattern -> uaddress -- simulation, decoder
|
%pattern_to_uaddr = (); # pattern -> uaddress -- simulation, decoder
|
|
|
LINE: foreach $line (@lines) {
|
LINE: foreach $line (@lines) {
|
|
|
$num_line++;
|
$num_line++;
|
|
|
$line =~ tr/A-Z/a-z/;
|
$line =~ tr/A-Z/a-z/;
|
$line =~ s/(--|\/\/).*//;
|
$line =~ s/(--|\/\/).*//;
|
$line =~ s/^\s*//g;
|
$line =~ s/^\s*//g;
|
$line =~ s/\s*\$//g;
|
$line =~ s/\s*\$//g;
|
chomp($line);
|
chomp($line);
|
|
|
$uinst = {
|
$uinst = {
|
field_1 => '',
|
field_1 => '',
|
src => '',
|
src => '',
|
special => '',
|
special => '',
|
field_2 => '',
|
field_2 => '',
|
field_0 => '000000',
|
field_0 => '000000',
|
flags => '',
|
flags => '',
|
error => '',
|
error => '',
|
asm => $line
|
asm => $line
|
};
|
};
|
|
|
|
|
# if line is whitespace or comment (which has been changed to whitespace)
|
# if line is whitespace or comment (which has been changed to whitespace)
|
# then skip to next line
|
# then skip to next line
|
if($line eq ''){
|
if($line eq ''){
|
next;
|
next;
|
}
|
}
|
|
|
# if $line is a label declaration, get it and skip to next line
|
# if $line is a label declaration, get it and skip to next line
|
# note labels come alone in the line, unlike other assemblers
|
# note labels come alone in the line, unlike other assemblers
|
# TODO it'd be simple to change this...
|
# TODO it'd be simple to change this...
|
if($line =~ /^\s*:(\w+)/){
|
if($line =~ /^\s*:(\w+)/){
|
# subroutine label (labels are only used for jsrs)
|
# subroutine label (labels are only used for jsrs)
|
$labels{$1} = $addr;
|
$labels{$1} = $addr;
|
next;
|
next;
|
}
|
}
|
|
|
# if line is a pragma, process it
|
# if line is a pragma, process it
|
if($line =~ /^\s*__/){
|
if($line =~ /^\s*__/){
|
# TODO process pragmas __reset, __fetch, __int
|
# TODO process pragmas __reset, __fetch, __int
|
|
|
#if($line =~ /^\s*__code\s+"([0|1|s|d|p|a|r]+)"/){
|
#if($line =~ /^\s*__code\s+"([0|1|s|d|p|a|r]+)"/){
|
# we do nothing with the opcode byte; it's for reference only
|
# we do nothing with the opcode byte; it's for reference only
|
#printf "%04d # %s\n",$addr,$1;
|
#printf "%04d # %s\n",$addr,$1;
|
#}
|
#}
|
if($line =~ /^\s*__asm\s+(.*)/){
|
if($line =~ /^\s*__asm\s+(.*)/){
|
# save the start address for the CPU instruction
|
# save the start address for the CPU instruction
|
# it will be used in the design of the decoder
|
# it will be used in the design of the decoder
|
$asm_to_uaddr{$1} = $addr;
|
$asm_to_uaddr{$1} = $addr;
|
$uaddr_to_asm{$addr} = $1;
|
$uaddr_to_asm{$addr} = $1;
|
}
|
}
|
|
|
if($line =~ /^\s*__code\s+"(.*)".*/){
|
if($line =~ /^\s*__code\s+"(.*)".*/){
|
# save the start address for the CPU instruction
|
# save the start address for the CPU instruction
|
# it will be used in the design of the decoder
|
# it will be used in the design of the decoder
|
$pattern_to_uaddr{$1} = $addr;
|
$pattern_to_uaddr{$1} = $addr;
|
$uaddr_to_pattern{$addr} = $1;
|
$uaddr_to_pattern{$addr} = $1;
|
}
|
}
|
|
|
|
|
next;
|
next;
|
}
|
}
|
|
|
# get flags field (all text following 1st '#' included)
|
# get flags field (all text following 1st '#' included)
|
# remove it so we're left with 'field1 ; field2 [;]'
|
# remove it so we're left with 'field1 ; field2 [;]'
|
$line = process_flags($line);
|
$line = process_flags($line);
|
|
|
# break line in 1 or 2 fields
|
# break line in 1 or 2 fields
|
@fields = split /;/, $line;
|
@fields = split /;/, $line;
|
|
|
# process 1st field...
|
# process 1st field...
|
$done = process_field1($fields[0]);
|
$done = process_field1($fields[0]);
|
|
|
# ...and process 2nd field if there is one (depends on field1 format)
|
# ...and process 2nd field if there is one (depends on field1 format)
|
# TODO check that there's no field2 when there shouldn't
|
# TODO check that there's no field2 when there shouldn't
|
if($done != 1){
|
if($done != 1){
|
$done = process_field2($fields[1]);
|
$done = process_field2($fields[1]);
|
}
|
}
|
|
|
# finally, process extra flags produced by field1 assembly (jsr/tjsr)
|
# finally, process extra flags produced by field1 assembly (jsr/tjsr)
|
process_extra_flags();
|
process_extra_flags();
|
|
|
# complete bitfield with flags...
|
# complete bitfield with flags...
|
substr($uinst->{field1}, 0, 6) = $uinst->{field_0};
|
substr($uinst->{field1}, 0, 6) = $uinst->{field_0};
|
|
|
# Now, we already have the bitfields.
|
# Now, we already have the bitfields.
|
|
|
push(@rom, $uinst->{field1});
|
push(@rom, $uinst->{field1});
|
push(@asm, substr($line,0,40));
|
push(@asm, substr($line,0,40));
|
push(@num_lines, $num_line);
|
push(@num_lines, $num_line);
|
if($uinst->{error} eq ''){
|
if($uinst->{error} eq ''){
|
push(@errors, '');
|
push(@errors, '');
|
}
|
}
|
else{
|
else{
|
push(@errors, $uinst->{error});
|
push(@errors, $uinst->{error});
|
}
|
}
|
|
|
$addr++; #addr++ even for error uinsts
|
$addr++; #addr++ even for error uinsts
|
|
|
}
|
}
|
continue {
|
continue {
|
}
|
}
|
|
|
# Line processing finished (1st pass). Start 2nd pass and do listings
|
# Line processing finished (1st pass). Start 2nd pass and do listings
|
# if requested
|
# if requested
|
|
|
# 2nd pass
|
# 2nd pass
|
|
|
# now we know the value of all labels, fill in address field of forward jumps
|
# now we know the value of all labels, fill in address field of forward jumps
|
foreach $target (@undefined_targets){
|
foreach $target (@undefined_targets){
|
@item = @{$target};
|
@item = @{$target};
|
$value = to_bin($labels{$item[0]}, 8);
|
$value = to_bin($labels{$item[0]}, 8);
|
$adr = $item[1]*1;
|
$adr = $item[1]*1;
|
|
|
substr($rom[$adr], 20,2, substr($value, 0,2));
|
substr($rom[$adr], 20,2, substr($value, 0,2));
|
substr($rom[$adr], 26,6, substr($value, 2,6));
|
substr($rom[$adr], 26,6, substr($value, 2,6));
|
}
|
}
|
|
|
foreach $bf (@rom){
|
foreach $bf (@rom){
|
push(@bitfields, $bf);
|
push(@bitfields, $bf);
|
}
|
}
|
|
|
# listings
|
# listings
|
|
|
if($cmdline =~ /-lst/){
|
if($cmdline =~ /-lst/){
|
$do_lst = 1;
|
$do_lst = 1;
|
}
|
}
|
|
|
$i = 0;
|
$i = 0;
|
foreach $bf (@rom){
|
foreach $bf (@rom){
|
if($do_lst){
|
if($do_lst){
|
printf "%02x %32s :: %s\n", $i, $bf, $asm[$i];
|
printf "%02x %32s :: %s\n", $i, $bf, $asm[$i];
|
if($errors[$i] ne ''){
|
if($errors[$i] ne ''){
|
printf " ERROR (%d): %s\n", $num_lines[$i], $errors[$i];
|
printf " ERROR (%d): %s\n", $num_lines[$i], $errors[$i];
|
}
|
}
|
}
|
}
|
|
|
$i++;
|
$i++;
|
}
|
}
|
|
|
if($do_lst){
|
if($do_lst){
|
# completion message
|
# completion message
|
printf "\nDone. %d uinsts, %d errors.\n", $addr, $num_errors;
|
printf "\nDone. %d uinsts, %d errors.\n", $addr, $num_errors;
|
}
|
}
|
|
|
# label listing
|
# label listing
|
if($cmdline =~ /\-labels/){
|
if($cmdline =~ /\-labels/){
|
label_list();
|
label_list();
|
}
|
}
|
|
|
# bitfield histogram
|
# bitfield histogram
|
if($cmdline =~ /\-bitfields/){
|
if($cmdline =~ /\-bitfields/){
|
bitfield_histogram();
|
bitfield_histogram();
|
}
|
}
|
|
|
# show cpu instruction microcode addresses
|
# show cpu instruction microcode addresses
|
if($cmdline =~ /\-instructions/){
|
if($cmdline =~ /\-instructions/){
|
foreach $asm (sort {$asm_to_uaddr{$a} <=> $asm_to_uaddr{$b}}(keys %asm_to_uaddr)){
|
foreach $asm (sort {$asm_to_uaddr{$a} <=> $asm_to_uaddr{$b}}(keys %asm_to_uaddr)){
|
$uaddress = $asm_to_uaddr{$asm};
|
$uaddress = $asm_to_uaddr{$asm};
|
printf "%02x %s %s\n", $uaddress, $uaddr_to_pattern{$uaddress}, $asm;
|
printf "%02x %s %s\n", $uaddress, $uaddr_to_pattern{$uaddress}, $asm;
|
}
|
}
|
}
|
}
|
|
|
if($cmdline =~ /\-rom_vhdl/){
|
if($cmdline =~ /\-rom_vhdl/){
|
show_decoder_table('vhdl');
|
show_decoder_table('vhdl');
|
}
|
}
|
|
|
if($cmdline =~ /\-rom_bin/){
|
if($cmdline =~ /\-rom_bin/){
|
show_decoder_table('bin');
|
show_decoder_table('bin');
|
}
|
}
|
|
|
# end of main program
|
# end of main program
|
|
|
|
|
################################################################################
|
################################################################################
|
|
|
|
|
sub show_decoder_table {
|
sub show_decoder_table {
|
|
|
my $fmat = shift(@_);
|
my $fmat = shift(@_);
|
|
|
# show decoder rom contents
|
# show decoder rom contents
|
%decoder_hash = ();
|
%decoder_hash = ();
|
foreach $pat (keys %pattern_to_uaddr){
|
foreach $pat (keys %pattern_to_uaddr){
|
$add = $pattern_to_uaddr{$pat};
|
$add = $pattern_to_uaddr{$pat};
|
$pat =~ s/[a-z]/\[01\]/g;
|
$pat =~ s/[a-z]/\[01\]/g;
|
$decoder_hash{$pat} = $add;
|
$decoder_hash{$pat} = $add;
|
}
|
}
|
|
|
@decoder_rom = ();
|
@decoder_rom = ();
|
for($i = 0; $i<256; $i++){
|
for($i = 0; $i<256; $i++){
|
$b = to_bin($i, 8);
|
$b = to_bin($i, 8);
|
$val = 0;
|
$val = 0;
|
# We'll match the opcode to the pattern with the shortest length; that is,
|
# We'll match the opcode to the pattern with the shortest length; that is,
|
# the one with the less wildcards in it. Crude but effective in this case.
|
# the one with the less wildcards in it. Crude but effective in this case.
|
$len_matched_pat = 1000;
|
$len_matched_pat = 1000;
|
foreach $pat (keys %decoder_hash){
|
foreach $pat (keys %decoder_hash){
|
if($b =~ /$pat/){
|
if($b =~ /$pat/){
|
if(length($pat) < $len_matched_pat){
|
if(length($pat) < $len_matched_pat){
|
$val = $decoder_hash{$pat};
|
$val = $decoder_hash{$pat};
|
$len_matched_pat = length($pat);
|
$len_matched_pat = length($pat);
|
}
|
}
|
#last;
|
#last;
|
}
|
}
|
}
|
}
|
push @decoder_rom, $val;
|
push @decoder_rom, $val;
|
}
|
}
|
|
|
if($fmat eq 'vhdl'){
|
if($fmat eq 'vhdl'){
|
# print rom vhdl header...
|
# print rom vhdl header...
|
print "type t_rom is array (0 to 511) of std_logic_vector(31 downto 0);\n";
|
print "type t_rom is array (0 to 511) of std_logic_vector(31 downto 0);\n";
|
print "signal rom : t_rom := (\n";
|
print "signal rom : t_rom := (\n";
|
}
|
}
|
|
|
# The 1st half of the uinst rom holds 256 uinstructions
|
# The 1st half of the uinst rom holds 256 uinstructions
|
my $i=0;
|
my $i=0;
|
foreach $bf (@rom){
|
foreach $bf (@rom){
|
if($fmat eq 'vhdl'){
|
if($fmat eq 'vhdl'){
|
printf "\"%s\", -- %03x\n", $bf, $i;
|
printf "\"%s\", -- %03x\n", $bf, $i;
|
}
|
}
|
else{
|
else{
|
printf "%s\n", $bf;
|
printf "%s\n", $bf;
|
}
|
}
|
$i++;
|
$i++;
|
}
|
}
|
# Fill remaining slots with ENDs
|
# Fill remaining slots with ENDs
|
for(;$i<256;$i++){
|
for(;$i<256;$i++){
|
my $val = '00000100000000000000000000000000';
|
my $val = '00000100000000000000000000000000';
|
if($fmat eq 'vhdl'){
|
if($fmat eq 'vhdl'){
|
printf "\"%s\", -- %03x\n", $val, $i;
|
printf "\"%s\", -- %03x\n", $val, $i;
|
}
|
}
|
else{
|
else{
|
printf "%s\n", $val;
|
printf "%s\n", $val;
|
}
|
}
|
}
|
}
|
|
|
# The 2nd half (upper 256 entries) of the ucode rom contains a jump table
|
# The 2nd half (upper 256 entries) of the ucode rom contains a jump table
|
# with a jsr for each of the 256 opcodes, serving as cheap decoder:
|
# with a jsr for each of the 256 opcodes, serving as cheap decoder:
|
foreach $entry (@decoder_rom){
|
foreach $entry (@decoder_rom){
|
my $val = to_bin($entry, 8);
|
my $val = to_bin($entry, 8);
|
$val = '00001000000000000000'.substr($val,0,2).'0000'.substr($val,2,6);
|
$val = '00001000000000000000'.substr($val,0,2).'0000'.substr($val,2,6);
|
$i++;
|
$i++;
|
if($fmat eq 'vhdl'){
|
if($fmat eq 'vhdl'){
|
printf "\"%s\"", $val;
|
printf "\"%s\"", $val;
|
if($i<512){
|
if($i<512){
|
print ",";
|
print ",";
|
}
|
}
|
else{
|
else{
|
print " ";
|
print " ";
|
}
|
}
|
printf " -- %03x\n", ($i - 1);
|
printf " -- %03x\n", ($i - 1);
|
}
|
}
|
else{
|
else{
|
printf "%s\n", $val;
|
printf "%s\n", $val;
|
}
|
}
|
}
|
}
|
|
|
if($fmat eq 'vhdl'){
|
if($fmat eq 'vhdl'){
|
# close vhdl declaration
|
# close vhdl declaration
|
print "\n);\n";
|
print "\n);\n";
|
}
|
}
|
|
|
}
|
}
|
|
|
sub label_list {
|
sub label_list {
|
# label table listing
|
# label table listing
|
print "\nlabels:\n";
|
print "\nlabels:\n";
|
print "---------------------------------\n";
|
print "---------------------------------\n";
|
print "label addr uses\n";
|
print "label addr uses\n";
|
print "---------------------------------\n";
|
print "---------------------------------\n";
|
|
|
%hist_labels;
|
%hist_labels;
|
$hist_labels{$_}++ for @label_uses;
|
$hist_labels{$_}++ for @label_uses;
|
|
|
foreach $label (keys %hist_labels){
|
foreach $label (keys %hist_labels){
|
printf "%-20s %04x %d\n", $label, $labels{$label}, $hist_labels{$label};
|
printf "%-20s %04x %d\n", $label, $labels{$label}, $hist_labels{$label};
|
}
|
}
|
}
|
}
|
|
|
sub bitfield_histogram {
|
sub bitfield_histogram {
|
|
|
%hist_bitfields;
|
%hist_bitfields;
|
$hist_bitfields{$_}++ for @bitfields;
|
$hist_bitfields{$_}++ for @bitfields;
|
@unique_bitfields = keys %hist_bitfields;
|
@unique_bitfields = keys %hist_bitfields;
|
|
|
printf "\nbitfield usage (total: %d)\n", $#unique_bitfields;
|
printf "\nbitfield usage (total: %d)\n", $#unique_bitfields;
|
print "------------------------------------------------\n";
|
print "------------------------------------------------\n";
|
print "bitfield uses\n";
|
print "bitfield uses\n";
|
print "------------------------------------------------\n";
|
print "------------------------------------------------\n";
|
|
|
foreach $bfield (sort sortFieldsByFrequency(keys %hist_bitfields)){
|
foreach $bfield (sort sortFieldsByFrequency(keys %hist_bitfields)){
|
printf "%-32s %d\n", $bfield, $hist_bitfields{$bfield};
|
printf "%-32s %d\n", $bfield, $hist_bitfields{$bfield};
|
}
|
}
|
}
|
}
|
|
|
sub sortFieldsByFrequency {
|
sub sortFieldsByFrequency {
|
$hist_bitfields{$b} <=> $hist_bitfields{$a};
|
$hist_bitfields{$b} <=> $hist_bitfields{$a};
|
}
|
}
|
|
|
sub process_extra_flags {
|
sub process_extra_flags {
|
|
|
$flags1 = '';
|
$flags1 = '';
|
$flags2 = '';
|
$flags2 = '';
|
|
|
|
|
# first, process flags produced by 1st field processing
|
# first, process flags produced by 1st field processing
|
if($uinst->{flags} =~ /#jsr/){
|
if($uinst->{flags} =~ /#jsr/){
|
if($flags2 ne ''){$error = 'incompatible flags'};
|
if($flags2 ne ''){$error = 'incompatible flags'};
|
$flags2 = '010';
|
$flags2 = '010';
|
}
|
}
|
if($uinst->{flags} =~ /#tjsr/){
|
if($uinst->{flags} =~ /#tjsr/){
|
if($flags2 ne ''){$error = 'incompatible flags'};
|
if($flags2 ne ''){$error = 'incompatible flags'};
|
$flags2 = '100';
|
$flags2 = '100';
|
}
|
}
|
|
|
$provisional_flags2 = substr($uinst->{field_0},3,3);
|
$provisional_flags2 = substr($uinst->{field_0},3,3);
|
if($flags2 ne ''){
|
if($flags2 ne ''){
|
if($provisional_flags2 ne '000'){
|
if($provisional_flags2 ne '000'){
|
$error = "flags incompatible with jsr/tjsr operation: "
|
$error = "flags incompatible with jsr/tjsr operation: "
|
.$provisional_flags2;
|
.$provisional_flags2;
|
$num_errors++;
|
$num_errors++;
|
$uinst->{error} = $error;
|
$uinst->{error} = $error;
|
}
|
}
|
else{
|
else{
|
substr($uinst->{field_0},3,3) = $flags2;
|
substr($uinst->{field_0},3,3) = $flags2;
|
}
|
}
|
}
|
}
|
|
|
if($uinst->{flags} =~ /#ld_al/){
|
if($uinst->{flags} =~ /#ld_al/){
|
substr($uinst->{field1},7,1) = '1';
|
substr($uinst->{field1},7,1) = '1';
|
}
|
}
|
if($uinst->{flags} =~ /#ld_addr/){
|
if($uinst->{flags} =~ /#ld_addr/){
|
substr($uinst->{field1},6,1) = '1';
|
substr($uinst->{field1},6,1) = '1';
|
}
|
}
|
|
|
if($uinst->{flags} =~ /#fp_c/){
|
if($uinst->{flags} =~ /#fp_c/){
|
substr($uinst->{field1},22,2) = '01';
|
substr($uinst->{field1},22,2) = '01';
|
}
|
}
|
if($uinst->{flags} =~ /#fp_r/){
|
if($uinst->{flags} =~ /#fp_r/){
|
substr($uinst->{field1},22,2) = '10';
|
substr($uinst->{field1},22,2) = '10';
|
}
|
}
|
if($uinst->{flags} =~ /#fp_rc/){
|
if($uinst->{flags} =~ /#fp_rc/){
|
substr($uinst->{field1},22,2) = '11';
|
substr($uinst->{field1},22,2) = '11';
|
}
|
}
|
|
if($uinst->{flags} =~ /#clr_acy/){
|
|
substr($uinst->{field1},17,1) = '1';
|
|
}
|
|
|
}
|
}
|
|
|
sub process_flags {
|
sub process_flags {
|
|
|
my $line = shift(@_);
|
my $line = shift(@_);
|
|
|
$line =~ s/#/##/;
|
$line =~ s/#/##/;
|
$line =~ /(.*)#(#.*)/;
|
$line =~ /(.*)#(#.*)/;
|
|
|
$flags1 = '';
|
$flags1 = '';
|
$flags2 = '';
|
$flags2 = '';
|
|
|
|
|
if($1 ne ''){
|
if($1 ne ''){
|
$line_without_flags = $1;
|
$line_without_flags = $1;
|
$flag_str = $2;
|
$flag_str = $2;
|
|
|
@flags = split /,/, $flag_str;
|
@flags = split /,/, $flag_str;
|
$error = '';
|
$error = '';
|
|
|
if($flag_str =~ /#end/){
|
if($flag_str =~ /#end/){
|
if($flags2 ne ''){$error = 'incompatible flags'};
|
if($flags2 ne ''){$error = 'incompatible flags'};
|
$flags2 = '001';
|
$flags2 = '001';
|
}
|
}
|
if($flag_str =~ /#ret/){
|
if($flag_str =~ /#ret/){
|
if($flags2 ne ''){$error = 'incompatible flags'};
|
if($flags2 ne ''){$error = 'incompatible flags'};
|
$flags2 = '011';
|
$flags2 = '011';
|
}
|
}
|
if($flag_str =~ /#rd/){
|
if($flag_str =~ /#rd/){
|
if($flags2 ne ''){$error = 'incompatible flags'};
|
if($flags2 ne ''){$error = 'incompatible flags'};
|
$flags2 = '101';
|
$flags2 = '101';
|
}
|
}
|
if($flag_str =~ /#wr/){
|
if($flag_str =~ /#wr/){
|
if($flags2 ne ''){$error = 'incompatible flags'};
|
if($flags2 ne ''){$error = 'incompatible flags'};
|
$flags2 = '110';
|
$flags2 = '110';
|
}
|
}
|
if($flag_str =~ /#auxcy/){
|
if($flag_str =~ /#auxcy/){
|
if($flags1 ne ''){$error = 'incompatible flags'};
|
if($flags1 ne ''){$error = 'incompatible flags'};
|
$flags1 = '101';
|
$flags1 = '101';
|
}
|
}
|
|
|
if($flag_str =~ /#decode/){
|
if($flag_str =~ /#decode/){
|
if($flags1 ne ''){$error = 'incompatible flags'};
|
if($flags1 ne ''){$error = 'incompatible flags'};
|
$flags1 = '001';
|
$flags1 = '001';
|
}
|
}
|
if($flag_str =~ /#clrt1/){
|
if($flag_str =~ /#clrt1/){
|
if($flags1 ne ''){$error = 'incompatible flags'};
|
if($flags1 ne ''){$error = 'incompatible flags'};
|
$flags1 = '110';
|
$flags1 = '110';
|
}
|
}
|
if($flag_str =~ /#halt/){
|
if($flag_str =~ /#halt/){
|
if($flags1 ne ''){$error = 'incompatible flags'};
|
if($flags1 ne ''){$error = 'incompatible flags'};
|
$flags1 = '111';
|
$flags1 = '111';
|
}
|
}
|
if($flag_str =~ /#di/){
|
if($flag_str =~ /#di/){
|
if($flags1 ne ''){$error = 'incompatible flags'};
|
if($flags1 ne ''){$error = 'incompatible flags'};
|
$flags1 = '010';
|
$flags1 = '010';
|
}
|
}
|
if($flag_str =~ /#ei/){
|
if($flag_str =~ /#ei/){
|
if($flags1 ne ''){$error = 'incompatible flags'};
|
if($flags1 ne ''){$error = 'incompatible flags'};
|
$flags1 = '011';
|
$flags1 = '011';
|
}
|
}
|
if($flag_str =~ /#io/){
|
if($flag_str =~ /#io/){
|
if($flags1 ne ''){$error = 'incompatible flags'};
|
if($flags1 ne ''){$error = 'incompatible flags'};
|
$flags1 = '100';
|
$flags1 = '100';
|
}
|
}
|
if($flag_str =~ /#setacy/){
|
if($flag_str =~ /#setacy/){
|
if($flags2 ne ''){$error = 'incompatible flags:'.$flags2};
|
if($flags2 ne ''){$error = 'incompatible flags:'.$flags2};
|
$flags2 = '111';
|
$flags2 = '111';
|
}
|
}
|
|
|
if($flags2 eq ''){ $flags2 = '000';};
|
if($flags2 eq ''){ $flags2 = '000';};
|
if($flags1 eq ''){ $flags1 = '000';};
|
if($flags1 eq ''){ $flags1 = '000';};
|
|
|
$uinst->{field_0} = $flags1.$flags2;
|
$uinst->{field_0} = $flags1.$flags2;
|
|
|
# Some of the flags must be processed after the rest of the uinst
|
# Some of the flags must be processed after the rest of the uinst
|
# has been assembled; save them into $uinst->{flags} for later.
|
# has been assembled; save them into $uinst->{flags} for later.
|
|
|
if($flag_str =~ /#ld_al/){
|
if($flag_str =~ /#ld_al/){
|
$uinst->{flags} = $uinst->{flags}." #ld_al";
|
$uinst->{flags} = $uinst->{flags}." #ld_al";
|
}
|
}
|
if($flag_str =~ /#ld_addr/){
|
if($flag_str =~ /#ld_addr/){
|
$uinst->{flags} = $uinst->{flags}." #ld_addr";
|
$uinst->{flags} = $uinst->{flags}." #ld_addr";
|
}
|
}
|
if($flag_str =~ /#fp_c/){
|
if($flag_str =~ /#fp_c/){
|
$uinst->{flags} = $uinst->{flags}." #fp_c";
|
$uinst->{flags} = $uinst->{flags}." #fp_c";
|
}
|
}
|
if($flag_str =~ /#fp_r/){
|
if($flag_str =~ /#fp_r/){
|
$uinst->{flags} = $uinst->{flags}." #fp_r";
|
$uinst->{flags} = $uinst->{flags}." #fp_r";
|
}
|
}
|
if($flag_str =~ /#fp_rc/){
|
if($flag_str =~ /#fp_rc/){
|
$uinst->{flags} = $uinst->{flags}." #fp_rc";
|
$uinst->{flags} = $uinst->{flags}." #fp_rc";
|
}
|
}
|
|
if($flag_str =~ /#clr_acy/){
|
|
$uinst->{flags} = $uinst->{flags}." #clr_acy";
|
|
}
|
|
|
if($error ne ''){
|
if($error ne ''){
|
$num_errors++;
|
$num_errors++;
|
$uinst->{error} = $error;
|
$uinst->{error} = $error;
|
};
|
};
|
|
|
return $line_without_flags;
|
return $line_without_flags;
|
}
|
}
|
|
|
return $line;
|
return $line;
|
}
|
}
|
|
|
|
|
sub process_field2 {
|
sub process_field2 {
|
my $field = shift(@_).";";
|
my $field = shift(@_).";";
|
|
|
$field =~ s/^\s*//g;
|
$field =~ s/^\s*//g;
|
$field =~ s/\s*;//g;
|
$field =~ s/\s*;//g;
|
$field =~ s/\s+/ /g;
|
$field =~ s/\s+/ /g;
|
|
|
$field =~ s/A-Z/a-z/g;
|
$field =~ s/A-Z/a-z/g;
|
|
|
|
|
# check for special field2 formats: nop
|
# check for special field2 formats: nop
|
if($field =~ /(nop)/){
|
if($field =~ /(nop)/){
|
# field2 is nop by default
|
# field2 is nop by default
|
return 0;
|
return 0;
|
}
|
}
|
|
|
|
|
if($field =~ /(_\w+|{p}0|{p}1|{d}|{s}|do) = (\w+|t1)/){
|
if($field =~ /(_\w+|{p}0|{p}1|{d}|{s}|do) = (\w+|t1)/){
|
|
|
#check that dst address is the same as field1's src address
|
#check that dst address is the same as field1's src address
|
#(since they end up being the same physical bits)
|
#(since they end up being the same physical bits)
|
@parts = split /=/, $field;
|
@parts = split /=/, $field;
|
$dst = $parts[0];
|
$dst = $parts[0];
|
$dst =~ s/\s//g;
|
$dst =~ s/\s//g;
|
if(($dst ne $uinst->{src})
|
if(($dst ne $uinst->{src})
|
&& ($dst ne 'do')
|
&& ($dst ne 'do')
|
&& ($uinst->{src} ne 'di')
|
&& ($uinst->{src} ne 'di')
|
&& ($uinst->{src} ne '')){
|
&& ($uinst->{src} ne '')){
|
# field mismatch
|
# field mismatch
|
$num_errors++;
|
$num_errors++;
|
$uinst->{error} = "field source/destination address mismatch";
|
$uinst->{error} = "field source/destination address mismatch";
|
return 1;
|
return 1;
|
}
|
}
|
else{
|
else{
|
# build bitfield for field2, including those bits that overlap
|
# build bitfield for field2, including those bits that overlap
|
# bits from field 1
|
# bits from field 1
|
|
|
if($dst eq 'do'){
|
if($dst eq 'do'){
|
substr($uinst->{field1}, 24, 1) = '1'; #ld_do
|
substr($uinst->{field1}, 24, 1) = '1'; #ld_do
|
}
|
}
|
else{
|
else{
|
substr($uinst->{field1}, 25, 1) = '1'; #ld_reg
|
substr($uinst->{field1}, 25, 1) = '1'; #ld_reg
|
|
|
if($dst eq '{p}0'){
|
if($dst eq '{p}0'){
|
substr($uinst->{field1}, 11, 2) = '11';
|
substr($uinst->{field1}, 11, 2) = '11';
|
substr($uinst->{field1}, 13, 4) = '0000';
|
substr($uinst->{field1}, 13, 4) = '0000';
|
}
|
}
|
elsif($dst eq '{p}1'){
|
elsif($dst eq '{p}1'){
|
substr($uinst->{field1}, 11, 2) = '11';
|
substr($uinst->{field1}, 11, 2) = '11';
|
substr($uinst->{field1}, 13, 4) = '0001';
|
substr($uinst->{field1}, 13, 4) = '0001';
|
}
|
}
|
elsif($dst eq '{d}'){
|
elsif($dst eq '{d}'){
|
substr($uinst->{field1}, 11, 2) = '10';
|
substr($uinst->{field1}, 11, 2) = '10';
|
substr($uinst->{field1}, 13, 4) = '0000';
|
substr($uinst->{field1}, 13, 4) = '0000';
|
}
|
}
|
elsif($dst eq '{s}'){
|
elsif($dst eq '{s}'){
|
substr($uinst->{field1}, 11, 2) = '01';
|
substr($uinst->{field1}, 11, 2) = '01';
|
substr($uinst->{field1}, 13, 4) = '0000';
|
substr($uinst->{field1}, 13, 4) = '0000';
|
}
|
}
|
else{
|
else{
|
%regs = ( '_b',0, '_c',1, '_d',2, '_e',3,
|
%regs = ( '_b',0, '_c',1, '_d',2, '_e',3,
|
'_h',4, '_l',5, '_f',6, '_a',7,
|
'_h',4, '_l',5, '_f',6, '_a',7,
|
'_ph',8, '_pl',9, '_x',10, '_y',11,
|
'_ph',8, '_pl',9, '_x',10, '_y',11,
|
'_z',12, '_w',13, '_sh',14, '_sl',15);
|
'_z',12, '_w',13, '_sh',14, '_sl',15);
|
|
|
$val_reg = to_bin($regs{$dst},4);
|
$val_reg = to_bin($regs{$dst},4);
|
substr($uinst->{field1}, 11, 2) = '00';
|
substr($uinst->{field1}, 11, 2) = '00';
|
substr($uinst->{field1}, 13, 4) = $val_reg; # RD address; same as WR
|
substr($uinst->{field1}, 13, 4) = $val_reg; # RD address; same as WR
|
}
|
}
|
|
|
}
|
}
|
|
|
# TODO deal with flag pattern
|
# TODO deal with flag pattern
|
$parts[1] =~ s/\s//g;
|
$parts[1] =~ s/\s//g;
|
$src = $field2_ops{$parts[1]}.'';
|
$src = $field2_ops{$parts[1]}.'';
|
if($src eq ''){
|
if($src eq ''){
|
$num_errors++;
|
$num_errors++;
|
$uinst->{error} = "field 2 operation unknown: [".$parts[1]."]";
|
$uinst->{error} = "field 2 operation unknown: [".$parts[1]."]";
|
return 1;
|
return 1;
|
}
|
}
|
else{
|
else{
|
substr($uinst->{field1},26,6) = $src;
|
substr($uinst->{field1},26,6) = $src;
|
return 0;
|
return 0;
|
}
|
}
|
}
|
}
|
|
|
}
|
}
|
elsif($field =~ /(sec|cpc)/){
|
elsif($field =~ /(sec|cpc)/){
|
substr($uinst->{field1},26,6) = $field2_ops{$1};
|
substr($uinst->{field1},26,6) = $field2_ops{$1};
|
}
|
}
|
else{
|
else{
|
# field2 empty or invalid
|
# field2 empty or invalid
|
$num_errors++;
|
$num_errors++;
|
$uinst->{error} = "field 2 empty or invalid: ".$re_field2;
|
$uinst->{error} = "field 2 empty or invalid: ".$re_field2;
|
return 1;
|
return 1;
|
}
|
}
|
|
|
}
|
}
|
|
|
|
|
|
|
# return !=0 when uinst is finished except for flags,
|
# return !=0 when uinst is finished except for flags,
|
# 0 when field2 has to be processed
|
# 0 when field2 has to be processed
|
|
|
sub process_field1 {
|
sub process_field1 {
|
|
|
my $field = shift(@_).";";
|
my $field = shift(@_).";";
|
|
|
$field =~ s/^\s*//g;
|
$field =~ s/^\s*//g;
|
$field =~ s/\s*;//g;
|
$field =~ s/\s*;//g;
|
$field =~ s/\s+/ /g;
|
$field =~ s/\s+/ /g;
|
|
|
# look for special format uinsts: jsr, tjsr, nop
|
# look for special format uinsts: jsr, tjsr, nop
|
if($field =~ /(jsr|tjsr)\s+([_\w]+)/){
|
if($field =~ /(jsr|tjsr)\s+([_\w]+)/){
|
$opcode = $1;
|
$opcode = $1;
|
$target = $2;
|
$target = $2;
|
# set flag
|
# set flag
|
$uinst->{flags} = $uinst->{flags}." #".$opcode." ";
|
$uinst->{flags} = $uinst->{flags}." #".$opcode." ";
|
|
|
# check that target is defined, otherwise tag it for 2nd pass
|
# check that target is defined, otherwise tag it for 2nd pass
|
$target_addr = $labels{$target};
|
$target_addr = $labels{$target};
|
|
|
tag_label_use($target, $addr);
|
tag_label_use($target, $addr);
|
|
|
if($target_addr eq ''){
|
if($target_addr eq ''){
|
push @undefined_targets, [$target, $addr];
|
push @undefined_targets, [$target, $addr];
|
$code = $field1_ops{$opcode};
|
$code = $field1_ops{$opcode};
|
$uinst->{field1} = $code;
|
$uinst->{field1} = $code;
|
}
|
}
|
else{
|
else{
|
# set up bitfield so we can fill the address in in 2nd pass
|
# set up bitfield so we can fill the address in in 2nd pass
|
$code = $field1_ops{$opcode};
|
$code = $field1_ops{$opcode};
|
$a = to_bin($target_addr+0, 8);
|
$a = to_bin($target_addr+0, 8);
|
substr($code, 20,2, substr($a, 0,2));
|
substr($code, 20,2, substr($a, 0,2));
|
substr($code, 26,6, substr($a, 2,6));
|
substr($code, 26,6, substr($a, 2,6));
|
$uinst->{field1} = $code;
|
$uinst->{field1} = $code;
|
}
|
}
|
return 1;
|
return 1;
|
}
|
}
|
|
|
if($field =~ /nop/){
|
if($field =~ /nop/){
|
# TODO encode NOP as 1st field
|
# TODO encode NOP as 1st field
|
$uinst->{field1} = $field1_ops{'nop'};
|
$uinst->{field1} = $field1_ops{'nop'};
|
return 0;
|
return 0;
|
}
|
}
|
|
|
# process regular field1 (register load): dst = src
|
# process regular field1 (register load): dst = src
|
|
|
if($field =~ /$re_field1/){
|
if($field =~ /$re_field1/){
|
@parts = split /=/, $field;
|
@parts = split /=/, $field;
|
|
|
# if a src reg address literal is specified, it has to be the same
|
# if a src reg address literal is specified, it has to be the same
|
# address as for field2 dest; save it for later comparison.
|
# address as for field2 dest; save it for later comparison.
|
|
|
$src = $parts[1];
|
$src = $parts[1];
|
$src =~ s/\s//g;
|
$src =~ s/\s//g;
|
|
|
$d = $field1_ops{$field}.'';
|
$d = $field1_ops{$field}.'';
|
|
|
if($d eq ''){
|
if($d eq ''){
|
# unrecognized source that somehow matches pattern (e.g. _pl0)
|
# unrecognized source that somehow matches pattern (e.g. _pl0)
|
$error = "invalid source in uinst field 1";
|
$error = "invalid source in uinst field 1";
|
$uinst->{field1} = $field1_ops{'nop'};
|
$uinst->{field1} = $field1_ops{'nop'};
|
$uinst->{error} = $error;
|
$uinst->{error} = $error;
|
$num_errors++;
|
$num_errors++;
|
$uinst->{src} = '?';
|
$uinst->{src} = '?';
|
return 1;
|
return 1;
|
}
|
}
|
else{
|
else{
|
$uinst->{src} = $src;
|
$uinst->{src} = $src;
|
$uinst->{field1} = $d;
|
$uinst->{field1} = $d;
|
}
|
}
|
return 0;
|
return 0;
|
}
|
}
|
else{
|
else{
|
# field1 not recognized.
|
# field1 not recognized.
|
$error = "uinst field 1 not recognized: '".$field."'";
|
$error = "uinst field 1 not recognized: '".$field."'";
|
$uinst->{field1} = $field1_ops{'nop'};
|
$uinst->{field1} = $field1_ops{'nop'};
|
$uinst->{error} = $error;
|
$uinst->{error} = $error;
|
$num_errors++;
|
$num_errors++;
|
return 1;
|
return 1;
|
}
|
}
|
|
|
}
|
}
|
|
|
sub tag_label_use {
|
sub tag_label_use {
|
|
|
my $label = shift(@_);
|
my $label = shift(@_);
|
my $address = shift(@_);
|
my $address = shift(@_);
|
|
|
push(@label_uses, $label);
|
push(@label_uses, $label);
|
|
|
}
|
}
|
|
|
sub to_bin {
|
sub to_bin {
|
my $number = shift(@_) * 1;
|
my $number = shift(@_) * 1;
|
my $length = shift(@_);
|
my $length = shift(@_);
|
|
|
$n = $number;
|
$n = $number;
|
$r = '';
|
$r = '';
|
for( my $i=$length-1;$i>=0;$i--){
|
for( my $i=$length-1;$i>=0;$i--){
|
$d = 2 ** $i;
|
$d = 2 ** $i;
|
|
|
if($n >= $d){
|
if($n >= $d){
|
$r = $r.'1';
|
$r = $r.'1';
|
$n = $n - $d;
|
$n = $n - $d;
|
}
|
}
|
else{
|
else{
|
$r = $r.'0';
|
$r = $r.'0';
|
}
|
}
|
}
|
}
|
|
|
return $r;
|
return $r;
|
}
|
}
|
|
|
|
|