#  Main Program for Tensilica Preprocessor.
#
#  Copyright (c) 2005-2018 Tensilica Inc.  ALL RIGHTS RESERVED.
#  These coded instructions, statements, and computer programs are the
#  copyrighted works and confidential proprietary information of Tensilica Inc.
#  They may not be modified, copied, reproduced, distributed, or disclosed to
#  third parties in any manner, medium, or form, in whole or in part, without
#  the prior written consent of Tensilica Inc.


package tpp;
use strict;
#no warnings;
use Exporter ();
@tpp::ISA = qw(Exporter);
@tpp::EXPORT = qw(include gen);
use vars qw( @incdirs );

our $global_debug = 0;


sub gen {
    print STDOUT (@_);
}

sub is_absolute_path {
  my ($path) = @_;
  #  Treat anything with a drive letter as absolute, even if not followed by a (back)slash.
  return 1 if $path =~ /^\w:/ and $^O =~ /MSWin32|cygwin/;
  return 1 if $path =~ m|^[/\\]|;
  return 0;
}


sub dirpath {
  my ($fname) = @_;

  #  Special case: If the file is in the root directory, use "/." for
  #  the directory name.  For Windows, if there is a drive letter in the
  #  path, use either "." or "/." after the drive letter, depending on
  #  whether it is a drive-relative path.  */

  my $drive = "";
  if ($^O =~ /MSWin32|cygwin/) {
    $drive = $1 if $fname =~ s/^([a-z]:)//i;
  }
defined($drive) or die "drive undefined ($fname)";
defined($fname) or die "fname undefined";
  $fname =~ s|[^/\\]*$||;		# remove leaf (filename) part
  $fname =~ s|\\|/|g;
  #$fname =~ s|/+|/|g;
  if ($fname eq "") {
    $fname = ".";
  } elsif ($fname eq "/") {
    $fname = "/.";
  } else {
    $fname =~ s|/$||;
  }
  return $drive.$fname;
}


sub quotem {
  my ($out) = @_;
  $out =~ s/([\"\$\@\%\\\`])/\\$1/g;		# protect quoted contents
  $out =~ s/\t/\\t/g;				# quote tabs
  $out =~ s/([\x00-\x1f])/"\\x".sprintf("%02x",ord($1))/ge;	# quote control chars
  return $out;
}


sub include {
  my ($fname) = @_;

  my $path = $fname;
  SEARCH:{
    if (!is_absolute_path ($fname)) {
      #  Search the include directories....
      foreach my $dir (@incdirs) {
	$path = $dir . "/" . $fname;
	last SEARCH if -e $path;
      }
      die "Error: could not find \"$fname\" in include path";
    }
  }
  open(IN, "<$path")
    or die "Error: could not open file \"$path\": $!";

print STDERR "****************  tpp processing '$path'\n" if $global_debug;
  push @incdirs, dirpath ($path);
  my $line;
  my $linenum = 0;
  my $code = "#line 1 \"$path\"\n";

  while (defined($line = <IN>)) {
    $linenum ++;
#print STDERR "+++ line $linenum: $line";

    #  Check for lines beginning with ';' but not ';;'.
    #  Unlike the usual TPP, treat lines with only ';' or beginning with '; //' as code too.
    if ($line =~ s/^\s*;([^;]|$)/$1/) {
      $code .= $line;
      next;
    }
    chomp($line);

    #  Don't strip out POD.  (Why bother?)

    $code .= "print STDOUT ";

    my $out = "";
    while ($line =~ s/^([^`]*)`//) {		# everything before the next backtick...
      $out .= $1;				# ... is normal output
      if ($line =~ /^\w/) {
	$out .= "`";				# `\w  is part of output, not a perl expr
	next;
      }
      if ($line =~ s/^([^`]*)`//) {		# if we find matching backtick
	$code .= '"'.quotem($out)."\" . ($1) . ";
	$out = "";
      } else {
	die "Error: $path line $linenum: unterminated embedded perl expression: `$line";
      }
    }
    $code .= '"'.quotem($out.$line)."\\n\";\n";
  }
  close(IN);

  #print STDERR ">>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>  EXECUTING:\n$code\n<<<<<<<<<<<<<<<<<<<<<<<<<\n";
  tppcode::execute($code);
  if ($@) {
    chomp($@);
    print STDERR "tpp: Error ($@) while preprocessing file \"$path\"\n";
    close STDOUT;
    exit 1;
  }

  pop @incdirs;
}


####################   Parse and process arguments.

my ($sconfig, $yconfig, $module, $output_file, $arg);
my (@input_files, @pre_eval_exprs, @post_eval_exprs);
@incdirs = (".");

my $path_to_self = $0;
my $xtensa_tools_root;
if ($path_to_self =~ s|[/\\]libexec[/\\][^/\\]+$||) {
    $xtensa_tools_root = $path_to_self;
    #$xtensa_tools_root .= "\\libexec/..";	# to look like tpp.exe for now
    $ENV{"XTENSA_TOOLS_ROOT"} = $xtensa_tools_root;
} else {
    delete $ENV{"XTENSA_TOOLS_ROOT"};
    #die "tpp: path to self not located in <XtensaTools>/libexec : '$0'";
}

while (defined($_ = shift)) {
  if (/^-(?:I|o|s|x|m|e|eval|p|peval)$/) {
    defined($arg = shift) or die "tpp: missing argument for '$_' option";
    /^-I/ and push @incdirs, $arg;	# -I dir: Search for include files in directory dir.
    /^-o/ and $output_file = $arg;	# -o file: Redirect the output to file rather than stdout.
    /^-s/ and $sconfig = $arg;		# -s file: Load the system config from SLD perl file into \$sys (OBSOLETE)
    /^-y/ and $yconfig = $arg;		# -y file: Load the system config from .yml (YAML) file into \$sys
    /^-x/ and $yconfig = $arg;		# -x file: (old alias for -y)
    /^-m/ and $module = $arg;		# -m module: Specify module to instantiate.
    /^-e/ and push @pre_eval_exprs, $arg;	# -eval exp: Eval exp after loading config.
    /^-p/ and push @post_eval_exprs, $arg;	# -peval exp: Eval exp after processing the input file.
    next;
  }
  if (/^-/) {
    die "tpp: unrecognized option '$_'";
  }
  push @input_files, $_;
}

@input_files or die "tpp: no input files";
$yconfig and $sconfig and die "tpp: cannot specify both -s and -x";
$sconfig and !$module and die "tpp: config file specified without a component module";

if ($output_file) {
  open(STDOUT, ">$output_file")
    or die "cannot open output file '$output_file': $!";
}

push @INC, @incdirs;

print STDERR "tpp: initializing...\n" if $global_debug;

# Read the Perl system description.
if ($sconfig) {
  tppcode::sinit($sconfig, $module);
} elsif ($yconfig) {
  tppcode::yinit($yconfig, $module);
}

foreach (@pre_eval_exprs) {
  print STDERR "tpp: preprocessing expression \"$_\"\n" if $global_debug;
  tppcode::execute($_);
  if ($@) {
    chomp($@);
    print STDERR "tpp: Error ($@) while preprocessing expression \"$_\"\n";
    exit 1;
  }
}

foreach (@input_files) {
  #print STDERR "******************  tpp.pl '$_'\n";
  tpp::include($_);
}

foreach (@post_eval_exprs) {
  #print STDERR "tpp: postprocessing expression \"$_\"\n";
  tppcode::execute($_);
  if ($@) {
    chomp($@);
    print STDERR "tpp: Error ($@) while preprocessing expression \"$_\"\n";
    exit 1;
  }
}

exit 0;

1;



package tppcode;
#no warnings;
no strict;		# sigh

use vars qw($pr $sys $layout);

sub addinc {
    push(@INC, @_);
}

sub execute {
    my ($code) = @_;
    eval ($code);
    die $@ if $@;
}

sub sinit {
    my ($sconfig, $module) = @_;
    require SLD::System;
    require $sconfig;
    GenSystem->import();
    $sys = new SLD::System(undef);
    my $exportedVars = createSystem($sys, $module);
    $pr = $sys->componentInstances($module);
    eval($exportedVars);
    die $@ if $@;
    undef $exportedVars;
}

#sub readfile {
#    my ($filename) = @_;
#    my $file;
#    open(IN,"<$filename") or die "could not open '$filename' for reading: $!";
#    defined(sysread(IN,$file,-s IN)) or die "could not read '$filename': $!";
#    close(IN);
#    return $file;
#}

sub yinit {
    my ($yconfig, $module) = @_;
    require Xtensa::AddressLayout; import Xtensa::AddressLayout;	# this happens run-time only
    $layout = Xtensa::AddressLayout::read_layout($yconfig);
}


1;