#
# perl <perl_script> <input_file> -o <output_file>
#
# convert the opc.table entries from the "vc" compiler source
# into an <output_file>.h and <output_file>.C which initializes
# the opcode table. Note that the output_file name should not include
# the suffix. Example:
#
# perl opc_script /vobs/quest/Import/vc/cg/opc.table -o opc
#
# This will read opc.table and generate two files, opc.h, which
# contains the defines and the data structure definition and
# opc.C, which initializes the op-code table.
#
# The data structure has a field, has_result, which is not present
# in the opc.table data structure. This field contains TRUE for
# most operands. The list "has_no_result" contains a list of
# operators with a has_result field that is FALSE.
#
#
# The reference I used to write this was "Programming PERL" by Wall and Schwartz,
# O'Reilly and Associates, Inc. I suppose that once one becomes expert in PERL
# you can write things very fast. This was my first try at PERL and I could
# have written the same thing faster in C. I also think that, despite my
# best efforts, PERL is not terribly readable.
#
# Ian Kaplan, August 1996
##
## Start of the PERL script
##
&main();
sub main {
local ($argcnt, $infile, $outfile, $outfile_h, $outfile_C);
local (@optable);
local ($define_name, $bad_op_name, $linecnt);
#
# First do checking to make sure that the input
# is correct. Note that $#ARGV is the last index
# in @ARGV, so add one to get the argument count.
#
$argcnt = $#ARGV + 1;
if ($argcnt != 3 || $ARGV[1] ne "-o") {
print "usage: perl <perl_script> <input_file> -o <output_file>\n";
}
else {
$infile = $ARGV[ 0 ];
$outfile = $ARGV[ 2 ];
# append the "output" file marker to the front of
# the output file names and add the suffixes.
$outfile_h = ">" . $outfile . ".h";
$outfile_C = ">" . $outfile . ".C";
if (! open(INFILE_HANDLE, $infile)) {
print "Error opening input file ", $infile, "\n";
}
elsif (! open(OUTFILE_HANDLE_H, $outfile_h)) {
print "Error opening ", $outfile_h, "\n";
}
elsif (! open(OUTFILE_HANDLE_C, $outfile_C)) {
print "Error opening ", $outfile_C, "\n";
}
else {
# This is a list of operators with a has_result field of zero.
# This is a global variable.
#
@has_no_result = ( "op_exit",
"op_br",
"op_bt",
"op_bf",
"op_sys_call",
);
# opc.table operators that should be skipped (no added to the
# define or initialization files.
# This is a global variable.
@skip_op = ("op_rd",
"op_wr",
);
# Read the opc.table once
@optable = <INFILE_HANDLE>;
close(INFILE_HANDLE);
#
# Create the *.h file
#
# Start the file with an ifndef to avoid multiple include
#
$define_name = $outfile;
$define_name =~ tr/a-z/A-Z/; # convert output file name out uppper case
$define_name = $define_name . "_H";
print OUTFILE_HANDLE_H "\n#ifndef ", $define_name, "\n";
print OUTFILE_HANDLE_H "#define ", $define_name, "\n";
print OUTFILE_HANDLE_H "\n/* This file was generated from opc.table by a PERL script */\n\n";
$bad_op_name = "OP_BADOP";
print OUTFILE_HANDLE_H "#define ", $bad_op_name, " \t 0 \n";
$linecnt = 0;
$opcnt = 1; # this is a global
while ($optable[$linecnt]) {
# note the & character that marks the subroutine call
&create_define( $optable[ $linecnt ] );
++$linecnt;
} # while
print OUTFILE_HANDLE_H "#define MAXOP \t ", $opcnt - 1, "\n";
&print_defines();
&print_data_struct();
print OUTFILE_HANDLE_H "\n#endif\n";
# We are done with the *.h file, so close it
close(OUTFILE_HANDLE_H);
# Now create the *.C file
print OUTFILE_HANDLE_C "\n/* This file was generated from opc.table by a PERL script */\n\n";
print OUTFILE_HANDLE_C "#include \"sutil.h\"\n";
print OUTFILE_HANDLE_C "#include \"opc.h\"\n\n";
print OUTFILE_HANDLE_C "INS_DEF Op_table[] = {\n\n";
print OUTFILE_HANDLE_C "{", $bad_op_name, ",", "\t\"bug\",0,0,\t{0}\t},\n";
$linecnt = 0;
$opcnt = 1; # this is a global (perl sucks)
while ($optable[$linecnt]) {
&create_init( $optable[ $linecnt ] );
++$linecnt;
} # while
print OUTFILE_HANDLE_C "{ 0, 0, 0, 0, {0} }\n";
print OUTFILE_HANDLE_C "}; /* end of Op_table */\n";
# We are done with the *.C file, so close it
close(OUTFILE_HANDLE_C);
}
}
} # main
sub is_skip_op {
local($name) = @_;
local($answer, $found, $i);
$found = 0;
for ($i = 0; $i < $#skip_op + 1; $i++) {
if ($skip_op[ $i ] eq $name) {
$found = 1;
last; # exit the loop
}
}
# A perl routine returns the value of the last expression
# evaluated. So use an assignment to force the return
# of the value of found.
$answer = $found;
} # is_skip_op
#
# Print out a define constructed from the op-code name from the
# second column of opc.table.
#
# As far as I can tell, perl subroutines cannot be passed lists.
# So, for example, this function could not be passed @optable. As
# a result, this function does not do as much as it could.
#
sub create_define {
local($line) = @_;
local($type, $name, $eq, $zero, $ascii, $args, $close);
local($name);
# note that \s+ means one more more white space characters
($type, $name, $eq, $zero, $ascii, $args, $close) = split(/\s+/, $line);
if ($type ne "/*" && $type ne "") {
if (! &is_skip_op( $name )) {
# The =~ assignment is a bit like the op-equal in C. The string operation
# is applied to $name
$name =~ tr/a-z/A-Z/;
print OUTFILE_HANDLE_H "#define ", $name," \t ", $opcnt, "\n";
++$opcnt; # this is a global
}
}
} # create_defines
#
# Print out the defines that are used in the definition of the
# assembler/interpreters op-code table.
#
sub print_defines {
print OUTFILE_HANDLE_H "\n\n";
print OUTFILE_HANDLE_H "#define MAX_OPNDS 2 \n";
print OUTFILE_HANDLE_H "#define SAL 0x01 \n";
print OUTFILE_HANDLE_H "#define IMM 0x02 \n";
print OUTFILE_HANDLE_H "#define LABEL 0x03 \n";
print OUTFILE_HANDLE_H "#define ADDR 0x04 \n";
print OUTFILE_HANDLE_H "#define BCND 0x05 \n";
} # print_defines
sub print_data_struct {
print OUTFILE_HANDLE_H "\n\n";
print OUTFILE_HANDLE_H "typedef struct opcode {\n";
print OUTFILE_HANDLE_H " int id;\n";
print OUTFILE_HANDLE_H " char *name;\n";
print OUTFILE_HANDLE_H " short opnd_cnt;\n";
print OUTFILE_HANDLE_H " short has_result;\n";
print OUTFILE_HANDLE_H " uint opnd_types[MAX_OPNDS];\n";
print OUTFILE_HANDLE_H "} INS_DEF;\n\n";
print OUTFILE_HANDLE_H "extern INS_DEF Op_table[];\n";
} # print_data_struct
sub create_init {
local($line) = @_;
local($type, $name, $eq, $zero, $ascii, $args, $close);
local($name, $i);
# note that \s+ means one more more white space characters
($type, $name, $eq, $zero, $ascii, $args, $close) = split(/\s+/, $line);
# if ($type ne "/*" && $type ne "") {
# print "type = ", $type, " name = ", $name, " eq = ", $eq, " zero = ", $zero,
# " ascii = ", $ascii, " args = ", $args, " close = ", $close, "\n";
# }
if ($type ne "/*" && $type ne "" && (! is_skip_op( $name))) {
# In theory this could be done with an associative array. For example
#
# $has_result = 1;
# if ($has_no_result{ $name }) {
# $has_result = 0;
# }
#
# Unfortunately, as far as I can tell, associative arrays do not return a
# null value if the reference is not in the array. Or at least I could not
# figure out how to get them to do this. So a for loop is used here instead.
#
$has_result = 1;
for ($i = 0; $i < $#has_no_result + 1; $i++) {
if ($has_no_result[ $i ] eq $name) {
$has_result = 0;
last;
}
}
# The =~ assignment is a bit like the op-equal in C. The string operation
# is applied to $args. This will replace any occurance of SAL,SAL,SAL
# with SAL,SAL
$args =~ s/SAL,SAL,SAL/SAL,SAL/;
$name =~ tr/a-z/A-Z/; # translate $name to upper case
# print "{", $name, ",\t", $ascii, $has_result, ",", "\t", $args, "\t}, /* ", $opcnt, " */\n";
print OUTFILE_HANDLE_C "{", $name, ",\t", $ascii, $has_result, ",", "\t", $args, "\t}, /* ",
$opcnt, " */\n";
++$opcnt; # this is a global
}
} # create_defines
back to perl article