Test initialisation of MUIA_List_AdjustWidth and MUIA_List_AdjustHeight, and
[AROS.git] / tools / sfdc / Stub.pl
blobbf6980cea762d843176c3ccddea1bb3e7ac0ebaa
2 ### Class Stub: Create a generic stub file ####################################
4 BEGIN {
5 package Stub;
7 sub new {
8 my $proto = shift;
9 my %params = @_;
10 my $class = ref($proto) || $proto;
11 my $self = {};
12 $self->{SFD} = $params{'sfd'};
13 $self->{NEWFILE} = 0;
14 bless ($self, $class);
15 return $self;
18 sub header {
19 my $self = shift;
20 my $sfd = $self->{SFD};
22 $self->{NEWFILE} = 1;
24 print "/* Automatically generated stubs! Do not edit! */\n";
25 print "\n";
27 foreach my $inc (@{$$sfd{'includes'}}) {
28 print "#include $inc\n";
31 foreach my $td (@{$$sfd{'typedefs'}}) {
32 print "typedef $td;\n";
35 print "\n";
36 print "#ifdef __cplusplus\n";
37 print "extern \"C\" {\n";
38 print "#endif /* __cplusplus */\n";
39 print "\n";
41 if ($$sfd{'base'} ne '') {
42 print "#ifndef BASE_EXT_DECL\n";
43 print "#define BASE_EXT_DECL\n";
44 print "#define BASE_EXT_DECL0 extern $$sfd{'basetype'} " .
45 "$$sfd{'base'};\n";
46 print "#endif /* !BASE_EXT_DECL */\n";
47 print "#ifndef BASE_PAR_DECL\n";
48 print "#define BASE_PAR_NAME\n";
49 print "#define BASE_PAR_DECL\n";
50 print "#define BASE_PAR_DECL0 void\n";
51 print "#endif /* !BASE_PAR_DECL */\n";
52 print "#ifndef BASE_NAME\n";
53 print "#define BASE_NAME $$sfd{'base'}\n";
54 print "#endif /* !BASE_NAME */\n";
55 print "\n";
56 print "BASE_EXT_DECL0\n";
57 print "\n";
62 sub function {
63 my $self = shift;
64 my %params = @_;
65 my $prototype = $params{'prototype'};
66 my $sfd = $self->{SFD};
68 # Don't process private functions
69 if ($prototype->{private}) {
70 return;
73 $self->function_proto (prototype => $prototype, decl_regular => $self->{NEWFILE} );
74 $self->function_start (prototype => $prototype);
75 for my $i (0 .. $$prototype{'numargs'} - 1 ) {
76 $self->function_arg (prototype => $prototype,
77 argtype => $$prototype{'argtypes'}[$i],
78 argname => $$prototype{'___argnames'}[$i],
79 argreg => $$prototype{'regs'}[$i],
80 argnum => $i );
82 $self->function_end (prototype => $prototype);
84 print "\n";
86 $self->{NEWFILE} = 0;
89 sub footer {
90 my $self = shift;
91 my $sfd = $self->{SFD};
93 print "\n";
94 print "#undef BASE_EXT_DECL\n";
95 print "#undef BASE_EXT_DECL0\n";
96 print "#undef BASE_PAR_NAME\n";
97 print "#undef BASE_PAR_DECL\n";
98 print "#undef BASE_PAR_DECL0\n";
99 print "#undef BASE_NAME\n";
100 print "\n";
101 print "#ifdef __cplusplus\n";
102 print "}\n";
103 print "#endif /* __cplusplus */\n";
107 # Helper functions
109 sub function_proto {
110 my $self = shift;
111 my %params = @_;
112 my $prototype = $params{'prototype'};
113 my $decl_regular = $params{'decl_regular'};
114 my $sfd = $self->{SFD};
116 if ($prototype->{type} eq 'varargs' && $decl_regular) {
117 my $rproto = $prototype->{real_prototype};
119 print "__inline $$rproto{'return'} $$rproto{'funcname'}(";
120 if (!$prototype->{nb}) {
121 if ($$rproto{'numargs'} == 0) {
122 print "BASE_PAR_DECL0";
124 else {
125 print "BASE_PAR_DECL ";
128 print join (', ', @{$$rproto{'___args'}});
130 print ");\n";
131 print "\n";
134 if ($prototype->{type} eq 'cfunction' &&
135 $prototype->{argnames}[$#{@{$prototype->{argnames}}}] eq '...') {
136 print "#if 0\n";
137 print "/* Unsupported */\n";
140 # Declare structs in case some ==include directive is missing
141 for my $argtype (@{$prototype->{argtypes}}) {
142 my $struct;
144 (undef, $struct) = ( $argtype =~ /\s*(const)?\s*struct\s*(\w+).*/) and
145 printf "struct $struct;\n";
149 print "__inline $$prototype{'return'}\n";
150 print "$$prototype{'funcname'}(";
151 if (!$prototype->{nb}) {
152 if ($$prototype{'numargs'} == 0) {
153 print "BASE_PAR_DECL0";
155 else {
156 print "BASE_PAR_DECL ";
159 print join (', ', @{$$prototype{'___args'}});
160 print ")";
164 sub function_start {
165 my $self = shift;
166 my %params = @_;
167 my $prototype = $params{'prototype'};
168 my $sfd = $self->{SFD};
170 print "\n";
171 print "{\n";
173 if ($$prototype{'type'} eq 'varargs') {
174 print " return $$prototype{'real_funcname'}(BASE_PAR_NAME ";
176 elsif ($prototype->{type} eq 'cfunction') {
177 if (!$prototype->{nb}) {
178 print " BASE_EXT_DECL\n";
181 my $argtypes = join (', ',@{$$prototype{'argtypes'}});
183 if ($argtypes eq '') {
184 if ($prototype->{nb}) {
185 $argtypes = "void";
188 else {
189 if (!$prototype->{nb}) {
190 $argtypes = "$sfd->{basetype}, $argtypes";
195 # Skip jmp instruction (is m68k ILLEGAL in MOS)
196 my $offs = $$prototype{'bias'} - 2;
198 print " $$prototype{'return'} (*_func) ($argtypes) = \n";
199 print " ($$prototype{'return'} (*) ($argtypes))\n";
200 print " *((ULONG*) (((char*) BASE_NAME) - $offs));\n";
201 print " return (*_func)(";
203 if (!$prototype->{nb}) {
204 print "BASE_NAME";
205 print ", " unless $prototype->{numargs} == 0;
208 else {
209 print STDERR "$prototype->{funcname}: Unhandled.\n";
210 die;
214 sub function_arg {
215 my $self = shift;
216 my %params = @_;
217 my $prototype = $params{'prototype'};
218 my $argtype = $params{'argtype'};
219 my $argname = $params{'argname'};
220 my $argreg = $params{'argreg'};
221 my $argnum = $params{'argnum'};
222 my $sfd = $self->{SFD};
224 my $argstr;
226 if ($$prototype{'type'} eq 'varargs') {
227 if ($prototype->{subtype} eq 'printfcall') {
228 if ($argnum < $$prototype{'numargs'} - 1) {
229 $argstr = $argname;
231 elsif ($argnum == $$prototype{'numargs'} - 1) {
232 my $vartype =
233 $$prototype{'argtypes'}[$$prototype{'numargs'} - 1];
234 my $argnm =
235 $$prototype{'___argnames'}[$$prototype{'numargs'} - 2];
236 $argstr = "($vartype) (&$argnm + 1)";
238 else {
239 $argstr = '';
242 else {
243 # tagcall/methodcall
244 if ($argnum < $$prototype{'numargs'} - 2) {
245 $argstr = $argname;
247 elsif ($argnum == $$prototype{'numargs'} - 2) {
248 my $vartype =
249 $$prototype{'argtypes'}[$$prototype{'numargs'} - 1];
250 $argstr = "($vartype) &$argname";
252 else {
253 $argstr = '';
257 elsif ($prototype->{type} eq 'cfunction') {
258 $argstr = $argname;
260 else {
261 print STDERR "$prototype->{funcname}: Unhandled.\n";
262 die;
265 if ($argstr ne '') {
266 print ($argnum != 0 ? ", $argstr" : $argstr);
270 sub function_end {
271 my $self = shift;
272 my %params = @_;
273 my $prototype = $params{'prototype'};
274 my $sfd = $self->{SFD};
276 print ");\n";
277 print "}\n";
279 if ($prototype->{type} eq 'cfunction' &&
280 $prototype->{argnames}[$#{@{$prototype->{argnames}}}] eq '...') {
281 print "/* Unsupported */\n";
282 print "#endif\n";