head	1.9;
access;
symbols
	bobbase:1.6
	bob:1.6.1
	r2_1:1.6
	r2_0:1.6
	r1_1_beta:1.6
	r1_1_alpha:1.5
	r1_0:1.4
	r0_11:1.4
	r0_10:1.4
	r0_9:1.2;
locks
	thoth:1.6.1.3; strict;
comment	@# @;


1.9
date	95.01.23.20.24.55;	author ljr;	state Exp;
branches;
next	1.8;

1.8
date	95.01.16.23.55.29;	author ljr;	state Exp;
branches;
next	1.7;

1.7
date	95.01.11.16.26.59;	author ljr;	state Exp;
branches;
next	1.6;

1.6
date	94.07.25.17.26.39;	author thoth;	state Exp;
branches
	1.6.1.1;
next	1.5;

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

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

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

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

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

1.6.1.1
date	94.12.28.17.27.06;	author thoth;	state Exp;
branches;
next	1.6.1.2;

1.6.1.2
date	95.01.09.18.21.10;	author thoth;	state Exp;
branches;
next	1.6.1.3;

1.6.1.3
date	95.01.13.19.37.42;	author thoth;	state Exp;
branches;
next	;


desc
@generator for C meta-code for binary operations.
@


1.9
log
@Undid changes made in revision 1.8; changed argtype subroutine to
emit const IA_Image<IA_Point<int>, $type>& to ease BC++ indigestion.
@
text
@#!/local/bin/perl

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

# $Id: gen-bo.perl,v 1.8 1995/01/16 23:55:29 ljr Exp ljr $

#
# $Log: gen-bo.perl,v $
# Revision 1.8  1995/01/16  23:55:29  ljr
# Changed some parameters passed by value to be passed by const
# reference instead to ease BC++ indigestion.
#
# Revision 1.7  1995/01/11  16:26:59  ljr
# Added some casts to resolve ambiguities in generated code for BC++.
#
# Revision 1.6  1994/07/25  17:26:39  thoth
# Name sanitization
#
# Revision 1.5  1994/07/08  16:15:07  thoth
# fixed segv caused by errant constructor/destructor.
#
# Revision 1.4  1994/01/07  15:15:14  thoth
# Image class is now CoreImage and named image types are
# Image<P,T>.
#
# Revision 1.3  1993/12/29  17:33:18  thoth
# New operator scheme that prevents the need for trivial Image conversions.
#
# Revision 1.2  1993/11/17  18:39:50  thoth
# short-circuiting pointwise logical operations were failing to increment
# the pointer.  We now increment outside the expression.
# reductions are now static functions.
#
# Revision 1.1  1993/09/15  13:03:56  thoth
# Initial revision
#
# Revision 1.6  93/05/27  11:46:11  thoth
# Copyright Notices
# 
# 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: gen-bo.perl,v 1.8 1995/01/16 23:55:29 ljr Exp ljr $

#
# $Log: gen-bo.perl,v $
# Revision 1.8  1995/01/16  23:55:29  ljr
# Changed some parameters passed by value to be passed by const
# reference instead to ease BC++ indigestion.
#
# Revision 1.7  1995/01/11  16:26:59  ljr
# Added some casts to resolve ambiguities in generated code for BC++.
#
# Revision 1.6  1994/07/25  17:26:39  thoth
# Name sanitization
#
# Revision 1.5  1994/07/08  16:15:07  thoth
# fixed segv caused by errant constructor/destructor.
#
# Revision 1.4  1994/01/07  15:15:14  thoth
# Image class is now CoreImage and named image types are
# Image<P,T>.
#
# Revision 1.3  1993/12/29  17:33:18  thoth
# New operator scheme that prevents the need for trivial Image conversions.
#
# Revision 1.2  1993/11/17  18:39:50  thoth
# short-circuiting pointwise logical operations were failing to increment
# the pointer.  We now increment outside the expression.
# reductions are now static functions.
#
# Revision 1.1  1993/09/15  13:03:56  thoth
# Initial revision
#
# Revision 1.6  93/05/27  11:46:11  thoth
# Copyright Notices
# 
# 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_VectorI<IA_Point<int>, $type> *";
	} elsif ($variety == 1) {
		return "$type ";
	} else {
		return "const IA_Image<IA_Point<int>, $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_VectorI<IA_Point<int>, $type> *)${side}hs.bip";
	} elsif ($variety == 1) {
		return "((IA_ConstI<IA_Point<int>, $type> *)${side}hs.bip)->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_VectorI<IA_Point<int>, $type>";
	} elsif ($variety == 1) {
		return "IA_ConstI<IA_Point<int>, $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_IVIter<IA_Point<int>, ${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_Image<IA_Point<int>, ATYPE>\n";
	} else {
		print "static 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_Set<IA_Point<int> > 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 IVIter?
	($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 "( (LTYPE)(", &inloop_val($i,"l"), ") SUBOP (RTYPE)(",
			&inloop_val($j,"r"), ") )";
	} else {
		print "SUBOP(", &inloop_val($i,"l"), ", ",
			&inloop_val($j,"r"), ")";
	}
	if ($pwise) {
		print ";\n";
	} else {
		print ")\n\t\treturn 0;\n";
	}
	($i==0) && print "\t    ls++;\n";
	($j==0) && print "\t    rs++;\n";
	print "\t}\n";
	print "    }\n";
	if ($pwise) {
# loop finished.  Result vector is filled.  Give the value vec away.
		print "    return IA_Image<IA_Point<int>, 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_Image<IA_Point<int>, 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_Image<IA_Point<int>, ATYPE>\n";
} else {
	print "ATYPE ";
}

if ($arity==0) {

	# generate an image - image operation

	print "$funcname ( const IA_CoreImage<IA_Point<int>, LTYPE> &lhs_,\n",
		"\t      const IA_CoreImage<IA_Point<int>, RTYPE> &rhs_)\n{\n",
		"    if (lhs_.domain() != rhs_.domain()) {\n",
		"\t ",
		$pwise?"IA_Image<IA_Point<int>, ATYPE>":"ATYPE", "\trval;\n",
		"\tia_throw( IA::PSET_MISMATCH, __FILE__,__LINE__);\n",
		"\treturn rval;\n",
		"    }\n\n";
	print "    IA_Image<IA_Point<int>, LTYPE>	lhs(lhs_);\n";
	print "    IA_Image<IA_Point<int>, RTYPE>	rhs(rhs_);\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_CoreImage<IA_Point<int>, LTYPE> &lhs_, RTYPE rhs)\n{\n";
	print "    IA_Image<IA_Point<int>, LTYPE>	lhs(lhs_);\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_CoreImage<IA_Point<int>, RTYPE> &rhs_)\n{\n";
	print "    IA_Image<IA_Point<int>, RTYPE>	rhs(rhs_);\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.8
log
@Changed some parameters passed by value to be passed by const
reference instead to ease BC++ indigestion.
@
text
@d8 1
a8 1
# $Id: gen-bo.perl,v 1.7 1995/01/11 16:26:59 ljr Exp ljr $
d12 4
d59 1
a59 1
# $Id: gen-bo.perl,v 1.7 1995/01/11 16:26:59 ljr Exp ljr $
d63 4
d131 1
a131 1
		return "IA_Image<IA_Point<int>, $type> ";
d234 2
a235 2
	print "const ", &argtype($i,$ltype),"&lhs,";
        print "const ", &argtype($j,$rtype),"&rhs)\n";
@


1.7
log
@Added some casts to resolve ambiguities in generated code for BC++.
@
text
@d8 1
a8 1
# $Id: gen-bo.perl,v 1.6 1994/07/25 17:26:39 thoth Exp ljr $
d12 3
d55 1
a55 1
# $Id: gen-bo.perl,v 1.6 1994/07/25 17:26:39 thoth Exp ljr $
d59 3
d226 2
a227 1
	print &argtype($i,$ltype),"lhs,",&argtype($j,$rtype),"rhs)\n";
@


1.6
log
@Name sanitization
@
text
@d8 1
a8 1
# $Id: generate-bo.perl,v 1.5 1994/07/08 16:15:07 thoth Exp $
d11 4
a14 1
# $Log: generate-bo.perl,v $
d52 1
a52 1
# $Id: generate-bo.perl,v 1.5 1994/07/08 16:15:07 thoth Exp $
d55 4
a58 1
# $Log: generate-bo.perl,v $
d257 1
a257 1
		print "( (", &inloop_val($i,"l"), ") SUBOP (",
@


1.6.1.1
log
@conversion from Image-friendliness to FBI friendliness.
conversion from switch statement to operator table.
@
text
@d8 1
a8 1
# $Id: gen-bo.perl,v 1.6 1994/07/25 17:26:39 thoth Exp thoth $
d11 1
a11 4
# $Log: gen-bo.perl,v $
# Revision 1.6  1994/07/25  17:26:39  thoth
# Name sanitization
#
d49 1
a49 1
# $Id: gen-bo.perl,v 1.6 1994/07/25 17:26:39 thoth Exp thoth $
d52 1
a52 4
# $Log: gen-bo.perl,v $
# Revision 1.6  1994/07/25  17:26:39  thoth
# Name sanitization
#
a105 2
	return "IA_BaseImage<IA_Point<int>, $type> &";

a123 7

	local($bip);
	#$bip = "${side}hs.bip";
	$bip = "IA_FBI<IA_Point<int>, IA_Point<int>, $type, $type, $type>::extract_baseptr(${side}hs)";

	return "$bip";

d125 1
a125 1
		return "(IA_VectorI<IA_Point<int>, $type> *)$bip";
d127 1
a127 1
		return "((IA_ConstI<IA_Point<int>, $type> *)$bip)->value";
d137 1
a137 1
    local($variety, $type) = @@_;
d139 7
a145 18
    if ($variety == 0) {
	return "IA_VectorI<IA_Point<int>, $type>";
    } elsif ($variety == 1) {
	return "IA_ConstI<IA_Point<int>, $type>";
    } else {
	return "0";
	die "Class 2 is everything else.";
    }
}
sub arg_s_type_ {
    local($variety, $type) = @@_;
    local ($suffix);
    if ($variety<2) {
	$suffix = "::s_type()";
    } else {
	$suffix = "";
    }
    return &arg_s_type($variety, $type).$suffix;
a159 3
	    print "\tIA_VectorI<IA_Point<int>, ${type}> *${side}hs\n",
	    "\t\t= (IA_VectorI<IA_Point<int>, ${type}> *)&${side}hs_;\n";

a160 3
	} elsif ($variety == 1) {
	    print "\tIA_ConstI<IA_Point<int>, ${type}> *${side}hs\n",
	    "\t\t= (IA_ConstI<IA_Point<int>, ${type}> *)&${side}hs_;\n";
d163 1
a163 1
		    "\tIA_BaseIVIter<IA_Point<int>, ${type}>\t*${side}iter = ${side}hs_.value_iterator();\n";
d176 1
a176 1
		return "${side}hs->value";
d194 5
d209 1
a209 1
		print "static IA_BaseImage<IA_Point<int>, ATYPE> *\n";
d214 1
a214 1
	print &argtype($i,$ltype),"lhs_,\n\t",&argtype($j,$rtype),"rhs_)\n";
d216 11
a226 18
	print "{\n    const IA_Set<IA_Point<int> > domain = lhs_.domain();\n";
	if ($i==1 && $j==1) {
	    &emititer($i,"l");
	    &emititer($j,"r");
	    print "    ATYPE	aval = ";
	    if ($infix) {
		print "( lhs->value SUBOP rhs->value )";
	    } else {
		print "SUBOP( lhs->value, rhs->value )";
	    }
	    print ";\n    return ";
	    if ($pwise) {
		print "new IA_ConstI<IA_Point<int>, ATYPE>(domain, aval)";
	    } else {
		print "aval";
	    }
	    print ";\n";
	} else {
d228 1
a228 1
	    print "    const unsigned sz = domain.card();\n",
d230 1
a230 1
	    "    ATYPE *const vec = new ATYPE[sz];\n\n    {\n",
d232 1
a232 1
	    "	ATYPE *ds = vec;\n";
d234 2
a235 2
	    &emititer($i,"l");
	    &emititer($j,"r");
d237 1
a237 1
	    print "\tfor (unsigned i=0; i<sz; i++) {\n";
d239 2
a240 2
	    ($i==2) && print "\t    liter->next(ltmp);\n";
	    ($j==2) && print "\t    riter->next(rtmp);\n";
d244 1
a244 1
	    if ($pwise) {
d246 1
a246 1
	    } else {
d249 2
a250 2
	    }
	    if ($infix) {
d252 2
a253 2
		&inloop_val($j,"r"), ") )";
	    } else {
d255 3
a257 3
		&inloop_val($j,"r"), ")";
	    }
	    if ($pwise) {
d259 1
a259 1
	    } else {
a260 37
	    }
	    ($i==0) && print "\t    ls++;\n";
	    ($j==0) && print "\t    rs++;\n";
	    print "\t}\n";
	    ($i==2) && print "\tdelete liter;\n";
	    ($j==2) && print "\tdelete riter;\n";
	    print "    }\n";
	    if ($pwise) {
# loop finished.  Result vector is filled.  Give the value vec away.
		print "    return new IA_VectorI<IA_Point<int>, ATYPE>(domain, vec, sz, 1);\n";
	    } else {
		print "    return 1;\n";
	    }
	}
	print "}\n";
	if ($i==1 || $j==1) {
		print "#endif // $sym\n";
	}
	print "\n";
}

sub generate_binary_swap
{
	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";

# 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";
d262 4
a265 2

# function header and argument types
d267 2
a268 1
		print "static IA_BaseImage<IA_Point<int>, ATYPE> *\n";
d270 1
a270 1
		print "static ATYPE ";
a271 6
	print $names[$i],"_",$names[$j],"_bo_OPNAME(";
	print &argtype($i,$ltype),"lhs_,\n\t",&argtype($j,$rtype),"rhs_)\n{\n";

	print "    return ", $names[$j], "_", $names[$i], "_bo_OPNAME(rhs_, lhs_);\n";
#	print "// NYI \n\n";

d391 1
a391 1
# emit the operations table declaration
d393 30
a422 15
$curr_tbl  = "IA_Image_IP_ATYPE_LTYPE_RTYPE_OPNAME_tbl";
print "#ifndef BOT_ATYPE_LTYPE_RTYPE_OPNAME\n",
    "#define BOT_ATYPE_LTYPE_RTYPE_OPNAME\n",
    "IA_BinaryOperationsTable<",
    ($pwise ? "IA_BaseImage<IA_Point<int>, ATYPE>*" : "ATYPE"),
    ",\n\tIA_BaseImage<IA_Point<int>, LTYPE>,\n",
    "\tIA_BaseImage<IA_Point<int>, RTYPE> >\n",
    "\t*IA_Image_IP_ATYPE_LTYPE_RTYPE_OPNAME_tbl;\n\n";
#print    "static IA_BinaryOperationsTable<",
#    ($pwise ? "IA_BaseImage<IA_Point<int>, ATYPE>*" : "ATYPE"),
#    ",\n\tIA_BaseImage<IA_Point<int>, LTYPE>,\n",
#    "\tIA_BaseImage<IA_Point<int>, RTYPE> > *&curr_tbl",
#    " = IA_Image_IP_ATYPE_LTYPE_RTYPE_OPNAME_tbl;\n\n";
print    "void IA_fill_Image_IP_ATYPE_LTYPE_RTYPE_OPNAME_tbl();\n\n",
    "#endif // BOT_ATYPE_LTYPE_RTYPE_OPNAME\n";
d424 2
a425 1
# emit operation wrapper 
a438 13
print "$funcname (";
if ($arity==2) {
    print " LTYPE lhs";
} else {
    print " const IA_CoreImage<IA_Point<int>, LTYPE> &lhs";
}
print ",\n";
if ($arity==1) {
    print "\t\tRTYPE rhs";
} else {
    print "\t\tconst IA_CoreImage<IA_Point<int>, RTYPE> &rhs";
}
print ")\n{\n";
a439 51
    print "    if (lhs.domain() != rhs.domain()) {\n",
    "\t ",
    $pwise?"IA_Image<IA_Point<int>, ATYPE>":"ATYPE", "\trval;\n",
    "\tia_throw(Image_DomainMismatch_Exception(__FILE__,__LINE__));\n",
    "\treturn rval;\n",
    "    }\n\n";
}
print "    if (!$curr_tbl)\n",
    "	IA_fill_Image_IP_ATYPE_LTYPE_RTYPE_OPNAME_tbl();\n\n",
    "    ",($pwise ? "IA_BaseImage<IA_Point<int>, ATYPE>*" : "ATYPE"), "(*f)( IA_BaseImage<IA_Point<int>, LTYPE> &,\n",
    "\t\tIA_BaseImage<IA_Point<int>, RTYPE> &);\n",
    "    f = $curr_tbl->lookup_operation\n",
    "	(";
if ($arity==2) {
    print "IA_ConstI<IA_Point<int>, LTYPE>::s_type()";
} else {
    print "lhs.type()";
}
print ", ";
if ($arity==1) {
    print "IA_ConstI<IA_Point<int>, RTYPE>::s_type()";
} else {
    print "rhs.type()";
}
print ");\n";
if ($arity==2) {
    print "    IA_ConstI<IA_Point<int>,LTYPE>	basel(IA_universal_ipset(0), lhs);\n"
} else {
    print "    IA_BaseImage<IA_Point<int>,LTYPE>	&basel =",
    " *IA_FBI<IA_Point<int>,IA_Point<int>, LTYPE,LTYPE,LTYPE>\n",
    "	    ::extract_baseptr(lhs);\n";
}
if ($arity==1) {
    print "    IA_ConstI<IA_Point<int>,LTYPE>	baser(IA_universal_ipset(0), rhs);\n"
} else {
    print "    IA_BaseImage<IA_Point<int>,LTYPE>	&baser =",
    " *IA_FBI<IA_Point<int>,IA_Point<int>, LTYPE,LTYPE,LTYPE>\n",
    "	    ::extract_baseptr(rhs);\n";
}
print "    return ";
if ($pwise) {
    print "IA_Image<IA_Point<int>,ATYPE>\n",
    "	(IA_FBI<IA_Point<int>,IA_Point<int>, ATYPE,ATYPE,ATYPE>\n",
    "	 ::make_Image(";
}
print "	 f(basel,baser)";
if ($pwise) {
    print "))";
}
print ";\n",
    "}\n\n//\n//\n//\n\n";
d441 1
d443 26
a468 1
# emit the code for support procedures
a469 15
if ($arity == 0) {
# emit support procedures for an image-image operation
    for ($i=0; $i<@@names; $i++) {
	for ($j=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.
	    if ($comm && $j<$i) {
		&generate_binary_swap($i,"l",$j,"r"); 
	    } else {
		&generate_binary_op($i,"l",$j,"r"); 
	    }
	}
    }
d471 11
a481 7
# 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");
	    &generate_binary_swap($i,"l",1,"r");
	} else {
	    &generate_binary_op($i,"l",1,"r");
d483 2
a484 1
    }
a485 10
# 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");
	    &generate_binary_swap(1,"l",$i,"r");
	} else {
	    &generate_binary_op(1,"l",$i,"r");
	}
    }
}
d487 1
a487 15
{
    print "#ifndef FILL_BOT_ATYPE_LTYPE_RTYPE_OPNAME\n",
    "#define FILL_BOT_ATYPE_LTYPE_RTYPE_OPNAME\n";
    local ($bop) = "IA_BinaryOperationsTable<".
        ($pwise ? "IA_BaseImage<IA_Point<int>, ATYPE>*" : "ATYPE").
	    ",\n\tIA_BaseImage<IA_Point<int>, LTYPE>,\n".
		"\tIA_BaseImage<IA_Point<int>, RTYPE> >";
    print "void IA_fill_Image_IP_ATYPE_LTYPE_RTYPE_OPNAME_tbl()\n",
    "{\n",
    "    if ($curr_tbl)\n",
    "\treturn;\n\n",
    
    "    $bop::function f;\n",
    "    f = ",$names[@@names-1],"_",$names[@@names-1],"_bo_OPNAME;\n\n",
    "    $curr_tbl = new $bop(iter_iter_bo_OPNAME);\n";
d489 3
a491 1
    for ($i=0; $i<@@names; $i++) {
d493 4
a496 6
	    next if (($i+1)==@@names && ($j+1)==@@names);

	    print "    $curr_tbl->add_operation\n",
	    "\t(", &arg_s_type_($i, "LTYPE"), ",\n",
	    "\t ", &arg_s_type_($j, "RTYPE"), ",\n",
	    "\t ", $names[$i],"_",$names[$j],"_bo_OPNAME);\n";
d498 1
a498 2
	print "\n";
    }
a499 2
    print "}\n";
    print "#endif // BOT_ATYPE_LTYPE_RTYPE_OPNAME\n";
a500 2

exit 0;
@


1.6.1.2
log
@removed duplicate log traces.
@
text
@d8 36
d52 1
a52 1
# $Id: gen-bo.perl,v 1.6.1.1 1994/12/28 17:27:06 thoth Exp thoth $
a55 4
# Revision 1.6.1.1  1994/12/28  17:27:06  thoth
# conversion from Image-friendliness to FBI friendliness.
# conversion from switch statement to operator table.
#
d77 17
@


1.6.1.3
log
@CoreImage has been re-merged with Image.  All special stuff should be
friends of FBI now.
@
text
@d16 1
a16 1
# $Id: gen-bo.perl,v 1.6.1.2 1995/01/09 18:21:10 thoth Exp thoth $
a19 3
# Revision 1.6.1.2  1995/01/09  18:21:10  thoth
# removed duplicate log traces.
#
d452 1
a452 1
    print " const IA_Image<IA_Point<int>, LTYPE> &lhs";
d458 1
a458 1
    print "\t\tconst IA_Image<IA_Point<int>, RTYPE> &rhs";
@


1.5
log
@fixed segv caused by errant constructor/destructor.
@
text
@d8 1
a8 1
# $Id: generate-bo.perl,v 1.4 1994/01/07 15:15:14 thoth Exp thoth $
d12 3
d49 1
a49 1
# $Id: generate-bo.perl,v 1.4 1994/01/07 15:15:14 thoth Exp thoth $
d53 3
d107 1
a107 1
		return "const IA_VectorI<IA_IntPoint, $type> *";
d111 1
a111 1
		return "IA_Image<IA_IntPoint, $type> ";
d125 1
a125 1
		return "(IA_VectorI<IA_IntPoint, $type> *)${side}hs.bip";
d127 1
a127 1
		return "((IA_ConstI<IA_IntPoint, $type> *)${side}hs.bip)->value";
d140 1
a140 1
		return "IA_VectorI<IA_IntPoint, $type>";
d142 1
a142 1
		return "IA_ConstI<IA_IntPoint, $type>";
d163 1
a163 1
		    "\tIA_IVIter<IA_IntPoint, ${type}>\t${side}iter(${side}hs);\n";
d209 1
a209 1
		print "static IA_Image<IA_IntPoint, ATYPE>\n";
d216 1
a216 1
	print "{\n    const IA_IntPointSet domain = ";
d268 1
a268 1
		print "    return IA_Image<IA_IntPoint, ATYPE>(domain, vec, sz, 1);\n";
d318 1
a318 1
	$pwise && print "IA_Image<IA_IntPoint, ATYPE> ($domain, ";
d434 1
a434 1
	print "IA_Image<IA_IntPoint, ATYPE>\n";
d443 2
a444 2
	print "$funcname ( const IA_CoreImage<IA_IntPoint, LTYPE> &lhs_,\n",
		"\t      const IA_CoreImage<IA_IntPoint, RTYPE> &rhs_)\n{\n",
d447 1
a447 1
		$pwise?"IA_Image<IA_IntPoint, ATYPE>":"ATYPE", "\trval;\n",
d451 2
a452 2
	print "    IA_Image<IA_IntPoint, LTYPE>	lhs(lhs_);\n";
	print "    IA_Image<IA_IntPoint, RTYPE>	rhs(rhs_);\n";
d474 2
a475 2
	print "$funcname ( const IA_CoreImage<IA_IntPoint, LTYPE> &lhs_, RTYPE rhs)\n{\n";
	print "    IA_Image<IA_IntPoint, LTYPE>	lhs(lhs_);\n";
d489 2
a490 2
	print "$funcname (LTYPE lhs, const IA_CoreImage<IA_IntPoint, RTYPE> &rhs_)\n{\n";
	print "    IA_Image<IA_IntPoint, RTYPE>	rhs(rhs_);\n";
@


1.4
log
@Image class is now CoreImage and named image types are
Image<P,T>.
@
text
@d8 1
a8 1
# $Id: generate-bo.perl,v 1.3 1993/12/29 17:33:18 thoth Exp thoth $
d12 4
d46 1
a46 1
# $Id: generate-bo.perl,v 1.3 1993/12/29 17:33:18 thoth Exp thoth $
d50 4
d440 1
a440 1
		"\tstatic ",
@


1.3
log
@New operator scheme that prevents the need for trivial Image conversions.
@
text
@d8 1
a8 1
# $Id: generate-bo.perl,v 1.2 1993/11/17 18:39:50 thoth Exp thoth $
d12 3
d42 1
a42 1
# $Id: generate-bo.perl,v 1.2 1993/11/17 18:39:50 thoth Exp thoth $
d46 3
d200 1
a200 1
	print "/*PROMOTE*/",&argtype($i,$ltype),"lhs,","/*PROMOTE*/",&argtype($j,$rtype),"rhs)\n";
d420 1
a420 1
	print "/*PROMOTE*/IA_Image<IA_IntPoint, ATYPE>\n";
d429 2
a430 2
	print "$funcname ( const IA_Image<IA_IntPoint, LTYPE> &lhs_,\n",
		"\t      const IA_Image<IA_IntPoint, RTYPE> &rhs_)\n{\n",
d437 2
a438 2
	print "    /*PROMOTE*/IA_Image<IA_IntPoint, LTYPE>	lhs(lhs_);\n";
	print "    /*PROMOTE*/IA_Image<IA_IntPoint, RTYPE>	rhs(rhs_);\n";
d460 2
a461 2
	print "$funcname ( const IA_Image<IA_IntPoint, LTYPE> &lhs_, RTYPE rhs)\n{\n";
	print "    /*PROMOTE*/IA_Image<IA_IntPoint, LTYPE>	lhs(lhs_);\n";
d475 2
a476 2
	print "$funcname (LTYPE lhs, const IA_Image<IA_IntPoint, RTYPE> &rhs_)\n{\n";
	print "    /*PROMOTE*/IA_Image<IA_IntPoint, RTYPE>	rhs(rhs_);\n";
@


1.2
log
@short-circuiting pointwise logical operations were failing to increment
the pointer.  We now increment outside the expression.
reductions are now static functions.
@
text
@d8 1
a8 1
# $Id: generate-bo.perl,v 1.1 1993/09/15 13:03:56 thoth Exp thoth $
d12 5
d39 1
a39 1
# $Id: generate-bo.perl,v 1.1 1993/09/15 13:03:56 thoth Exp thoth $
d43 5
d194 1
a194 1
	print &argtype($i,$ltype),"lhs,",&argtype($j,$rtype),"rhs)\n";
d414 1
a414 1
	print "IA_Image<IA_IntPoint, ATYPE>\n";
d423 3
a425 3
	print "$funcname ( const IA_Image<IA_IntPoint, LTYPE> &lhs,\n",
		"\t      const IA_Image<IA_IntPoint, RTYPE> &rhs)\n{\n",
		"    if (lhs.domain() != rhs.domain()) {\n",
d431 2
d454 2
a455 1
	print "$funcname ( const IA_Image<IA_IntPoint, LTYPE> &lhs, RTYPE rhs)\n{\n";
d469 2
a470 1
	print "$funcname (LTYPE lhs, const IA_Image<IA_IntPoint, RTYPE> &rhs)\n{\n";
@


1.1
log
@Initial revision
@
text
@d8 1
a8 1
# $Id: generate-bo.perl,v 1.6 93/05/27 11:46:11 thoth Exp $
d11 4
a14 1
# $Log:	generate-bo.perl,v $
d34 1
a34 1
# $Id: generate-bo.perl,v 1.6 93/05/27 11:46:11 thoth Exp $
d37 4
a40 1
# $Log:	generate-bo.perl,v $
d144 1
a144 1
		return "*(${side}s++)";
d181 1
a181 1
		print "ATYPE ";
d228 1
a228 1
		print ";\n\t}\n";
d230 1
a230 1
		print ")\n\t\treturn 0;\n\t}\n";
d232 3
@
