#
#  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.
 #

##
## 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