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


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

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

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

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

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

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


desc
@perl script to generate meta files for all sorts of binary operations.
@


1.6
log
@Copyright Notices
@
text
@#!/local/bin/perl

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

# $Id: generate-bo.perl,v 1.5 93/04/08 13:22:35 thoth Exp Locker: thoth $

#
# $Log:	generate-bo.perl,v $
# Revision 1.5  93/04/08  13:22:35  thoth
# the domains of the two images are now checked for match.
# floats and u_chars are now passed by value.
# 
# Revision 1.4  93/03/10  13:47:07  thoth
# *** empty log message ***
# 

# This perl script generates meta files for binary image operations.
# The operations may be commutative (-c) or noncommutative (-nc).
# The operations may be Image - Image (-ii), Image - scalar (-is),
#	or scalar - Image (-si).
# Arguments are required.



# $Id: generate-bo.perl,v 1.5 93/04/08 13:22:35 thoth Exp Locker: thoth $

#
# $Log:	generate-bo.perl,v $
# Revision 1.5  93/04/08  13:22:35  thoth
# the domains of the two images are now checked for match.
# floats and u_chars are now passed by value.
# 
# Revision 1.4  93/03/10  13:47:07  thoth
# *** empty log message ***
# 
# Revision 1.3  93/03/10  13:37:41  thoth
# A few extra parenthesis can't hurt.
# Detection of infix should now be automatic.
# 
# Revision 1.2  93/02/24  10:42:10  thoth
# revamping to allow strict relational operators.
# 




# variety is a number from 0..2 meaning
# VectorDI
# ConstDI
# other (but we can iterate over it!)

# Here is a vector with shorthand for each variety
@@names = ("vec", "scalar", "iter");

# Given the variety of the image and its type:
# how will it be DECLARED as an argument to the static support procedure?
# $variety is 0..2.  $type may be either "LTYPE" or "RTYPE".
sub argtype {
	local($variety, $type) = @@_;

	if ($variety == 0) {
		return "const IA_VectorDI<$type> *";
	} elsif ($variety == 1) {
		return "$type ";
	} else {
		return "IA_DiscreteImage<$type> ";
	}
}

# Given the variety of the image and its type:
# how will it be PASSED as an argument to the static support procedure?
# $variety is 0..2.  $side may be either "l" or "r".
sub I_argexpr {
	local($variety, $side) = @@_;
	local($uside, $type);

	($uside = $side) =~ y/a-z/A-Z/;
	$type = $uside . "TYPE";
	if ($variety == 0) {
		return "(IA_VectorDI<$type> *)${side}hs.bdip";
	} elsif ($variety == 1) {
		return "((IA_ConstDI<$type> *)${side}hs.bdip)->value";
	} else {
		return "${side}hs";
	}
}

# When we're checking the type of an argument against the static types
# of all but the last variety, what is the class to check against?
# $variety is 0..1.  $type may be either "LTYPE" or "RTYPE".
sub arg_s_type {
	local($variety, $type) = @@_;

	if ($variety == 0) {
		return "IA_VectorDI<$type>";
	} elsif ($variety == 1) {
		return "IA_ConstDI<$type>";
	} else {
		die "Class 2 is everything else.";
	}
}

# Emit variable declarations necessary for the central loop which
# actually calculates a result.  Vec needs a properly initialized
# pointer.  Const doesn't need an iterator.  Others just use a DIVIter
# of the appropriate type and a temporary of the appropriate type.
# $variety is 0..2.  $side may be either "l" or "r".
sub emititer {
	local($variety, $side) = @@_;
	local($uside, $type);

	($uside = $side) =~ y/a-z/A-Z/;
	$type = $uside . "TYPE";
	if ($variety == 0) {
		print "\tconst ${type} *${side}s = ${side}hs->vec;\n";
	} elsif ($variety == 2) {
		print "\t${type} ${side}tmp;\n",
		    "\tIA_DIVIter<${type}>\t${side}iter(${side}hs);\n";
	}
}

# When inside the loop and doing work, how do we use the iterator to
# calculate the result value?
# $variety is 0..2.  $side may be either "l" or "r".
sub inloop_val {
	($variety, $side) = @@_;

	if ($variety == 0) {
		return "*(${side}s++)";
	} elsif ($variety == 1) {
		return "${side}hs";
	} else {
		return "${side}tmp";
	}
}

# Emit the code for a support procedure.
# $i is the variety of the lhs image
# $j is the variety of the rhs image
sub generate_binary_op {
	local($i,$lside,$j,$rside) = @@_;
	local($ltype, $rtype) = ($lside,$rside);
	local($sym);	
	$ltype =~ tr/a-z/A-Z/;
	$ltype .= "TYPE";
	$rtype =~ tr/a-z/A-Z/;
	$rtype .= "TYPE";

	if ($i==1 && $j==1) {
		print "// scalar-scalar operation is trivial\n\n";
		return;
	}

# Make sure that we don't duplicate the work of
# an image-scalar operation.
	if ($i==1 || $j==1) {
		$sym = $names[$i]."_".$names[$j]."_ATYPE_LTYPE_RTYPE_OPNAME";
		print "#ifndef ",$sym,"\n",
			"#define ",$sym,"\n";
	}

# function header and argument types
	if ($pwise) {
		print "static IA_DiscreteImage<ATYPE>\n";
	} else {
		print "ATYPE ";
	}
	print $names[$i],"_",$names[$j],"_bo_OPNAME(";
	print &argtype($i,$ltype),"lhs,",&argtype($j,$rtype),"rhs)\n";
# the IntPointSet domain we are iterating over.
	print "{\n    const IA_IntPointSet domain = ";
	if ($i == 0) {
		print "lhs->";
	} elsif ($i == 2) {
		print "lhs.";
	} elsif ($j == 0) {
		print "rhs->";
	} elsif ($j == 2) {
		print "rhs.";
	}
	print "domain();\n";
# how long the result vector will be
	print "    const unsigned sz = domain.card();\n",
# declare the result vec
	"    ATYPE *const vec = new ATYPE[sz];\n\n    {\n",
# declare a scanning pointer for the inner loop
	"	ATYPE *ds = vec;\n";
# emit iterator declarations for the left and right hand sides of the operation
	&emititer($i,"l");
	&emititer($j,"r");
# begin the loop
	print "\tfor (unsigned i=0; i<sz; i++) {\n";
# do we need to get values from the DIVIter?
	($i==2) && print "\t    liter(ltmp);\n";
	($j==2) && print "\t    riter(rtmp);\n";

# perform the operation for one pixel, Yaay!

	if ($pwise) {
		print "\t    *(ds++) = ";
	} else {
		# strictrel
		print "\t    if (!";
	}
	if ($infix) {
		print "( (", &inloop_val($i,"l"), ") SUBOP (",
			&inloop_val($j,"r"), ") )";
	} else {
		print "SUBOP(", &inloop_val($i,"l"), ", ",
			&inloop_val($j,"r"), ")";
	}
	if ($pwise) {
		print ";\n\t}\n";
	} else {
		print ")\n\t\treturn 0;\n\t}\n";
	}
	print "    }\n";
	if ($pwise) {
# loop finished.  Result vector is filled.  Give the value vec away.
		print "    return IA_DiscreteImage<ATYPE>(domain, vec, sz, 1);\n";
	} else {
		print "    return 1;\n";
	}
	print "}\n";
	if ($i==1 || $j==1) {
		print "#endif // $sym\n";
	}
	print "\n";
}

# Emit code for the beginning of an image variety case
# $variety is 0..2.  $side is "l" or "r".
sub emit_begin_imagecase {
	local($variety,$side) = @@_;
	local($uside, $type);

	($uside = $side) =~ y/a-z/A-Z/;
	$type = $uside . "TYPE";

	if ($variety+1 < @@names) {
		print "if (${side}hs.type() == ", &arg_s_type($variety,$type), "::s_type()) ";
	}
	print "{\n";
}

# Emit the call to a support procedure for a particular variety combination.
# This is where the ConstDI - ConstDI case is optimized.
# $i and $j are the varieties of the left- and right-hand side image arguments.
# If one of the varieties is negative, that means the corresponding
# argument to the enclosing procedure was a scalar argument instead of
# an image argument.
sub emit_support_call {
    local($i,$j) = @@_;
    local($lexpr,$rexpr);
    $domain = "lhs.domain()";
    if ($i<0) {
	$i=1;
	$lexpr = "lhs";
	$domain = "rhs.domain()";
    } else {
        $lexpr = &I_argexpr($i,"l");
    }
    if ($j<0) {
	$j=1;
	$rexpr = "rhs";
    } else {
	$rexpr = &I_argexpr($j,"r");
    }
    if ($i==1 && $j==1) {
	$pwise && print "IA_DiscreteImage<ATYPE> ($domain, ";
	if ($infix) {
		print "($lexpr) SUBOP ($rexpr)";
	} else {
		print "SUBOP($lexpr, $rexpr)";
	}
	$pwise && print ")";
    } elsif ($comm && $j < $i) {
	print $names[$j],"_",$names[$i],"_bo_OPNAME(",
		$rexpr,",",$lexpr,")";
    } else {
	print $names[$i],"_",$names[$j],"_bo_OPNAME(",
		$lexpr,",",$rexpr,")";
    }
}

# Emit code for the end of an image variety case.
sub emit_end_imagecase {
	local($variety,$indent) = @@_;
	print $indent,"}";
	if ($variety+1 < @@names) {
		print " else ";
	}
}

#
# begin the main code
#


# parse arguments
$comm = 2;
$arity = 3;
$optype = 2;
$pwise = 2;
while (@@ARGV) {
	$_ = shift(@@ARGV);
	if ($_ eq "-nc") {
		$comm = 0;
	} elsif ($_ eq "-c") {
		$comm = 1;

	} elsif ($_ eq "-II") {
		$arity = 0;
	} elsif ($_ eq "-Is") {
		$arity = 1;
	} elsif ($_ eq "-sI") {
		$arity = 2;

	} elsif ($_ eq "-fn") {
		$optype = 0;
	} elsif ($_ eq "-op") {
		$optype = 1;
#	} elsif ($_ eq "-sr") {
#		$optype = 2;

	} elsif ($_ eq "-sr") {
		$pwise = 0;
	} elsif ($_ eq "-pw") {
		$pwise = 1;
	} else {
		die "unrecognized flag: $_\n";
	}
}
die "No value selected for commutativity.  Choose -c or -nc\n" if ($comm>1);
die "Must select -II, -Is, or -sI.\n" if ($arity>2);
die "Must select -op or -fn.\n" if ($optype>1);
die "Must select -sr or -pw.\n" if ($pwise>1);

#

$infix = ($optype==1);

# emit the code for support procedures

if ($arity == 0) {
# emit support procedures for an image-image operation
	for ($i=0; $i<@@names; $i++) {
	  for ($j=($comm?$i:0); $j<@@names; $j++) {
		# If the operation is commutative, we don't need to generate
		# the mirror image of an asymmetric support procedure.
		# We merely have to swap the order of the arguments in
		# the call.
		&generate_binary_op($i,"l",$j,"r");
	  }
	}
} elsif ($arity == 1) {
# emit support procedures for an image-scalar operation
	for ($i=0; $i<@@names; $i++) {
		if ($i>1 && $comm) {
			&generate_binary_op(1,"r",$i,"l");
		} else {
			&generate_binary_op($i,"l",1,"r");
		}
	}
} else {
# emit support procedures for an scalar-image operation
	for ($i=0; $i<@@names; $i++) {
		if ($i<1 && $comm) {
			&generate_binary_op($i,"r",1,"l");
		} else {
			&generate_binary_op(1,"l",$i,"r");
		}
	}
}

# Emit the code that calls the support procedures.
# This is an externally available operator.

if (0 && $infix) {
	$funcname = "operator OP";
} else {
	$funcname = "OP";
}

if ($pwise) {
	print "IA_DiscreteImage<ATYPE>\n";
} else {
	print "ATYPE ";
}

if ($arity==0) {

	# generate an image - image operation

	print "$funcname ( const IA_DiscreteImage<LTYPE> &lhs,\n",
		"\t      const IA_DiscreteImage<RTYPE> &rhs)\n{\n",
		"    if (lhs.domain() != rhs.domain()) {\n",
		"\tstatic ",
		$pwise?"IA_DiscreteImage<ATYPE>":"ATYPE", "\trval;\n",
		"\tia_throw( IA::PSET_MISMATCH, __FILE__,__LINE__);\n",
		"\treturn rval;\n",
		"    }\n\n";

	print "    ";
	for ($i=0; $i<@@names; $i++) {
	  &emit_begin_imagecase($i,"l");

	  print "\t";
	  for ($j=0; $j<@@names; $j++) {
	    &emit_begin_imagecase($j,"r");
	    print "\t    return ";
	    &emit_support_call($i,$j);
	    print ";\n";
	    &emit_end_imagecase($j,"\t");
	  }
	  &emit_end_imagecase($i,"\n    ");
	}
	print "\n}\n";

} elsif ($arity == 1) {

	# generate an image - scalar operation

	print "$funcname ( const IA_DiscreteImage<LTYPE> &lhs, RTYPE rhs)\n{\n";
	print "    ";
	for ($i=0; $i<@@names; $i++) {
	  &emit_begin_imagecase($i,"l");
	  print "\treturn ";
	  &emit_support_call($i,-1);
	  &emit_end_imagecase($i,";\n    ");
	}
	print "\n}\n";

} else {

	# generate an image - scalar operation

	print "$funcname (LTYPE lhs, const IA_DiscreteImage<RTYPE> &rhs)\n{\n";
	print "    ";
	for ($j=0; $j<@@names; $j++) {
	  &emit_begin_imagecase($j,"r");
	  print "\treturn ";
	  &emit_support_call(-1,$j);
	  &emit_end_imagecase($j,";\n    ");
	}
	print "\n}\n";

}
@


1.5
log
@the domains of the two images are now checked for match.
floats and u_chars are now passed by value.
@
text
@d3 4
a6 1
# $Id: generate-bo.perl,v 1.4 93/03/10 13:47:07 thoth Exp Locker: thoth $
d8 2
d12 4
d28 1
a28 1
# $Id: generate-bo.perl,v 1.4 93/03/10 13:47:07 thoth Exp Locker: thoth $
d32 4
@


1.4
log
@*** empty log message ***
@
text
@d3 1
a3 1
# $Id: generate-ops-c.perl,v 1.2 93/03/10 13:38:55 thoth Exp $
d6 4
a9 1
# $Log:	generate-ops-c.perl,v $
d19 1
a19 1
# $Id: generate-bo.perl,v 1.3 93/03/10 13:37:41 thoth Exp Locker: thoth $
d23 3
d386 7
a392 1
		"\t      const IA_DiscreteImage<RTYPE> &rhs)\n{\n";
@


1.3
log
@A few extra parenthesis can't hurt.
Detection of infix should now be automatic.
@
text
@d3 5
d16 1
a16 1
# $Id: generate-bo.perl,v 1.2 93/02/24 10:42:10 thoth Exp Locker: thoth $
d20 4
@


1.2
log
@revamping to allow strict relational operators.
@
text
@d11 1
a11 1
# $Id$
d14 4
a17 1
# $Log$
d178 1
a178 1
		print "\t    if (!(";
d181 2
a182 2
		print "(", &inloop_val($i,"l"), ")SUBOP(",
			&inloop_val($j,"r"), ")";
d190 1
a190 1
		print "))\n\t\treturn 0;\n\t}\n";
d354 1
a354 1
if ($infix) {
@


1.1
log
@Initial revision
@
text
@d11 1
d13 6
d97 1
a97 1
sub emitval {
d101 1
a101 1
		print "*(${side}s++)";
d103 1
a103 1
		print "${side}hs";
d105 1
a105 1
		print "${side}tmp";
d135 5
a139 1
	print "static IA_DiscreteImage<ATYPE>\n";
d166 10
a175 2
	if ($i==2) {
		print "\t    liter(ltmp);\n";
d177 6
a182 2
	if ($j==2) {
		print "\t    riter(rtmp);\n";
d184 2
a185 8
# perform the operation for one pixel, Yaay!
	print "\t    *(ds++) = ";
	if ($isop) {
		print "(";
		&emitval($i,"l");
		print ") OP (";
		&emitval($j,"r");
		print ")";
d187 1
a187 5
		print "OP(";
		&emitval($i,"l");
		print ", ";
		&emitval($j,"r");
		print ")";
d189 2
a190 1
	print ";\t}\n    }\n";
d192 5
a196 2
	print "    return IA_DiscreteImage<ATYPE>(domain, vec, sz, 1);\n}\n";

d242 3
a244 3
	print "IA_DiscreteImage<ATYPE> ($domain, ";
	if ($isop) {
		print "$lexpr OP $rexpr";
d246 1
a246 1
		print "OP($lexpr, $rexpr)";
d248 1
a248 1
	print ")";
d275 2
a276 1
$isop = 2;
d283 1
d290 3
d294 8
a301 3
		$isop = 1;
	} elsif ($_ eq "-fn") {
		$isop = 0;
d308 2
a309 1
die "Must select -op or -fn.\n" if ($isop>1);
d311 4
d351 1
a351 1
if ($isop) {
d357 6
d367 1
a367 2
	print "IA_DiscreteImage<ATYPE>\n",
		"$funcname ( const IA_DiscreteImage<LTYPE> &lhs,\n",
d390 1
a390 2
	print "IA_DiscreteImage<ATYPE>\n",
		"$funcname ( const IA_DiscreteImage<LTYPE> &lhs, RTYPE rhs)\n{\n";
d404 1
a404 2
	print "IA_DiscreteImage<ATYPE>\n",
		"$funcname (LTYPE lhs, const IA_DiscreteImage<RTYPE> &rhs)\n{\n";
@
