head	1.10;
access;
symbols
	bobbase:1.10
	bob:1.10
	r2_1:1.10
	r2_0:1.9
	r1_1_beta:1.9
	r1_1_alpha:1.8
	r1_0:1.8
	r0_11:1.8
	r0_10:1.6
	r0_9:1.3;
locks; strict;
comment	@# @;


1.10
date	94.09.16.14.57.11;	author thoth;	state Exp;
branches;
next	1.9;

1.9
date	94.07.25.17.26.39;	author thoth;	state Exp;
branches;
next	1.8;

1.8
date	94.02.22.18.49.07;	author thoth;	state Exp;
branches;
next	1.7;

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

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

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

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

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

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

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


desc
@generator for C meta-code for convolutions.
@


1.10
log
@more DOS-inspired renaming.
@
text
@#!/local/bin/perl

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

#
# $Log: c-gen-conv.perl,v $
# Revision 1.9  1994/07/25  17:26:39  thoth
# Name sanitization
#
# Revision 1.8  1994/02/22  18:49:07  thoth
# New template-template convolutions.
#
# Revision 1.7  1994/02/12  19:44:25  thoth
# Rehack of template operation specifications.
#
# Revision 1.6  1994/01/31  15:55:37  thoth
# prevented leakage of old values into new convolution specs.
#
# Revision 1.5  1994/01/07  15:24:40  thoth
# Image class is now CoreImage and named image types are
# Image<P,T>.
#
# Revision 1.4  1993/12/29  17:33:18  thoth
# New operator scheme that prevents the need for trivial Image conversions.
#
# Revision 1.3  1993/11/17  18:38:34  thoth
# template reductions are now supported.
# forward convolutions are now supported.
#
# Revision 1.2  1993/09/21  11:43:46  thoth
# the convolution description files can now have arbitrary
# white space in the operation specifications.
#
# Revision 1.1  93/09/15  13:03:22  thoth
# Initial revision
# 
# Revision 1.3  93/05/27  11:46:04  thoth
# Copyright Notices
# 
# Revision 1.2  93/04/29  11:21:43  thoth
# IBTYPE is now used in a #define symbol.
# 
# Revision 1.1  93/03/18  11:22:02  thoth
# Initial revision
# 

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

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

sub is_basic {
    return !&is_image(@@_) && !&is_template(@@_);
}

sub base_type {
    local($_) = @@_;
    if (/^[TI]\((.*)\)$/) {
	return $1;
    } else {
	return $_;
    }
}

sub TT_product_subst {
	local ($fname,
	       $name, $rval, $litype, $ritype) = @@_;
	local ($abtype, $lbtype, $rbtype) =
	    (&base_type($rval), &base_type($litype), &base_type($ritype));

	local ($aitype, $litype, $ritype) =
	    ("IA_Image<IA_Point<int>,$abtype>",
	     "IA_Image<IA_Point<int>,$lbtype>",
	     "IA_Image<IA_Point<int>,$rbtype>");

	local($_);
	local($/) = -1;

	open(FILE, "<$fname") ||
		die "couldn't open $fname";

	$_ = <FILE>;


	s/CONV/$name/g;
	s/ABTYPE/$abtype/g;
	s/AITYPE/$aitype/g;
	s/LBTYPE/$lbtype/g;
	s/LITYPE/$litype/g;
	s/RBTYPE/$rbtype/g;
	s/RITYPE/$ritype/g;

	print "$_\n";

	close(FILE);
}

sub TI_product_subst {
	local ($fname,
	       $init, $accum, $accvar, $final,
	       $name, $rval, $itype, $ttype, $zero) = @@_;
	local ($rbtype, $ibtype, $tbtype) =
	    (&base_type($rval), &base_type($itype), &base_type($ttype));
	local ($titype) = "IA_Image<IA_Point<int>,$tbtype>";

	local ($ival, $tval, $rval) = ("#undef#","#undef#","#undef#");
	local($_);
	local($/) = -1;

	open(FILE, "<$fname") ||
		die "couldn't open $fname";

	$_ = <FILE>;

	s/\bINITIALIZE\b/$init/g;

	s/\bACCUMULATE\b/$accum/g;
	s/\bACCUMULATEVAR\b/$accvar/g;
	s/\bRESULT\b/$final/g;

	s/RTYPE/$rbtype/g;
	s/CONV/$name/g;
	s/IBTYPE\b/$ibtype/g;
	s/\bTBTYPE\b/$tbtype/g;
	s/\bTITYPE\b/$titype/g;
	s/\bZERO\b/$zero/g;

	local(@@_) = split("\n");
	foreach (@@_) {
		if (m:^\s*//\s*_IVAL_=:)    { $ival = $'; next; }
		if (m:^\s*//\s*_TVAL_=:)    { $tval = $'; next; }
		if (m:^\s*//\s*_IRESULT_=:) { $rval = $'; next; }
		s/\bIVAL\b/$ival/g;
		s/\bTVAL\b/$tval/g;
		s/\bIRESULT\b/$rval/g;
	}

	print join("\n", @@_);
	print "\n";

	$/ = '\n';

	close(FILE);
}

sub reduction_subst {
	local ($fname, $accum, $name,
		$rval, $arg, $zero) = @@_;
	local($rbtype, $tbtype) = (&base_type($rval), &base_type($arg));
	local($titype) = "IA_Image<IA_Point<int>,$tbtype>";
	local ($ival, $tval, $rval) = ("#undef#","#undef#","#undef#");
	local($_);
	local($/) = -1;

	open(FILE, "<$fname") ||
		die "couldn't open $fname";

	$_ = <FILE>;

	if (m-^// _IVAL_=-) {
		print STDERR "IVAL: ", $';
	}

	s/\bACCUMULATE\b/$accum/g;

	s/\bRTYPE\b/$rbtype/g;
	s/REDUCT/$name/g;
	s/\bTBTYPE\b/$tbtype/g;
	s/\bTITYPE\b/$titype/g;
	s/\bZERO\b/$zero/g;

	local(@@_) = split("\n");
	foreach (@@_) {
		if (m:^\s*//\s*_TVAL_=:)    { $tval = $'; next; }
		if (m:^\s*//\s*_IRESULT_=:) { $rval = $'; next; }
		s/\bTVAL\b/$tval/g;
		s/\bIRESULT\b/$rval/g;
	}

	print join("\n", @@_);
	print "\n";

	$/ = '\n';

	close(FILE);
}


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 binary_templ_subst
{
    local($fname, $op, $subop, $zero, $rval, $lhs, $rhs) = @@_;

    open(FILE, "<$fname") ||
			die "couldn't open opgen-templs/$fname, stopped";

    local ($baserval, $baselhs, $baserhs) = 
	(&base_type($rval), &base_type($lhs), &base_type($rhs));

    local($_);
    local($/) = -1;
    $_ = <FILE>;
    close(FILE);
    local($opname) = &make_opname($op);
    if ($opname eq "") {
	$opname = $op;
    }
    s/\bOP\b/$op/g;
    s/\bSUBOP\b/$subop/g;
    s/OPNAME/$opname/g;
    s/ATYPE/$baserval/g;
    s/LTYPE/$baselhs/g;
    s/RTYPE/$baserhs/g;
    s/ZERO/$zero/g;
    print;
}

#
#
#


while (<>) {
    next if /^\s*$/;

    if (/^#/) {
	print "//", $';
	next;
    }

    print "// $_";

    @@_ = split;

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

    if ($sort eq "convolution") {

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

	local ($_);

	local($zero);
	while (@@_) {
	    $_ = $_[0];
	    if (/^zero=/) {
		$zero = $';
	    } else {
		last;
	    }
	    shift(@@_);
	}

	local($rval, $lhs, $rhs, @@blah) = @@_;

	die "extra arguments on convolution line: ", join(" ", @@blah)
	    if (@@blah);

	local($init,$accum,$accvar,$final);

	while ($_ = <>) {
	    chop;
	    last if $_ eq "end";

	    if (/^init:\s*/) {
		$init = $';
	    } elsif (/^accum:\s*/) {
		$accum = $';
	    } elsif (/^accvar:\s*/) {
		$accvar = $';
	    } elsif (/^final:\s*/) {
		$final = $';
	    } else {
		die "unknown convolution field: $_\n";
	    }
	}

	if (&is_template($rval)
	    && &is_template($lhs)
	    && &is_template($rhs)) {
	    # template-template convolution
	    &TT_product_subst("templ-templ-product",
			      $name, $rval, $lhs, $rhs);
	} elsif ($zero ne "") {
	    if (&is_image($rval) && &is_template($lhs) && &is_image($rhs)) {
		# forward image-template convolution
		defined $init || die "no initiazlier for convolution $name\n";
		defined $accum || die "no accumulator for convolution $name\n";
		defined $final || die "no final for convolution $name\n";
		defined $accvar || die "no variant accumulator for convolution $name\n";
		&TI_product_subst("templ-img-product", $init,
				  $accum, $accvar, $final,
				  $name, $rval, $rhs, $lhs, $zero);
	    } elsif (&is_image($rval)&& &is_image($lhs)&& &is_template($rhs)) {
		# backward image-template convolution
		defined $init || die "no initiazlier for convolution $name\n";
		defined $accum || die "no accumulator for convolution $name\n";
		defined $final || die "no final for convolution $name\n";
		$accvar = $accum unless defined $accvar;
		&TI_product_subst("img-templ-product", $init,
				  $accum, $accvar, $final,
				  $name, $rval, $lhs, $rhs, $zero);
	    } else {
		die "Unknown argument configuration to convolution: $rval $lhs $rhs\n";
	    }
	} else {
	    print "// non-absorbers not handled yet\n";
	}

	print "\n";
    } elsif ($sort eq "reduction") {

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

	local ($_);

	local($zero);
	while (@@_) {
	    $_ = $_[0];
	    if (/^zero=/) {
		$zero = $';
	    } else {
		last;
	    }
	    shift(@@_);
	}

	local($rval, $arg, @@blah) = @@_;

	die "extra arguments on convolution line: ", join(" ", @@blah)
	    if (@@blah);

	local ($accum);
	while ($_ = <>) {
	    chop;
	    last if $_ eq "end";

	    if (/^accum:\s*/) {
		$accum = $';
	    } else {
		die "unknown convolution field: $_\n";
	    }
	}
	($accum ne "") || die "no accumulator for convolution $name\n";

	if ($zero ne "") {
	    if (&is_image($rval) && &is_template($arg)) {
		&reduction_subst("template-reduction", $accum, $name, 
				 $rval, $arg, $zero);
	    } else {
		die "Unknown argument configuration to reduction: $rval $arg\n";
	    }
	} else {
	    print "// template reductions without an identity are not implemented\n";
	}
    } elsif  ($sort eq "binary") {

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

	local ($_);

	local($subop, $zero, $gamma) = ($name);
	while (@@_) {
	    $_ = $_[0];
	    if (/^zero=/) {
		$zero = $';
	    } elsif (/^gamma=/) {
		$gamma = $';
	    } elsif (/^subop=/) {
		$subop = $';
	    } else {
		last;
	    }
	    shift(@@_);
	}

	local($rval, $lhs, $rhs, @@blah) = @@_;

	die "extra arguments on convolution line: ", join(" ", @@blah)
	    if (@@blah);

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

	if (&is_template($rval) && &is_template($lhs) && &is_template($rhs)) {
	    &binary_templ_subst("bin-T".($infix?"O":"F"),
				$name, $subop, $zero, $rval, $lhs, $rhs);
	} else {
	    die "Unknown argument configuration to binary: $rval $lhs $rhs\n";
	}
    } else {
	die "Unknown template operation $sort at";
    }
}
@


1.9
log
@Name sanitization
@
text
@d9 4
a12 1
# $Log: gen-conv-c.perl,v $
d419 1
a419 1
	    &binary_templ_subst("binary-templ".($infix?"op":"fn"),
@


1.8
log
@New template-template convolutions.
@
text
@d10 3
d75 3
a77 3
	    ("IA_Image<IA_IntPoint,$abtype>",
	     "IA_Image<IA_IntPoint,$lbtype>",
	     "IA_Image<IA_IntPoint,$rbtype>");
d107 1
a107 1
	local ($titype) = "IA_Image<IA_IntPoint,$tbtype>";
d153 1
a153 1
	local($titype) = "IA_Image<IA_IntPoint,$tbtype>";
@


1.7
log
@Rehack of template operation specifications.
@
text
@d10 3
d65 33
d121 1
a121 1
	s/\bRTYPE\b/$rbtype/g;
a304 3
	defined $init || die "no initiazlier for convolution $name\n";
	defined $accum || die "no accumulator for convolution $name\n";
	defined $final || die "no final for convolution $name\n";
d306 7
a312 1
	if ($zero ne "") {
d315 3
d324 3
@


1.6
log
@prevented leakage of old values into new convolution specs.
@
text
@d10 3
d41 22
a62 1
sub absorber_subst {
d64 6
a69 2
		$init, $forw_init, $accum, $accvar, $forw_accvar, $final,
		$rtype, $name, $itype, $tbtype, $titype, $zero) = @@_;
a78 5
	if (m-^// _IVAL_=-) {
		print STDERR "IVAL: ", $';
	}

	s/\bFORW_INITIALIZE\b/$forw_init/g;
a80 1
	s/\bFORW_ACCUMULATEVAR\b/$forw_accvar/g;
d85 1
a85 1
	s/\bRTYPE\b/$rtype/g;
d87 1
a87 1
	s/IBTYPE\b/$itype/g;
d111 4
a114 3
	local ($fname,
		$accum,
		$rtype, $name, $tbtype, $titype, $zero) = @@_;
d130 1
a130 1
	s/\bRTYPE\b/$rtype/g;
d152 63
d231 1
a231 2
	local($rtype, $name, $itype, $ttype, @@blah) = @@_;
	$titype = "IA_Image<IA_IntPoint,$ttype> ";
d233 1
a233 1
	@@_ = @@blah;
a235 1

d237 1
a237 2
	    $_ = shift(@@_);

d241 1
a241 1
		warn "Unknown option $_. ";
d243 1
d246 1
a246 1
	local($init,$accum,$accvar,$final,$forw_init,$forw_accumvar);
d248 5
a264 4
	    } elsif (/^forw_init:\s*/) {
		$forw_init = $'
	    } elsif (/^forw_accumvar:\s*/) {
		$forw_accumvar = $'
d269 3
a271 6
	defined $init || die "no initiazlier for backward convolution $name\n";
	defined $accum || die "no accumulator for backward convolution $name\n";
	$accvar = $accum unless defined $accvar;
	defined $final || die "no final for backward convolution $name\n";
	defined $forw_init || die "no initializer for forward convolution $name\n";
	defined $forw_accumvar || die "no accumulator for forward convolution $name\n";
d274 15
a288 3
	    &absorber_subst("absorber", $init, $forw_init,
			    $accum, $accvar, $forw_accumvar, $final,
			    $rtype, $name, $itype, $ttype, $titype, $zero);
a294 2
	local($rtype, $name, $ttype, @@blah) = @@_;
	$titype = "IA_Image<IA_IntPoint,$ttype> ";
d296 1
a296 1
	@@_ =  @@blah;
d298 2
a300 1

d302 1
a302 2
	    $_ = shift(@@_);

d306 1
a306 1
		warn "Unknown option $_. ";
d308 1
d311 1
a311 3
	$_ = <>; chop;
	/^accum:\s*/ || die "no accumulator for convolution $name\n";
	$accum = $';
d313 16
d330 6
a335 2
	    &reduction_subst("template-reduction", $accum, $rtype,
			    $name, $ttype, $titype, $zero);
d339 36
@


1.5
log
@Image class is now CoreImage and named image types are
Image<P,T>.
@
text
@d10 4
d161 2
@


1.4
log
@New operator scheme that prevents the need for trivial Image conversions.
@
text
@d10 3
d142 1
a142 1
	$titype = "/*PROMOTE*/IA_Image<IA_IntPoint,$ttype> ";
d196 1
a196 1
	$titype = "/*PROMOTE*/IA_Image<IA_IntPoint,$ttype> ";
@


1.3
log
@template reductions are now supported.
forward convolutions are now supported.
@
text
@d10 4
d139 1
a139 1
	$titype = "IA_Image<IA_IntPoint,$ttype> ";
d193 1
a193 1
	$titype = "IA_Image<IA_IntPoint,$ttype> ";
@


1.2
log
@the convolution description files can now have arbitrary
white space in the operation specifications.
@
text
@d9 5
a13 1
# $Log:	gen-conv-c.perl,v $
d27 1
a27 1
sub file_subst {
d29 1
a29 1
		$init, $accum, $accvar, $final,
d44 1
d46 2
d70 42
d130 6
a135 3
    local($rtype, $name, $itype, $ttype, @@blah) = @@_;
   #unless ($ttype =~ m-/-) {die "template type must be of form image/base\n";}
    $titype = "IA_Image<IA_IntPoint,$ttype> ";
d137 1
a137 1
    @@_ = @@blah;
d139 1
a139 1
    local($zero);
d141 2
a142 2
    while (@@_) {
	$_ = shift(@@_);
d144 1
a144 1
	if (/^zero=/) {
d146 36
d183 18
d202 1
a203 1
    }
a204 11
    $_ = <>; chop;
    /^init:\s*/ || die "no initiazlier for convolution $name\n";
    $init = $';

    $_ = <>; chop;
    /^accum:\s*/ || die "no accumulator for convolution $name\n";
    $accum = $';

    $_ = <>; chop;
    if (/^accvar:\s*/) {
	$accvar = $';
d206 2
a207 5
    } else {
	$accvar = $accum;
    }
    /^final:\s*/ || die "no final for convolution $name\n";
    $final = $';
d209 6
a214 5
    if ($zero ne "") {
	&file_subst("absorber", $init, $accum, $accvar, $final,
			$rtype, $name, $itype, $ttype, $titype, $zero);
    } else {
	print "// non-absorbers not handled yet\n";
a215 2

    print "\n";
@


1.1
log
@Initial revision
@
text
@d10 3
d100 1
a100 1
    /^init:\t/ || die "no initiazlier for convolution $name\n";
d104 1
a104 1
    /^accum:\t/ || die "no accumulator for convolution $name\n";
d108 1
a108 1
    if (/^accvar:\t/) {
d114 1
a114 1
    /^final:\t/ || die "no final for convolution $name\n";
@
