KerberosCFMGlue.pl   [plain text]

#!/usr/bin/perl
#
# Copyright 2002 by the Massachusetts Institute of Technology
#
# All rights reserved.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted,
# provided that the above copyright notice appear in all copies and that
# both that copyright notice and this permission notice appear in
# supporting documentation, and that the name of the Massachusetts
# Institute of Technology (M.I.T.) not be used in advertising or publicity
# pertaining to distribution of the software without specific, written
# prior permission.
#
# M.I.T. DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL
# M.I.T. BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
# SOFTWARE.

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;

#
# Argument parsing:
#

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; }
}

# Make sure we got the arguments we need
if (!$inExportFile) {
	die "$0: No export file specified";
}

#
# Read in the export file:
#

my $exportList;
open EXPORTFILE, "${inExportFile}" or die "$0: Unable to open '${inExportFile}': $!\n";
{
    undef $/; # Ignore end-of-line delimiters in the file    
    $exportList = <EXPORTFILE>;
}
close EXPORTFILE;

# Get rid of comments and convert white space into single spaces
$exportList =~ s@\#.*?\n@\n@xg;
$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;
        }
    }
}

#
# Generate the output files:
#
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";

# necessary header files
print "#include <CFBundle.h>\n";
print "#include <CodeFragments.h>\n\n";

# externs for pointers:
foreach $symbol (@exportSymbols) {
    print "extern ProcPtr ${symbol}_ProcPtr;\n";
}

# load the Kerberos Framework:
print <<LOADKERBEROSFRAMEWORK;

pascal OSErr __initalizeCFM2MachOGlue (CFragInitBlockPtr inInitBlock);

pascal OSErr __initalizeCFM2MachOGlue (CFragInitBlockPtr inInitBlock)
{
#pragma unused(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

# load each symbol:
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";
}

# make a function for each symbol 
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 "    tc      %s[TC], %s[DS]\n",                 $symbol, $symbol;
printf "    csect   %s[DS]\n",                         $symbol;
printf "    dc.l    .%s[PR]\n",                        $symbol;
printf "    dc.l    TOC[tc0]\n";
printf "    \n";
#printf "    tc      %s[TC], .%s[PR]\n",                $symbol, $symbol;
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;