#!/usr/bin/perl -w
#
#     sfdc - Compile SFD files into someting useful
#     Copyright (C) 2003-2005 Martin Blom <martin@blom.org>
#     
#     This program is free software; you can redistribute it and/or
#     modify it under the terms of the GNU General Public License
#     as published by the Free Software Foundation; either version 2
#     of the License, or (at your option) any later version.
#     
#     This program is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
#     
#     You should have received a copy of the GNU General Public License
#     along with this program; if not, write to the Free Software
#     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

use strict;

use IO::Handle;
use Getopt::Long;

# The default AmigaOS GG installation of does not seem to include
# Pod::Usage, so we have to provide a fallback. Ugly, but it works and
# that's what counts.

eval {
    require Pod::Usage;
    import Pod::Usage;
};

if ($@) {
    eval '
      # Minimal fall-back ...

      sub pod2usage {
          my @params = @_;
          
          my $verbose = 0;
          my $exitval = 0;
          my $message = "";
          my $output = \*STDERR;

          while (@params) {
            for (shift @params) {
                /^-verbose$/ && do { $verbose = shift @params};
                /^-exitval$/ && do { $exitval = shift @params};
                /^-message$/ && do { $message = shift @params};
                /^-output$/  && do { $output  = shift @params};
            }
          }
      
          print $output "$message\n" if $message;
          print $output "\n";
          print $output "Perl module Pod::Usage is missing.\n";
          print $output "Please refer to the sfdc documentation for usage, ".
            "or install Pod::Usage.\n";
          exit $exitval;
      }
    ';
}
    
sub parse_sfd ( $ );
sub parse_proto ( $$$ );
sub open_output ( $$ );
sub will_close_output ( $$ );
sub close_output ();

my @lf =
[
 'struct Library* LibInit(struct Library* library,' .
 '                        BPTR seglist,' .
 '                        struct ExecBase* SysBase)' .
 '                       (d0,a0,a6)',
 'struct Library* LibOpen(ULONG version) (d0)',
 'BPTR LibClose() ()',
 'BPTR LibExpunge() ()',
 'ULONG LibNull() ()'
 ];

my @df  =
[
 'struct Library* DevInit(struct Library* library,' .
 '                        BPTR seglist,' .
 '                        struct ExecBase* SysBase)' .
 '                       (d0,a0,a6)',
 'ULONG DevOpen(struct IORequest* ioreq,' .
 '              ULONG unit,' .
 '              ULONG flags) (a1,d0,d1)',
 'BPTR DevClose(struct IORequest* ioreq) (a1)',
 'BPTR DevExpunge() ()',
 'ULONG DevNull() ()',
 'VOID DevBeginIO(struct IORequest* ioreq) (a1)',
 'ULONG DevAbortIO(struct IORequest* ioreq) (a1)'
 ];

my @bf  =
[
 'struct ClassLibrary* ClassInit(struct ClassLibrary* library,' .
 '                               BPTR seglist,' .
 '                               struct ExecBase* SysBase)' .
 '                              (d0,a0,a6)',
 'struct ClassLibrary* ClassOpen(ULONG version) (d0)',
 'BPTR ClassClose() ()',
 'BPTR ClassExpunge() ()',
 'ULONG ClassNull() ()',
 'Class* ObtainEngine() ()',
 ];

my %targets = (
            'generic' =>
               { target    => 'generic',
             vectors   => { 'library' => @lf, 'device' => @df, 'boopsi' => @bf },
             macros    => 'Macro',
             stubs     => 'Stub',
             gatestubs => 'Gate',
             interface => 'Interface'
             },
    
            '(\w)+(-.*)?-aros' =>
             { target    => 'aros',
             vectors   => { 'library' => @lf, 'device' => @df, 'boopsi' => @bf },
             macros    => 'MacroAROS',
             stubs     => 'StubAROS',
             gatestubs => 'GateAROS',
             interface => 'Interface'
             },
             
            'i.86be(-pc)?-amithlon' =>
             { target    => 'amithlon',
             vectors   => { 'library' => @lf, 'device' => @df, 'boopsi' => @bf },
             macros    => 'MacroLP',
             stubs     => 'StubAmithlon',
             gatestubs => 'GateAmithlon',
             interface => 'Interface'
             },
             
            'm68k(-unknown)?-amigaos' =>
             { target    => 'amigaos',
             vectors   => { 'library' => @lf, 'device' => @df, 'boopsi' => @bf },
             macros    => 'Macro68k',
             stubs     => 'Stub68k',
             gatestubs => 'Gate68k',
             interface => 'Interface'
             },
             
            'p(ower)?pc(-unknown)?-amigaos' =>
             { target    => 'amigaos4',
             vectors   => { 'library' => @lf, 'device' => @df, 'boopsi' => @bf },
             macros    => 'MacroAOS4',
             stubs     => 'StubAOS4',
             gatestubs => 'GateAOS4',
             interface => 'InterfaceAOS4'
             },
    
            'p(ower)?pc(-unknown)?-morphos' =>
             { target    => 'morphos',
             vectors   => { 'library' => @lf, 'device' => @df, 'boopsi' => @bf },
             macros    => 'MacroMOS',
             stubs     => 'StubMOS',
             gatestubs => 'GateMOS',
             interface => 'Interface'
             }
            );

my $classes;

###############################################################################
### Main program ##############################################################
###############################################################################

Getopt::Long::Configure ("bundling");

my $gateprefix = '';
my $help       = '0';
my $libarg     = 'none';
my $libprefix  = '';
my $sdi        = '0';
my $addvectors = 'none';
my $man        = '0';
my $mode       = 'verify';
my $output     = '-';
my $quiet      = '0';
my $target     = 'm68k-unknown-amigaos';
my $version    = '0';

GetOptions ('addvectors=s' => \$addvectors,
            'gateprefix=s' => \$gateprefix,
            'help|h'       => \$help,
            'libarg=s'     => \$libarg,
            'libprefix=s'  => \$libprefix,
            'sdi'          => \$sdi,
          'man'          => \$man,
          'mode=s'       => \$mode,
          'output|o=s'   => \$output,
          'quiet|q'      => \$quiet,
          'target=s'     => \$target,
          'version|v'    => \$version) or exit 10;

if ($version) {
    print STDERR "sfdc 1.10 (2016-04-11)\n";
    print STDERR "Copyright (C) 2003-2016 Martin Blom <martin\@blom.org>\n";
    print STDERR "This is free software; " .
      "see the source for copying conditions.\n";
    exit 0;
}

if ($help) {
    pod2usage (-verbose => 1,
             -exitval => 0,
             -output => \*STDOUT);
}

if ($man) {
    pod2usage (-verbose => 3,
             -exitval => 0);
    exit 0;
}

if ($#ARGV < 0) {
    pod2usage (-message => "No SFD file specified.",
             -verbose => 0,
             -exitval => 10);
}

$mode = lc $mode;

if (!($mode =~ /^(autoopen|clib|dump|fd|functable|libproto|lvo|interface|macros|proto|pragmas|stubs|gateproto|gatestubs|verify)$/)) {
    pod2usage (-message => "Unknown mode specified. Use --help for a list.",
             -verbose => 0,
             -exitval => 10);
}

if ($libarg !~ /^(first|last|none)$/) {
    pod2usage (-message => "Unknown libarg specified. Use --help for a list.",
             -verbose => 0,
             -exitval => 10);
}

if ($addvectors !~ /^(none|library|device|boopsi)$/) {
    pod2usage (-message => "Unknown addvectors value. Use --help for a list.",
             -verbose => 0,
             -exitval => 10);
}

check_target: {
    foreach my $target_regex (keys %targets) {
      if ($target =~ /^$target_regex$/) {
          $classes = $targets{$target_regex};
          last check_target;
      }
    }

    pod2usage (-message => "Unknown target specified. Use --help for a list.",
             -verbose => 0,
             -exitval => 10);
}

# Save old STDOUT

open( OLDOUT, ">&STDOUT" );

for my $i ( 0 .. $#ARGV ) {
    my $sfd = parse_sfd ($ARGV[$i]);
    my $num = $#{$$sfd{'prototypes'}};

    my $obj;

    for ($mode) {
      /^autoopen$/ && do {
          $obj = AutoOpen->new( sfd => $sfd );
          last;
      };

      /^clib$/ && do {
          $obj = CLib->new( sfd => $sfd );
          last;
      };

      /^dump$/ && do {
          $obj = Dump->new( sfd => $sfd );
          last;
      };
    
      /^fd$/ && do {
          $obj = FD->new( sfd => $sfd );
          last;
      };
    
      /^functable$/ && do {
          $obj = FuncTable->new( sfd => $sfd );
          last;
      };

      /^libproto$/ && do {
          $obj = Gate->new( sfd => $sfd,
                        proto => 0,
                        libproto => 1 );
          last;
      };

      /^lvo$/ && do {
          $obj = LVO->new( sfd => $sfd );
          last;
      };

      /^interface$/ && do {
          $obj = $$classes{'interface'}->new( sfd => $sfd );
          last;
      };
      
      /^macros$/ && do {
          $obj = $$classes{'macros'}->new( sfd => $sfd );

          # By tradition, the functions in the macro files are sorted
#         @{$$sfd{'prototypes'}} = sort {
#           $$a{'funcname'} cmp $$b{'funcname'}
#         } @{$$sfd{'prototypes'}};
          last;
      };

      /^proto$/ && do {
          $obj = Proto->new( sfd => $sfd );
          last;
      };

      /^pragmas$/ && do {
          $obj = SASPragmas->new( sfd => $sfd );
          last;
      };

      /^verify$/ && do {
          $obj = Verify->new( sfd => $sfd );
          last;
      };

      /^stubs$/ && do {
          $obj = $$classes{'stubs'}->new( sfd => $sfd );

          # By tradition, the functions in the stub files are sorted
#         @{$$sfd{'prototypes'}} = sort {
#           $$a{'funcname'} cmp $$b{'funcname'}
#         } @{$$sfd{'prototypes'}};
          last;
      };

      /^gateproto$/ && do {
          $obj = $$classes{'gatestubs'}->new( sfd => $sfd,
                                    proto => 1,
                                    libproto => 0);
          last;
      };
      
      /^gatestubs$/ && do {
          $obj = $$classes{'gatestubs'}->new( sfd => $sfd,
                                    proto => 0,
                                    libproto => 0);
                                    
          last;
      };

      die "Unknown mode specified: " . $mode;
    }


    for my $j ( 0 .. $num + 1) {
      my $prototype = $$sfd{'prototypes'}[$j];
      my $funcname  = $$prototype{'funcname'};
      
      if (!defined ($funcname) || will_close_output ($sfd, $funcname) != 0) {
          $obj->footer ();
      }

      if ($j > $num) {
          last;
      }
      
      if (open_output ($sfd, $funcname) != 0) {
          $obj->header ();
      }

      $obj->function (prototype => $prototype);
    }

    close_output ();
}

if (!$quiet) {
    print STDERR "All done.\n";
}

open (STDOUT, ">&OLDOUT");
close (OLDOUT);

exit 0;






###############################################################################
### Subroutines ###############################################################
###############################################################################


### parse_sfd: Parse a SFD file hand return a hash record #####################

sub parse_sfd ( $ ) {
    my $file = shift;
    local *SFD;

    my $type      = 'function';
    my $last_type = $type;
    my $private   = 0;
    my $bias      = 0;
    my $version   = 1;
    my $comment   = '';

    my $result = {
      copyright  => 'Copyright  2001 Amiga, Inc.',
      id         => '',
      libname    => '',
      base       => '',
      basetype   => 'struct Library *',
#     includes   => (),
#     typedefs   => (),
#     prototypes => (),
      basename   => '',
      BASENAME   => '',
      Basename   => ''
    };

    # Why do I need this????
    $$result{'prototypes'} = ();
    $$result{'includes'}   = ();
    $$result{'typedefs'}   = ();

    if ($addvectors ne 'none') {
      push @{$$result{'includes'}}, '<dos/dos.h>';
      push @{$$result{'includes'}}, '<exec/execbase.h>';

      if ($addvectors eq 'device') {
          push @{$$result{'includes'}}, '<exec/io.h>';
      }
      elsif ($addvectors eq 'boopsi') {
          push @{$$result{'includes'}}, '<intuition/classes.h>';
      }
      
      for my $i ( 0 .. $#{$classes->{vectors}->{$addvectors}} ) {
          push @{$$result{'prototypes'}}, {
            type    => 'function',
            subtype => $addvectors,
            value   => $classes->{vectors}->{$addvectors}[$i],
            line    => 0,
            private => 0,
            bias    => 6 * $i,
            version => 0,
            comment => ''
            };
      }
    }
      
    
    my $proto_line = '';
    my %proto;

    if (!$quiet) {
      ( my $fn = $file ) =~ s,.*[/\\](.*),$1,;
      print STDERR "Processing SFD file '$fn'.\n";
      STDERR->flush();
    }
    
    unless (open (SFD, "<" . $file)) {
      print STDERR "Unable to open file '$file'.\n";
      die;
    };

    my $line_no = 0;

  LINE:
    while (my $line = <SFD>) {

      ++$line_no;
      
      for ($line) {
          /==copyright\s/ && do {
            ( $$result{'copyright'} = $_ ) =~ s/==copyright\s+(.*)\s*/$1/;
            last;
          };

          /==id\s+/ && do {
            ( $$result{'id'} = $_ ) =~ s/==id\s+(.*)\s*/$1/;
            last;
          };

          /==libname\s+/ && do {
            ( $$result{'libname'} = $_ ) =~ s/==libname\s+(.*)\s*/$1/;
            last;
          };

          /==base\s+/ && do {
            ( $$result{'base'} = $_ ) =~ s/==base\s+_?(.*)\s*/$1/;
            last;
          };

          /==basetype\s+/ && do {
            ( $$result{'basetype'} = $_ ) =~ s/==basetype\s+(.*)\s*/$1/;
            last;
          };

          /==include\s+/ && do {
            ( my $inc = $_ ) =~ s/==include\s+(.*)\s*/$1/;

            push @{$$result{'includes'}}, $inc;
            last;
          };

          /==typedef\s+/ && do {
            ( my $td = $_ ) =~ s/==typedef\s+(.*)\s*$/$1/;

            push @{$$result{'typedefs'}}, $td;
            last;
          };
          
          /==bias\s+/ && do {
            ( $bias = $_ ) =~ s/==bias\s+(.*)\s*/$1/;
            last;
          };

          /==reserve\s+/ && do {
            ( my $reserve = $_ ) =~ s/==reserve\s+(.*)\s*/$1/;

            $bias += 6 * $reserve;
            last;
          };

          /==alias\s*$/ && do {
            # Move back again
            $type = $last_type;
            $bias -= 6;
            last;
          };

          /==varargs\s*$/ && do {
            $type = 'varargs';
            # Move back again
            $bias -= 6;
            last;
          };
          
          /==private\s*$/ && do {
            $private = 1;
            last;
          };

          /==public\s*$/ && do {
            $private = 0;
            last;
          };

          /==version\s+/ && do {
            ( $version = $_ ) =~ s/==version\s+(.*)\s*/$1/;
            last;
          };
          
          /==end\s*$/ && do {
            last LINE;
          };
          
          /^\*/ && do {
            ( my $cmt = $_ ) =~ s/^\*(.*)\s*/$1/;

            $comment .= ($comment eq '' ? "" : "\n" ) . $cmt;
            last;
          };
          
          /^[^=*\n]/ && do {
            # Strip whitespaces and append
            $line =~ s/\s*(.*)\s*/$1/;
            $proto_line .= $line . " ";
            last;
          };

          /^\s*$/ && do {
            # Skip blank lines
            last;
          };

          # If we get here, we found a line we don't understand
          print STDERR "Unable to parse line $line_no in SFD file" .
            " '$file'. The line looks like this:\n" . $line ;
          die;
      };
      
      if ( $proto_line =~
           /.*[A-Za-z0-9_]+\s*\(.*\).*\(((base|sysv|autoreg|[\saAdD][0-7]-?),?)*\)\s*$/
           ) {

          if ($proto_line =~ /.*\(.*[0-7]-.*\)\s*$/) {
            if ($$classes{'target'} ne 'amigaos') {
                print STDERR "Warning: Multiregister functions are m68k only.\n";
            }
            $proto_line =~ s/([da][0-7])-[da][0-7]/$1/g;
          }
#         else {
            push @{$$result{'prototypes'}}, {
                type    => $type,
                subtype => '',
                value   => $proto_line,
                line    => $line_no,
                private => $private,
                bias    => $bias,
                version => $version,
                comment => $comment
                };

            $comment    = '';
#         }

          $last_type  = $type;
          $type       = 'function';
          $proto_line = '';
          $bias += 6;
      }
    }

    if( $proto_line ne '' ) {
      # If $proto_line isn't empty, we couldn't parse it
      die "Unhanled proto '" . $proto_line . "'\n";
    }

    close (SFD);

    # Now parse the prototypes
    my $real_funcname  = '';
    my $real_prototype = {};
    my $varargs_type   = '';

    for my $i ( 0 .. $#{$$result{'prototypes'}} ) {
      my $prototype = $$result{'prototypes'}[$i];

      if ($$prototype{'type'} eq 'varargs') {
          $$prototype{'real_funcname'}  = $real_funcname;
          $$prototype{'real_prototype'} = $real_prototype;
      }
      else {
          $$prototype{'real_funcname'}  = '';
          $$prototype{'real_prototype'} = '';
      }
      
      parse_proto ($result, $prototype, $varargs_type);

      if ($$prototype{'type'} eq 'function') {
          $varargs_type = $$prototype{'argtypes'}[$#{$$prototype{'argtypes'}}];
      }

      if ($$prototype{'type'} eq 'function') {
          $real_funcname  = $$prototype{'funcname'};
          $real_prototype = $prototype;
      }
    };

    # Create some other variables

    ( $$result{'basename'} = $$result{'libname'} ) =~ s/(.*)\.\w+/$1/;

    if ($$result{'basename'} eq '') {
      ( $$result{'basename'} = $file ) =~ s:.*/(\w+?)_lib\.sfd:$1: or do {
          print STDERR "Unable to find or guess base name.\n";
          print STDERR "Please add \"==libname module_name\" to SFD file.\n";
          die;
      };

      # Fake the CIA libname
      if ($$result{'basename'} eq "cia") {
          $$result{'libname'} = "ciaX.resource";
      }
      else {
          $$result{'libname'} = $$result{'basename'} . ".library";
      }
    }

    # Fake the Workbench basename
    if ($$result{'basename'} eq "workbench") {
      $$result{'basename'} = "wb";
    }

    $$result{'basename'} =~ s/-/_/g;
    $$result{'BASENAME'} = uc $$result{'basename'};
    $$result{'Basename'} = lc $$result{'basename'};
    $$result{'Basename'} = ucfirst $$result{'Basename'};
    ($result->{BaseName} = $result->{base}) =~ s/Base//;

    return $result;
}


### parse_proto: Parse a single function prototype  ###########################

sub parse_proto ( $$$ ) {
    my $sfd          = shift;
    my $prototype    = shift;
    my $varargs_type = shift;
    
    my $return;
    my $name;
    my $arguments;
    my $registers;
    my $str;
    my @array;

    # strip leading+trailing spaces first
    $$prototype{'value'} =~ s/^\s+|\s+$//g;

    # we are doing a reverse regexp match here to make the regular expression
    # substantially easier as sfd prototypes can be better matched from the back to the front
    # (e.g. always starts with '()')
    $str = $$prototype{'value'};
    @array = (reverse $str) =~ / \)( (?: [^()]* | (?0) )* )\( /xg;

    $registers = reverse $array[0];
    $registers =~ s/^\s+|\s+$//g;   # trim whitspaces
    $arguments = reverse $array[1];
    $arguments =~ s/^\s+|\s+$//g;   # trim whitspaces

    $name = substr($str, 0, index($str, "(" . $arguments . ")"));
    $name =~ s/^\s+|\s+$//g; # trim whitspaces
    $return = substr($name, 0, rindex($name, " "));
    $name = substr($name, rindex($name, " "));
    $name =~ s/^\s+|\s+$//g; # trim whitspaces

    # Nuke whitespaces from the register specification
    $registers =~ s/\s//;

    $$prototype{'return'}   = $return;
    $$prototype{'funcname'} = $name;

    $$prototype{'numargs'}  = 0;
    $$prototype{'numregs'}  = 0;
    
    @{$$prototype{'regs'}}        = ();
    @{$$prototype{'args'}}        = ();
    @{$$prototype{'___args'}}     = ();
    @{$$prototype{'argnames'}}    = ();
    @{$$prototype{'___argnames'}} = ();
    @{$$prototype{'argtypes'}}    = ();

    if ($arguments =~ /^(void|VOID)$/) {
      $arguments = "";
    }

    my @args = split(/,/,$arguments);

    # Fix function pointer arguments and build $$prototype{'args'} 

    my $par_cnt = 0;
    foreach my $arg (@args) {
      # Strip whitespaces
      $arg =~ s/\s*(.*?)\s*/$1/;

      if ($par_cnt != 0) {
          my $old_arg = pop @{$$prototype{'args'}};
          
          push @{$$prototype{'args'}}, $old_arg . "," . $arg;
      }
      else {
          push @{$$prototype{'args'}}, $arg;
      }

      # Count parentheses (a function pointer arguments is processed
      # when $par_cnt is 0).
      $par_cnt += ( $arg =~ tr/\(/\(/ );
      $par_cnt -= ( $arg =~ tr/\)/\)/ );
    }

    $$prototype{'numargs'} = $#{$$prototype{'args'}} + 1;

    if ($registers =~ /sysv/) {
      $prototype->{type} = 'cfunction';
      $prototype->{nb}   = 1;
    }
    elsif ($registers =~ /autoreg/) {
      my $a_cnt = 0;
      my $d_cnt = 0;
      foreach my $arg (@{$$prototype{'args'}}) {
          if ($arg =~ /\*/) {
            push @{$$prototype{'regs'}}, "a$a_cnt";
            $a_cnt++;
          }
          else {
            push @{$$prototype{'regs'}}, "d$d_cnt";
            $d_cnt++;
          }
      }
      
      $prototype->{numregs} = $#{$$prototype{'regs'}} + 1;
      $prototype->{nb}      = $sfd->{base} eq '';
    }
    else {
      # Split regs and make them lower case
      @{$$prototype{'regs'}} = split(/,/,lc $registers);
      $prototype->{numregs} = $#{$$prototype{'regs'}} + 1;
      $prototype->{nb}      = $sfd->{base} eq '' || $registers =~ /a6/;
    }

    $$prototype{'nr'} = $$prototype{'return'} =~ /^(VOID|void)$/;
    
    # varargs sub types:
    #   printfcall: LONG Printf( STRPTR format, ... );
    #     All varargs are optional
    #   tagcall:    BOOL AslRequestTags( APTR requester, Tag Tag1, ... );
    #     First vararg is a Tag, then a TAG_DONE terminated tag list
    #   methodcall: ULONG DoGadgetMethod( ... ULONG message, ...);
    #     First vararg is required.

    if ($prototype->{type} eq 'varargs') {
      if (defined($varargs_type) && $varargs_type =~
          /^\s*(const|CONST)?\s*struct\s+TagItem\s*\*\s*$/ ) {
          $prototype->{subtype} = 'tagcall';

          if ($prototype->{numargs} == $prototype->{numregs}) {
            if (!$quiet) {
                print STDERR "Warning: Adding missing Tag argument to " .
                  $prototype->{funcname} . "()\n";
            }
            
            my $last = pop @{$prototype->{args}};
            push @{$prototype->{args}}, "Tag _tag1" ;
            push @{$prototype->{args}}, $last;

            ++$prototype->{numargs};
          }
      }
      else {
          if ($prototype->{numargs} == $prototype->{numregs}) {
            $prototype->{subtype} = 'printfcall';
          }
          elsif ($prototype->{numargs} == $prototype->{numregs} + 1) {
            $prototype->{subtype} = 'methodcall';
          }
      }
    }
    elsif ($prototype->{type} eq 'cfunction') {
      foreach (split(/,/,lc $registers)) {
          /^sysv$/ && do {
            $prototype->{subtype} = 'sysv';
            next;
          };

          /^base$/ && do {
            if ($sfd->{base} eq '') {
                printf STDERR "$prototype->{funcname}: " .
                  "Library has no base!\n";
                die;
            }
            
            $prototype->{nb} = 0;
            next;
          };
      }
    }



    # Make sure we have the same number of arguments as registers, or,
    # if this is a varargs function, possible one extra,  la "MethodID, ...".
    # Tagcalls always have one extra,  la "Tag, ...".

    if (($prototype->{type} eq 'varargs' &&
       $prototype->{subtype} eq 'tagcall' &&
       $prototype->{numargs} != $prototype->{numregs} + 1 ) ||

      ($prototype->{type} eq 'varargs' &&
       $prototype->{subtype} eq 'printfcall' &&
       $prototype->{numargs} != $prototype->{numregs}) ||

      ($prototype->{type} eq 'varargs' &&
       $prototype->{subtype} eq 'methodcall' &&
       $prototype->{numargs} != $prototype->{numregs} + 1) ||

      ($prototype->{type} eq 'function' &&
       $prototype->{numargs} != $prototype->{numregs})) {
      
      print STDERR "Failed to parse arguments/registers on SFD " .
          "line $$prototype{'line'}:\n$$prototype{'value'}\n";
      print STDERR "The number of arguments doesn't match " .
          "the number of registers (+1 if tagcall).\n";
      die;
    }

    my $type = '';
    
    foreach my $arg (@{$$prototype{'args'}}) {
      my $name    = '';
      my $___name = '';
      my $___arg  = '';

      # MorhOS includes use __CLIB_PROTOTYPE for some reason ...
      if ($arg =~ /.*\(.*?\)\s*(__CLIB_PROTOTYPE)?\(.*\)/) {
          my $type1;
          my $type2;
          
          ($type1, $name, $type2) =
            ( $arg =~ /^\s*(.*)\(\s*\*+\s*(\w+)\s*\)\s*(\w*\(.*\))\s*/ );
          $type = "$type1(*)$type2";
          $___name = "___$name";
          $___arg = "$type1(*___$name) $type2";
      }
      elsif ($arg !~ /^\.\.\.$/) {
          ($type, $name) = ( $arg =~ /^\s*(.*?[\s*]*?)\s*(\w+)\s*$/ );
          $___name = "___$name";
          $___arg = "$type ___$name";
      }
      else {
          if ($prototype->{type} eq 'varargs' && defined($varargs_type)) {
            $type = $varargs_type;
          }
          else {
            # Unknown type
#           $type = "void*";
            $type = "...";
          }
          $name = '...';
          $___name = '...';
          $___arg = '...';
      }

      if ($type eq '' || $name eq '' ) {
          print STDERR "Type or name missing from '$arg'.\n";
          die;
      }

      push @{$$prototype{'___args'}}, $___arg;
      push @{$$prototype{'argnames'}}, $name;
      push @{$$prototype{'___argnames'}}, $___name;

      push @{$$prototype{'argtypes'}}, $type;
    }
}



sub BEGIN {
    my $old_output = '';


### close_output: Close the output file if necessary  #########################

    sub close_output () {
      close (STDOUT);
      $old_output = '';
    }
    

### check_output: Check if the file will be reopended by open_output ##########

    sub will_close_output ( $$ ) {
      my $sfd      = shift;
      my $function = shift;

      my $new_output = $output;

      $new_output =~ s/%f/$function/;
      $new_output =~ s/%b/$$sfd{'base'}/;
      $new_output =~ s/%l/$$sfd{'libname'}/;
      $new_output =~ s/%n/$$sfd{'basename'}/;

      if( $old_output ne '' &&
          $new_output ne $old_output ) {
          return 1;
      }
      else {
          return 0;
      }
    }
    
### open_output: (Re)open the output file if necessary  #######################

    sub open_output ( $$ ) {
      my $sfd      = shift;
      my $function = shift;

      my $new_output = $output;

      $new_output =~ s/%f/$function/;
      $new_output =~ s/%b/$$sfd{'base'}/;
      $new_output =~ s/%l/$$sfd{'libname'}/;
      $new_output =~ s/%n/$$sfd{'basename'}/;

      if( $new_output ne $old_output ) {

          close_output ();

          if ($new_output eq '-') {
            open (STDOUT, ">&OLDOUT") or die;
          }
          else {
            open (STDOUT, ">" . $new_output) or die;

            if (!$quiet) {
                print STDERR "Writing to '$new_output'\n";
            }
          }
          
          $old_output = $new_output;

          return 1;
      }
      else {
          return 0;
      }
    }
}

### Class GateAROS: Create an AROS gatestub file ##############################

BEGIN {
    package GateAROS;
    use vars qw(@ISA);
    @ISA = qw( Gate );

    sub new {
      my $proto  = shift;
      my $class  = ref($proto) || $proto;
      my $self   = $class->SUPER::new( @_ );
      bless ($self, $class);
      return $self;
    }

    sub header {
      my $self = shift;
      my $sfd  = $self->{SFD};
      
      $self->SUPER::header (@_);

      print "#include <aros/libcall.h>\n";
      print "\n";
    }

    sub function {
      my $self     = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      if ($prototype->{type} eq 'cfunction') {
          print "#define $gateprefix$prototype->{funcname} " .
            "AROS_SLIB_ENTRY(" .
            "$gateprefix$prototype->{funcname},$sfd->{Basename})\n\n";
      }

      $self->SUPER::function (@_);
    }
      
    sub function_start {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};
      my $nb        = $prototype->{nb} || $libarg eq 'none';

      # AROS macros cannot handle function pointer arguments :-(

      for my $i (0 .. $prototype->{numargs} - 1) {
          if ($prototype->{argtypes}[$i] =~ /\(\*\)/) {
            my $typedef  = $prototype->{argtypes}[$i];
            my $typename = "$sfd->{Basename}_$prototype->{funcname}_fp$i";

            $typedef =~ s/\(\*\)/(*_$typename)/;
                
            print "typedef $typedef;\n";
          }
      }

      if ($self->{PROTO}) {
          printf "AROS_LD%d%s(", $prototype->{numargs}, $nb ? "I" : "";
      }
      else {
          printf "AROS_LH%d%s(", $prototype->{numargs}, $nb ? "I" : "";
      }
      print "$prototype->{return}, $gateprefix$prototype->{funcname},\n";
    }

    sub function_arg {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $argtype   = $params{'argtype'};
      my $argname   = $params{'argname'};
      my $argreg    = $params{'argreg'};
      my $argnum    = $params{'argnum'};
      my $sfd       = $self->{SFD};

      if ($argtype =~ /\(\*\)/) {
          $argtype = "_$sfd->{Basename}_$prototype->{funcname}_fp$argnum";
      }

      if ($self->{PROTO}) {
          print " AROS_LDA($argtype, $argname, " . (uc $argreg) . "),\n";
      }
      else {
          print " AROS_LHA($argtype, $argname, " . (uc $argreg) . "),\n";
      }         
    }
    
    sub function_end {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      my $bt = "/* bt */";
      my $bn = "/* bn */";

      if ($prototype->{nb}) {
          for my $i (0 .. $#{$prototype->{regs}}) {
            if ($prototype->{regs}[$i] eq 'a6') {
                $bt = $prototype->{argtypes}[$i];
                $bn  =$prototype->{___argnames}[$i];
                last;
            }
          }
      }
      else {
          $bt = $sfd->{basetype};
          $bn = "_base";
      }

      printf "    $bt, $bn, %d, $sfd->{Basename})",
      $prototype->{bias} / 6;

      if ($self->{PROTO}) {
          print ";\n";
          print "#define $gateprefix$prototype->{funcname} " .
            "AROS_SLIB_ENTRY(" .
            "$gateprefix$prototype->{funcname},$sfd->{Basename})\n";
      }
      else {
          print "\n";
          print "{\n";
          print "  AROS_LIBFUNC_INIT\n";
          print "  return $libprefix$prototype->{funcname}(";

          if ($libarg eq 'first' && !$prototype->{nb}) {
            print "_base";
            print $prototype->{numargs} > 0 ? ", " : "";
          }

          print join (', ', @{$prototype->{___argnames}});
      
          if ($libarg eq 'last' && !$prototype->{nb}) {
            print $prototype->{numargs} > 0 ? ", " : "";
            print "_base";
          }
      
          print ");\n";
          print "  AROS_LIBFUNC_EXIT\n";
          print "}\n";
      }
    }
}

### Class FD: Create an old-style FD file #####################################

BEGIN {
    package FD;

    sub new {
      my $proto  = shift;
      my %params = @_;
      my $class  = ref($proto) || $proto;
      my $self   = {};
      $self->{SFD}     = $params{'sfd'};
      $self->{BIAS}    = -1;
      $self->{PRIVATE} = -1;
      $self->{VERSION} = 1;
      bless ($self, $class);
      return $self;
    }

    sub header {
      my $self = shift;
      my $sfd  = $self->{SFD};

      print "* \"$$sfd{'libname'}\"\n";
      print "* Automatically generated FD (sfdc 1.10)! Do not edit!\n";
      print "##base _$$sfd{'base'}\n";
      $self->{BIAS}    = -1;
      $self->{PRIVATE} = -1;
      $self->{VERSION} = 1;
    }

    sub function {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      if ($prototype->{type} eq 'function' ||
          $prototype->{type} eq 'cfunction') {
          if ($self->{BIAS} != $$prototype{'bias'}) {
            $self->{BIAS} = $$prototype{'bias'};
            print "##bias $self->{BIAS}\n";
          }

          if ($self->{PRIVATE} != $$prototype{'private'}) {
            $self->{PRIVATE} = $$prototype{'private'};
            print $self->{PRIVATE} == 1 ? "##private\n" : "##public\n";
          }

          if ($self->{VERSION} != $$prototype{'version'}) {
            $self->{VERSION} = $$prototype{'version'};

            print "*--- functions in V$self->{VERSION} or higher ---\n";
          }

          if ($$prototype{'comment'} ne '') {
            my $comment = $$prototype{'comment'};

            $comment =~ s/^/\*/m;
            
            print "$comment\n";
          }
          
          print "$$prototype{'funcname'}(";
          print join (',', @{$$prototype{'argnames'}});
          print ")(";

          if ($prototype->{type} eq 'function') {
            print join (',', @{$$prototype{'regs'}});
          }
          elsif ($prototype->{type} eq 'cfunction') {
            print "base," unless $prototype->{nb};
            print "$prototype->{subtype}";
          }
          else {
            die;
          }
          
          print ")\n";
      
          $self->{BIAS} += 6;
      }
    }
    
    sub footer {
      my $self = shift;

      print "##end\n";
    }
}

### Class Gate68k: Create a AmigaOS gatestub file #############################

BEGIN {
    package Gate68k;
    use vars qw(@ISA);
    @ISA = qw( Gate );

    sub new {
      my $proto  = shift;
      my $class  = ref($proto) || $proto;
      my $self   = $class->SUPER::new( @_ );
      bless ($self, $class);
      return $self;
    }

    sub function_start {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      print "$prototype->{return}\n";
      print "$gateprefix$prototype->{funcname}(";
    }

    sub function_arg {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $argtype   = $params{'argtype'};
      my $argname   = $params{'argname'};
      my $argreg    = $params{'argreg'};
      my $argnum    = $params{'argnum'};
      my $sfd       = $self->{SFD};

      if ($argnum != 0) {
          print ",\n";
      }

      print "     $prototype->{___args}[$argnum] __asm(\"$argreg\")";
    }
    
    sub function_end {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      if ($libarg ne 'none' && !$prototype->{nb}) {
          if ($prototype->{numargs} > 0 ) {
            print ",\n";
          }

          print " $sfd->{basetype} _base __asm(\"a6\")";
      }
      elsif ($prototype->{numargs} == 0) {
          print "void";
      }

      if ($self->{PROTO}) {
          print ");\n";
      }
      else {
          print ")\n";
          print "{\n";

          print "  return $libprefix$prototype->{funcname}(";

          if ($libarg eq 'first' && !$prototype->{nb}) {
            print "_base";
            print $prototype->{numargs} > 0 ? ", " : "";
          }

          print join (', ', @{$prototype->{___argnames}});

          if ($libarg eq 'last' && !$prototype->{nb}) {
            print $prototype->{numargs} > 0 ? ", " : "";
            print "_base";
          }
      
          print ");\n";
          print "}\n";
      }
    }
}

### Class StubAmithlon: Create a Amithlon stub file ###########################

BEGIN {
    package StubAmithlon;
    use vars qw(@ISA);
    @ISA = qw( Stub );

    sub new {
      my $proto  = shift;
      my $class  = ref($proto) || $proto;
      my $self   = $class->SUPER::new( @_ );
      bless ($self, $class);
      return $self;
    }

    sub header {
      my $self = shift;
      
      $self->SUPER::header (@_);

      print "#ifndef __INLINE_MACROS_H\n";
      print "#define __INLINE_MACROS_H\n";
      print "\n";
      print "#ifndef __INLINE_MACROS_H_REGS\n";
      print "#define __INLINE_MACROS_H_REGS\n";
      print "\n";
      print "#include <exec/types.h>\n";
      print "\n";
      print "struct _Regs {\n";
      print "     ULONG d0;\n";
      print "     ULONG d1;\n";
      print "     ULONG d2;\n";
      print "     ULONG d3;\n";
      print "     ULONG d4;\n";
      print "     ULONG d5;\n";
      print "     ULONG d6;\n";
      print "     ULONG d7;\n";
      print "     ULONG a0;\n";
      print "     ULONG a1;\n";
      print "     ULONG a2;\n";
      print "     ULONG a3;\n";
      print "     ULONG a4;\n";
      print "     ULONG a5;\n";
      print "     ULONG a6;\n";
      print "     ULONG a7;\n";
      print "};\n";
      print "\n";
      print "#endif /* __INLINE_MACROS_H_REGS */\n";
      print "\n";
      print "ULONG _CallLib68k(struct _Regs*,LONG) " .
          "__attribute__((__regparm__(3)));\n";
      print "\n";
      print "#endif /* __INLINE_MACROS_H */\n";
      print "\n";
    }
    
    sub function_start {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      if ($prototype->{type} eq 'function') {
          print "\n";
          print "{\n";

          if (!$prototype->{nb}) {
            print "  BASE_EXT_DECL\n";
          }
          if (!$prototype->{nr}) {
            print "  $prototype->{return} _res;\n";
          }

          print "  struct _Regs _regs;\n";
      }
      else {
          $self->SUPER::function_start (@_);
      }
    }

    sub function_arg {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $argtype   = $params{'argtype'};
      my $argname   = $params{'argname'};
      my $argreg    = $params{'argreg'};
      my $argnum    = $params{'argnum'};

      if ($$prototype{'type'} eq 'function') {
          printf "  __asm(\"movl %%1,%%0\":\"=m\"(_regs.%s)" .
            ":\"ri\"((ULONG)%s));\n", $argreg, $argname;
      }
      else {
          $self->SUPER::function_arg (@_);
      }
    }
    
    sub function_end {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      
      if ($$prototype{'type'} eq 'function') {
          if (!$prototype->{nb}) {
            print "  __asm(\"movl %1,%0\":\"=m\"(_regs.a6)" .
                ":\"ri\"((ULONG)(BASE_NAME)));\n";
          }

          print "  ";
          
          if (!$prototype->{nr}) {
            print "_res = ($prototype->{return}) ";
          }

          print "_CallLib68k(&_regs,-$prototype->{bias});\n";
          
          if (!$prototype->{nr}) {
            print "  return _res;\n";
          }

          print "}\n";
      }
      else {
          $self->SUPER::function_end (@_);
      }
    }
}

### Class SASPragmas: Create a SAS/C pragmas file #############################

BEGIN {
    package SASPragmas;

    sub new {
      my $proto  = shift;
      my %params = @_;
      my $class  = ref($proto) || $proto;
      my $self   = {};
      $self->{SFD} = $params{'sfd'};
      bless ($self, $class);
      return $self;
    }

    sub header {
      my $self = shift;
      my $sfd  = $self->{SFD};

      my $id = $$sfd{'id'};
      my $v  = $id;
      my $d  = $id;

      $v =~ s/^\$[I]d: .*? ([0-9.]+).*/$1/;
      $d =~ s,^\$[I]d: .*? [0-9.]+ (\d{4})/(\d{2})/(\d{2}).*,($3.$2.$1),;

      print "/* Automatically generated header (sfdc 1.10)! Do not edit! */\n";
      print "#ifndef PRAGMAS_$sfd->{BASENAME}_PRAGMAS_H\n";
      print "#define PRAGMAS_$sfd->{BASENAME}_PRAGMAS_H\n";
      print "\n";
      print "/*\n";
      print "**   \$VER: $$sfd{'basename'}_pragmas.h $v $d\n";
      print "**\n";
      print "**   Direct ROM interface (pragma) definitions.\n";
      print "**\n";
      print "**   $$sfd{'copyright'}\n";
      print "**       All Rights Reserved\n";
      print "*/\n";
      print "\n";

      print "#if defined(LATTICE) || defined(__SASC) || defined(_DCC)\n";
      print "#ifndef __CLIB_PRAGMA_LIBCALL\n";
      print "#define __CLIB_PRAGMA_LIBCALL\n";
      print "#endif /* __CLIB_PRAGMA_LIBCALL */\n";
      print "#else /* __MAXON__, __STORM__ or AZTEC_C */\n";
      print "#ifndef __CLIB_PRAGMA_AMICALL\n";
      print "#define __CLIB_PRAGMA_AMICALL\n";
      print "#endif /* __CLIB_PRAGMA_AMICALL */\n";
      print "#endif /* */\n";
      print "\n";
      print "#if defined(__SASC_60) || defined(__STORM__)\n";
      print "#ifndef __CLIB_PRAGMA_TAGCALL\n";
      print "#define __CLIB_PRAGMA_TAGCALL\n";
      print "#endif /* __CLIB_PRAGMA_TAGCALL */\n";
      print "#endif /* __MAXON__, __STORM__ or AZTEC_C */\n";
      print "\n";
    }

    sub function {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      # Don't process private functions
      if ($prototype->{private}) {
          return;
      }

      my $regs = '';
      
      foreach my $reg (@{$prototype->{regs}}) {
          my $num;
          
          if ($reg =~ /^d[0-7]$/) {
            ($num) = $reg =~ /^d(.)/;
          }
          elsif ($reg =~ /^a[0-9]$/) {
            ($num) = $reg =~ /^a(.)/;
            $num += 8;
          }
          else {
            die;
          }

          $regs = sprintf "%x$regs", $num;
      }

      $regs .= '0'; #Result in d0
      $regs .= $prototype->{numregs};
      
      if ($prototype->{type} eq 'function') {
          # Always use libcall, since access to 4 is very expensive

          print "#ifdef __CLIB_PRAGMA_LIBCALL\n";
          print " #pragma libcall $sfd->{base} $prototype->{funcname} ";
          printf "%x $regs\n", $prototype->{bias};
          print "#endif /* __CLIB_PRAGMA_LIBCALL */\n";
          print "#ifdef __CLIB_PRAGMA_AMICALL\n";
          printf " #pragma amicall($sfd->{base}, 0x%x, $prototype->{funcname}(",
            $prototype->{bias};
          print join (',', @{$prototype->{regs}}) . "))\n";
          print "#endif /* __CLIB_PRAGMA_AMICALL */\n";
      }
      elsif ($prototype->{type} eq 'varargs') {
          print "#ifdef __CLIB_PRAGMA_TAGCALL\n";
          print " #ifdef __CLIB_PRAGMA_LIBCALL\n";
          print "  #pragma tagcall $sfd->{base} $prototype->{funcname} ";
          printf "%x $regs\n", $prototype->{bias};
          print " #endif /* __CLIB_PRAGMA_LIBCALL */\n";
          print " #ifdef __CLIB_PRAGMA_AMICALL\n";
          printf "  #pragma tagcall($sfd->{base}, 0x%x, $prototype->{funcname}(",
            $prototype->{bias};
          print join (',', @{$prototype->{regs}}) . "))\n";
          print " #endif /* __CLIB_PRAGMA_AMICALL */\n";
          print "#endif /* __CLIB_PRAGMA_TAGCALL */\n";
      }
      elsif ($prototype->{type} eq 'cfunction') {
          # Do nothing
      }
      else {
          print STDERR "$prototype->{funcname}: Unsupported function " .
            "type.\n";
          die;
      }
    }
    
    sub footer {
      my $self = shift;
      my $sfd  = $self->{SFD};

      print "\n";
      print "#endif /* PRAGMAS_$sfd->{BASENAME}_PRAGMAS_H */\n";
    }
}

### Class StubAROS: Create an AROS stub file ##################################

BEGIN {
    package StubAROS;
    use vars qw(@ISA);
    @ISA = qw( Stub );

    sub new {
      my $proto  = shift;
      my $class  = ref($proto) || $proto;
      my $self   = $class->SUPER::new( @_ );
      bless ($self, $class);
      return $self;
    }

    sub header {
      my $self = shift;
      
      $self->SUPER::header (@_);

      print "#include <aros/libcall.h>\n";
      print "\n";
    }

    sub function_start {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      if ($prototype->{type} eq 'function') {
          print "\n";
          print "{\n";

          if (!$prototype->{nb}) {
            print "  BASE_EXT_DECL\n";
          }

          if (!$prototype->{nr}) {
            print "  $prototype->{return} _res = ($prototype->{return}) ";
          }
          else {
            print "  ";
          }

          printf "AROS_LC%d%s($prototype->{return}, $prototype->{funcname},\n",
          $prototype->{numargs}, $prototype->{nb} ? "I" : "";
      }
      else {
          $self->SUPER::function_start (@_);
      }
    }

    sub function_arg {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $argtype   = $params{'argtype'};
      my $argname   = $params{'argname'};
      my $argreg    = $params{'argreg'};
      my $argnum    = $params{'argnum'};
      my $sfd       = $self->{SFD};

      if ($$prototype{'type'} eq 'function') {
          print "    AROS_LCA($argtype, $argname, " . (uc $argreg) . "),\n";
      }
      else {
          $self->SUPER::function_arg (@_);
      }
    }
    
    sub function_end {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};
      
      if ($$prototype{'type'} eq 'function') {
          if ($prototype->{nb}) {
            my $bt = "/* bt */";
            my $bn = "/* bn */";

            for my $i (0 .. $#{$prototype->{regs}}) {
                if ($prototype->{regs}[$i] eq 'a6') {
                  $bt = $prototype->{argtypes}[$i];
                  $bn  =$prototype->{___argnames}[$i];
                  last;
                }
            }
            
            printf "    $bt, $bn, %d, $sfd->{Basename});\n",
            $prototype->{bias} / 6;
          }
          else {
            printf "    $sfd->{basetype}, BASE_NAME, %d, $sfd->{Basename});\n",
            $prototype->{bias} / 6;
          }

          if (!$prototype->{nr}) {
            print "  return _res;\n";
          }
          
          print "};\n";
      }
      else {
          $self->SUPER::function_end (@_);
      }
    }
}

### Class AutoOpen: Create a proto file #######################################

BEGIN {
    package AutoOpen;

    sub new {
      my $proto    = shift;
      my %params   = @_;
      my $class    = ref($proto) || $proto;
      my $self     = {};
      $self->{SFD} = $params{'sfd'};
      bless ($self, $class);
      return $self;
    }

    sub header {
      my $self = shift;
      my $sfd  = $self->{SFD};

      print "/* Automatically generated header (sfdc 1.10)! Do not edit! */\n";
      print "\n";
      if ($sfd->{base} ne '') {
          print "#ifdef __cplusplus\n";
          print "extern \"C\" {\n";
          print "#endif /* __cplusplus */\n";
          print "\n";
          print "#if defined (__libnix__)\n";
          print "\n";
          print "#include <stabs.h>\n";
          print "void* $sfd->{base}" . "[2] = { 0, \"$sfd->{libname}\" };\n";
          print "ADD2LIB($sfd->{base});\n";
          print "\n";
          print "#elif defined (__AMIGAOS4__)\n";
          print "\n";
          print "#undef __USE_INLINE__\n";
          print "#define _NO_INLINE\n";
          foreach my $inc (@{$$sfd{'includes'}}) {
            print "#include $inc\n";
          }
          
          foreach my $td (@{$$sfd{'typedefs'}}) {
            print "typedef $td;\n";
          }

          print "\n";
          print "#include <interfaces/$sfd->{basename}.h>\n";
          print "#include <proto/exec.h>\n";
          print "#include <assert.h>\n";
          print "\n";
          print "__attribute__((weak)) $sfd->{basetype} $sfd->{base} = NULL;\n";
          print "__attribute__((weak)) struct $sfd->{BaseName}IFace* I$sfd->{BaseName} = NULL;\n";
          print "\n";
          print "void __init_$sfd->{BaseName}(void) __attribute__((constructor));\n";
          print "void __exit_$sfd->{BaseName}(void) __attribute__((destructor));\n";
          print "\n";
          print "void __init_$sfd->{BaseName}(void) {\n";
          print "  if ($sfd->{base} == NULL) {\n";
          print "    $sfd->{base} = ($sfd->{basetype}) IExec->OpenLibrary(\"$sfd->{libname}\", 0);\n";
          print "    assert($sfd->{base} != NULL);\n";
          print "  }\n";
          print "  if (I$sfd->{BaseName} == NULL) {\n";
          print "    I$sfd->{BaseName} = (struct $sfd->{BaseName}IFace*) IExec->GetInterface(";
          print "(struct Library*) $sfd->{base}, \"main\", 1, NULL);\n";
          print "    assert(I$sfd->{BaseName} != NULL);\n";
          print "  }\n";
          print "}\n";
          print "\n";
          print "void __exit_$sfd->{BaseName}(void) {\n";
          print "  IExec->DropInterface((struct Interface*) I$sfd->{BaseName});\n";
          print "  IExec->CloseLibrary((struct Library*) $sfd->{base});\n";
          print "}\n";
          print "\n";
          print "\n";
          print "#endif\n";
      }

      
      print "\n";
      print "#ifdef __cplusplus\n";
      print "}\n";
      print "#endif /* __cplusplus */\n";
    }

    sub function {
      # Nothing to do here ...
    }

    sub footer {
      # Nothing to do here ...
    }
}

### Class MacroAOS4: Create a AOS4-style macro file ###########################

BEGIN {
    package MacroAOS4;
    use vars qw(@ISA);
    @ISA = qw( Macro );

    sub new {
      my $proto  = shift;
      my $class  = ref($proto) || $proto;
      my $self   = $class->SUPER::new( @_ );
      bless ($self, $class);
      return $self;
    }

    sub function_start {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      if ($prototype->{type} eq 'function' ||
          $prototype->{type} eq 'varargs') {
          printf "      I$sfd->{BaseName}->$prototype->{funcname}(";
      }
      else {
          $self->SUPER::function_start (@_);
      }
    }

    sub function_arg {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $argtype   = $params{'argtype'};
      my $argname   = $params{'argname'};
      my $argreg    = $params{'argreg'};
      my $argnum    = $params{'argnum'};
      my $sfd       = $self->{SFD};

      if ($prototype->{type} eq 'function' ||
          $prototype->{type} eq 'varargs') {
          print ", " unless $argnum == 0;
          if ($argname ne '...') {
            print "$argname";
          }
          else {
            print "__VA_ARGS__";
          }
      }
      else {
          $self->SUPER::function_arg (@_);
      }
    }
    
    sub function_end {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      
      if ($prototype->{type} eq 'function' ||
          $prototype->{type} eq 'varargs') {
          print ")\n";
      }
      else {
          $self->SUPER::function_end (@_);
      }
    }
}

### Class Proto: Create a proto file ##########################################

BEGIN {
    package Proto;

    sub new {
      my $proto    = shift;
      my %params   = @_;
      my $class    = ref($proto) || $proto;
      my $self     = {};
      $self->{SFD} = $params{'sfd'};
      bless ($self, $class);
      return $self;
    }

    sub header {
      my $self = shift;
      my $sfd  = $self->{SFD};

      my $base      = $$sfd{'base'};
      my $basename  = $$sfd{'basename'};
      my $BASENAME  = $$sfd{'BASENAME'};
      my $BaseName  = $$sfd{'BaseName'};
      my $basetype  = $$sfd{'basetype'};

      print "/* Automatically generated header (sfdc 1.10)! Do not edit! */\n";
      print "\n";
      print "#ifndef PROTO_${BASENAME}_H\n";
      print "#define PROTO_${BASENAME}_H\n";
      print "\n";
      print "#include <clib/${basename}_protos.h>\n";
      print "\n";
      print "#ifndef _NO_INLINE\n";
      print "# if defined(__GNUC__)\n";
      print "#  ifdef __AROS__\n";
      print "#   include <defines/${basename}.h>\n";
      print "#  else\n";
      print "#   include <inline/${basename}.h>\n";
      print "#  endif\n";
      print "# else\n";
      print "#  include <pragmas/${basename}_pragmas.h>\n";
      print "# endif\n";
      print "#endif /* _NO_INLINE */\n";
      print "\n";

      if ($base ne '') {
          print "#ifdef __amigaos4__\n";
          print "# include <interfaces/${basename}.h>\n";
          print "# ifndef __NOGLOBALIFACE__\n";
          print "   extern struct ${BaseName}IFace *I${BaseName};\n";
          print "# endif /* __NOGLOBALIFACE__*/\n";  
          print "#endif /* !__amigaos4__ */\n";
          print "#ifndef __NOLIBBASE__\n";
          print "  extern ${basetype}\n";
          print "# ifdef __CONSTLIBBASEDECL__\n";
          print "   __CONSTLIBBASEDECL__\n";
          print "# endif /* __CONSTLIBBASEDECL__ */\n";
          print "  ${base};\n";
          print "#endif /* !__NOLIBBASE__ */\n";
          print "\n";
      }
    }

    sub function {
      # Nothing to do here ...
    }

    sub footer {
      my $self = shift;
      my $sfd  = $self->{SFD};

      print "#endif /* !PROTO_$$sfd{'BASENAME'}_H */\n";
    }
}

### Class Macro: Create a generic macro file ##################################

# Macros are a bit different than those generated by fd2inline.
#
# Tag lists ("stdarg") are always initialized with the first tag value
# followed by __VA_ARGS__. This generates a compile-time error if no tags
# are supplied (TAG_DONE is the minimal tag list).

BEGIN {
    package Macro;

    sub new {
      my $proto  = shift;
      my %params = @_;
      my $class  = ref($proto) || $proto;
      my $self   = {};
      $self->{SFD}  = $params{'sfd'};
      $self->{BASE} = "${$self->{SFD}}{'BASENAME'}_BASE_NAME";
      $self->{BASE} =~ s/^([0-9])/_$1/;
      bless ($self, $class);
      return $self;
    }

    sub header {
      my $self = shift;
      my $sfd  = $self->{SFD};

      print "/* Automatically generated header (sfdc 1.10)! Do not edit! */\n";
      print "\n";
      print "#ifndef _INLINE_$$sfd{'BASENAME'}_H\n";
      print "#define _INLINE_$$sfd{'BASENAME'}_H\n";
      print "\n";
      print "#ifndef _SFDC_VARARG_DEFINED\n";
      print "#define _SFDC_VARARG_DEFINED\n";
      print "#ifdef __HAVE_IPTR_ATTR__\n";
      print "typedef APTR _sfdc_vararg __attribute__((iptr));\n";
      print "#else\n";
      print "typedef ULONG _sfdc_vararg;\n";
      print "#endif /* __HAVE_IPTR_ATTR__ */\n";
      print "#endif /* _SFDC_VARARG_DEFINED */\n";
      print "\n";
    }

    sub function {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      # Don't process private functions
      if ($prototype->{private}) {
          return;
      }
      
      if ($$prototype{'type'} eq 'varargs') {
          if ($prototype->{subtype} eq 'tagcall') {
            print "#ifndef NO_INLINE_STDARG\n";
          }
          else {
            print "#ifndef NO_INLINE_VARARGS\n";
          }
      }
      
      $self->function_define (prototype => $prototype);
      $self->function_start (prototype => $prototype);
      for my $i (0 .. $$prototype{'numargs'} - 1 ) {
          $self->function_arg (prototype => $prototype,
                         argtype   => $$prototype{'argtypes'}[$i],
                         argname   => $$prototype{'___argnames'}[$i],
                         argreg    => $$prototype{'regs'}[$i],
                         argnum    => $i );
      }
      $self->function_end (prototype => $prototype);

      if ($$prototype{'type'} eq 'varargs') {
          if ($prototype->{subtype} eq 'tagcall') {
          print "#endif /* !NO_INLINE_STDARG */\n";
          }
          else {
          print "#endif /* !NO_INLINE_VARARGS */\n";
          }
      }

      print "\n";
    }

    sub footer {
      my $self = shift;
      my $sfd  = $self->{SFD};

      print "#endif /* !_INLINE_$$sfd{'BASENAME'}_H */\n";
    }


    # Helper functions
    
    sub function_define {
      my $self     = shift;
      my %params   = @_;
      my $prototype = $params{'prototype'};
      my $sfd      = $self->{SFD};

      print "#define $$prototype{'funcname'}(";
      print join (', ', @{$$prototype{'___argnames'}});
      print ") \\\n";
    }

    sub function_start {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};
      my $nr        = $$prototype{'return'} =~ /^(VOID|void)$/;

      if ($$prototype{'type'} eq 'varargs') {
          if ($prototype->{subtype} eq 'tagcall' ||
            $prototype->{subtype} eq 'methodcall') {
            my $first_stdargnum = $$prototype{'numargs'} - 2;
            my $first_stdarg = $$prototype{'___argnames'}[$first_stdargnum];
          
            printf "    ({_sfdc_vararg _%s[] = { $first_stdarg, __VA_ARGS__ }; ",
            $prototype->{subtype} eq 'tagcall' ? "tags" : "message";
            print "$$prototype{'real_funcname'}(";
          }
          else {
            print "     ({_sfdc_vararg _args[] = { __VA_ARGS__ }; ";

            print "$$prototype{'real_funcname'}(";
          }
      }
      elsif ($prototype->{type} eq 'cfunction') {
          my $argtypes = join (', ',@{$$prototype{'argtypes'}});

          if ($argtypes eq '') {
            if ($prototype->{nb}) {
                $argtypes = "void";
            }
          }
          else {
            if (!$prototype->{nb}) {
                $argtypes = "$sfd->{basetype}, $argtypes";
            }
          }
          
          print " ({$$prototype{'return'} (*_func) ($argtypes) = \\\n";
          print "     ($$prototype{'return'} (*) ($argtypes))\\\n";

          if ($$classes{'target'} eq 'morphos') {
            # Skip jmp instruction (is m68k ILLEGAL in MorphOS)
            my $o = $$prototype{'bias'} - 2;
            print "         *((ULONG*) (((char*) $self->{BASE}) - $o));\\\n";
          }
          elsif ($classes->{target} eq 'aros') {
            my $o = $$prototype{'bias'} / 6;
            print "         __AROS_GETVECADDR($self->{BASE}, $o);\\\n";
          }
          else {
            my $o = $$prototype{'bias'};
            print "         (((char*) $self->{BASE}) - $o);\\\n";
          }

          print "   (*_func)(";

          if (!$prototype->{nb}) {
            print "($self->{BASE})";
            print ", " unless $prototype->{numargs} == 0;
          }
      }
      else {
          print STDERR "$prototype->{funcname}: Unhandled.\n";
          die;
      }
    }

    sub function_arg {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $argtype   = $params{'argtype'};
      my $argname   = $params{'argname'};
      my $argreg    = $params{'argreg'};
      my $argnum    = $params{'argnum'};
      my $sfd       = $self->{SFD};

      if ($$classes{'target'} eq 'morphos') {
    if($argtype eq "va_list") {
      $argtype = "long *";
    }
  }

      if ($$prototype{'type'} eq 'varargs') {
          if ($prototype->{subtype} eq 'tagcall' ||
            $prototype->{subtype} eq 'methodcall') {
            my $first_stdargnum = $$prototype{'numargs'} - 2;

            # Skip the first stdarg completely
            if( $argnum != $first_stdargnum ) {
                if ($argname eq '...') {
                  if ($prototype->{subtype} eq 'tagcall') {
                      print "($argtype) _tags";
                  }
                  else {
                      print "($argtype) _message";
                  }
                }
                else {
                  print "($argname), ";
                }
            }
          }
          else {
            if ($argname eq '...') {
                print "($argtype) _args";
            }
            else {
                print "($argname), ";
            }
          }
      }
      elsif ($prototype->{type} eq 'cfunction') {
          if ($argname eq '...' ) {
            print ($argnum != 0 ? ", __VA_ARGS__" : "__VA_ARGS__");
          }
          else {
            print ($argnum != 0 ? ", ($argname)" : "($argname)");
          }
      }
      else {
          print STDERR "$prototype->{funcname}: Unhandled.\n";
          die;
      }
    }
    
    sub function_end {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      
      print "); })\n";
    }
}

### Class CLib: Create a clib file ############################################

BEGIN {
    package CLib;

    sub new {
      my $proto  = shift;
      my %params = @_;
      my $class  = ref($proto) || $proto;
      my $self   = {};
      $self->{SFD}     = $params{'sfd'};
      $self->{VERSION} = 1;
      bless ($self, $class);
      return $self;
    }

    sub header {
      my $self = shift;
      my $sfd  = $self->{SFD};

      my $id = $$sfd{'id'};
      my $v  = $id;
      my $d  = $id;

      $v =~ s/^\$[I]d: .*? ([0-9.]+).*/$1/;
      $d =~ s,^\$[I]d: .*? [0-9.]+ (\d{4})/(\d{2})/(\d{2}).*,($3.$2.$1),;
            
      print "/* Automatically generated header (sfdc 1.10)! Do not edit! */\n";
      print "\n";
      print "#ifndef CLIB_$$sfd{'BASENAME'}_PROTOS_H\n";
      print "#define CLIB_$$sfd{'BASENAME'}_PROTOS_H\n";
      print "\n";
      print "/*\n";
      print "**   \$VER: $$sfd{'basename'}_protos.h $v $d\n";
      print "**\n";
      print "**   C prototypes. For use with 32 bit integers only.\n";
      print "**\n";
      print "**   $$sfd{'copyright'}\n";
      print "**       All Rights Reserved\n";
      print "*/\n";
      print "\n";

      foreach my $inc (@{$$sfd{'includes'}}) {
          print "#include $inc\n";
      }

      foreach my $td (@{$$sfd{'typedefs'}}) {
          print "typedef $td;\n";
      }

      print "\n";
      print "#ifdef __cplusplus\n";
      print "extern \"C\" {\n";
      print "#endif /* __cplusplus */\n";
      print "\n";

      $self->{VERSION} = 1;
    }

    sub function {
      my $self     = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};
      
      # Don't process private functions
      if ($prototype->{private}) {
          return;
      }
      
      if ($self->{VERSION} != $$prototype{'version'}) {
          $self->{VERSION} = $$prototype{'version'};

          print "\n";
          print "/*--- functions in V$self->{VERSION} or higher ---*/\n";
      }
      
      if ($$prototype{'comment'} ne '') {
          my $comment = $$prototype{'comment'};

          $comment =~ s,^(\s?)(.*)$,/*$1$2$1*/,mg;
            
          print "\n";
          print "$comment\n";
      }
      
      my $args = join (', ',@{$$prototype{'args'}});

      if ($args eq '') {
          $args = "void";
      }
      
      print "$$prototype{'return'} $$prototype{'funcname'}($args)";

      if ($$classes{'target'} eq 'morphos' &&
          $$prototype{'type'} eq 'varargs' &&
          $$prototype{'subtype'} ne 'tagcall') {
          print " __attribute__((varargs68k))";
      }

      if ($classes->{target} eq 'amigaos4' &&
          $prototype->{type} eq 'varargs') {
          print " __attribute__((linearvarargs))";
      }
      
      print ";\n";
    }

    sub footer {
      my $self = shift;
      my $sfd  = $self->{SFD};

      print "\n";
      print "#ifdef __cplusplus\n";
      print "}\n";
      print "#endif /* __cplusplus */\n";
      print "\n";
      print "#endif /* CLIB_$$sfd{'BASENAME'}_PROTOS_H */\n";
    }
}

### Class Interface: Create a struct with function pointers ###################

BEGIN {
    package Interface;

    sub new {
      my $proto  = shift;
      my %params = @_;
      my $class  = ref($proto) || $proto;
      my $self   = {};
      $self->{SFD} = $params{'sfd'};
      $self->{BIAS} = -1;
      $self->{PADCNT} = 1;
      bless ($self, $class);
      return $self;
    }

    sub header {
      my $self = shift;
      my $sfd  = $self->{SFD};

      print "/* Automatically generated function table (sfdc 1.10)! Do not edit! */\n";
      print "\n";
      print "#ifndef $sfd->{'BASENAME'}_INTERFACE_DEF_H\n";
      print "#define $sfd->{'BASENAME'}_INTERFACE_DEF_H\n";
      print "\n";

      foreach my $inc (@{$$sfd{'includes'}}) {
          print "#include $inc\n";
      }

      foreach my $td (@{$$sfd{'typedefs'}}) {
          print "typedef $td;\n";
      }

      print "\n";
      $self->define_interface_data();
      print "\n";

      print "struct $sfd->{BaseName}IFace\n";
      print "{\n";

      $self->output_prelude();
    }

    sub function {
      my $self      = shift;
      my $sfd       = $self->{SFD};
      my %params    = @_;
      my $prototype = $params{'prototype'};

      if ($self->{BIAS} == -1) {
          $self->{BIAS} = $prototype->{bias} - 6;
      }

      while ($self->{BIAS} < ($prototype->{bias} - 6)) {
          print "  APTR Pad$self->{PADCNT};\n";
          $self->{BIAS} += 6;
          ++$self->{PADCNT};
      }

      $self->{BIAS} = $prototype->{bias};

      $self->output_function(@_);
    }
    
    sub footer {
      my $self = shift;
      my $sfd  = $self->{SFD};

      print "};\n";
      print "\n";
      print "#endif /* $sfd->{'BASENAME'}_INTERFACE_DEF_H */\n";
    }


    # Helper functions
    
    sub define_interface_data {
      my $self     = shift;
      my $sfd      = $self->{SFD};

      print "struct $sfd->{BaseName}InterfaceData {\n";
      print "  $sfd->{basetype} LibBase;\n";
      print "};\n";
    }


    sub output_prelude {
      my $self     = shift;
      my $sfd      = $self->{SFD};

      print "  struct $sfd->{BaseName}InterfaceData Data;\n";
      print "\n";
      print "  static struct $sfd->{BaseName}IFace* CreateIFace($sfd->{basetype} _$sfd->{base}) {\n";
      print "    struct $sfd->{BaseName}IFace* _iface = new struct $sfd->{BaseName}IFace();\n";
      print "    _iface->Data.LibBase = _$sfd->{base};\n";
      print "    return _iface;\n";
      print "  }\n";
      print "\n";
      print "  static void DestroyIFace(struct $sfd->{BaseName}IFace* _iface) {\n";
      print "    delete _iface;\n";
      print "  }\n";
      print "\n";
    }

    sub output_function {
      my $self     = shift;
      my $sfd      = $self->{SFD};
      my %params    = @_;
      my $prototype = $params{'prototype'};

      print "  $prototype->{return} ";
      print "$prototype->{funcname}(";
      print join (', ', @{$prototype->{args}});
      print ");\n";
    }
}

### Class MacroMOS: Implements MorphOS-only features for macro files ##########

BEGIN {
    package MacroMOS;
    use vars qw(@ISA);
    @ISA = qw (Macro68k);

    sub new {
      my $proto  = shift;
      my $class  = ref($proto) || $proto;
      my $self   = $class->SUPER::new( @_ );
      bless ($self, $class);
      return $self;
    }

    sub header {
      my $self = shift;
      my $sfd  = $self->{SFD};

      print "/* Automatically generated header (sfdc 1.10)! Do not edit! */\n";
      print "\n";
      print "#ifndef _PPCINLINE_$$sfd{'BASENAME'}_H\n";
      print "#define _PPCINLINE_$$sfd{'BASENAME'}_H\n";
      print "\n";
      print "#ifndef _SFDC_VARARG_DEFINED\n";
      print "#define _SFDC_VARARG_DEFINED\n";
      print "#ifdef __HAVE_IPTR_ATTR__\n";
      print "typedef APTR _sfdc_vararg __attribute__((iptr));\n";
      print "#else\n";
      print "typedef ULONG _sfdc_vararg;\n";
      print "#endif /* __HAVE_IPTR_ATTR__ */\n";
      print "#endif /* _SFDC_VARARG_DEFINED */\n";
      print "\n";
 
      print "#ifndef __PPCINLINE_MACROS_H\n";
      print "#include <ppcinline/macros.h>\n";
      print "#endif /* !__PPCINLINE_MACROS_H */\n";
      print "\n";

      if ($$sfd{'base'} ne '') {
          print "#ifndef $self->{BASE}\n";
          print "#define $self->{BASE} $$sfd{'base'}\n";
          print "#endif /* !$self->{BASE} */\n";
          print "\n";
      }
    }

    sub footer {
      my $self = shift;
      my $sfd  = $self->{SFD};

      print "#endif /* !_PPCINLINE_$$sfd{'BASENAME'}_H */\n";
    }

    sub function_start {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      if ($$prototype{'type'} eq 'function') {

          my $regs      = join(',', @{$$prototype{'regs'}});
          my $argtypes  = join(',', @{$$prototype{'argtypes'}});
          my $fp        = $argtypes =~ /\(\*+\)/;
      my $return    = $$prototype{'return'};
      my $numfp     = 0;

      @{$self->{FUNCARGTYPE}} = ();
          for my $argtype (@{$$prototype{'argtypes'}}) {
            if ($argtype =~ /\(\*+\)/) {
                @{$self->{FUNCARGTYPE}}[$numfp] = $argtype;
        $numfp++;
            }
          }

      $self->{FUNCRETTYPE} = '';
      if($return =~ /\(\*+\)/)
      {
        $self->{FUNCRETTYPE} = $return;
      }
          
          printf "      LP%d%s%s%s%s%s(0x%x, ", $$prototype{'numargs'},
          $prototype->{nr} ? "NR" : "",
          $prototype->{nb} ? "NB" : "",
          scalar @{$self->{FUNCARGTYPE}} > 0 ? "FP" : "",
          scalar @{$self->{FUNCARGTYPE}} > 1 ? scalar @{$self->{FUNCARGTYPE}} : "",
      $self->{FUNCRETTYPE} ne '' ? "FR" : "",
          $$prototype{'bias'};

      if ($self->{FUNCRETTYPE})
      {
        print "__fpr, "; 
      }
          elsif (!$prototype->{nr}) {
            print "$$prototype{'return'}, ";
          }

          print "$$prototype{'funcname'} ";
      }
      else {
          $self->SUPER::function_start (@_);
      }
    }

    sub function_arg {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};

      if ($$prototype{'type'} eq 'function') {
          my $argtype   = $params{'argtype'};
          my $argname   = $params{'argname'};
          my $argreg    = $params{'argreg'};
      my $fpidx     = 0;
      my $fpfound   = 0;
          
          if ($argreg eq 'a4' || $argreg eq 'a5') {
            $argreg = 'd7';
          }
          
      for my $atype (@{$self->{FUNCARGTYPE}}) {
        $fpidx++;
        if ($atype eq $argtype) {
          printf ", __fpt%s, %s, %s",
            scalar @{$self->{FUNCARGTYPE}} > 1 ? $fpidx : "",
            $argname, $argreg;
          $fpfound = 1;
          last;
                }
      }

          if($fpfound eq 0) {
        if($argtype eq "va_list") {
          print ", long *, $argname, $argreg";
        } else {
          print ", $argtype, $argname, $argreg";
        }
          }
      }
        else {
          $self->SUPER::function_arg (@_);
      }
    }


    sub function_end {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};
  my $fpidx     = 0;

      if ($$prototype{'type'} eq 'function') {
          if (!$prototype->{nb}) {
            print ",\\\n      , $self->{BASE}";
          }

      for my $fa (@{$self->{FUNCARGTYPE}}) {
        $fpidx++;
        if(scalar @{$self->{FUNCARGTYPE}} gt 1) {
                  $fa =~ s/\((\*+)\)/($1__fpt$fpidx)/;
        }
        else {
                  $fa =~ s/\((\*+)\)/($1__fpt)/;
        }
                print ", $fa";
      }

      if ($self->{FUNCRETTYPE} ne '')
      {
        my $fr = $self->{FUNCRETTYPE};

        $fr =~ s/\((\*+)\)/($1__fpr)/;

        print ", $fr";
      }
          
          print ", 0, 0, 0, 0, 0, 0)\n";
      }
      else {
          $self->SUPER::function_end (@_);
      }
    }
}

### Class Stub: Create a generic stub file ####################################

BEGIN {
    package Stub;

    sub new {
      my $proto  = shift;
      my %params = @_;
      my $class  = ref($proto) || $proto;
      my $self   = {};
      $self->{SFD}     = $params{'sfd'};
      $self->{NEWFILE} = 0;
      bless ($self, $class);
      return $self;
    }

    sub header {
      my $self = shift;
      my $sfd  = $self->{SFD};

      $self->{NEWFILE} = 1;

      print "/* Automatically generated stubs (sfdc 1.10)! Do not edit! */\n";
      print "\n";

      foreach my $inc (@{$$sfd{'includes'}}) {
          print "#include $inc\n";
      }

      foreach my $td (@{$$sfd{'typedefs'}}) {
          print "typedef $td;\n";
      }

      print "\n";
      print "#ifdef __cplusplus\n";
      print "extern \"C\" {\n";
      print "#endif /* __cplusplus */\n";
      print "\n";

      if ($$sfd{'base'} ne '') { 
          print "#ifndef BASE_EXT_DECL\n";
          print "#define BASE_EXT_DECL\n";
          print "#define BASE_EXT_DECL0 extern $$sfd{'basetype'} " .
            "$$sfd{'base'};\n";
          print "#endif /* !BASE_EXT_DECL */\n";
          print "#ifndef BASE_PAR_DECL\n";
          print "#define BASE_PAR_NAME\n";
          print "#define BASE_PAR_DECL\n";
          print "#define BASE_PAR_DECL0 void\n";
          print "#endif /* !BASE_PAR_DECL */\n";
          print "#ifndef BASE_NAME\n";
          print "#define BASE_NAME $$sfd{'base'}\n";
          print "#endif /* !BASE_NAME */\n";
          print "\n";
          print "BASE_EXT_DECL0\n";
          print "\n";
      }

    }

    sub function {
      my $self     = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      # Don't process private functions
      if ($prototype->{private}) {
          return;
      }
      
      $self->function_proto (prototype => $prototype, decl_regular => $self->{NEWFILE} );
      $self->function_start (prototype => $prototype);
      for my $i (0 .. $$prototype{'numargs'} - 1 ) {
          $self->function_arg (prototype => $prototype,
                         argtype   => $$prototype{'argtypes'}[$i],
                         argname   => $$prototype{'___argnames'}[$i],
                         argreg    => $$prototype{'regs'}[$i],
                         argnum    => $i );
      }
      $self->function_end (prototype => $prototype);

      print "\n";

      $self->{NEWFILE} = 0;
    }

    sub footer {
      my $self = shift;
      my $sfd  = $self->{SFD};

      print "\n";
      print "#undef BASE_EXT_DECL\n";
      print "#undef BASE_EXT_DECL0\n";
      print "#undef BASE_PAR_NAME\n";
      print "#undef BASE_PAR_DECL\n";
      print "#undef BASE_PAR_DECL0\n";
      print "#undef BASE_NAME\n";
      print "\n";
      print "#ifdef __cplusplus\n";
      print "}\n";
      print "#endif /* __cplusplus */\n";
    }


    # Helper functions
    
    sub function_proto {
      my $self     = shift;
      my %params   = @_;
      my $prototype    = $params{'prototype'};
      my $decl_regular = $params{'decl_regular'};
      my $sfd      = $self->{SFD};

      if ($prototype->{type} eq 'varargs' && $decl_regular) {
          my $rproto = $prototype->{real_prototype};

          print "__inline $$rproto{'return'} $$rproto{'funcname'}(";
          if (!$prototype->{nb}) {
            if ($$rproto{'numargs'} == 0) {
                print "BASE_PAR_DECL0";
            }
            else {
                print "BASE_PAR_DECL ";
            }
          }
          print join (', ', @{$$rproto{'___args'}});

          print ");\n";
          print "\n";
      }

      if ($prototype->{type} eq 'cfunction' &&
          $prototype->{argnames}[$#{@{$prototype->{argnames}}}] eq '...') {
          print "#if 0\n";
          print "/* Unsupported */\n";
      }

      # Declare structs in case some ==include directive is missing
      for my $argtype (@{$prototype->{argtypes}}) {
          my $struct;

          (undef, $struct) = ( $argtype =~ /\s*(const)?\s*struct\s*(\w+).*/) and
            printf "struct $struct;\n";
      }

      
      print "__inline $$prototype{'return'}\n";
      print "$$prototype{'funcname'}(";
      if (!$prototype->{nb}) {
          if ($$prototype{'numargs'} == 0) {
            print "BASE_PAR_DECL0";
          }
          else {
            print "BASE_PAR_DECL ";
          }
      }
      print join (', ', @{$$prototype{'___args'}});
      print ")";
      
    }

    sub function_start {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};
      
      print "\n";
      print "{\n";

      if ($$prototype{'type'} eq 'varargs') {
          print "  return $$prototype{'real_funcname'}(BASE_PAR_NAME ";
      }
      elsif ($prototype->{type} eq 'cfunction') {
          if (!$prototype->{nb}) {
            print "  BASE_EXT_DECL\n";
          }

          my $argtypes = join (', ',@{$$prototype{'argtypes'}});

          if ($argtypes eq '') {
            if ($prototype->{nb}) {
                $argtypes = "void";
            }
          }
          else {
            if (!$prototype->{nb}) {
                $argtypes = "$sfd->{basetype}, $argtypes";
            }
          }


          # Skip jmp instruction (is m68k ILLEGAL in MOS)
          my $offs = $$prototype{'bias'} - 2;
          
          print "  $$prototype{'return'} (*_func) ($argtypes) = \n";
          print "    ($$prototype{'return'} (*) ($argtypes))\n";
          print "    *((ULONG*) (((char*) BASE_NAME) - $offs));\n";
          print "  return (*_func)(";

          if (!$prototype->{nb}) {
            print "BASE_NAME";
            print ", " unless $prototype->{numargs} == 0;
          }
      }
      else {
          print STDERR "$prototype->{funcname}: Unhandled.\n";
          die;
      }
    }

    sub function_arg {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $argtype   = $params{'argtype'};
      my $argname   = $params{'argname'};
      my $argreg    = $params{'argreg'};
      my $argnum    = $params{'argnum'};
      my $sfd       = $self->{SFD};

      my $argstr;
      
      if ($$prototype{'type'} eq 'varargs') {
          if ($prototype->{subtype} eq 'printfcall') {
            if ($argnum < $$prototype{'numargs'} - 1) {
                $argstr = $argname;
            }
            elsif ($argnum == $$prototype{'numargs'} - 1) {
                my $vartype  =
                  $$prototype{'argtypes'}[$$prototype{'numargs'} - 1];
                my $argnm =
                  $$prototype{'___argnames'}[$$prototype{'numargs'} - 2];
                $argstr = "($vartype) (&$argnm + 1)";
            }
            else {
                $argstr = '';
            }
          }
          else {
            # tagcall/methodcall
            if ($argnum < $$prototype{'numargs'} - 2) {
                $argstr = $argname;
            }
            elsif ($argnum == $$prototype{'numargs'} - 2) {
                my $vartype =
                  $$prototype{'argtypes'}[$$prototype{'numargs'} - 1];
                $argstr = "($vartype) &$argname";
            }
            else {
                $argstr = '';
            }
          }
      }
      elsif ($prototype->{type} eq 'cfunction') {
          $argstr = $argname;
      }
      else {
          print STDERR "$prototype->{funcname}: Unhandled.\n";
          die;
      }

      if ($argstr ne '') {
          print ($argnum != 0 ? ", $argstr" : $argstr);
      }
    }

    sub function_end {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};
      
      print ");\n";
      print "}\n";

      if ($prototype->{type} eq 'cfunction' &&
          $prototype->{argnames}[$#{@{$prototype->{argnames}}}] eq '...') {
          print "/* Unsupported */\n";
          print "#endif\n";
      }
    }
}

### Class Gate: Create a generic gate file ####################################

BEGIN {
    package Gate;

    sub new {
      my $proto  = shift;
      my %params = @_;
      my $class  = ref($proto) || $proto;
      my $self   = {};
      $self->{SFD}      = $params{'sfd'};
      $self->{PROTO}    = $params{'proto'};
      $self->{LIBPROTO} = $params{'libproto'};
      bless ($self, $class);
      return $self;
    }

    sub header {
      my $self = shift;
      my $sfd  = $self->{SFD};

      if ($self->{PROTO}) {
          print "/* Automatically generated header (sfdc 1.10)! Do not edit! */\n";
          print "\n";
          print "#ifndef _GATEPROTO_$$sfd{'BASENAME'}_H\n";
          print "#define _GATEPROTO_$$sfd{'BASENAME'}_H\n";
      }
      elsif ($self->{LIBPROTO}) {
          print "/* Automatically generated header (sfdc 1.10)! Do not edit! */\n";
          print "\n";
          print "#ifndef _LIBPROTO_$$sfd{'BASENAME'}_H\n";
          print "#define _LIBPROTO_$$sfd{'BASENAME'}_H\n";
      }
      else {
          print "/* Automatically generated gatestubs (sfdc 1.10)! Do not edit! */\n";
      }
      print "\n";

      foreach my $inc (@{$$sfd{'includes'}}) {
          print "#include $inc\n";
      }

      foreach my $td (@{$$sfd{'typedefs'}}) {
          print "typedef $td;\n";
      }

      print "\n";
      print "#define _sfdc_strarg(a) _sfdc_strarg2(a)\n";
      print "#define _sfdc_strarg2(a) #a\n";

      print "\n";
      print "#ifdef __cplusplus\n";
      print "extern \"C\" {\n";
      print "#endif /* __cplusplus */\n";
      print "\n";
    }

    sub function {
      my $self     = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      if ($prototype->{type} eq 'function') {
          $self->function_proto (prototype => $prototype);
          $self->function_start (prototype => $prototype);
          for my $i (0 .. $$prototype{'numargs'} - 1 ) {
            $self->function_arg (prototype => $prototype,
                             argtype   => $$prototype{'argtypes'}[$i],
                             argname   => $$prototype{'___argnames'}[$i],
                             argreg    => $$prototype{'regs'}[$i],
                             argnum    => $i );
          }
          $self->function_end (prototype => $prototype);
          
          print "\n";
      }
      elsif ($prototype->{type} eq 'cfunction') {
          $self->function_proto (prototype => $prototype);

          if (!$self->{LIBPROTO}) {
            print_gateproto ($sfd, $prototype);
            print ";\n\n";
          }

          if (!$self->{PROTO} && !$self->{LIBPROTO}) {
            print "__asm(\".globl \" _sfdc_strarg(" .
                "$gateprefix$prototype->{funcname}) );\n";
            print "__asm(\".type  \" _sfdc_strarg(" .
                "$gateprefix$prototype->{funcname}) \"" .
                ", \@function\");\n";
            print "__asm(_sfdc_strarg(".
                "$gateprefix$prototype->{funcname}) \":\");\n";
            print "#if defined(__mc68000__) || defined(__i386__)\n";
            print "__asm(\"jmp $libprefix$prototype->{funcname}\");\n";
            print "#else\n";
            print "# error \"Unknown CPU\"\n";
            print "#endif\n";
            print "\n";
          }
      }
    }

    sub footer {
      my $self = shift;
      my $sfd  = $self->{SFD};

      print "\n";
      print "#ifdef __cplusplus\n";
      print "}\n";
      print "#endif /* __cplusplus */\n";

      if ($self->{PROTO}) {
          print "\n";
          print "#endif /* _GATEPROTO_$$sfd{'BASENAME'}_H */\n";
      }
      elsif ($self->{LIBPROTO}) {
          print "\n";
          print "#endif /* _LIBPROTO_$$sfd{'BASENAME'}_H */\n";
      }
    }


    # Helper functions
    
    sub function_proto {
      my $self     = shift;
      my %params   = @_;
      my $prototype = $params{'prototype'};
      my $sfd      = $self->{SFD};

      if (!$self->{PROTO} and $sdi eq 0) {
          if ($prototype->{type} eq 'varargs') {
            print_libproto($sfd, $prototype->{real_prototype});
          }
          else {
            print_libproto($sfd, $prototype);
          }
          print ";\n\n";
      }
    }

    sub function_start {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      if (!$self->{LIBPROTO}) {
          print_gateproto ($sfd, $prototype);
      }
      
      if ($self->{PROTO}) {
          print ";\n";
      }
      elsif (!$self->{LIBPROTO}) {
          print "\n";
          print "{\n";
          print "  return $libprefix$prototype->{funcname}(";

          if ($libarg eq 'first' && !$prototype->{nb}) {
            print "_base";
            print $prototype->{numargs} > 0 ? ", " : "";
          }
      }
    }

    sub function_arg {
      my $self      = shift;

      if (!$self->{PROTO} && !$self->{LIBPROTO}) {
          my %params    = @_;
          my $argname   = $params{'argname'};
          my $argnum    = $params{'argnum'};

          print $argnum > 0 ? ", " : "";
          print $argname;
      }
    }

    sub function_end {
      my $self      = shift;
      
      if (!$self->{PROTO} && !$self->{LIBPROTO}) {
          my %params    = @_;
          my $prototype = $params{'prototype'};
          my $sfd       = $self->{SFD};
          
          if ($libarg eq 'last' && !$prototype->{nb}) {
            print $prototype->{numargs} > 0 ? ", " : "";
            print "_base";
          }
          
          print ");\n";
          print "}\n";
      }
    }


    sub print_gateproto {
      my $sfd       = shift;
      my $prototype = shift;
      
      print "$prototype->{return}\n";
      print "$gateprefix$prototype->{funcname}(";

      if ($libarg eq 'first' && !$prototype->{nb}) {
          print "$sfd->{basetype} _base";
          print $prototype->{numargs} > 0 ? ", " : "";
      }
      
      print join (', ', @{$prototype->{___args}});

      if ($libarg eq 'last' && !$prototype->{nb}) {
          print $prototype->{numargs} > 0 ? ", " : "";
          print "$sfd->{basetype} _base";
      }

      if ($libarg eq 'none' && $prototype->{numargs} == 0) {
          print "void";
      }

      print ")";
    }

    sub print_libproto {
      my $sfd       = shift;
      my $prototype = shift;
      
      my $rettype_prefix = $prototype->{return};
      my $rettype_postfix = "";
      if ($prototype->{return} =~ /(.*\(\*+)(\).*)/) {
        $rettype_prefix = $1;
        $rettype_postfix = $2;
      }

      print "$rettype_prefix ";
      print "$libprefix$prototype->{funcname}(";

      if ($libarg eq 'first' && !$prototype->{nb}) {
          print "$sfd->{basetype} _base";
      }

      for my $i (0 .. $prototype->{numargs} - 1 ) {
        my $argtype = $$prototype{'argtypes'}[$i];
        my $argname = $$prototype{'___argnames'}[$i];
        if($argtype eq "va_list") {
          $argtype = "long *";
        }
        my $argdef = $argtype . " " . $argname;
        if ($argtype =~ /\(\*+\)/) {
          $argdef = $argtype;
          $argdef =~ s/\(\*+\)/\(\*$argname\)/g;
        }

        print ", $argdef";
      }

      if ($libarg eq 'last' && !$prototype->{nb}) {
          print $prototype->{numargs} > 0 ? ", " : "";
          print "$sfd->{basetype} _base";
      }

      if ($libarg eq 'none' && $prototype->{numargs} == 0) {
          print "void";
      }
      
      print ")" . $rettype_postfix;
    }
}

### Class Interface: Create a struct with function pointers ###################

BEGIN {
    package InterfaceAOS4;
    use vars qw(@ISA);
    @ISA = qw( Interface );

    sub new {
      my $proto  = shift;
      my $class  = ref($proto) || $proto;
      my $self   = $class->SUPER::new( @_ );
      bless ($self, $class);
      return $self;
    }

    # Helper functions
    
    sub define_interface_data {
      my $self     = shift;
      my $sfd      = $self->{SFD};

      print "#include <exec/interfaces.h>\n";
    }


    sub output_prelude {
      my $self     = shift;
      my $sfd      = $self->{SFD};

      print "  struct InterfaceData Data;\n";
      print "\n";
      print "#ifdef __cplusplus\n";
      print "  static struct $sfd->{BaseName}IFace* CreateIFace($sfd->{basetype} _$sfd->{base}) {\n";
      print "    return (struct $sfd->{BaseName}IFace*) GetInterface((struct Library*) _$sfd->{base}, \"main\", 1, NULL);\n";
      print "  }\n";
      print "\n";
      print "  static void DestroyIFace(struct $sfd->{BaseName}IFace* _iface) {\n";
      print "      DropInterface((struct Interface*) _iface);\n";
      print "  }\n";
      print "#endif\n";
      print "\n";
      print "  ULONG APICALL (*Obtain)(struct $sfd->{BaseName}IFace *Self);\n";
      print "  ULONG APICALL (*Release)(struct $sfd->{BaseName}IFace *Self);\n";
      print "  void APICALL (*Expunge)(struct $sfd->{BaseName}IFace *Self);\n";
      print "  struct Interface * APICALL (*Clone)(struct $sfd->{BaseName}IFace *Self);\n";
    }

    sub output_function {
      my $self     = shift;
      my $sfd      = $self->{SFD};
      my %params    = @_;
      my $prototype = $params{'prototype'};

      print "  $prototype->{return} APICALL ";
      print "(*$prototype->{funcname})(struct $sfd->{BaseName}IFace* Self";

      if ($prototype->{type} eq 'varargs' &&
          ($prototype->{subtype} eq 'tagcall' ||
           $prototype->{subtype} eq 'methodcall')) {
          # Nuke second last argument (=first varargs argument) 
          # or it will be placed in a register!
          for my $i (0 .. $#{@{$prototype->{args}}}) {
            if ($i != $prototype->{numargs} - 2 ) {
                print ", $prototype->{args}[$i]";
          }
      }
          
      }
      else {
          if ($prototype->{numargs} != 0) {
            print ", ";
          }
          print join (', ', @{$prototype->{args}});
      }
      print ");\n";
    }
}

### Class GateMOS: Create a MorphOS gatestub file #############################

BEGIN {
    package GateMOS;
    use vars qw(@ISA);
    @ISA = qw( Gate );

    sub new {
      my $proto  = shift;
      my $class  = ref($proto) || $proto;
      my $self   = $class->SUPER::new( @_ );
      bless ($self, $class);
      return $self;
    }

    sub header {
      my $self = shift;
      
      $self->SUPER::header (@_);

      if ($sdi eq 0) {
        print "#include <emul/emulregs.h>\n\n";
        print "int $gateprefix" . "UNIMPLEMENTED(void)";
      }
      else {
        print "#include <SDI_lib.h>\n\n";
        print "LIBSTUB(UNIMPLEMENTED, int)";
      }

      if ($self->{PROTO}) {
        print ";";
      }
      else {
        print "\n";
        print "{\n";
        print "  // nothing\n";
        print "  return 0;\n";
        print "}\n";
      }
      print "\n";
    }

    sub function_start {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      my $rettype_prefix = $prototype->{return};
      my $rettype_postfix = "";
      if ($prototype->{return} =~ /(.*\(\*+)(\).*)/) {
        $rettype_prefix = $1;
        $rettype_postfix = $2;
      }

      if ($sdi eq 0) {
        print "$rettype_prefix ";
        print "$gateprefix$prototype->{funcname}(void)$rettype_postfix";
        
      }
      else {
        if ($prototype->{return} =~ /\(\*+\)/) {
          print "LIBSTUB($prototype->{funcname}, void *)";
        }
        else {
          print "LIBSTUB($prototype->{funcname}, $prototype->{return})";
        }
      }

      if ($self->{PROTO}) {
        print ";";
      }
      else {
        print "\n";
        print "{\n";
        if ($sdi ne 0) {
          print "  __BASE_OR_IFACE = (__BASE_OR_IFACE_TYPE)REG_A6;\n";
          print "  return CALL_LFUNC($prototype->{funcname}";
        }
      }
    }

    sub function_arg {
      my $self      = shift;

      if (!$self->{PROTO}) {
          my %params    = @_;
          my $prototype = $params{'prototype'};
          my $argtype   = $params{'argtype'};
          my $argname   = $params{'argname'};
          my $argreg    = $params{'argreg'};
          my $argnum    = $params{'argnum'};
          my $sfd       = $self->{SFD};

          if($argtype eq "va_list") {
            $argtype = "long *";
          }

          my $argdef = $argtype . " " . $argname;
          if ($argtype =~ /\(\*+\)/) {
            $argdef = $argtype;
            $argdef =~ s/\(\*+\)/\(\*$argname\)/g;
          }

          if ($sdi eq 0) {
            print "  $argdef = ($argtype)REG_" . (uc $argreg) . ";\n";
          }
          else {
            print ", ($argtype)REG_" . (uc $argreg);
          }
      }
    }
    
    sub function_end {
      my $self      = shift;

      if (!$self->{PROTO}) {
          my %params    = @_;
          my $prototype = $params{'prototype'};
          my $sfd       = $self->{SFD};

          if ($sdi eq 0) {
            if ($libarg ne 'none' && !$prototype->{nb}) {
              print "  $sfd->{basetype} _base = ($sfd->{basetype})"."REG_A6;\n";
            }
            
            print "  return $libprefix$prototype->{funcname}(";

            if ($libarg eq 'first' && !$prototype->{nb}) {
              print "_base";
              print $prototype->{numargs} > 0 ? ", " : "";
            }

            print join (', ', @{$prototype->{___argnames}});
      
            if ($libarg eq 'last' && !$prototype->{nb}) {
              print $prototype->{numargs} > 0 ? ", " : "";
              print "_base";
            }
          }
      
          print ");\n";
          print "}\n";
      }
    }
}

### Class Verify: Verify SFD info #################################################

BEGIN {
    package Verify;

    sub new {
      my $proto       = shift;
      my %params      = @_;
      my $class       = ref($proto) || $proto;
      my $self        = {};
      $self->{SFD}    = $params{'sfd'};
      $self->{CNT}    = 0;
      $self->{FUNCS}  = {};
      $self->{ERRORS} = 0;
      $self->{WARNS}  = 0;
      bless ($self, $class);
      return $self;
    }

    sub header {
      my $self      = shift;
      my $sfd       = $self->{SFD};

      print "Checking SFD for $$sfd{'libname'} ...";
      $self->{CNT} = 0;

      if ($#{\@{$sfd->{typedefs}}} != -1) {
          print "\nWarning: SFD uses nonstandard '==typedef' command.";
          ++$self->{WARNS};
      }
    }

    sub function {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      if ($self->{FUNCS}{$prototype->{funcname}}) {
          if ($prototype->{private}) {
            print "\nWarning: Private function $prototype->{funcname}() ".
                "is defined more than once!";
            ++$self->{WARNS};
          }
          else {
            print "\nError: Public function $prototype->{funcname}() ".
                "is defined more than once!";
            ++$self->{ERRORS};
          }
      }
      else {
          $self->{FUNCS}{$prototype->{funcname}} = 1;
      }

      ++$self->{CNT};
    }

    sub footer {
      my $self = shift;
      my $sfd  = $self->{SFD};

      if ($self->{WARNS} != 0 || $self->{ERRORS} != 0) {
          print "\n$self->{WARNS} warning(s), $self->{ERRORS} error(s); ";

          die if $self->{ERRORS};
      }
      
      printf " $self->{CNT} function%s verified\n", $self->{CNT} == 1 ? "" : "s";
    }
}

### Class GateAOS4: Create a AmigaOS gatestub file ############################

BEGIN {
    package GateAOS4;
    use vars qw(@ISA);
    @ISA = qw( Gate );

    sub new {
      my $proto  = shift;
      my $class  = ref($proto) || $proto;
      my $self   = $class->SUPER::new( @_ );
      bless ($self, $class);
      return $self;
    }

    sub header {
      my $self = shift;
      my $sfd  = $self->{SFD};
      
      $self->SUPER::header (@_);

      print "#undef __USE_INLINE__\n";
      print "#define _NO_INLINE\n";
      print "#define __NOLIBBASE__\n";
      print "#define __NOGLOBALIFACE__\n";
      print "#include <proto/$sfd->{basename}.h>\n";
      print "#undef _NO_INLINE\n";
      print "#undef __NOLIBBASE__\n";
      print "#undef __NOGLOBALIFACE__\n";
      print "#include <stdarg.h>\n";
      print "#include <interfaces/exec.h>\n";
      print "#include <exec/emulation.h>\n";
      print "\n";
    }

    sub function {
      my $self     = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      if ($prototype->{type} eq 'function' ||
          $prototype->{type} eq 'varargs' ) {
          $self->function_proto (prototype => $prototype);
          $self->function_start (prototype => $prototype);
          for my $i (0 .. $$prototype{'numargs'} - 1 ) {
            $self->function_arg (prototype => $prototype,
                             argtype   => $$prototype{'argtypes'}[$i],
                             argname   => $$prototype{'___argnames'}[$i],
                             argreg    => $$prototype{'regs'}[$i],
                             argnum    => $i );
          }
          $self->function_end (prototype => $prototype);
          
          print "\n";

          if ($prototype->{type} eq 'function' && $prototype->{bias} != 0) {
            if (!$self->{PROTO}) {
                $self->emu_function_start (prototype => $prototype);
                for my $i (0 .. $$prototype{'numargs'} - 1 ) {
                  $self->emu_function_arg (prototype => $prototype,
                                     argtype   => $$prototype{'argtypes'}[$i],
                                     argname   => $$prototype{'___argnames'}[$i],
                                     argreg    => $$prototype{'regs'}[$i],
                                     argnum    => $i );
                }
                $self->emu_function_end (prototype => $prototype);
            }

            $self->emu_trap (prototype => $prototype);
          }
      }
    }
    
    sub function_start {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      print "$prototype->{return}";
      if ($prototype->{type} eq 'varargs') {
          print " VARARGS68K";
      }
      print "\n";
      print "$gateprefix$prototype->{funcname}(";
      if ($prototype->{type} eq 'function' &&
          $prototype->{subtype} =~ /^(library|device|boopsi)$/) {
          # Special function prototype

          if ($prototype->{bias} == 0) {
            # Do nothing
          }
          elsif ($prototype->{subtype} eq 'library' ||
               $prototype->{subtype} eq 'boopsi') {
            print "struct LibraryManagerInterface* _iface";
          }
          elsif( $prototype->{subtype} eq 'device') {
            print "struct DeviceManagerInterface* _iface";
          }
      }
      else {
          print "struct $sfd->{BaseName}IFace* _iface";
      }
    }

    sub function_arg {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $argtype   = $params{'argtype'};
      my $argname   = $params{'argname'};
      my $argreg    = $params{'argreg'};
      my $argnum    = $params{'argnum'};
      my $sfd       = $self->{SFD};

      if ($prototype->{subtype} ne 'tagcall' ||
          $argnum ne $prototype->{numargs} - 2) {

          if ($argnum != 0 || $prototype->{bias} != 0) {
            print ",\n";
          }

          if ($prototype->{subtype} =~ /^(library|device|boopsi)$/ &&
            $prototype->{bias} == 0 &&
            $argnum == $prototype->{numargs} - 1 ) {
            print "     struct ExecIFace* _iface";
          }
          else {
            print "     $prototype->{___args}[$argnum]";
          }
      }
    }
    
    sub function_end {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      if ($self->{PROTO}) {
          print ");\n";
      }
      else {
          print ")\n";
          print "{\n";
          
          if ($prototype->{subtype} =~ /^(library|device|boopsi)$/ &&
            $prototype->{bias} == 0) {
            print "  $prototype->{___args}[$prototype->{numargs} - 1] = ".
                "($prototype->{argtypes}[$prototype->{numargs} - 1]) " .
                "_iface->Data.LibBase;\n";
          }
          
          if ($prototype->{type} ne 'varargs') {
            print "  return $libprefix$prototype->{funcname}(";

            if ($libarg eq 'first' && !$prototype->{nb}) {
                print "($sfd->{basetype}) _iface->Data.LibBase";
                print $prototype->{numargs} > 0 ? ", " : "";
            }

            print join (', ', @{$prototype->{___argnames}});

            if ($libarg eq 'last' && !$prototype->{nb}) {
                print $prototype->{numargs} > 0 ? ", " : "";
                print "($sfd->{basetype}) _iface->Data.LibBase";
            }
          }
          else {
            my $na;

            if ($prototype->{subtype} eq 'tagcall') {
                $na = $prototype->{numargs} - 3;
            }
            elsif ($prototype->{subtype} eq 'printfcall') {
                $na = $prototype->{numargs} - 2;
            }
            else {
                # methodcall: first vararg is removed
                $na = $prototype->{numargs} - 3;
            }
            
            print "  va_list _va;\n";
            print "  va_startlinear (_va, ";
            if ($na >= 0) {
                print "$prototype->{___argnames}[$na]);\n";
            }
            else {
                print "_iface);\n"
            }

            print "  return $libprefix$prototype->{real_funcname}(";

            if ($libarg eq 'first' && !$prototype->{nb}) {
                print "($sfd->{basetype}) _iface->Data.LibBase";
                print $prototype->{numargs} > 0 ? ", " : "";
            }

            for (my $i = 0; $i <= $na; ++$i) {
                print "@{$prototype->{___argnames}}[$i], ";
            }

            print "va_getlinearva (_va, " .
                "$prototype->{argtypes}[$prototype->{numargs}-1])";
            
            if ($libarg eq 'last' && !$prototype->{nb}) {
                print $prototype->{numargs} > 0 ? ", " : "";
                print "($sfd->{basetype}) _iface->Data.LibBase";
            }
          }
      
          print ");\n";
          print "}\n";
      }
    }


    sub emu_function_start {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      print "STATIC $prototype->{return} \n";
      print "$gateprefix$prototype->{funcname}PPC(ULONG *regarray)\n";
      print "{\n";
      print "  struct Library * _base = (struct Library *) regarray[REG68K_A6/4];\n";
      print "  struct ExtendedLibrary * ExtLib = (struct ExtendedLibrary *) ((ULONG) _base + _base->lib_PosSize);\n";
      
      if ($prototype->{subtype} =~ /^(library|device|boopsi)$/) {
          # Special function prototype

          if ($prototype->{bias} == 0) {
            # Do nothing
          }
          elsif ($prototype->{subtype} eq 'library' ||
               $prototype->{subtype} eq 'boopsi') {
            print "  struct LibraryManagerInterface* _iface = ";
            print "ExtLib->ILibrary;\n";
          }
          elsif( $prototype->{subtype} eq 'device') {
            print "  struct DeviceManagerInterface* _iface = ";
            print "ExtLib->IDevice;\n";
          }
      }
      else {
          print "  struct $sfd->{BaseName}IFace* _iface = ";
          print "(struct $sfd->{BaseName}IFace*) ExtLib->MainIFace;\n";
      }
    }

    sub emu_function_arg {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $argtype   = $params{'argtype'};
      my $argname   = $params{'argname'};
      my $argreg    = $params{'argreg'};
      my $argnum    = $params{'argnum'};
      my $sfd       = $self->{SFD};

      print "  $prototype->{___args}[$argnum] = ($argtype) regarray[REG68K_" .
          (uc $argreg) . "/4];\n";
    }
    
    sub emu_function_end {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      print "\n";

      my $funcname = $prototype->{funcname};
      
      if ($prototype->{subtype} eq 'library' ||
          $prototype->{subtype} eq 'device' ||
          $prototype->{subtype} eq 'boopsi') {

          if ($prototype->{bias} == 6) {
            $funcname = "Open";
          }
          elsif ($prototype->{bias} == 12) {
            $funcname = "Close";
          }
          elsif ($prototype->{bias} == 18 ||
               $prototype->{bias} == 24) {
            print "  return 0;\n";
            print "}\n";
            print "\n";
            return;
          }

          if ($prototype->{subtype} eq 'device') {
            if ($prototype->{bias} == 30) {
                $funcname = "BeginIO";
            }
            elsif ($prototype->{bias} == 36) {
                $funcname = "AbortIO";
            }
          }
      }
      
      print "  return _iface->$funcname(";
      print join (', ', @{$prototype->{___argnames}});

      if ($prototype->{subtype} eq 'device' && ($prototype->{bias} == 36)) {
          print "), 0;  /* Return type changed to VOID in OS4?! */\n";
      }
      else {
          print ");\n";
      }
      print "}\n";
      print "\n";
    }
    
    sub emu_trap {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      if ($self->{PROTO}) {
          print "extern ";
      }

      print "CONST struct EmuTrap m68k$gateprefix$prototype->{funcname}";

      if (!$self->{PROTO}) {
          print " = { TRAPINST, TRAPTYPE, (ULONG (*)(ULONG *)) $gateprefix$prototype->{funcname}PPC }";
      }
      
      print ";\n";
      print "\n";
    }
}

### Class FuncTable: Create a function table fragment #########################

BEGIN {
    package FuncTable;

    sub new {
      my $proto  = shift;
      my %params = @_;
      my $class  = ref($proto) || $proto;
      my $self   = {};
      $self->{SFD} = $params{'sfd'};
      bless ($self, $class);
      return $self;
    }

    sub header {
      my $self = shift;
      my $sfd  = $self->{SFD};

      print "/* Automatically generated function table (sfdc 1.10)! Do not edit! */\n";
      print "\n";
      print "#ifdef __SFDC_FUNCTABLE_M68K__\n";
      print "# define _sfdc_func(f) &m68k ## f\n";
      print "#else\n";
      print "# define _sfdc_func(f) f\n";
      print "#endif\n";
    }

    sub function {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};

      if ($prototype->{bias} == 0) {
          return;
      }

      if ($prototype->{type} eq 'function' ||
          $prototype->{type} eq 'cfunction') {
          print "  (CONST_APTR) _sfdc_func($gateprefix$prototype->{funcname}),\n";
      }
    }
    
    sub footer {
      my $self = shift;
      my $sfd  = $self->{SFD};

      print "#undef _sfdc_func\n";
      print "\n";
    }
}

### Class MacroAROS: Implements AROS macro files ##############################

BEGIN {
    package MacroAROS;
    use vars qw(@ISA);
    @ISA = qw( Macro );

    sub new {
      my $proto  = shift;
      my $class  = ref($proto) || $proto;
      my $self   = $class->SUPER::new( @_ );
      bless ($self, $class);
      return $self;
    }

    sub header {
      my $self = shift;
      my $sfd  = $self->{SFD};

      $self->SUPER::header (@_);
      
      print "#ifndef AROS_LIBCALL_H\n";
      print "#include <aros/libcall.h>\n";
      print "#endif /* !AROS_LIBCALL_H */\n";
      print "\n";

      if ($$sfd{'base'} ne '') {
          print "#ifndef $self->{BASE}\n";
          print "#define $self->{BASE} $$sfd{'base'}\n";
          print "#endif /* !$self->{BASE} */\n";
          print "\n";
      }
    }

    sub function_start {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      if ($$prototype{'type'} eq 'function') {
          printf "      AROS_LC%d%s(%s, %s, \\\n",
          $$prototype{'numargs'}, $prototype->{nb} ? "I" : "",
          $$prototype{'return'}, $$prototype{'funcname'};
      }
      else {
          $self->SUPER::function_start (@_);
      }
    }


    sub function_arg {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};

      if ($$prototype{'type'} eq 'function') {
          my $argtype   = $params{'argtype'};
          my $argname   = $params{'argname'};
          my $argreg    = $params{'argreg'};
          
          print " AROS_LCA($argtype, ($argname), " . uc $argreg . "), \\\n";
      }
        else {
          $self->SUPER::function_arg (@_);
      }
    }

    sub function_end {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      if ($$prototype{'type'} eq 'function') {
          if( !$prototype->{nb}) {
            print "     $$sfd{'basetype'}, $self->{BASE}, ";
          }
          else {
            my $bt = "/* bt */";
            my $bn = "/* bn */";

            for my $i (0 .. $#{$prototype->{regs}}) {
                if ($prototype->{regs}[$i] eq 'a6') {
                  $bt = $prototype->{argtypes}[$i];
                  $bn  =$prototype->{___argnames}[$i];
                  last;
                }
            }
            
            print "     $bt, $bn, ";
          }
          
          print $$prototype{'bias'} / 6;
          print ", $sfd->{Basename})\n";
      }
      else {
          $self->SUPER::function_end (@_);
      }
    }
}

### Class Stub68k: Create a 68k stub file #####################################

BEGIN {
    package Stub68k;
    use vars qw(@ISA);
    @ISA = qw( Stub );

    sub new {
      my $proto  = shift;
      my $class  = ref($proto) || $proto;
      my $self   = $class->SUPER::new( @_ );
      bless ($self, $class);
      return $self;
    }

    sub function_start {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      if ($prototype->{type} eq 'function') {
          print "\n";
          print "{\n";

          if (!$prototype->{nb}) {
            print "  BASE_EXT_DECL\n";
          }
          if (!$prototype->{nr}) {
            print "  register $prototype->{return} _res __asm(\"d0\");\n";
          }
          if (!$prototype->{nb}) {
            print "  register $sfd->{basetype} _base __asm(\"a6\") " .
                "= BASE_NAME;\n";
          }
      }
      else {
          $self->SUPER::function_start (@_);
      }
    }

    sub function_arg {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $argtype   = $params{'argtype'};
      my $argname   = $params{'argname'};
      my $argreg    = $params{'argreg'};
      my $argnum    = $params{'argnum'};
      my $sfd       = $self->{SFD};

      if ($$prototype{'type'} eq 'function') {
          if ($argreg eq 'a4' || $argreg eq 'a5') {
            $argreg = 'd7';
          }
          
          print "  register $prototype->{args}[$argnum] __asm(\"$argreg\") " .
            "= $argname;\n";
      }
      else {
          $self->SUPER::function_arg (@_);
      }
    }
    
    sub function_end {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      
      if ($$prototype{'type'} eq 'function') {
          my $regs      = join(',', @{$$prototype{'regs'}});
          my $a4        = $regs =~ /a4/;
          my $a5        = $regs =~ /a5/;

          if ($a4 && $a5 && !$quiet) {
            print STDERR "$$prototype{'funcname'} uses both a4 and a5 " .
                "for arguments. This is not going to work.\n";
          }

          if ($a4) {
            print "  __asm volatile (\"exg d7,a4\\n\\tjsr a6@(-" .
                "$prototype->{bias}:W)\\n\\texg d7,a4\"\n";
          }
          elsif ($a5) {
            print "  __asm volatile (\"exg d7,a5\\n\\tjsr a6@(-" .
                "$prototype->{bias}:W)\\n\\texg d7,a5\"\n";
          }
          else {
            print "  __asm volatile (\"jsr a6@(-$prototype->{bias}:W)\"\n";
          }
          print "  : " .
            ($prototype->{nr} ? "/* No output */" : '"=r" (_res)') . "\n";
          print "  : ";
          if (!$prototype->{nb}) {
            print '"r" (_base)';
          }

          for my $i (0 .. $prototype->{numargs} - 1) {
            if ($i != 0 || !$prototype->{nb}) {
                print ", ";
            }
            
            print '"r" (' . $prototype->{argnames}[$i] . ')';
          }

          print "\n";
          print '  : "d0", "d1", "a0", "a1", "fp0", "fp1", "cc", "memory");';
          print "\n";
          
          if (!$prototype->{nr}) {
            print "  return _res;\n";
          }

          print "}\n";
      }
      else {
          $self->SUPER::function_end (@_);
      }
    }
}

### Class LVO: Create an assembler LVO include file ###########################

BEGIN {
    package LVO;

    sub new {
      my $proto  = shift;
      my %params = @_;
      my $class  = ref($proto) || $proto;
      my $self   = {};
      $self->{SFD} = $params{'sfd'};
      bless ($self, $class);
      return $self;
    }

    sub header {
      my $self = shift;
      my $sfd  = $self->{SFD};

      print "* Automatically generated header (sfdc 1.10)! Do not edit!\n";
      print "     IFND  LVO_$sfd->{BASENAME}_LIB_I\n";
      print "LVO_$sfd->{BASENAME}_LIB_I   SET   1\n";
      print "\n";
    }

    sub function {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};

      # Don't process private functions
      if ($prototype->{private}) {
          return;
      }

      if ($prototype->{type} eq 'function') {
          print "_LVO$prototype->{funcname}     EQU   -$prototype->{bias}\n";
      }
    }
    
    sub footer {
      my $self = shift;
      my $sfd  = $self->{SFD};

      print "\n";
      print "     ENDC  * LVO_$sfd->{BASENAME}_LIB_I\n";
    }
}

### Class StubMOS: Create a MorphOS stub file #################################

BEGIN {
    package StubMOS;
    use vars qw(@ISA);
    @ISA = qw( Stub );

    sub new {
      my $proto  = shift;
      my $class  = ref($proto) || $proto;
      my $self   = $class->SUPER::new( @_ );
      bless ($self, $class);
      return $self;
    }

    sub header {
      my $self = shift;
      
      $self->SUPER::header (@_);

      print "\n";
      print "#include <emul/emulregs.h>\n";
      print "#include <stdarg.h>\n";
      print "\n";
    }

    sub function_proto {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};

      if ($prototype->{type} eq 'varargs') {

          if ($prototype->{subtype} ne 'tagcall') {
            # We have to add the attribute to ourself first
          
            $self->special_function_proto (@_);
            print " __attribute__((varargs68k));\n";
            print "\n";
            $self->special_function_proto (@_);
          }
      }
      else {
          $self->SUPER::function_proto (@_);
      }
    }
    
    sub function_start {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      if ($prototype->{type} eq 'function') {
          print "\n";
          print "{\n";

          if (!$prototype->{nb}) {
            print "  BASE_EXT_DECL\n";
          }
      }
      elsif ($prototype->{type} eq 'varargs') {
          if ($prototype->{subtype} ne 'tagcall') {
            my $na;

            if ($prototype->{subtype} eq 'printfcall') {
                $na = $prototype->{numargs} - 2;
            }
            else {
                # methodcall: first vararg is removed
                $na = $prototype->{numargs} - 3;
            }
            
            print "\n";
            print "{\n";
            print "  va_list _va;\n";
            print "  va_start (_va, $prototype->{___argnames}[$na]);\n";
            print "  return $$prototype{'real_funcname'}(BASE_PAR_NAME ";
          }
          else {
            # Shamelessly stolen from fd2inline ...
            
            # number of regs that contain varargs
            my $n = 9 - $prototype->{numregs};

            # add 4 bytes if that's an odd number, to avoid splitting a tag
            my $d = $n & 1 ? 4 : 0;

            # offset of the start of the taglist
            my $taglist = 8;

            # size of the stack frame
            my $local = ($taglist + $n * 4 + $d + 8 + 15) & ~15;

            #  Stack frame:
            #
            #   0 -  3: next frame ptr
            #   4 -  7: save lr
            #   8 -  8+n*4+d+8-1: tag list start
            #   ? - local-1: padding

            print  "__asm(\"\n";
            print  "    .align      2\n";
            print  "    .globl      $prototype->{funcname}\n";
            print  "    .type $prototype->{funcname},\@function\n";
            print  "$prototype->{funcname}:\n";
            print  "    stwu  1,-$local(1)\n";
            print  "    mflr  0\n";
            printf "    stw   0,%d(1)\n", $local + 4;

            # If n is odd, one tag is split between regs and stack.
            # Copy its ti_Data together with the ti_Tag.
          
            if ($d != 0) {
                # read ti_Data
                printf "      lwz   0,%d(1)\n", $local + 8;
            }

            # Save the registers
          
            for my $count ($prototype->{numregs} .. 8) {
                printf "      stw   %d,%d(1)\n",
                $count + 2,
                ($count - $prototype->{numregs}) * 4 + $taglist;
            }

            if ($d != 0) {
                # write ti_Data
                printf "      stw   0,%d(1)\n", $taglist + $n * 4;
            }

            # Add TAG_MORE

            print  "    li    11,2\n";
            printf "    addi  0,1,%d\n", $local + 8 + $d;
            printf "    stw   11,%d(1)\n", $taglist + $n * 4 + $d;
            printf "    stw   0,%d(1)\n", $taglist + $n * 4 + $d + 4;

            # vararg_reg = &saved regs
          
            printf "    addi  %d,1,%d\n",
            $prototype->{numregs} + 2, $taglist;
            print "     bl    $prototype->{real_funcname}\n";
          }
      }
      else {
          $self->SUPER::function_start (@_);
      }
    }

    sub function_arg {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $argtype   = $params{'argtype'};
      my $argname   = $params{'argname'};
      my $argreg    = $params{'argreg'};
      my $argnum    = $params{'argnum'};
      my $sfd       = $self->{SFD};

      if ($$prototype{'type'} eq 'function') {
          print "  REG_" . (uc $argreg) . " = (ULONG) $argname;\n";
      }
      elsif ($prototype->{type} eq 'varargs') {
          if ($prototype->{subtype} eq 'tagcall') {
          }
          elsif ($prototype->{subtype} eq 'methodcall' &&
               $argnum == $prototype->{numargs} - 2) {
            # Nuke it!
          }
          elsif ($argnum == $prototype->{numargs} - 1) {
            my $vt  = $$prototype{'argtypes'}[$$prototype{'numargs'} - 1];
            print ", ($vt) _va->overflow_arg_area";
          }
          else {
            $self->SUPER::function_arg (@_);
          }
      }
      else {
          $self->SUPER::function_arg (@_);
      }
    }
    
    sub function_end {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      if ($$prototype{'type'} eq 'function') {
          if (!$prototype->{nb}) {
            print "  REG_A6 = (ULONG) BASE_NAME;\n";
          }

          print "  ";
          
          if (!$prototype->{nr}) {
            print "return ($prototype->{return}) ";
          }

          print "(*MyEmulHandle->EmulCallDirectOS)(-$prototype->{bias});\n";
          print "}\n";
      }
      elsif ($prototype->{type} eq 'varargs') {
          if ($prototype->{subtype} eq 'tagcall') {
            # number of regs that contain varargs
            my $n = 9 - $prototype->{numregs};

            # add 4 bytes if that's an odd number, to avoid splitting a tag
            my $d = $n & 1 ? 4 : 0;

            # offset of the start of the taglist
            my $taglist = 8;

            # size of the stack frame
            my $local = ($taglist + $n * 4 + $d + 8 + 15) & ~15;

            # clear stack frame & return
            printf "    lwz   0,%d(1)\n", $local + 4;
            print  "    mtlr  0\n";
            printf "    addi  1,1,%d\n", $local;
            print  "    blr\n";
            print  ".L$prototype->{funcname}e1:\n";
            print  "    .size $prototype->{funcname}," .
                ".L$prototype->{funcname}e1-$prototype->{funcname}\n";

            print "\");\n";
          }
          else {
            print ");\n";
            print "}\n";
          }
      }
      else {
          $self->SUPER::function_end (@_);
      }
    }


    sub special_function_proto {
      my $self     = shift;
      my %params   = @_;
      my $prototype    = $params{'prototype'};
      my $decl_regular = $params{'decl_regular'};
      my $sfd      = $self->{SFD};

      if ($prototype->{type} eq 'varargs' && $decl_regular) {
          my $rproto = $prototype->{real_prototype};

          print "$$rproto{'return'} $$rproto{'funcname'}(";
          if (!$prototype->{nb}) {
            if ($$rproto{'numargs'} == 0) {
                print "BASE_PAR_DECL0";
            }
            else {
                print "BASE_PAR_DECL ";
            }
          }
          print join (', ', @{$$rproto{'___args'}});

          print ");\n";
          print "\n";
      }
      
      print "$$prototype{'return'}\n";
      print "$$prototype{'funcname'}(";
      if (!$prototype->{nb}) {
          if ($$prototype{'numargs'} == 0) {
            print "BASE_PAR_DECL0";
          }
          else {
            print "BASE_PAR_DECL ";
          }
      }

      my @newargs;

      for my $i (0 .. $#{@{$prototype->{___args}}}) {
          if ($prototype->{subtype} ne 'methodcall' ||
            $i != $prototype->{numargs} - 2 ) {
            push @newargs, $prototype->{___args}[$i];
          }
      }

      print join (', ', @newargs);
      print ")";
      
    }
}

### Class MacroLP: Create a LP-style macro file ###############################

BEGIN {
    package MacroLP;
    use vars qw(@ISA);
    @ISA = qw( Macro );

    sub new {
      my $proto  = shift;
      my $class  = ref($proto) || $proto;
      my $self   = $class->SUPER::new( @_ );
      bless ($self, $class);
      return $self;
    }

    sub header {
      my $self = shift;
      my $sfd  = $self->{SFD};

      $self->SUPER::header (@_);
      
      print "#ifndef __INLINE_MACROS_H\n";
      print "#include <inline/macros.h>\n";
      print "#endif /* !__INLINE_MACROS_H */\n";
      print "\n";

      if ($$sfd{'base'} ne '') {
          print "#ifndef $self->{BASE}\n";
          print "#define $self->{BASE} $$sfd{'base'}\n";
          print "#endif /* !$self->{BASE} */\n";
          print "\n";
      }
    }
    
    sub function_start {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      if ($$prototype{'type'} eq 'function') {
          printf "      LP%d%s%s(0x%x, ", $$prototype{'numargs'},
          $prototype->{nr} ? "NR" : "",
          $prototype->{nb} ? "NB" : "", $$prototype{'bias'};

          if (!$prototype->{nr}) {
            print "$$prototype{'return'}, ";
          }

          print "$$prototype{'funcname'}";
      }
      else {
          $self->SUPER::function_start (@_);
      }
    }

    sub function_arg {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $argtype   = $params{'argtype'};
      my $argname   = $params{'argname'};
      my $argreg    = $params{'argreg'};
      my $argnum    = $params{'argnum'};
      my $sfd       = $self->{SFD};

      if ($$prototype{'type'} eq 'function') {
          print ", $argtype, $argname, $argreg";
      }
      else {
          $self->SUPER::function_arg (@_);
      }
    }
    
    sub function_end {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      
      if ($$prototype{'type'} eq 'function') {

          if (!$prototype->{nb}) {
            print ",\\\n      , $self->{BASE})\n";
          }
          else {
            print ")\n";
          }
      }
      else {
          $self->SUPER::function_end (@_);
      }
    }
}

### Class GateAmithlon: Create an Amithlon gatestub file ######################

BEGIN {
    package GateAmithlon;
    use vars qw(@ISA);
    @ISA = qw( Gate );

    sub new {
      my $proto  = shift;
      my $class  = ref($proto) || $proto;
      my $self   = $class->SUPER::new( @_ );
      bless ($self, $class);
      return $self;
    }

    sub header {
      my $self = shift;
      
      $self->SUPER::header (@_);

      print "#ifndef __INLINE_MACROS_H\n";
      print "#define __INLINE_MACROS_H\n";
      print "\n";
      print "#ifndef __INLINE_MACROS_H_REGS\n";
      print "#define __INLINE_MACROS_H_REGS\n";
      print "\n";
      print "#include <exec/types.h>\n";
      print "\n";
      print "struct _Regs {\n";
      print "     ULONG d0;\n";
      print "     ULONG d1;\n";
      print "     ULONG d2;\n";
      print "     ULONG d3;\n";
      print "     ULONG d4;\n";
      print "     ULONG d5;\n";
      print "     ULONG d6;\n";
      print "     ULONG d7;\n";
      print "     ULONG a0;\n";
      print "     ULONG a1;\n";
      print "     ULONG a2;\n";
      print "     ULONG a3;\n";
      print "     ULONG a4;\n";
      print "     ULONG a5;\n";
      print "     ULONG a6;\n";
      print "     ULONG a7;\n";
      print "};\n";
      print "\n";
      print "#endif /* __INLINE_MACROS_H_REGS */\n";
      print "\n";
      print "#endif /* __INLINE_MACROS_H */\n";
      print "\n";
    }

    sub function_proto {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      $self->SUPER::function_proto (@_);

      print_gateproto($sfd, $prototype);
      print ";\n\n";
    }
    
    sub function_start {
      my $self      = shift;

      if (!$self->{PROTO}) {
          my %params    = @_;
          my $prototype = $params{'prototype'};
          my $sfd       = $self->{SFD};

          print "$prototype->{return}\n";
          print "$gateprefix$prototype->{funcname}(struct _Regs* _regs)\n";
          print "{\n";
      }
    }

    sub function_arg {
      my $self      = shift;

      if (!$self->{PROTO}) {
          my %params    = @_;
          my $prototype = $params{'prototype'};
          my $argtype   = $params{'argtype'};
          my $argname   = $params{'argname'};
          my $argreg    = $params{'argreg'};
          my $argnum    = $params{'argnum'};
          my $sfd       = $self->{SFD};

          print "  $prototype->{___args}[$argnum] = ($argtype) ({long r;" .
            "__asm(\"movl %1,%0\":\"=r\"(r):\"m\"(_regs->$argreg));" .
            "r;});\n";
      }
    }
    
    sub function_end {
      my $self      = shift;

      if (!$self->{PROTO}) {
          my %params    = @_;
          my $prototype = $params{'prototype'};
          my $sfd       = $self->{SFD};

          if ($libarg ne 'none' && !$prototype->{nb}) {
            print "  $sfd->{basetype} _base = ($sfd->{basetype}) " .
                "({long r;" .
                "__asm(\"movl %1,%0\":\"=r\"(r):\"m\"(_regs->a6));" .
                "r;});\n";
          }

          print "  return $libprefix$prototype->{funcname}(";

          if ($libarg eq 'first' && !$prototype->{nb}) {
            print "_base";
            print $prototype->{numargs} > 0 ? ", " : "";
          }

          print join (', ', @{$prototype->{___argnames}});
      
          if ($libarg eq 'last' && !$prototype->{nb}) {
            print $prototype->{numargs} > 0 ? ", " : "";
            print "_base";
          }
      
          print ");\n";
          print "}\n";
      }
    }

    sub print_gateproto {
      my $sfd       = shift;
      my $prototype = shift;
      
      print "$prototype->{return}\n";
      print "$gateprefix$prototype->{funcname}" .
          "(struct _Regs* _regs) __attribute__((regparm(3)))";
    }
}

### Class StubAOS4: Create an AOS4 stub file ####################################

BEGIN {
    package StubAOS4;
    use vars qw(@ISA);
    @ISA = qw( Stub );

    sub new {
      my $proto  = shift;
      my $class  = ref($proto) || $proto;
      my $self   = $class->SUPER::new( @_ );
      bless ($self, $class);
      return $self;
    }

    sub header {
      my $self = shift;
      my $sfd       = $self->{SFD};

      # Ugly, but it works

      print "/* Interface base override */\n";
      print "\n";
      print "#ifndef BASE_EXT_DECL\n";
      print "#define BASE_EXT_DECL\n";
      print "#define BASE_EXT_DECL0 extern struct $sfd->{BaseName}IFace * I$sfd->{BaseName};\n";
      print "#endif /* !BASE_EXT_DECL */\n";
      print "#ifndef BASE_NAME\n";
      print "#define BASE_NAME I$sfd->{BaseName}\n";
      print "#endif /* !BASE_NAME */\n";
      print "\n";
      
      $self->SUPER::header (@_);

      print "#include <interfaces/$sfd->{basename}.h>\n";
      print "#include <stdarg.h>\n";
      print "\n";
    }

    sub function_proto {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};

      if ($prototype->{type} eq 'varargs') {

          if ($prototype->{subtype} ne 'tagcall') {
            # We have to add the attribute to ourself first
          
            $self->special_function_proto (@_);
            print " __attribute__((linearvarargs));\n";
            print "\n";
            $self->special_function_proto (@_);
          }
      }
      else {
          $self->SUPER::function_proto (@_);
      }
    }

    sub function_start {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      if ($prototype->{type} eq 'function') {
          print "\n";
          print "{\n";

          if (!$prototype->{nb}) {
            print "  BASE_EXT_DECL\n";
          }

          if (!$prototype->{nr}) {
            print "  $prototype->{return} _res = ($prototype->{return}) ";
          }
          else {
            print "  ";
          }

          printf "BASE_NAME->$prototype->{funcname}(";
      }
      elsif ($prototype->{type} eq 'varargs') {
          if ($prototype->{subtype} ne 'tagcall') {
            my $na;

            if ($prototype->{subtype} eq 'printfcall') {
                $na = $prototype->{numargs} - 2;
            }
            else {
                # methodcall: first vararg is removed
                $na = $prototype->{numargs} - 3;
            }
            
            print "\n";
            print "{\n";
            print "  va_list _va;\n";
            print "  va_startlinear (_va, $prototype->{___argnames}[$na]);\n";
            print "  return $$prototype{'real_funcname'}(BASE_PAR_NAME ";
          }
          else {
            # Shamelessly stolen from fd2inline ...
            
            # number of regs that contain varargs
            my $n = 9 - $prototype->{numregs};

            # add 4 bytes if that's an odd number, to avoid splitting a tag
            my $d = $n & 1 ? 4 : 0;

            # offset of the start of the taglist
            my $taglist = 8;

            # size of the stack frame
            my $local = ($taglist + $n * 4 + $d + 8 + 15) & ~15;

            #  Stack frame:
            #
            #   0 -  3: next frame ptr
            #   4 -  7: save lr
            #   8 -  8+n*4+d+8-1: tag list start
            #   ? - local-1: padding

            print  "__asm(\"\\n\\\n";
            print  "    .align      2\\n\\\n";
            print  "    .globl      $prototype->{funcname}\\n\\\n";
            print  "    .type $prototype->{funcname},\@function\\n\\\n";
            print  "$prototype->{funcname}:\\n\\\n";
            print  "    stwu  1,-$local(1)\\n\\\n";
            print  "    mflr  0\\n\\\n";
            printf "    stw   0,%d(1)\\n\\\n", $local + 4;

            # If n is odd, one tag is split between regs and stack.
            # Copy its ti_Data together with the ti_Tag.
          
            if ($d != 0) {
                # read ti_Data
                printf "      lwz   0,%d(1)\\n\\\n", $local + 8;
            }

            # Save the registers
          
            for my $count ($prototype->{numregs} .. 8) {
                printf "      stw   %d,%d(1)\\n\\\n",
                $count + 2,
                ($count - $prototype->{numregs}) * 4 + $taglist;
            }

            if ($d != 0) {
                # write ti_Data
                printf "      stw   0,%d(1)\\n\\\n", $taglist + $n * 4;
            }

            # Add TAG_MORE

            print  "    li    11,2\\n\\\n";
            printf "    addi  0,1,%d\\n\\\n", $local + 8 + $d;
            printf "    stw   11,%d(1)\\n\\\n", $taglist + $n * 4 + $d;
            printf "    stw   0,%d(1)\\n\\\n", $taglist + $n * 4 + $d + 4;

            # vararg_reg = &saved regs
          
            printf "    addi  %d,1,%d\\n\\\n",
            $prototype->{numregs} + 2, $taglist;
            print "     bl    $prototype->{real_funcname}\\n\\\n";
          }
      }
      else {
          $self->SUPER::function_start (@_);
      }
    }

    sub function_arg {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $argtype   = $params{'argtype'};
      my $argname   = $params{'argname'};
      my $argreg    = $params{'argreg'};
      my $argnum    = $params{'argnum'};
      my $sfd       = $self->{SFD};

      if ($$prototype{'type'} eq 'function') {
          print "$argname";
          print ", " unless $argnum == $prototype->{numargs} - 1;
      }
      elsif ($prototype->{type} eq 'varargs') {
          if ($prototype->{subtype} eq 'tagcall') {
          }
          elsif ($prototype->{subtype} eq 'methodcall' &&
               $argnum == $prototype->{numargs} - 2) {
            # Nuke it!
          }
          elsif ($argnum == $prototype->{numargs} - 1) {
            my $vt  = $$prototype{'argtypes'}[$$prototype{'numargs'} - 1];
            print ", va_getlinearva(_va, $vt)";
          }
          else {
            $self->SUPER::function_arg (@_);
          }
      }
      else {
          $self->SUPER::function_arg (@_);
      }
    }
    
    sub function_end {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};
      
      if ($$prototype{'type'} eq 'function') {
          print ");\n";
          
          if (!$prototype->{nr}) {
            print "  return _res;\n";
          }
    
          print "};\n";
      }
      elsif ($prototype->{type} eq 'varargs') {
          if ($prototype->{subtype} eq 'tagcall') {
            # number of regs that contain varargs
            my $n = 9 - $prototype->{numregs};

            # add 4 bytes if that's an odd number, to avoid splitting a tag
            my $d = $n & 1 ? 4 : 0;

            # offset of the start of the taglist
            my $taglist = 8;

            # size of the stack frame
            my $local = ($taglist + $n * 4 + $d + 8 + 15) & ~15;

            # clear stack frame & return
            printf "    lwz   0,%d(1)\\n\\\n", $local + 4;
            print  "    mtlr  0\\n\\\n";
            printf "    addi  1,1,%d\\n\\\n", $local;
            print  "    blr\\n\\\n";
            print  ".L$prototype->{funcname}e1:\\n\\\n";
            print  "    .size $prototype->{funcname}," .
                ".L$prototype->{funcname}e1-$prototype->{funcname}\\n\\\n";

            print "\");\n";
          }
          else {
            print ");\n";
            print "}\n";
          }
      }
      else {
          $self->SUPER::function_end (@_);
      }
    }


    sub special_function_proto {
      my $self     = shift;
      my %params   = @_;
      my $prototype    = $params{'prototype'};
      my $decl_regular = $params{'decl_regular'};
      my $sfd      = $self->{SFD};

      if ($prototype->{type} eq 'varargs' && $decl_regular) {
          my $rproto = $prototype->{real_prototype};

          print "$$rproto{'return'} $$rproto{'funcname'}(";
          if (!$prototype->{nb}) {
            if ($$rproto{'numargs'} == 0) {
                print "BASE_PAR_DECL0";
            }
            else {
                print "BASE_PAR_DECL ";
            }
          }
          print join (', ', @{$$rproto{'___args'}});

          print ");\n";
          print "\n";
      }
      
      print "$$prototype{'return'}\n";
      print "$$prototype{'funcname'}(";
      if (!$prototype->{nb}) {
          if ($$prototype{'numargs'} == 0) {
            print "BASE_PAR_DECL0";
          }
          else {
            print "BASE_PAR_DECL ";
          }
      }

      my @newargs;

      for my $i (0 .. $#{@{$prototype->{___args}}}) {
          if ($prototype->{subtype} ne 'methodcall' ||
            $i != $prototype->{numargs} - 2 ) {
            push @newargs, $prototype->{___args}[$i];
          }
      }

      print join (', ', @newargs);
      print ")";
      
    }
}

### Class Macro68k: Implements m68k-only features for macro files #############

BEGIN {
    package Macro68k;
    use vars qw(@ISA);
    @ISA = qw( MacroLP );

    sub new {
      my $proto  = shift;
      my $class  = ref($proto) || $proto;
      my $self   = $class->SUPER::new( @_ );
      bless ($self, $class);
      return $self;
    }

    sub function_start {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      if ($$prototype{'type'} eq 'function') {

          my $regs      = join(',', @{$$prototype{'regs'}});
          my $argtypes  = join(',', @{$$prototype{'argtypes'}});
          my $a4        = $regs =~ /a4/;
          my $a5        = $regs =~ /a5/;
          my $fp        = $argtypes =~ /\(\*+\)/;
      my $return    = $$prototype{'return'};
      my $numfp     = 0;

          if ($a4 && $a5 && !$quiet) {
            print STDERR "$$prototype{'funcname'} uses both a4 and a5 " .
                "for arguments. This is not going to work.\n";
          }
      
      @{$self->{FUNCARGTYPE}} = ();
          for my $argtype (@{$$prototype{'argtypes'}}) {
            if ($argtype =~ /\(\*+\)/) {
                @{$self->{FUNCARGTYPE}}[$numfp] = $argtype;
        $numfp++;
            }
          }

      $self->{FUNCRETTYPE} = '';
      if($return =~ /\(\*+\)/)
      {
        $self->{FUNCRETTYPE} = $return;
      }
          
          printf "      LP%d%s%s%s%s%s%s%s(0x%x, ", $$prototype{'numargs'},
          $prototype->{nr} ? "NR" : "",
          $prototype->{nb} ? "NB" : "",
          $a4 ? "A4" : "", $a5 ? "A5" : "",
          scalar @{$self->{FUNCARGTYPE}} > 0 ? "FP" : "",
          scalar @{$self->{FUNCARGTYPE}} > 1 ? scalar @{$self->{FUNCARGTYPE}} : "",
      $self->{FUNCRETTYPE} ne '' ? "FR" : "",
          $$prototype{'bias'};

      if ($self->{FUNCRETTYPE})
      {
        print "__fpr, "; 
      }
          elsif (!$prototype->{nr}) {
            print "$$prototype{'return'}, ";
          }

          print "$$prototype{'funcname'} ";
      }
      else {
          $self->SUPER::function_start (@_);
      }
    }


    sub function_arg {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};

      if ($$prototype{'type'} eq 'function') {
          my $argtype   = $params{'argtype'};
          my $argname   = $params{'argname'};
          my $argreg    = $params{'argreg'};
      my $fpidx     = 0;
      my $fpfound   = 0;
          
          if ($argreg eq 'a4' || $argreg eq 'a5') {
            $argreg = 'd7';
          }
          
      for my $atype (@{$self->{FUNCARGTYPE}}) {
        $fpidx++;
        if ($atype eq $argtype) {
          printf ", __fpt%s, %s, %s",
            scalar @{$self->{FUNCARGTYPE}} > 1 ? $fpidx : "",
            $argname, $argreg;
          $fpfound = 1;
          last;
                }
      }

          if($fpfound eq 0) {
        print ", $argtype, $argname, $argreg";
          }
      }
        else {
          $self->SUPER::function_arg (@_);
      }
    }

    sub function_end {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};
  my $fpidx     = 0;

      if ($$prototype{'type'} eq 'function') {
          if (!$prototype->{nb}) {
            print ",\\\n      , $self->{BASE}";
          }

      for my $fa (@{$self->{FUNCARGTYPE}}) {
        $fpidx++;
        if(scalar @{$self->{FUNCARGTYPE}} gt 1) {
                  $fa =~ s/\((\*+)\)/($1__fpt$fpidx)/;
        }
        else {
                  $fa =~ s/\((\*+)\)/($1__fpt)/;
        }
                print ", $fa";
      }

      if ($self->{FUNCRETTYPE} ne '')
      {
        my $fr = $self->{FUNCRETTYPE};

        $fr =~ s/\((\*+)\)/($1__fpr)/;

        print ", $fr";
      }
          
          print ")\n";
      }
      else {
          $self->SUPER::function_end (@_);
      }
    }
}

### Class Dump: Dump SFD info #################################################

BEGIN {
    package Dump;

    sub new {
      my $proto    = shift;
      my %params   = @_;
      my $class    = ref($proto) || $proto;
      my $self     = {};
      $self->{SFD} = $params{'sfd'};
      bless ($self, $class);
      return $self;
    }

    sub header {
      my $self = shift;
      my $sfd  = $self->{SFD};

      print "SFD information\n";
      print "\n";
      print "Copyright:       $$sfd{'copyright'}\n";
      print "RCS ID:                $$sfd{'id'}\n";
      print "Module name:           $$sfd{'libname'}\n";
      print "Module base:           $$sfd{'base'}\n";
      print "Module base type:      $$sfd{'basetype'}\n";
      print "Module base names:     $$sfd{'basename'}, $$sfd{'BASENAME'}, ";
      print "$$sfd{'Basename'}\n";
      print "\n";
      print "Include files:         ";
      print join ("\n               ", @{$$sfd{'includes'}});
      print "\n";
      print "Type definitions:            ";
      if ($#{\@{$sfd->{typedefs}}} != -1) {
          print join ("\n                 ", @{$$sfd{'typedefs'}});
      }
      print "\n";
      print "\n";
    }

    sub function {
      my $self      = shift;
      my %params    = @_;
      my $prototype = $params{'prototype'};
      my $sfd       = $self->{SFD};

      print "* Line $$prototype{'line'}: $$prototype{'funcname'}()\n";
      print "     Type:             " . ucfirst $$prototype{'type'} . "\n";
      print "     Subtype:          $prototype->{subtype}\n";
      if ($prototype->{real_funcname} ne '') {
          print " Real function name:\t$$prototype{'real_funcname'}\n";
      }
      print "     Visibility:       ";
      print $$prototype{'private'} == 0 ? "Public\n" : "Private\n";
      print "     Library offset/bias:    -$$prototype{'bias'}\n";
      print "     Available since:  V$$prototype{'version'}\n";
      print "     Comment:          $$prototype{'comment'}\n";
      print "\n";
      print "     No return:        ";
      print $prototype->{nr} ? "Yes\n" : "No\n";
      print "     No base:          ";
      print $prototype->{nb} ? "Yes\n" : "No\n";
      print "\n";
      print "     Return value:           $$prototype{'return'}\n";
      print "     Arguments:        ";
      print join (",\n\t\t\t\t", @{$$prototype{'args'}});
      print "\n";
      print "     Argument names:         ";
      print join (", ", @{$$prototype{'argnames'}});
      print "\n";
      print "     Local arguments:  ";
      print join (",\n\t\t\t\t", @{$$prototype{'___args'}});
      print "\n";
      print "     Local argument names:   ";
      print join (", ", @{$$prototype{'___argnames'}});
      print "\n";
      print "     Argument types:         ";
      print join (",\n\t\t\t\t", @{$$prototype{'argtypes'}});
      print "\n";

      print "\n";

#           value   => $proto_line,

#    $$prototype{'return'}     = $return;
#    $$prototype{'funcname'}   = $name;
#    @{$$prototype{'args'}}     = ();
#    @{$$prototype{'regs'}} = split(/,/,lc $registers);  # Make regs lower case
#    @{$$prototype{'argnames'}} = ();                    # Initialize array
#    @{$$prototype{'argtypes'}} = ();                    # Initialize array
    }

    sub footer {
      print "\n";
    }
}

### Help message and manual page ##############################################

__END__

=head1 NAME

sfdc - Compile SFD files into someting useful

=head1 SYNOPSIS

sfdc [options] file1.sfd [file2.sfd ...]

  Options:
    --addvectors=TYPE       Add default functions
    --gateprefix=PREFIX     Prefix for gatestub functions
    --help -h               Show full help message and exit
    --libarg=LOCATION       Where to pass the libbase
    --libprefix=PREFIX      Prefix for library functions
    --sdi                   SDI header compatibility mode
    --man                   Show full manual page and exit
    --mode=MODE             What to do
    --output=FILE -o FILE   Where to store the output
    --quiet -q              Be quiet
    --target=TARGET         Specifies the machine target
    --version -v            Show version and exit

=head1 OPTIONS

=over 8


=item B<--addvectors>

This flag adds the standard library/device/BOOPSI functions to the
list of function entries to process. Possible values are B<none>,
B<library>, B<device> and B<boopsi>. The default is B<none>. Useful
when generating gate stub functions.


=item B<--gateprefix>

Sets a function name prefix for the gate stub functions when
generating gatestubs or gateproto files.


=item B<--help>

Show the full help message and exit.

    
=item B<--libarg>

Specifies where to place the library base argument when generating
gatestubs or gateproto and libproto files. Possible values are
B<none>, B<first> and B<last>. The default is B<none>.


=item B<--libprefix>

Sets a function name prefix for the local library functions when
generating gatestubs or libproto files.


=item B<--sdi>

Turns on the SDI header compatibility mode. This will make sure
that all header files (especially the gatestub and gateproto files
are generated to be used in a SDI compatible environment.


=item B<--man>

Show the complete manual page and exit.


=item B<--mode>

Instructs F<sfdc> what to do. F<sfdc> can handle the
following arguments:

=over 4

=item B<autoopen>

Generate C code for automatically opening the module. It is usually
placed in a link library together with C stub functions.

=item B<clib>

Generate C prototypes to be placed in F<Include/clib/>.


=item B<dump>

Dumps all information gathered from the SFD file.


=item B<fd>

Generate an old-style FD file.


=item B<functable>

Generate a list of function names suitable for inclusion in a library
function table. By defining the preprocessor symbol
B<__SFDC_FUNCTABLE_M68K__>, the list of functions will be modified so
it's suitable for AmigaOS 4's m68k function table.

    
=item B<gateproto>

Generate a prototype header file for library gate stubs. Useful for
library and device developers.


=item B<gatestubs>

Generate library gate stubs. Useful for library and device developers.


=item B<interface>

Generate a struct with function pointers, like that uses in AmigaOS 4.


=item B<libproto>

Generate a prototype header file for library functions. This is almost
like B<clib>, but for internal use by library and device developers.


=item B<lvo>

Generate an assembler LVO include file.


=item B<macros>

Generate a header file containing F<gcc> specific preprocessor macros,
similar to F<fd2inline>'s B<--new> switch. For AROS targets, it
generates a file suitable to be placed in the F<Include/defines/>
directory.

    
=item B<proto>

Generate header file to be placed in F<Include/proto/> that includes
the C prototypes as well as compiler-specific inlines or pragma files.


=item B<pragmas>

Generate a F<SAS/C>/F<LATTICE>/F<DICE> and F<Maxon C>/F<Storm
C>/F<Aztec C> pragma file.


=item B<stubs>

Generate C library stubs suitable to be compiled and archived into
F<libamiga.a>, F<libamigastubs.a> or
F<libI<E<lt>moduleE<gt>>.a>. Using the B<%f> escape sequence in the
B<--output> switch or a tool like F<splitasm.awk> strongly is
recommended.

=item B<verify>

Just loads and parses the SFD file. This is the default.

=back


=item B<--output> 

Specifies where the result will be stored. The following escape
sequencies are allowed in the file name. If the sequence B<%f> is
present in the name, a new file will be created for each function
processed.

=over 4

=item B<%b>

The library base variable name (C<DOSBase>, for example).

=item B<%f>

The current funcion name (C<Open>, for example).

=item B<%l>

The name of the library or device (F<dos.library>, for example).

=item B<%n>

The base name of the library or device (C<dos>, for example).

=back

If omitted, the result will be sent to the standard output instead of
a file.

=item B<--quiet>

Be quiet.


=item B<--target>

Specifies the target when generating macros etc. The target names
follow the GNU autoconf standard. Some possible values are listed
below. The default is B<m68k-unknown-amigaos>.

=over 4

=item B<i?86-pc-aros>, B<i?86-linux-aros>, B<ppc-aros> ...

AROS. Anything goes, as long as it ends in C<-aros>.


=item B<i?86be-pc-amithlon>, B<i?86be-amithlon>

Amithlon/big endian IA32.


=item B<m68k-unknown-amigaos>, B<m68k-amigaos>

Traditional AmigaOS/m68k.


=item B<ppc-unknown-amigaos>, B<ppc-amigaos>

AmigaOS 4/PowerPC.


=item B<powerpc-unknown-morphos>, B<ppc-morphos>

MorphOS/PowerPC.


=back



=item B<--version>

Prints the version and exits.


=back

=head1 DESCRIPTION

F<sfdc> is an open source replacement for Amiga, Inc.'s F<sfd> tool,
distributed with B<NDK 3.9>. It is also an replacement for
F<fd2inline> from GeekGadgets and the MorphOS team, later improved to
death by Martin Blom. It's now a complete mess and needs a
replacement. SFD files and F<sfdc> might to be a good start.

For developers using F<gcc>, F<sfdc> aims to handle all your needs
when it comes to libraries, devices, datatypes, BOOPSI classes or
similar modules. F<sfdc> can also generate F<SAS/C>, F<DICE> and
F<Storm C> files for end users of such modules.

The basis for all work performed by F<sfdc> is the B<SFD> file, which
contains all required information about the module and the functions
provided. From this information, F<sfdc> can:

=over 4

=item *

Generate an old-style B<FD> file for futher processing with other tools.


=item *

Generate a B<C prototype file>, such as those normally found in the
F<Include/clib/> directory.


=item *

Generate F<gcc> B<inlines> (actually preprocessor macros) or
B<pragmas> for direct library function calls (without going via
library stubs).


=item *

Generate the F<Include/proto/> file, which includes the
F<Include/clib/> file and either the inlines or pragmas.


=item *

Generate an B<assembler LVO> file, which contains the library offset
of all functions in the library.


=item *

Generate B<C stubs>, which can be compiled and archived into a stub
library. It can also generate auto-open and auto-close code.


=item *

Generate library B<gateway stubs>, which can be used as part of your
module as glue between the module function table and your C functions.


=back


Additionally, F<sfdc> does all this for several Amiga-like operating
systems: traditional B<AmigaOS>, native B<Amithlon>, B<AROS> and
B<MorphOS>.

F<sfdc> uses F<autoconf> style identifies for the operating systems,
making it easy to generate the correct output. Just make sure
F<configure.in> contains the B<AC_CANONICAL_SYSTEM> command and use
B<@host@> in your F<Makefile.in>. Using F<autoconf> and F<sfdc>, it's
easy to make for example a library that can be compiled or
cross-compiiled for any of the mentioned architectures.


=head1 RETURN VALUE

Returns 0 on success and 10 on errors.


=head1 NOTES

Had I seen F<cvinclude.pl> before I started writing this program, I
might still have been using fd/clib files. Or maybe not.

=head1 AUTHOR

Martin Blom <martin@blom.org>

=head1 HISTORY

=over

=item B<1.0 (2003-07-27)>

Initial release.


=item B<1.1 (2003-12-22)>

Added workaround for workbench.library (base name is "wb").
Added AmigaOS 4 support.
Added the B<--addvectors> switch.


=item B<1.2 (2004-06-16)>

Generates files for mathieeedoub*, though probably broken. Well they
are the same as fd2inline generates at least.


=item B<1.2a (2004-06-20)>

Replace AROS_LP with AROS_LD. Because it is guaranteed to define the
function prototype. [verhaegs]

=item B<1.3 (2004-11-12)>

=over 2

=item

Correctly handle the argument C<type **arg>, where there is no
whitespace between the argument type and the argument name.

=item

Correctly handle the prototype C<void function (void)>, were there is
a whitespace between the function name and the parenthesis and "void"
is used to indicate no arguments.

=item

Replace C<-> with C<_> in base/library name.

=item

New special keyword for register specification (in addition to B<sysv>
and B<base>): B<autoreg>, which automatically allocates m68k registers
for the arguments.

=item

B<sysv> now works correctly with varargs functions. B<sysv> combined
with B<gatestubs> work for m68k and i386 only for now. For AROS
targets in B<macros>, the correct AROS macro is used to fetch the
function to be called.

=item

New B<--mode>: B<functable>. For proper code generation in AROS, make
sure gateprotos are included before you include the functable.

=item

B<proto> files now include F<Include/defines/> files when used in AROS.

=back

=item B<1.4 (2005-09-23)>

=over 2

=item

Added AmigaOS 4-style interfaces (C++ only for non-OS4 targets, and
without implementation).

=item

The library base in the B<proto> file is now defined for AmigaOS 4
too.

=item

AmigaOS 4 B<clib> files now add B<__attribute__((linearvarargs))> to
varargs functions.

=item

Added AmigaOS 4 support for B<stubs> files.

=item

Added support for the 'iptr' gcc attribute.

=item

Added B<__SFDC_FUNCTABLE_M68K__> check in the B<functable> mode.

=item

Added m68k stub functions to AmigaOS 4's B<gatestubs> and
B<gateproto>.

=item

Added the B<autoopen> mode.

=back

=back
