#! perl -w
#
# process_switch.pl
#
# Take a file of opcode functions and emit a #defined DO_OP switch  them

#
# Reads in opcode_table and @ARGV, which is basic_opcodes.ops, the skeleton
#

#
# Outputs basic_opcodes.h, with the DO_OP
#

#
# Run this as  prompt$ perl process_switch.pl basic_opcodes.ops
# in the top parrot directory
#

use strict;
use Parrot::Opcode;

my %opcodes = Parrot::Opcode::read_ops();

my %op_data;

#
# grok the number of each opcode
#
# do we still need this?
#
open GUTS, "include/parrot/interp_guts.h"
  or die "Could not open include/parrot/interp_guts.h";
my $opcode;
while (<GUTS>) {
    next unless /\tx\[(\d+)\] = ([a-z_]+);/;
    $op_data{$2}{OPNUM} = $1;
}


my %psize = ('i' => 1,
	     'n' => 2,
	     'I' => 1,
	     'N' => 1,
	     'D' => 1,
	     'S' => 1,
	     's' => 1,
	     );


open OP_TAB, "opcode_table" or die "Can't open opcode_table, $!/$^E";
while (<OP_TAB>) {
    s/#.*//;
    s/^\s+//;
    chomp;
    next unless $_;
    my ($name, $params, @params) = split /\s+/;
    $op_data{$name}{PARAM_COUNT} = $params;
    $op_data{$name}{PARAM_ARRAY} = \@params;

    my $psize=0;
    foreach (@params) {
       $psize+=$psize{$_};
    }


    $op_data{$name}{RETURN_OFFSET} = 1 + $psize;
    my $count = 1;
    $op_data{$name}{PARAMETER_SUB} = 
	     ["", 
	      map {if ($_ eq "n") { 
		  my $temp = '*(NV *)(&code[' . $count . '])';
		  $count += 2;
		  $temp;
	      } else {
		  "code[" . $count++ . "]"
	      }
	       } @params];
}



my $orig = my $file = $ARGV[0];
open DOT_OPS, $file or die "Can't open $file, $!/$^E";
if (! ($file =~ s/\.ops$/.h/)) {
    $file .= ".h";
}



#
# print a header on basic_opcodes.h
#
open OP_DOT_H, ">$file" or die "Can't open $file, $!/$^E";
print OP_DOT_H <<EOF;
/* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
   This file is built by $orig from its data.  Any changes made here
   will be lost!
*/

#include "parrot/parrot.h"
#include <math.h>

#define DO_OP(code) do { \\
switch(code) { \\
EOF

my($name, $footer, @param_sub, $op_type);

while (<DOT_OPS>) {
    chomp;

    # we have a problem with the #includes...
    s|#include.*||;

    # strip C comments here.
    s|/\*.+||;
#    s|\s*\*.*||; #this is clobering STRING *, damn

    # stupid closing braces....
#    s|^\}$||;


    if (/^AUTO_OP/) {
	$op_type = 'AUTO';
	($name, $footer) = emit_auto_header($_);
    }

    if (/^MANUAL_OP/) {
	$op_type = 'MANUAL';
	($name, $footer) = emit_manual_header($_);
    }

    if (/^(AUTO|MANUAL)_OP/) {
	my $count = 1;
	@param_sub = ("",
		      map {if ($_ eq "n") {
			  my $temp = '*(NV *)&code[' . $count . ']';
			  $count += 2;
			  $temp;
		      } else {
			  "code[" . $count++ . "]"
		      }
		       } @{$opcodes{$name}{TYPES}});
	next;
    }


    s/\bP(\d+)\b/$param_sub[$1]/g;

    s/RETURN\((.*)\)/code += $1/;

    if ( /^}/  ) {
	my $eol = $op_type eq 'AUTO' ? "  \\\n" : "";
        print OP_DOT_H $footer, $eol;
	print OP_DOT_H "  break;  \\\n";
	next;
    }

    if ( /\S+/ ) {
	print OP_DOT_H $_, "  \\", "\n";
    }
    else {
	next;
    }
}

print OP_DOT_H "} \\\n";
print OP_DOT_H "} while (0);\n";


sub emit_auto_header {
    my $line = shift;
    my ($name) = $line =~ /AUTO_OP\s+(\w+)/;

    my $psize=0;
    foreach (@{$opcodes{$name}{TYPES}}) {
       $psize+=$psize{$_};
    }
    my $return_offset = $psize + 1;

    $op_data{$name}{RETURN_OFFSET} = 1 + $psize;

    # this needs to be matched with any extension ("_op_idx")
    print OP_DOT_H "case $name:  \\\n";

    return($name, "  code += " . $return_offset . ";");
}

sub emit_manual_header {
    my $line = shift;
    my ($name) = $line =~ /MANUAL_OP\s+(\w+)/;
    
    my $psize=0;
    foreach (@{$opcodes{$name}{TYPES}}) {
       $psize+=$psize{$_};
    }
    my $return_offset = $psize + 1;

    $op_data{$name}{RETURN_OFFSET} = 1 + $psize;

    # this needs to be matched with any extension ("_op_idx")
    print OP_DOT_H "case $name:  \\\n";

    # maybe just have the second param be ""
    return($name, "");
}