1 line
5.3 KiB
Perl
Executable File
1 line
5.3 KiB
Perl
Executable File
#!/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
|