add device tree support
[AROS.git] / tools / sfdc / GateAROS.pl
blobd0340971944384434293ab4cfd30d3f94354885e
2 ### Class GateAROS: Create an AROS gatestub file ##############################
4 BEGIN {
5 package GateAROS;
6 use vars qw(@ISA);
7 @ISA = qw( Gate );
9 sub new {
10 my $proto = shift;
11 my $class = ref($proto) || $proto;
12 my $self = $class->SUPER::new( @_ );
13 bless ($self, $class);
14 return $self;
17 sub header {
18 my $self = shift;
19 my $sfd = $self->{SFD};
21 $self->SUPER::header (@_);
23 print "#include <aros/libcall.h>\n";
24 print "\n";
27 sub function {
28 my $self = shift;
29 my %params = @_;
30 my $prototype = $params{'prototype'};
31 my $sfd = $self->{SFD};
33 if ($prototype->{type} eq 'cfunction') {
34 print "#define $gateprefix$prototype->{funcname} " .
35 "AROS_SLIB_ENTRY(" .
36 "$gateprefix$prototype->{funcname},$sfd->{Basename},".
37 ($prototype->{bias}/6).")\n\n";
40 $self->SUPER::function (@_);
43 sub function_start {
44 my $self = shift;
45 my %params = @_;
46 my $prototype = $params{'prototype'};
47 my $sfd = $self->{SFD};
48 my $nb = $prototype->{nb} || $libarg eq 'none';
50 # AROS macros cannot handle function pointer arguments :-(
52 for my $i (0 .. $prototype->{numargs} - 1) {
53 if ($prototype->{argtypes}[$i] =~ /\(\*\)/) {
54 my $typedef = $prototype->{argtypes}[$i];
55 my $typename = "$sfd->{Basename}_$prototype->{funcname}_fp$i";
57 $typedef =~ s/\(\*\)/(*_$typename)/;
59 print "typedef $typedef;\n";
63 if ($self->{PROTO}) {
64 printf "AROS_LD%d%s(", $prototype->{numargs}, $nb ? "I" : "";
66 else {
67 printf "AROS_LH%d%s(", $prototype->{numargs}, $nb ? "I" : "";
69 print "$prototype->{return}, $gateprefix$prototype->{funcname},\n";
72 sub function_arg {
73 my $self = shift;
74 my %params = @_;
75 my $prototype = $params{'prototype'};
76 my $argtype = $params{'argtype'};
77 my $argname = $params{'argname'};
78 my $argreg = $params{'argreg'};
79 my $argnum = $params{'argnum'};
80 my $sfd = $self->{SFD};
82 if ($argtype =~ /\(\*\)/) {
83 $argtype = "_$sfd->{Basename}_$prototype->{funcname}_fp$argnum";
86 if ($self->{PROTO}) {
87 print " AROS_LDA($argtype, $argname, " . (uc $argreg) . "),\n";
89 else {
90 print " AROS_LHA($argtype, $argname, " . (uc $argreg) . "),\n";
94 sub function_end {
95 my $self = shift;
96 my %params = @_;
97 my $prototype = $params{'prototype'};
98 my $sfd = $self->{SFD};
100 my $bt = "/* bt */";
101 my $bn = "/* bn */";
103 if ($prototype->{nb}) {
104 for my $i (0 .. $#{$prototype->{regs}}) {
105 if ($prototype->{regs}[$i] eq 'a6') {
106 $bt = $prototype->{argtypes}[$i];
107 $bn =$prototype->{___argnames}[$i];
108 last;
112 else {
113 $bt = $sfd->{basetype};
114 $bn = "_base";
117 printf " $bt, $bn, %d, $sfd->{Basename})",
118 $prototype->{bias} / 6;
120 if ($self->{PROTO}) {
121 print ";\n";
122 print "#define $gateprefix$prototype->{funcname} " .
123 "AROS_SLIB_ENTRY(" .
124 "$gateprefix$prototype->{funcname},$sfd->{Basename},".($prototype->{bias}/6).")\n";
126 else {
127 print "\n";
128 print "{\n";
129 print " AROS_LIBFUNC_INIT\n";
130 print " return $libprefix$prototype->{funcname}(";
132 if ($libarg eq 'first' && !$prototype->{nb}) {
133 print "_base";
134 print $prototype->{numargs} > 0 ? ", " : "";
137 print join (', ', @{$prototype->{___argnames}});
139 if ($libarg eq 'last' && !$prototype->{nb}) {
140 print $prototype->{numargs} > 0 ? ", " : "";
141 print "_base";
144 print ");\n";
145 print " AROS_LIBFUNC_EXIT\n";
146 print "}\n";