From 21dfde3a5bf7bea9dcaf695b30e9fd1cc78aac24 Mon Sep 17 00:00:00 2001
From: mazze <mazze@fb15a70f-31f2-0310-bbcc-cdcc74a49acc>
Date: Wed, 27 Aug 2014 20:40:29 +0000
Subject: [PATCH] sfdc: experimental extension which creates stubs files to be
 used with SDI macros.

git-svn-id: https://svn.aros.org/svn/aros/trunk/AROS@49547 fb15a70f-31f2-0310-bbcc-cdcc74a49acc
---
 tools/sfdc/SDIAROS.pl | 127 ++++++++++++++++++++++++++++++++++++++++++++++++++
 tools/sfdc/main.pl    |  11 ++++-
 2 files changed, 136 insertions(+), 2 deletions(-)
 create mode 100644 tools/sfdc/SDIAROS.pl

diff --git a/tools/sfdc/SDIAROS.pl b/tools/sfdc/SDIAROS.pl
new file mode 100644
index 0000000000..4c19d309fe
--- /dev/null
+++ b/tools/sfdc/SDIAROS.pl
@@ -0,0 +1,127 @@
+
+### Class SDIAROS: Create an AROS SDI stub file ##############################
+
+BEGIN {
+    package SDIAROS;
+    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 "#include <SDI_lib.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},".
+		($prototype->{bias}/6).")\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";
+	    }
+	}
+
+	printf "AROS_LH%d(", $prototype->{numargs};
+
+	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";
+	}
+
+	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_OR_IFACE_VAR";
+	}
+
+	print "    $bt, $bn, 0, LIBSTUB\n)";
+
+	print "\n";
+	print "{\n";
+	print "    AROS_LIBFUNC_INIT\n";
+
+	if ($prototype->{numargs} > 0) {
+	    print "    return CALL_LFUNC($libprefix$prototype->{funcname}";
+	    print join (', ', @{$prototype->{___argnames}});
+	}
+	else {
+	    print "    return CALL_LFUNC_NP($libprefix$prototype->{funcname}";
+	}
+    
+	print ");\n";
+	print "    AROS_LIBFUNC_EXIT\n";
+	print "}\n";
+    }
+}
diff --git a/tools/sfdc/main.pl b/tools/sfdc/main.pl
index 5374b4fd6d..dd07e501d7 100644
--- a/tools/sfdc/main.pl
+++ b/tools/sfdc/main.pl
@@ -123,7 +123,8 @@ my %targets = (
 		 vectors   => { 'library' => @lf, 'device' => @df, 'boopsi' => @bf },
 		 macros    => 'MacroAROS',
 		 stubs     => 'StubAROS',
-		 gatestubs => 'GateAROS'
+		 gatestubs => 'GateAROS',
+		 sdistubs  => 'SDIAROS'
 	       },
 	       
 	      'i.86be(-pc)?-amithlon' =>
@@ -219,7 +220,7 @@ if ($#ARGV < 0) {
 
 $mode = lc $mode;
 
-if (!($mode =~ /^(clib|dump|fd|libproto|lvo|functable|macros|proto|pragmas|stubs|gateproto|gatestubs|verify)$/)) {
+if (!($mode =~ /^(clib|dump|fd|libproto|lvo|functable|macros|proto|pragmas|stubs|gateproto|gatestubs|sdistubs|verify)$/)) {
     pod2usage (-message => "Unknown mode specified. Use --help for a list.",
 	       -verbose => 0,
 	       -exitval => 10);
@@ -342,6 +343,12 @@ for my $i ( 0 .. $#ARGV ) {
 						
 	    last;
 	};
+	
+	/^sdistubs$/ && do {
+	    $obj = $$classes{'sdistubs'}->new( sfd => $sfd );
+						
+	    last;
+	};
 
 	die "Unknown mode specified: " . $mode;
     }
-- 
2.11.4.GIT