KerberosCFMGlue.pl [plain text]
use strict;
use integer;
my $inExportFile;
my $framework = "/System/Library/Frameworks/Kerberos.framework";
my $outSourceFile = `pwd` . "glue.c";
my $outAssemblyFile = `pwd` . "glue.s";
my $outExportFile = `pwd` . "glue.et";
my $symbol;
my $usage =
"Usage: KerberosCFMGlue <options> export-file\n" .
" [--help] Display this information\n" .
" [--load-framework <framework-path>] Load <framework> for symbols\n" .
" [--out-source <file>] Place the source output into <file>\n" .
" [--out-assembly <file>] Place the assembly output into <file>\n" .
" [--out-export <file>] Place the export output into <file>\n";
while (my $arg = shift @ARGV) {
$_ = $arg;
if (/^--load-framework$/) { $framework = shift @ARGV; }
elsif (/^--out-source$/) { $outSourceFile = shift @ARGV; }
elsif (/^--out-assembly$/) { $outAssemblyFile = shift @ARGV; }
elsif (/^--out-export$/) { $outExportFile = shift @ARGV; }
elsif (/^--help$/) { print $usage; exit 0; }
else { $inExportFile = $arg; }
}
if (!$inExportFile) {
die "$0: No export file specified";
}
my $exportList;
open EXPORTFILE, "${inExportFile}" or die "$0: Unable to open '${inExportFile}': $!\n";
{
undef $/; $exportList = <EXPORTFILE>;
}
close EXPORTFILE;
$exportList =~ s@\$exportList =~ tr! \t\n\r! !s;
my @exportSymbols = split (/\s+/, $exportList);
if ($inExportFile =~ /\.pbexp$/) {
for (my $i = 0; $i < scalar (@exportSymbols); $i++) {
if ($exportSymbols[$i] =~ /^_(.*)$/) {
$exportSymbols[$i] = $1;
}
}
}
open SOURCE, ">$outSourceFile" or die ("$0: Can't open $outSourceFile for writing: $!\n");
select SOURCE;
print "/* This file is autogenerated. Please do not modify it. */\n\n";
print "#include <CFBundle.h>\n";
print "#include <CodeFragments.h>\n\n";
foreach $symbol (@exportSymbols) {
print "extern ProcPtr ${symbol}_ProcPtr;\n";
}
print <<LOADKERBEROSFRAMEWORK;
pascal OSErr __initalizeCFM2MachOGlue (CFragInitBlockPtr inInitBlock);
pascal OSErr __initalizeCFM2MachOGlue (CFragInitBlockPtr inInitBlock)
{
CFBundleRef kerberosBundle = NULL;
CFURLRef kerberosURL = NULL;
Boolean loaded = 0;
kerberosURL = CFURLCreateWithFileSystemPath (kCFAllocatorDefault,
CFSTR("${framework}"),
kCFURLPOSIXPathStyle,
true);
if (kerberosURL == NULL) {
return 1;
}
kerberosBundle = CFBundleCreate (kCFAllocatorDefault, kerberosURL);
CFRelease (kerberosURL);
if (kerberosBundle == NULL) {
return 1;
}
loaded = CFBundleLoadExecutable (kerberosBundle);
if (!loaded) {
CFRelease (kerberosBundle);
return 1;
}
LOADKERBEROSFRAMEWORK
foreach $symbol (@exportSymbols) {
print " ${symbol}_ProcPtr = (ProcPtr) CFBundleGetFunctionPointerForName (kerberosBundle, CFSTR(\"${symbol}\"));\n";
print " if (${symbol}_ProcPtr == NULL) return 1;\n\n";
}
print " return noErr;\n";
print "}\n";
close SOURCE;
open ASSEMBLY, ">$outAssemblyFile" or die "$0: Can't open $outAssemblyFile for writing: $!\n";
select ASSEMBLY;
print "; This file is autogenerated. Please do not modify it.\n\n";
foreach $symbol (@exportSymbols) {
printf " export %s[DS]\n", $symbol;
printf " export .%s[PR]\n", $symbol;
printf " export ${symbol}_ProcPtr[RW]\n\n";
}
foreach $symbol (@exportSymbols) {
printf "\n";
printf ";;;;; ${symbol} ;;;;;\n";
printf "\n";
printf " toc\n";
printf "T_${symbol}_ProcPtr: ; TOC relative address\n";
printf " tc ${symbol}_ProcPtr[TC], ${symbol}_ProcPtr[RW]\n";
printf " csect ${symbol}_ProcPtr[RW]\n";
printf " ds.l 1\n";
printf " ds.l 1\n";
printf " \n";
printf " csect %s[DS]\n", $symbol;
printf " dc.l .%s[PR]\n", $symbol;
printf " dc.l TOC[tc0]\n";
printf " \n";
printf " csect .%s[PR]\n", $symbol;
printf " lwz r12, T_${symbol}_ProcPtr(RTOC)\n";
printf " lwz r12, 0(r12)\n";
printf " lwz r0, 0(r12)\n";
printf " mtctr r0\n";
printf " lwz RTOC, 4(r12) ; Overwrite RTOC. Since we are called cross-fragment the caller restores ours\n";
printf " bctr\n";
}
close ASSEMBLY;
open EXPORT, ">$outExportFile" or die "$0: Can't open $outExportFile for writing: $!\n";
foreach $symbol (@exportSymbols) {
print EXPORT "${symbol}\n";
}
close EXPORT;