head	1.7;
access;
symbols
	r0_10:1.7
	Eglin_alpha_1:1.6;
locks; strict;
comment	@# @;


1.7
date	93.08.18.16.09.48;	author thoth;	state Exp;
branches;
next	1.6;

1.6
date	93.05.27.11.46.13;	author thoth;	state Exp;
branches;
next	1.5;

1.5
date	93.05.18.21.43.00;	author thoth;	state Exp;
branches;
next	1.4;

1.4
date	93.04.08.13.25.40;	author thoth;	state Exp;
branches;
next	1.3;

1.3
date	93.03.18.13.17.03;	author thoth;	state Exp;
branches;
next	1.2;

1.2
date	93.03.10.13.38.55;	author thoth;	state Exp;
branches;
next	1.1;

1.1
date	93.02.20.12.19.34;	author thoth;	state Exp;
branches;
next	;


desc
@perl script to generate C++ implementations for operations on images.
@


1.7
log
@Problems with the generation of the formal parameters in the
procedure body necessitate removal of special cases.
@
text
@#!/local/bin/perl

#
#	Copyright 1993, Center for Computer Vision and Visualization,
#	University of Florida.  All rights reserved.
#


# $Id: generate-ops-c.perl,v 1.6 93/05/27 11:46:13 thoth Exp Locker: thoth $

#
# $Log:	generate-ops-c.perl,v $
# Revision 1.6  93/05/27  11:46:13  thoth
# Copyright Notices
# 
# Revision 1.5  93/05/18  21:43:00  thoth
# Fixed uninitialized value bug when generating reductions.
# 
# Revision 1.4  93/04/08  13:25:40  thoth
# floats and u_chars are now passed by value.
# 
# Revision 1.3  93/03/18  13:17:03  thoth
# Operator mangling is not yet finished, but covers more cases now.
# We now handle converions from one Image type to another.
# Image-scalar operations with different basetypes
# now generate correct code (I hope).
# 
# Revision 1.2  93/03/10  13:38:55  thoth
# Operator mangling is not yet finished, but covers more cases now.
# Infix detection is now automatic.
# We now handle reducers.
# We now handle unary operations.
# 


sub is_imagearg {
	return $_[0] =~ /^I\((.*)\)$/;
}

sub basetype {
	local($_) = @@_;
	if (/^I\((.*)\)$/) {
		return $1;
	} else {
		return $_;
	}
}

sub retcodeof {
	local($_) = @@_;
	if (/^I\((.*)\)$/) {
		return "IA_DiscreteImage<".$1.">";
	} else {
		return $_;
	}
}

sub retcodeof {
	local($_) = @@_;
	if (/^I\((.*)\)$/) {
		return "IA_DiscreteImage<".$1.">";
	} else {
		return $_;
	}
}

sub paramcodeof {
	local($_) = @@_;
	if (/^I\((.*)\)$/) {
		return "const IA_DiscreteImage<".$1."> &";
	} elsif (1 ||
		 $_ eq "u_char" ||
		 $_ eq "int" ||
		 $_ eq "float" ||
		 $_ eq "double") {
		return $_;
	} else {
		return "const ".$_." &";
	}
}

sub make_opname {
	local($_) = @@_;
	s/\+/IAOPpl/g;
	s/-/IAOPmn/g;
	s/\*/IAOPmu/g;
	s:/:IAOPdv:g;

	s/%/IAOPmd/g;
	s/&&/IAOPla/g;
	s/\|\|/IAOPlo/g;
	s/!/IAOPno/g;

	s/&/IAOPba/g;
	s/\|/IAOPbo/g;
	s/\^/IAOPbx/g;
	s/~/IAOPbn/g;

	s/<</IAOPls/g;
	s/>>/IAOPrs/g;

	s/<=/IAOPle/g;
	s/</IAOPlt/g;
	s/==/IAOPeq/g;
	s/!=/IAOPne/g;
	s/>=/IAOPge/g;
	s/>/IAOPgt/g;
	return $_;
}

sub file_substitution {
	local($fname, $op, $subop, $atype, $ltype, $rtype) = @@_;
	open(FILE, "<opgen-templs/$fname") ||
			die "couldn't open opgen-templs/$fname, stopped";
	local($_);
	local($/) = -1;
	$_ = <FILE>;
	s/\bOP\b/$op/g;
	s/\bSUBOP\b/$subop/g;
	$opname = &make_opname($op);
	if ($opname eq "") {
		$opname = $op;
	}
	# print STDERR $op , " = ", $opname, "\n";
	s/OPNAME/$opname/g;
	s/ATYPE/$atype/g;
	s/LTYPE/$ltype/g;
	s/RTYPE/$rtype/g;
	print $_;
	$/ = '\n';
	close(FILE);
}

print <<EOT
// Emacs -*- C++ -*-

// Machine generated include file, do not modify.

EOT
;

while (<>) {
    if (/^#/) {
	if ($' eq "\n") {
	    print $';
	} else {
	    print "// ",$';
	}
	next;
    } elsif ( /^\s+$/) {
	next;
    }

    local($bin,$pwise,$comm,$optype) = (0,0,0,0);
    print "/" x 70,
	"\n//\n",
	"// Begin operation support routines for :\n",
	"// ",$_,
	"//\n";
    split;
#    print STDERR join(" ",@@_),"\n";
    while (@@_) {
    	$_ = shift(@@_);
	#print STDERR $_,"\n";
    	if ($_ eq "reduction") {
	    $pwise = 0;
	    $bin = 0;
	} elsif ($_ eq "pointwise") {
	    $pwise = 1;
	} elsif ($_ eq "strictrel") {
	    $pwise = 2;
	} elsif ($_ eq "conversion") {
	    $pwise = 3;

	} elsif ($_ eq "binary") {
	    $bin = 1;
    	} elsif ($_ eq "unary") {
	    $bin = 0;

	} elsif ($_ eq "commutative") {
	    $comm = 1;
	} elsif ($_ eq "non-commutative") {
	    $comm = 0;

#	} elsif ($_ eq "function") {
#	    $optype = 0;
#	} elsif ($_ eq "operator") {
#	    $optype = 1;
#	} elsif ($_ eq "opeq") {
#	    $optype = 2;
#	    $bin = 0;
#	} elsif ($_ eq "strictrel") {
#	    $optype = 3;

	} else {
	    unshift(@@_,$_);
	    last;
	}
    }

    unless (@@_) { next; }

    local($op) = shift(@@_);

    if ($_[0] =~ /^subop=/) {
	$subopname = $subop = $';
	shift(@@_);
    } else {
	$subopname = $subop = $op;
    }

    $infix = ($subop =~ s/^operator//);
    $opeq = ($subop =~ m/=$/);


    if ($pwise==0) {
	local($rtype, $argtype) = @@_;
	(&is_imagearg($argtype) && !&is_imagearg($rtype)) || die "reductions are from images to scalars. stopped";
	&file_substitution("reduce_".($infix?"op":"fn")."_nz",
		$op, $subop, &basetype($rtype), &basetype($argtype),
		" #ERROR# ");
	#print $friend,&retcodeof($rtype)," ", $op, "(",
	#	&paramcodeof("I($rtype)"),");\n";
    } elsif ($pwise==3) {
	local($lhs) = @@_;
	(&is_imagearg($op) && &is_imagearg($lhs)) || die "conversions must be from image to image. stopped";
	&file_substitution("conversion", $op, $op,
			&basetype($op), &basetype($lhs), " #ERROR# ");
    } elsif ($bin) {
	local($lhs, $rhs, $rtype) = @@_;

	#if ($lhs eq $rhs) {
	##  (&is_imagearg($lhs) && &is_imagearg($rhs)) || die "symmetric non-image operation, stopped";
	#  &file_substitution
	#	("binary_".
	#	 ($comm ? "commutative_II":"noncommutative_II").
	#	 ( $optype ? "_operator":"_function"),
	#	$op, &basetype($rtype),
	#	&basetype($rhs),&basetype($lhs));
	#} elsif (&is_imagearg($lhs)) {
	$commcode = $comm;
	if (&is_imagearg($lhs)) {
	  if (&is_imagearg($rhs)) {
		$arity = "II";
		$commcode = $comm && (&basetype($lhs) eq &basetype($rhs));
	  } else {
		$arity = "Is";
		$commcode = $comm && (&basetype($lhs) eq $rhs);
	  }
	} else {
	  if (&is_imagearg($rhs)) {
		$arity = "sI";
		$commcode = $comm && ($lhs eq &basetype($rhs));
	  } else {
		die "Non-image operation, stopped";
	  }
	}
	&file_substitution("b".
		($pwise==2 ? "sr" : "pw")."_".
		( $commcode ? "c":"nc").
		"_${arity}_".($infix ? "op":"fn"),
		$op, $subop, &basetype($rtype),
		&basetype($lhs),&basetype($rhs));
    } else { # unary
	local($rtype, $arg) = @@_;
	$retcname = &retcodeof($rtype);
	if ($opeq) {
		print "// There are none (it's inline)\n";
	} else {
		&file_substitution("upw", $op, $subop, &basetype($rtype),
			&basetype($arg),"");
	}
	# print $opname,"(", &paramcodeof($arg),");\n";
    }
    print "\n";
}

exit 0;

print<<EndOfDescription

Lines beginning with a # are ignored.


EndOfDescription
@


1.6
log
@Copyright Notices
@
text
@d9 1
a9 1
# $Id: generate-ops-c.perl,v 1.5 93/05/18 21:43:00 thoth Exp Locker: thoth $
d13 3
d71 2
a72 1
	} elsif ($_ eq "u_char" ||
@


1.5
log
@Fixed uninitialized value bug when generating reductions.
@
text
@d3 4
a7 1
# $Id: generate-ops-c.perl,v 1.4 93/04/08 13:25:40 thoth Exp Locker: thoth $
d9 2
d13 3
@


1.4
log
@floats and u_chars are now passed by value.
@
text
@d4 1
a4 1
# $Id: generate-ops-c.perl,v 1.3 93/03/18 13:17:03 thoth Exp Locker: thoth $
d8 3
d142 1
a142 1
    ($bin,$pwise,$comm,$optype) = (0,0,0,0);
d155 1
a155 1
	    $binary = 0;
d179 1
a179 1
#	    $binary = 0;
d191 1
a191 1
    $op = shift(@@_);
d205 1
a205 1
	($argtype, $rtype) = @@_;
d208 2
a209 1
		$op, $subop, &basetype($rtype), &basetype($lhs), " #ERROR# ");
d213 1
a213 1
	($lhs) = @@_;
d218 1
a218 1
	($lhs, $rhs, $rtype) = @@_;
d253 1
a253 1
	($rtype, $arg) = @@_;
@


1.3
log
@Operator mangling is not yet finished, but covers more cases now.
We now handle converions from one Image type to another.
Image-scalar operations with different basetypes
now generate correct code (I hope).
@
text
@d4 1
a4 1
# $Id: generate-ops-c.perl,v 1.2 93/03/10 13:38:55 thoth Exp Locker: thoth $
d8 6
d57 3
a59 1
	} elsif ($_ eq "int" ||
@


1.2
log
@Operator mangling is not yet finished, but covers more cases now.
Infix detection is now automatic.
We now handle reducers.
We now handle unary operations.
@
text
@d4 1
a4 1
# $Id: generate-bo.perl,v 1.2 93/02/24 10:42:10 thoth Exp Locker: thoth $
d7 7
a13 1
# $Log:	generate-bo.perl,v $
d67 3
d71 5
d149 2
d193 1
a193 1
    if (!$pwise) {
d200 5
d224 1
d229 1
@


1.1
log
@Initial revision
@
text
@d4 6
d55 17
a71 11
	if ($_ eq "+") {
		return "IAOPpl";
	} elsif ($_ eq "-") {
		return "IAOPmn";
	} elsif ($_ eq "*") {
		return "IAOPmu";
	} elsif ($_ eq "/") {
		return "IAOPdv";
	} else {
		return "";
	}
d75 1
a75 1
	local($fname, $op, $atype, $ltype, $rtype) = @@_;
d77 1
a77 1
			die "couldn't open opgen-templs/$fname";
d82 1
d87 1
d117 1
a117 1
    ($bin,$pwise,$comm,$isop) = (0,0,0,0);
d120 1
a120 1
	"// begin operation support routines for :\n",
d128 9
a136 1
    	if ($_ eq "binary") {
d140 1
a140 5
	} elsif ($_ eq "pointwise") {
	    $pwise = 1;
	} elsif ($_ eq "reduction") {
	    $pwise = 0;
	    $binary = 0;
d145 11
a155 7
	} elsif ($_ eq "operator") {
	    $isop = 1;
	} elsif ($_ eq "opeq") {
	    $isop = 2;
	    $binary = 0;
	} elsif ($_ eq "function") {
	    $isop = 0;
d166 3
a168 2
    if ($isop) {
	$opname = "operator".$op;
d170 1
a170 1
	$opname = $op;
d173 4
d178 4
a181 2
	$subop = shift(@@_);
	($rtype) = @@_;
d188 1
a188 1
	##  (&is_imagearg($lhs) && &is_imagearg($rhs)) || die "symmetric non-image operation";
d192 1
a192 1
	#	 ( $isop ? "_operator":"_function"),
d208 1
a208 1
		die "Non-image operation\n";
d212 1
d214 2
a215 2
		"_${arity}_".( $isop ? "op":"fn"),
		$op, &basetype($rtype),
d220 2
a221 2
	if ($isop == 2) {
	    # print $retcname," & ";
d223 2
a224 1
	    # print $friend,$retcname, " ";
@
