head	1.8;
access;
symbols
	bobbase:1.7
	bob:1.7.1
	r2_1:1.7
	r2_0:1.7
	r1_1_beta:1.7
	r1_1_alpha:1.7
	r1_0:1.7
	r0_11:1.6
	r0_10:1.4
	r0_9:1.1;
locks
	fjsoria:1.8; strict;
comment	@# @;


1.8
date	95.02.01.18.25.36;	author fjsoria;	state Exp;
branches;
next	1.7;

1.7
date	94.05.17.12.57.54;	author thoth;	state Exp;
branches
	1.7.1.1;
next	1.6;

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

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

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

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

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

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

1.7.1.1
date	94.12.28.17.50.26;	author thoth;	state Exp;
branches;
next	;


desc
@generator for C code for image operations.
@


1.8
log
@fix for cast problem in g++
@
text
@#!/local/bin/perl

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


# $Id: c-gen-ops.perl,v 1.7 1994/05/17 12:57:54 thoth Exp thoth $

#
# $Log: c-gen-ops.perl,v $
# Revision 1.7  1994/05/17  12:57:54  thoth
# Improved operations generation scheme.  Lines from the op.desc file can
# be quoted into the .c file to allow inclusion of infrastructure.  Also
# the op.desc output can be redirected to several files.  The prefix
# directive allows common information (include files) to be included in
# every generated source file.
#
# Revision 1.6  1994/02/12  19:45:10  thoth
# removed cruft.
# improved data hiding.
#
# Revision 1.5  1994/02/03  16:22:48  thoth
# Arguments to binary operations were specified "lhs rhs return" but are
# now specified "return lhs rhs" to be consistent with function declaration
# syntax.
#
# Revision 1.4  1994/01/31  15:56:25  thoth
# What was previously called conversion is really a constructor.  We have
# a new thing that is truly a conversion (for stuff like int->float in the
# int class).
#
# Revision 1.3  1994/01/07  15:12:35  thoth
# Image class is now CoreImage and named image types are
# Image<P,T>.
#
# Revision 1.2  1993/12/29  17:33:18  thoth
# New operator scheme that prevents the need for trivial Image conversions.
#
# Revision 1.1  1993/09/15  13:04:07  thoth
# Initial revision
#
# 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.
# 

#
# Stuff to handle buffering for the prefix stuff
#

sub get_line {
    if (@@buffer) {
	return shift(@@buffer);
    } else {
	return scalar(<>);
    }
}

sub push_lines {
    push(@@buffer, @@_);
    #print STDERR "pushed ", scalar(@@_), " lines into buffer\n";
}

#
#
#

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

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

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, $zero, $atype, $ltype, $rtype) = @@_;
	open(FILE, "<opgen-templs/$fname") ||
			die "couldn't open opgen-templs/$fname, stopped";
#	print STDERR "zero : $zero. \t ltype: $ltype\n";
	local($_);
	local($/) = -1;
	$_ = <FILE>;
	s/\bOP\b/$op/g;
	s/\bSUBOP\b/$subop/g;
	local($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;
	s/ZERO/$zero/g;
	print $_;
	$/ = '\n';
	close(FILE);
}


@@buffer = ();
open(REALOUT, ">&STDOUT") || die "unable to copy stdout";
close(STDOUT);

while ($_ = &get_line) {
    if (/^#/) {
	if ($' eq "\n") {
	    print $';
	} else {
	    print "// ",$';
	}
	next;
    } elsif (/^"H?C/) {
	print $';
	next;
    } elsif (/^"H/) {
	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 "filename") {
	    close(STDOUT);
	    local($filename) = @@_;
	    open(STDOUT, ">$filename")
		|| die "unable to open $filename for write";
	    print REALOUT $filename, "\n";
	    #print STDERR "Opened $filename for write \n";

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

// Machine generated include file, do not modify.

EOT
    ;
	    &push_lines(@@file_prefix);
	    @@_ = (); last;	# next input line
	} elsif ($_ eq "prefix") {
	    @@file_prefix = ();
	    while (<>) {
		last if (/^end$/);

		push(@@file_prefix, $_);
	    }
	    #print STDERR "Prefix contains ", scalar(@@file_prefix), " lines\n";
	    @@_ = (); last;	# next input line

	} elsif ($_ eq "reduction") {
	    $pwise = 0;
	    $bin = 0;
	} elsif ($_ eq "pointwise") {
	    $pwise = 1;
	} elsif ($_ eq "strictrel") {
	    $pwise = 2;
	} elsif ($_ eq "constructor") {
	    $pwise = 3;
	} elsif ($_ eq "conversion") {
	    $pwise = 4;

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

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

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

    unless (@@_) { next; }

    local($op, $subopname, $subop);
    undef($zero);

    $op = shift(@@_);
    if ($pwise == 3 || $pwise == 4) {
	$subopname = "none";
	$subop = "";
    } else {
	$subopname = $subop = $op;
    }
    while (1) {
	if ($_[0] =~ /^subop=/) {
	    $subopname = $subop = $';
	} elsif ($_[0] =~ /^zero=/) {
	    $zero = $';
	} else {
	    last;
	}
	shift(@@_);
    }

    #print STDERR "function $op, subop=$subop\n";

    $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";
	defined($zero) || die "reductions require a zero.";
	&file_substitution("reduce_".($infix?"op":"fn")."_nz",
		$op, $subop, $zero, &basetype($rtype), &basetype($argtype),
		" #ERROR# ");
    } elsif ($pwise==3) {
	local($lhs) = @@_;
	(&is_imagearg($op) && &is_imagearg($lhs)) || die "constructor must be from image to image. stopped";
	&file_substitution("constructor", $op, $op, "#error#",
			&basetype($op), &basetype($lhs), " #ERROR# ");
    } elsif ($pwise==4) {
	local($lhs) = @@_;
	(&is_imagearg($op) && &is_imagearg($lhs)) || die "conversion must be from image to image. stopped";
	&file_substitution("conversion", $op, $subop, "#error#",
			&basetype($op), &basetype($lhs), " #ERROR# ");
    } elsif ($bin) {
	local($rtype, $lhs, $rhs) = @@_;

	$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, "#error#", &basetype($rtype),
			   &basetype($lhs),&basetype($rhs));
    } else { # unary
	local($rtype, $arg) = @@_;
	if ($opeq) {
	    print "// There are none (it's inline)\n";
	} else {
	    &file_substitution("upw", $op, $subop, "#error#",
			       &basetype($rtype),
			       &basetype($arg),"");
	}
    }
    print "\n";
}

exit 0;

print<<EndOfDescription

Lines beginning with a # are ignored.


EndOfDescription
@


1.7
log
@Improved operations generation scheme.  Lines from the op.desc file can
be quoted into the .c file to allow inclusion of infrastructure.  Also
the op.desc output can be redirected to several files.  The prefix
directive allows common information (include files) to be included in
every generated source file.
@
text
@d9 1
a9 1
# $Id: generate-ops-c.perl,v 1.6 1994/02/12 19:45:10 thoth Exp thoth $
d12 8
a19 1
# $Log: generate-ops-c.perl,v $
d248 7
a254 2
    $subopname = $subop = $op = shift(@@_);

d266 2
d287 1
a287 1
	&file_substitution("conversion", $op, $op, "#error#",
@


1.7.1.1
log
@Constructors and conversions are impossible as friends.
@
text
@d9 1
a9 1
# $Id: c-gen-ops.perl,v 1.7 1994/05/17 12:57:54 thoth Exp thoth $
d12 1
a12 8
# $Log: c-gen-ops.perl,v $
# Revision 1.7  1994/05/17  12:57:54  thoth
# Improved operations generation scheme.  Lines from the op.desc file can
# be quoted into the .c file to allow inclusion of infrastructure.  Also
# the op.desc output can be redirected to several files.  The prefix
# directive allows common information (include files) to be included in
# every generated source file.
#
d266 4
a269 8
	if (1) {
	    print "//** constructors are obsolete?\n";
	} else {
	    local($lhs) = @@_;
	    (&is_imagearg($op) && &is_imagearg($lhs)) || die "constructor must be from image to image. stopped";
	    &file_substitution("constructor", $op, $op, "#error#",
			       &basetype($op), &basetype($lhs), " #ERROR# ");
	}
d271 4
a274 8
	if (1) {
	    print "//** conversions are obsolete?\n";
	} else {
	    local($lhs) = @@_;
	    (&is_imagearg($op) && &is_imagearg($lhs)) || die "conversion must be from image to image. stopped";
	    &file_substitution("conversion", $op, $op, "#error#",
			       &basetype($op), &basetype($lhs), " #ERROR# ");
	}
@


1.6
log
@removed cruft.
improved data hiding.
@
text
@d9 1
a9 1
# $Id: generate-ops-c.perl,v 1.5 1994/02/03 16:22:48 thoth Exp thoth $
d13 4
d59 20
a146 4
print <<EOT
// Emacs -*- C++ -*-

// Machine generated include file, do not modify.
d148 3
a150 2
EOT
;
d152 1
a152 1
while (<>) {
d160 5
d180 29
a208 1
    	if ($_ eq "reduction") {
@


1.5
log
@Arguments to binary operations were specified "lhs rhs return" but are
now specified "return lhs rhs" to be consistent with function declaration
syntax.
@
text
@d9 1
a9 1
# $Id: generate-ops-c.perl,v 1.4 1994/01/31 15:56:25 thoth Exp thoth $
d13 5
a68 34
sub retcodeof {
	local($_) = @@_;
	if (/^I\((.*)\)$/) {
		return "IA_CoreImage<IA_IntPoint,".$1.">";
	} else {
		return $_;
	}
}

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

sub paramcodeof {
	local($_) = @@_;
	if (/^I\((.*)\)$/) {
		return "const IA_CoreImage<IA_IntPoint,".$1."> &";
	} elsif (1 ||
		 $_ eq "u_char" ||
		 $_ eq "int" ||
		 $_ eq "float" ||
		 $_ eq "double") {
		return $_;
	} else {
		# gotta find a way to do this
		return "const ".$_." &";
	}
}

d108 1
a108 1
	$opname = &make_opname($op);
a210 2
	#print $friend,&retcodeof($rtype)," ", $op, "(",
	#	&paramcodeof("I($rtype)"),");\n";
a248 1
	$retcname = &retcodeof($rtype);
a255 1
	# print $opname,"(", &paramcodeof($arg),");\n";
@


1.4
log
@What was previously called conversion is really a constructor.  We have
a new thing that is truly a conversion (for stuff like int->float in the
int class).
@
text
@d9 1
a9 1
# $Id: generate-ops-c.perl,v 1.3 1994/01/07 15:12:35 thoth Exp thoth $
d13 5
d253 1
a253 1
	local($lhs, $rhs, $rtype) = @@_;
@


1.3
log
@Image class is now CoreImage and named image types are
Image<P,T>.
@
text
@d9 1
a9 1
# $Id: generate-ops-c.perl,v 1.2 1993/12/29 17:33:18 thoth Exp $
d13 4
d185 2
d188 1
a188 1
	    $pwise = 3;
a199 10
#	} elsif ($_ eq "function") {
#	    $optype = 0;
#	} elsif ($_ eq "operator") {
#	    $optype = 1;
#	} elsif ($_ eq "opeq") {
#	    $optype = 2;
#	    $bin = 0;
#	} elsif ($_ eq "strictrel") {
#	    $optype = 3;

d239 6
a244 1
	(&is_imagearg($op) && &is_imagearg($lhs)) || die "conversions must be from image to image. stopped";
@


1.2
log
@New operator scheme that prevents the need for trivial Image conversions.
@
text
@d9 1
a9 1
# $Id: generate-ops-c.perl,v 1.1 1993/09/15 13:04:07 thoth Exp thoth $
d13 3
d58 1
a58 1
		return "IA_Image<IA_IntPoint,".$1.">";
d67 1
a67 1
		return "IA_Image<IA_IntPoint,".$1.">";
d76 1
a76 1
		return "const IA_Image<IA_IntPoint,".$1."> &";
@


1.1
log
@Initial revision
@
text
@d9 1
a9 1
# $Id: generate-ops-c.perl,v 1.6 93/05/27 11:46:13 thoth Exp $
d12 4
a15 1
# $Log:	generate-ops-c.perl,v $
d116 1
a116 1
	local($fname, $op, $subop, $atype, $ltype, $rtype) = @@_;
d119 1
d134 1
d209 4
a212 1
    local($op) = shift(@@_);
d214 8
a221 2
    if ($_[0] =~ /^subop=/) {
	$subopname = $subop = $';
a222 2
    } else {
	$subopname = $subop = $op;
d232 1
d234 1
a234 1
		$op, $subop, &basetype($rtype), &basetype($argtype),
d241 1
a241 1
	&file_substitution("conversion", $op, $op,
a245 9
	#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)) {
d248 1
a248 1
	  if (&is_imagearg($rhs)) {
d251 1
a251 1
	  } else {
d254 1
a254 1
	  }
d256 1
a256 1
	  if (&is_imagearg($rhs)) {
d259 1
a259 1
	  } else {
d261 1
a261 1
	  }
d264 5
a268 5
		($pwise==2 ? "sr" : "pw")."_".
		( $commcode ? "c":"nc").
		"_${arity}_".($infix ? "op":"fn"),
		$op, $subop, &basetype($rtype),
		&basetype($lhs),&basetype($rhs));
d273 1
a273 1
		print "// There are none (it's inline)\n";
d275 3
a277 2
		&file_substitution("upw", $op, $subop, &basetype($rtype),
			&basetype($arg),"");
@
