eudora-mac/Bits/makecomponent

#!/usr/local/bin/perl
#
# this thing generates all sorts of component crap
#
# usage: makecomponent prefix outputfile.h outputfile.c inputfiles...
#    eg: makecomponent PETE :include:petecomp.h petecomp.c :{ext}:editor:pete.h
#
$prefix = $ARGV[0]; shift;
$hfile = $ARGV[0]; shift;
$cfile = $ARGV[0]; shift;

$littlePrefix = $prefix;
$littlePrefix =~ s/(.).*/$1/;
$littlePrefix =~ tr/A-Z/a-z/;

%smallTypes = ("Boolean",1, "Byte",1, "char",1);

open(HFILE,">$hfile")||die;
open(CFILE,">$cfile")||die;
while (<>)
{
	if (/^pascal/)
	{
		chop;

		#
		# make sure we can use whitespace for tokens
		s/\(/ \(/g;

		#
		# trim the pascal part
		s/pascal\s*//;
		
		#
		# nab the return type
		($returns,$rest) = split("[ \t]+",$_,2);
		
		#
		# nab the function name
		($func,$rest) = split("[ \t]+",$rest,2);
		
		#
		# and the parameters
		$rest =~ s/.*\(//;
		$rest =~ s/\).*//;
		$params = $rest;
		@params = split(',',$rest);
		
		#
		# record the function name
		$funcList[$#funcList+1] = $func;
		
		#
		# Declare the param structure
		print HFILE "typedef struct $func" . "Params\n{\n";
		for ($i=$#params;$i>=0;$i--)
		{
			$littleParam = $params[$i];
			$littleParam =~ s/[ \t]+.*//;
			print HFILE "\t$params[$i];\n";
			if ($smallTypes{$littleParam})
			{
				print HFILE "\tByte filler$i;\n";
			}
		}
		print HFILE "} $func" . "Params;\n\n";
		
		#
		# now ugly UPP stuff
		#
		
		#
		# ProcPtrs
		print HFILE "typedef pascal $returns (*$func" . "ProcPtr)($params);\n";
		print HFILE "#if GENERATINGCFM\n";
		print HFILE "typedef UniversalProcPtr $func" . "UPP;\n";
		print HFILE "#else\n";
		print HFILE "typedef $func" . "ProcPtr $func" . "UPP;\n";
		print HFILE "#endif\n\n";
		
		#
		# UPP enum
		print HFILE "enum {\n";
		print HFILE "\tupp" . $func . "ProcInfo = kPascalStackBased\n";
		if ($returns ne "void")
		{
			print HFILE "\t\t| RESULT_SIZE(SIZE_CODE(sizeof($returns)))\n";
		}
		for ($i=0;$i<=$#params;$i++)
		{
			$littleParam = $params[$i];
			$littleParam =~ s/[ \t]+.*//;
			print HFILE "\t\t| STACK_ROUTINE_PARAMETER(" . ($i+1) . ", SIZE_CODE(sizeof($littleParam)))\n";
		}
		print HFILE "};\n\n";
		
		#
		# NewRoutineDescriptor stuff
		print HFILE "#if GENERATINGCFM\n";
		print HFILE "#define $func" . "Proc(userRoutine)\\\n";
		print HFILE "\t($func" . "UPP) NewRoutineDescriptor((ProcPtr)(userRoutine)\\\n";
		print HFILE "\t\tupp$func" . "ProcInfo,\\\n";
		print HFILE "\t\tSetCurrentArchitecture())\n";
		print HFILE "#else\n";
		print HFILE "typedef $func" . "Proc(userRoutine)\\\n";
		print HFILE "\t(($func" . "UPP) (userRoutine))\n";
		print HFILE "#endif\n\n";
		
		#
		# the call macro
		print HFILE "#if GENERATINGCFM\n";
		print HFILE "#define Call$func" . "Proc(userRoutine";
		for ($i=0;$i<=$#params;$i++)
		{
			print HFILE ",p" . ($i+1);
		}
		print HFILE ")\\\n";
		print HFILE "\tCallUniversalProc((UniversalProcPtr)(userRoutine),upp$func" . "ProcInfo";
		for ($i=0;$i<=$#params;$i++)
		{
			print HFILE ",(p" . ($i+1) . ")";
		}
		print HFILE ")\n";
		print HFILE "#else\n";
		print HFILE "#define Call$func" . "Proc(userRoutine";
		for ($i=0;$i<=$#params;$i++)
		{
			print HFILE ",p" . ($i+1);
		}
		print HFILE ")\\\n";
		print HFILE "\t(*(userRoutine))(";
		for ($i=0;$i<=$#params;$i++)
		{
			if ($i) {print HFILE ",";}
			print HFILE "(p" . ($i+1) . ")";
		}
		print HFILE ")\n";
		print HFILE "#endif\n\n";
		
		#
		# the gcp stuff
		$littleFunc = $func;
		$littleFunc =~ s/$prefix/$littlePrefix/;
		print HFILE "#define $func(";
		for ($i=0;$i<=$#params;$i++)
		{
			if ($i) {print HFILE ",";}
			print HFILE "p" . ($i+1);
		}
		print HFILE ")\\\n";
		print HFILE "\t(\\\n";
		for ($i=0;$i<=$#params;$i++)
		{
			($type,$littleParam) = split("[ \t]+",$params[$i]);
			print HFILE "\t\tGCP.$littleFunc" . ".$littleParam = p" . ($i+1) . ",\\\n";
		}
		print HFILE "\tGCPCall($tinyFunc))\n\n";
	}
}

#
# a really big union
print HFILE "typedef union $prefix" . "ComponentParamUnion\n{\n";
for ($i=0;$i<=$#funcList;$i++)
{
	$func = $funcList[$i];
	$littleFunc = $func;
	$littleFunc =~ s/$prefix/$littlePrefix/;
	
	print HFILE "\t$func" . "Params $littleFunc;\n";
}
print HFILE "} $prefix" . "ComponentParamUnion;\n\n";

#
# a really big enum
print HFILE "typedef enum\n{\n";
print HFILE "\tk$prefix" . "EnumStart=256,\n";
for ($i=0;$i<=$#funcList;$i++)
{
	print HFILE "\tk$funcList[$i]" . "Rtn,\n";
}
print HFILE "\tk$prefix" . "EnumEnd\n";
print HFILE "} $prefix" . "ComponentRoutineEnum;\n\n";

#
# and now the C file
print CFILE <<BOILER;
//beginning boilerplate here
BOILER
$paramType = $prefix . "ComponentParamUnion";
print CFILE "pascal ComponentResult $prefix" . "_main($paramType *params, Handle globals);\n";
print CFILE "pascal ComponentResult $prefix" . "_main($paramType *params, Handle globals)\n";
print CFILE "{\n";
print CFILE "	OSErr errCode;\n";
print CFILE "	$paramType cp;\n";
print CFILE "	Boolean withStorage;\n";
print CFILE "	$prefix" . "ComponentRoutineEnum routine;\n";
print CFILE "\n";
print CFILE <<BOILER;
	BlockMoveData(params,&cp,sizeof(cp)-sizeof(long)+params->paramSize);
	routine = nil;
	withStorage = false;
	switch (cp.what)
	{
BOILER
for ($i=0;$i<=$#funcList;$i++)
{
	$littleFunc = $funcList[$i];
	$littleFunc =~ s/$prefix//;
	print CFILE "		case k" . $funcList[$i] . "Rtn:\n";
	print CFILE "			COMPONENT_UPP_DECLARATION($littleFunc,$littleFunc,routine);\n";
	print CFILE "			break;\n\n";
}
print CFILE <<BOILER;
//ending boilerplate here
BOILER