mercury/scripts/mod2c

# Leave the first line of this file blank!
# This is a Perl script; the following two lines allow us to avoid
# embedding the path of the perl interpreter in the script.
eval "exec perl -S $0 $*"
    if $running_under_some_shell;

#---------------------------------------------------------------------------#
# Copyright (C) 1995 University of Melbourne.
# This file may only be copied under the terms of the GNU General
# Public License - see the file COPYING in the Mercury distribution.
#---------------------------------------------------------------------------#

# This script converts .mod files to .c files.

sub println {
    local ($line) = @_;
    if ($line =~ /\n/) {
	print "/* oops - line = $line */\n";
    }
    print "$line\n";
    $line_count++;
}

sub printlines {
    local ($lines) = @_;
    foreach $line (split(/\n/,$lines)) {
	do println($line);
    }
}

$decl = $code = $init = $special_init = $gnudecl = $gnuinit = "";
$in_module = $in_code = 0;
$init_funcs = "";
$output_init = 0;

unshift(@ARGV, '-') if $#ARGV < $[;
FILE:
while ($ARGV = shift) {
  if ($ARGV eq "-s") {
    shift;
    next FILE;
  }
  if ($ARGV =~ /^-s/) {
    next FILE;
  }
  open(F, $ARGV) || die "mod2c: can't open input file `$ARGV': $!\n";
  LINE:
  while (<F>) {
    $target = $ARGV;
    $target =~ s/\.mod//;
    $target =~ s/.*\///;

    if ($output_init == 0) {
	do println("/*");
	do println("INIT mercury_sys_init_$target");
	do println("ENDINIT");
	do println("*/");
	$output_init = 1;
    }

    if (/^BEGIN_MODULE\((\w+)\)/) {
        $module = $1;
        $in_module = 1;
        next LINE;
    }
    if (/^BEGIN_CODE/) {
        $in_code = 1;
        next LINE;
    }
    if (/^END_MODULE/) {
        do printlines($decl);
	do println("");
	do println("BEGIN_MODULE($module)");
        do printlines($special_init);
        do printlines($init);
	do println("BEGIN_CODE");
        do printlines($code);
        do println("END_MODULE");
	$init_funcs .= "\t$module();\n";
	$decl = $code = $init = $special_init = "";
        $in_module = $in_code = 0;
        next LINE;
    }
    if (! $in_module) {
	chop;
        do println("$_");
        next LINE;
    }
    if (! $in_code) {
        $special_init .= $_;
        next LINE;
    }
    $save = $_;
    s/^[ \t]*//;
    ($label, $_) = split;
    if ($label =~ /^[a-zA-Z0-9_]*:$/)
    {
        chop $label;
	if ($label =~ /^default/ || $label =~ /^otherwise/) {
	    $code .= $save;
	    next LINE;
	}
	#
	# A label is considered an entry point if
	#	- it starts with "do_" (eg. do_fail)
	#	- it matches <letters and underlines><underline><digits>
	#	  but does NOT start with "aux"
	#	- it matches the same pattern followed by "_input"
	#
	# A label is considered a local entry point if
	#	- it matches <letters and underlines><underline><digits>_l
	#	  but does NOT start with "aux"
	#
        if ($label =~ /^do_/ ||
	    ($label =~ /^([a-zA-Z0-9_]+)_([0-9]+)$/ && ! ($label =~ /^aux/)) ||
	    ($label =~ /^([a-zA-Z0-9_]+)_([0-9]+)_input$/ && ! ($label =~ /^aux/)))
        {
	    $type = "entry";
        }
        else {
	if ($label =~ /^([a-zA-Z0-9_]+)_([0-9]+)_l$/ && ! ($label =~ /^aux/))
        {
	    $type = "local";
	}
        else
        {
	    $type = "label";
        }
	}
        $init .= "\tinit_$type($label);\n";
	if ($type eq "entry") {
		$decl .= "Define_extern_entry($label);\n";
	} else {
		$decl .= "Declare_$type($label);\n";
	}
        $code .= "Define_$type($label);\n";
    } else {
        $code .= $save;
    }
  }
}
do println("void mercury_sys_init_$target(void); /* suppress gcc warning */");
do println("void mercury_sys_init_$target(void) {");
do printlines($init_funcs);
do println("}");