File Coverage

File:config/gen/opengl.pm
Coverage:84.7%

linestmtbrancondsubcode
1# Copyright (C) 2008, Parrot Foundation.
2
3 - 33
=head1 NAME

config/gen/opengl.pm - OpenGL binding generated files

=head1 DESCRIPTION

Generates several files used by the OpenGL binding.  These include:

=over 4

=item F<runtime/parrot/include/opengl_defines.pasm>

=item F<runtime/parrot/library/OpenGL_funcs.pir>

=item F<src/glut_nci_thunks.nci>

=item F<src/glut_callbacks.c>

=back

For information about Parrot's OpenGL support on different platforms, and
system libraries/headers that must be installed to enable OpenGL support,
see F<config/auto/opengl.pm>, where this support is detected.

For information on how to I<use> Parrot's OpenGL support, see
F<runtime/parrot/library/OpenGL.pir> for an overview, or the OpenGL examples
starting with F<examples/opengl/triangle.pir> for more detail.

=begin ignored

=cut
34
35package gen::opengl;
36
37
2
2
2
2
use strict;
38
2
2
2
2
use warnings;
39
2
2
2
2
use File::Basename;
40
2
2
2
2
use File::Glob;
41
2
2
2
2
use File::Which;
42
43
2
2
2
2
use base qw(Parrot::Configure::Step);
44
45
2
2
2
2
use Parrot::Configure::Utils ':gen';
46
47# taken from List::MoreUtils
48sub any {
49
5808
5808
    my $f = shift;
50
5808
100
    return if ! @_;
51
5565
    for (@_) {
52
16479
50
        return 1 if $f->();
53    }
54
5565
    return 0;
55}
56
57my @GLUT_1_CALLBACKS = (
58    [ 'Display', 'void' ],
59    [ 'Idle', 'void' ],
60    [ 'Entry', 'int state' ],
61    [ 'Menu State', 'int status' ],
62    [ 'Visibility', 'int state' ],
63    [ 'Motion', 'int x, int y' ],
64    [ 'Passive Motion', 'int x, int y' ],
65    [ 'Reshape', 'int width, int height' ],
66    [ 'Keyboard', 'unsigned char key, int x, int y' ],
67    [ 'Mouse', 'int button, int state, int x, int y' ],
68
69    # NOTE: Hardcoded because of special arguments
70    # [ 'Timer', 'int data' ],
71);
72
73my @GLUT_2_CALLBACKS = (
74    [ 'Button Box', 'int button, int state' ],
75    [ 'Dials', 'int dial, int value' ],
76    [ 'Spaceball Button', 'int button, int state' ],
77    [ 'Tablet Motion', 'int x, int y' ],
78    [ 'Spaceball Motion', 'int x, int y, int z' ],
79    [ 'Spaceball Rotate', 'int x, int y, int z' ],
80    [ 'Special', 'int key, int x, int y' ],
81    [ 'Tablet Button', 'int button, int state, int x, int y' ],
82);
83
84my @GLUT_3_CALLBACKS = (
85    [ 'Overlay Display', 'void' ],
86    [ 'Menu Status', 'int status, int x, int y' ],
87);
88
89my @GLUT_4_CALLBACKS = (
90    [ 'Window Status', 'int state' ],
91    [ 'Keyboard Up', 'unsigned char key, int x, int y' ],
92    [ 'Special Up', 'int key, int x, int y' ],
93
94    # NOTE: Hardcoded because of special arguments
95    # [ 'Joystick', 'int buttons, int xaxis, int yaxis, int zaxis' ],
96);
97
98my @MACOSXGLUT_CALLBACKS = (
99    # Also works in freeglut
100    [ 'WM Close', 'void' ],
101);
102
103my @FREEGLUT_CALLBACKS = (
104    [ 'Close', 'void' ],
105    [ 'Menu Destroy', 'void' ],
106    [ 'Mouse Wheel', 'int wheel, int direction, int x, int y' ],
107);
108
109# These typemaps try to be both portable and accurate. However, there is
110# at least one OS release known to get some of these wrong: Mac OS X 10.4
111# headers typedef some of the 'int' types as 'long' instead. This disagrees
112# with all other headers I can find, and was fixed in Mac OS X 10.5 -- those
113# typedefs now match accepted standards. I am told that Mac OS X 10.4 has
114# a 32-bit core, making the difference immaterial, so I don't bother to
115# alter the typemaps to fit this bug.
116
117my %C_TYPE = (
118    VOID => 'void',
119    GLvoid => 'void',
120    GLUnurbs => 'void',
121    GLUquadric => 'void',
122    GLUtesselator => 'void',
123    gleGC => 'void',
124    muiObject => 'void',
125    SphereMap => 'void',
126    Display => 'void',
127    XVisualInfo => 'void',
128    GLEWContext => 'void',
129    GLXEWContext => 'void',
130    WGLEWContext => 'void',
131    _CGLContextObject => 'void',
132    CGDirectDisplayID => 'void',
133    GLXHyperpipeConfigSGIX => 'void',
134    GLXHyperpipeNetworkSGIX => 'void',
135    PIXELFORMATDESCRIPTOR => 'void',
136    COLORREF => 'void',
137
138    wchar_t => 'void',
139    GLCchar => 'void',
140
141    GLMfunctions => 'void*',
142    GLXContext => 'void*',
143    GLXFBConfig => 'void*',
144    GLXFBConfigSGIX => 'void*',
145    CGLContextObj => 'void*',
146    CGLPixelFormatObj => 'void*',
147    CGLRendererInfoObj => 'void*',
148    CGLPBufferObj => 'void*',
149    AGLContext => 'void*',
150    AGLDevice => 'void*',
151    AGLDrawable => 'void*',
152    AGLPixelFormat => 'void*',
153    AGLRendererInfo => 'void*',
154    AGLPbuffer => 'void*',
155    GDHandle => 'void*',
156    IOSurfaceRef => 'void*',
157    WindowRef => 'void*',
158    HIViewRef => 'void*',
159    Style => 'void*',
160    HANDLE => 'void*',
161    HPBUFFERARB => 'void*',
162    HPBUFFEREXT => 'void*',
163    HVIDEOINPUTDEVICENV => 'void*',
164    HVIDEOOUTPUTDEVICENV => 'void*',
165    HPVIDEODEV => 'void*',
166    HPGPUNV => 'void*',
167    HGPUNV => 'void*',
168    HDC => 'void*',
169    HGLRC => 'void*',
170    LPGLYPHMETRICSFLOAT => 'void*',
171    LPLAYERPLANEDESCRIPTOR => 'void*',
172    LPPIXELFORMATDESCRIPTOR => 'void*',
173    LPVOID => 'void*',
174    PGPU_DEVICE => 'void*',
175    GLsync => 'void*',
176
177    GLchar => 'char',
178    GLcharARB => 'char',
179    GLbyte => 'signed char',
180    GLubyte => 'unsigned char',
181    GLboolean => 'unsigned char',
182
183    GLshort => 'short',
184    USHORT => 'unsigned short',
185    GLushort => 'unsigned short',
186    GLhalfARB => 'unsigned short',
187    GLhalfNV => 'unsigned short',
188
189    BOOL => 'int',
190    Bool => 'int',
191    Status => 'int',
192    GLint => 'int',
193    GLsizei => 'int',
194    GLfixed => 'int',
195    GLclampx => 'int',
196    int32_t => 'int',
197    INT32 => 'int',
198    INT => 'int',
199
200    GLenum => 'unsigned int',
201    GLCenum => 'unsigned int',
202    CGLPixelFormatAttribute => 'unsigned int',
203    CGLRendererProperty => 'unsigned int',
204    CGLContextEnable => 'unsigned int',
205    CGLContextParameter => 'unsigned int',
206    CGLGlobalOption => 'unsigned int',
207    CGLError => 'unsigned int',
208    SphereMapFlags => 'unsigned int',
209
210    UINT => 'unsigned int',
211    GLuint => 'unsigned int',
212    GLbitfield => 'unsigned int',
213    GLhandleARB => 'unsigned int',
214    GLXVideoDeviceNV => 'unsigned int',
215
216    DWORD => 'unsigned long',
217    GLulong => 'unsigned long',
218    XID => 'unsigned long',
219    Window => 'unsigned long',
220    Drawable => 'unsigned long',
221    Font => 'unsigned long',
222    Pixmap => 'unsigned long',
223    Cursor => 'unsigned long',
224    Colormap => 'unsigned long',
225    GContext => 'unsigned long',
226    KeySym => 'unsigned long',
227    GLXContextID => 'unsigned long',
228    GLXPixmap => 'unsigned long',
229    GLXDrawable => 'unsigned long',
230    GLXPbuffer => 'unsigned long',
231    GLXWindow => 'unsigned long',
232    GLXFBConfigID => 'unsigned long',
233    GLXPbufferSGIX => 'unsigned long',
234    GLXFBConfigIDSGIX => 'unsigned long',
235    GLXVideoSourceSGIX => 'unsigned long',
236    GLXVideoCaptureDeviceNV => 'unsigned long',
237
238    int64_t => 'long long',
239    INT64 => 'long long',
240    GLint64 => 'signed long long',
241    GLint64EXT => 'signed long long',
242    GLuint64 => 'unsigned long long',
243    GLuint64EXT => 'unsigned long long',
244
245    FLOAT => 'float',
246    GLfloat => 'float',
247    GLclampf => 'float',
248    GLdouble => 'double',
249    GLclampd => 'double',
250    gleDouble => 'double',
251
252    GLintptr => 'ptrdiff_t',
253    GLsizeiptr => 'ptrdiff_t',
254    GLintptrARB => 'ptrdiff_t',
255    GLsizeiptrARB => 'ptrdiff_t',
256    GLvdpauSurfaceNV => 'ptrdiff_t',
257);
258
259my %NCI_TYPE = (
260    ( map {( $_ => $_ )}
261        qw[ void char short int long longlong float double longdouble ] ),
262
263    size_t => 'long',
264    ptrdiff_t => 'long',
265
266    ( map {( "$_*" => 'ptr', "$_**" => 'ptr' )}
267        qw[ void char short int long ptrdiff_t longlong float double ] ),
268
269    'double***' => 'ptr',
270);
271
272my %PCC_TYPE = (
273    char => 'I',
274    short => 'I',
275    int => 'I',
276    long => 'I',
277    float => 'N',
278    double => 'N',
279    ptr => 'P',
280);
281
282my %PCC_CAST = (
283    I => '(INTVAL) ',
284    N => '(FLOATVAL) ',
285    S => '',
286    P => '',
287);
288
289my %OVERRIDE = (
290    glutInit => [[qw[ void int& ptr ]], [0, 0, 0]],
291);
292
293my @IGNORE = (
294    # Most of these are limitations of this module or Parrot NCI
295
296    # Don't handle GetProcAddress type functions yet
297    'glutGetProcAddress',
298    'glXGetProcAddress',
299    'glXGetProcAddressARB',
300    'wglGetProcAddress',
301
302    # Don't handle this odd create/callback register function yet
303    'glutCreateMenu',
304
305    # Don't handle Mesa, GLC, GLU, or MUI callbacks yet
306    'glProgramCallbackMESA',
307    'glcCallbackFunc',
308    'glcGetCallbackFunc',
309    'gluNurbsCallback',
310    'gluQuadricCallback',
311    'gluTessCallback',
312    'muiSetCallback',
313    'muiSetNonMUIcallback',
314    'handler',
315    'callback',
316
317    # Don't handle functions without "namespace" prefixes matching library
318    'rot_axis',
319    'rot_about_axis',
320    'rot_omega',
321    'rot_prince',
322    'urot_axis',
323    'urot_about_axis',
324    'urot_omega',
325    'urot_prince',
326    'uview_direction',
327    'uviewpoint',
328
329    # Some versions of GLUT declare these both with and without prefixes;
330    # ignore the non-prefixed versions
331    'SwapBuffers',
332    'ChoosePixelFormat',
333    'DescribePixelFormat',
334    'GetPixelFormat',
335    'SetPixelFormat',
336
337    # Can't handle weird data types specified only in proprietary headers
338    'glXCreateGLXVideoSourceSGIX',
339    'glXAssociateDMPbufferSGIX',
340
341    # Ignore internal GLUT Win32 compatibility hackage
342    'exit',
343);
344
345my @SKIP = (
346    # Can't properly support these yet; some (such as the internal headers)
347    # may never be supported.
348
349    # Mesa non-standard driver headers
350    'amesa.h',
351    'dmesa.h',
352    'foomesa.h',
353    'fxmesa.h',
354    'ggimesa.h',
355    'mesa_wgl.h',
356    'mglmesa.h',
357    'osmesa.h',
358    'svgamesa.h',
359    'uglmesa.h',
360    'wmesa.h',
361    'xmesa.h',
362    'xmesa_xf86.h',
363    'xmesa_x.h',
364
365    # Mesa API-mangling headers (to load vendor GL and Mesa simultaneously)
366    'gl_mangle.h',
367    'glu_mangle.h',
368    'glx_mangle.h',
369
370    # OpenVMS API-mangling header
371    'vms_x_fix.h',
372
373    # Internal headers for DRI
374    'dri_interface.h',
375    'glcore.h',
376
377    # Apple CGL OpenGL API conversion macros
378    'CGLMacro.h',
379
380    # Internal headers for GLE (OpenGL Extrusions) library
381    'extrude.h',
382    'segment.h',
383
384    # Rotation math utility functions from GLE
385    'gutil.h',
386
387    # Plane math utility functions/macros from GLE
388    'intersect.h',
389
390    # MUI (internal?) headers lacking "namespace" identifier prefixes
391    'browser.h',
392    'gizmo.h',
393    'hslider.h',
394    'vslider.h',
395
396    # SGI GLw Drawing Area headers
397    'GLwDrawA.h',
398    'GLwDrawAP.h',
399    'GLwMDrawA.h',
400    'GLwMDrawAP.h',
401
402    # GLFW, a replacement for GLUT
403    'glfw.h',
404);
405
406my $MACRO_FILE = 'runtime/parrot/include/opengl_defines.pasm';
407my $FUNCS_FILE = 'runtime/parrot/library/OpenGL_funcs.pir';
408my $SIGS_FILE = 'src/glut_nci_thunks.nci';
409my $C_FILE = 'src/glut_callbacks.c';
410
411
412sub _init {
413
4
4
    my $self = shift;
414
415    return {
416
4
        description => q{Generating OpenGL bindings},
417        result => q{},
418    }
419}
420
421sub runstep {
422
4
4
    my ($self, $conf) = @_;
423
424
4
100
    unless ($conf->data->get('has_opengl')) {
425
1
        $self->set_result('skipped');
426
1
        return 1;
427    }
428
429
3
50
    my @include_paths_win32 = grep /\S/ => split /;/ => ($ENV{INCLUDE} || '');
430
431
3
    my $osname = $conf->data->get('osname');
432
3
50
33
    if (scalar @include_paths_win32 == 0 && $osname =~ /mswin32/i) {
433
0
        my $cc = $conf->data->get('cc');
434
0
        my $path = dirname(dirname(which($cc))) . '\include';
435
0
        @include_paths_win32 = ( $path );
436    }
437
438
3
    s{\\}{/}g foreach @include_paths_win32;
439
440
3
    my @header_globs = (
441        # Default locations for most UNIX-like platforms
442        '/usr/include/GL/*.h',
443        '/usr/local/include/GL/*.h',
444
445        # Mac OS X
446        '/System/Library/Frameworks/OpenGL.framework/Headers/*.h',
447        '/System/Library/Frameworks/GLUT.framework/Headers/*.h',
448
449        # Cygwin
450        '/usr/include/w32api/GL/*.h',
451
452        # Windows/MSVC
453        (map "$_/gl/*.h" => @include_paths_win32),
454
455# # Portability testing headers
456# "$ENV{HOME}/src/gentoo3/*.h",
457# "$ENV{HOME}/src/gentoo4/usr/include/GL/*.h",
458# "$ENV{HOME}/src/osx/headers/GLUT/*.h",
459# "$ENV{HOME}/src/osx/headers/OpenGL/*.h",
460# "$ENV{HOME}/src/osx-10.4/GLUT/*.h",
461# "$ENV{HOME}/src/osx-10.4/OpenGL/*.h",
462# "$ENV{HOME}/src/cygwin/opengl-1.1.0/GLUI_v2_1_beta/*.h",
463# "$ENV{HOME}/src/cygwin/opengl-1.1.0/glut-3.7.3/include/GL/*.h",
464# "$ENV{HOME}/src/cygwin/opengl-1.1.0/glut-3.7.3/include/mui/*.h",
465# "$ENV{HOME}/src/glut-3.7.6/include/GL/*.h",
466# "$ENV{HOME}/src/glut-3.7.6/include/mui/*.h",
467# "$ENV{HOME}/src/freebsd-gl/usr/local/include/GL/*.h",
468
469# "$ENV{HOME}/src/osx-insane/Developer/Platforms/Aspen.platform/Developer/SDKs/Aspen1.2.sdk/System/Library/Frameworks/OpenGLES.framework/Headers/ES1/*.h",
470# "$ENV{HOME}/src/osx-insane/Developer/SDKs/MacOSX10.4u.sdk/System/Library/Frameworks/AGL.framework/Versions/A/Headers/*.h",
471# "$ENV{HOME}/src/osx-insane/Developer/SDKs/MacOSX10.4u.sdk/System/Library/Frameworks/OpenGL.framework/Versions/A/Headers/*.h",
472# "$ENV{HOME}/src/osx-insane/Developer/SDKs/MacOSX10.4u.sdk/System/Library/Frameworks/GLUT.framework/Versions/A/Headers/*.h",
473# "$ENV{HOME}/src/osx-insane/Developer/SDKs/MacOSX10.4u.sdk/usr/X11R6/include/GL/*.h",
474# "$ENV{HOME}/src/osx-insane/Developer/SDKs/MacOSX10.5.sdk/System/Library/Frameworks/AGL.framework/Versions/A/Headers/*.h",
475# "$ENV{HOME}/src/osx-insane/Developer/SDKs/MacOSX10.5.sdk/System/Library/Frameworks/OpenGL.framework/Versions/A/Headers/*.h",
476# "$ENV{HOME}/src/osx-insane/Developer/SDKs/MacOSX10.5.sdk/System/Library/Frameworks/GLUT.framework/Versions/A/Headers/*.h",
477# "$ENV{HOME}/src/osx-insane/Developer/SDKs/MacOSX10.5.sdk/usr/X11/include/GL/*.h",
478# "$ENV{HOME}/src/osx-insane/Developer/SDKs/MacOSX10.5.sdk/usr/X11/include/GL/internal/*.h",
479# "$ENV{HOME}/src/osx-insane/System/Library/Frameworks/AGL.framework/Versions/A/Headers/*.h",
480# "$ENV{HOME}/src/osx-insane/System/Library/Frameworks/OpenGL.framework/Versions/A/Headers/*.h",
481# "$ENV{HOME}/src/osx-insane/System/Library/Frameworks/GLUT.framework/Versions/A/Headers/*.h",
482# "$ENV{HOME}/src/osx-insane/usr/include/GL/*.h",
483# "$ENV{HOME}/src/osx-insane/usr/X11/include/GL/*.h",
484# "$ENV{HOME}/src/osx-insane/usr/X11/include/GL/internal/*.h",
485# "$ENV{HOME}/src/osx-insane/usr/X11R6 1/include/GL/*.h",
486# "$ENV{HOME}/src/osx-10.6.3/Headers/*.h",
487    );
488
489    # X freeglut only if DISPLAY is set, otherwise use native w32api GLUT
490
3
50
33
    shift @header_globs if $^O eq 'cygwin' and !$ENV{DISPLAY};
491
492
3
    my $globs_str = join("\n\t", @header_globs) . "\n";
493
3
    $conf->debug(
494        "\n",
495        "Checking for OpenGL headers using the following globs:\n",
496        "\t$globs_str"
497    );
498
499
3
15
    my @header_files = sort map {File::Glob::bsd_glob($_)} @header_globs;
500
501
3
102
    my %skip = map {($_ => 1)} @SKIP;
502
36
    @header_files =
503
3
36
        grep {my ($file) = m{([^/]+)$}; !$skip{$file}} @header_files;
504
3
50
    die "OpenGL enabled and detected, but no OpenGL headers found!"
505        unless @header_files;
506
507
3
    my $files_str = join("\n\t", @header_files) . "\n";
508
3
    $conf->debug(
509        "\n",
510        "Found the following OpenGL headers:\n",
511        "\t$files_str\n",
512    );
513
514
3
    my $autogen_header = <<'HEADER';
515# DO NOT EDIT THIS FILE.
516#
517# Any changes made here will be lost.
518#
519# This file is generated automatically by config/gen/opengl.pm
520# using the following files:
521#
522HEADER
523
524
3
    $autogen_header .= "# $_\n" foreach @header_files;
525
526
3
    $self->gen_opengl_defines ($conf, \@header_files, $autogen_header);
527
3
    $self->gen_opengl_wrappers($conf, \@header_files, $autogen_header);
528
3
    $self->gen_glut_callbacks ($conf);
529
530
3
    return 1;
531}
532
533sub gen_opengl_defines {
534
3
3
    my ($self, $conf, $header_files, $autogen_header) = @_;
535
536
3
    my (%defs, @macros, %non_numeric);
537
3
    my $max_len = 0;
538
539
3
    foreach my $file (@$header_files) {
540
27
50
        open my $header, '<', $file
541        or die "Could not open header '$file': $!";
542
543
27
        while (<$header>) {
544
35733
            s/^\s*#\s*define\b/#define/;
545
546
35733
            my (@F) = split;
547
35733
100
100
            next unless @F > 2 and $F[0] eq '#define';
548
12777
100
            next unless $F[1] =~ /^(AGL|CGL|WGL|GLX|MUI|SMAP|TUBE|GL[A-Z]*)_/;
549
12693
50
            next if $F[1] =~ /\(/;
550
551
12693
100
            $max_len = length $F[1] if $max_len < length $F[1];
552
553
12693
            my $api = $1;
554
12693
100
            if ($F[2] =~ /^(?:[ACW])?GL[A-Z]*_\w+$/) {
555
81
                push @macros, [$api, $F[1], $F[2]];
556            }
557
12693
50
100
100
            if ($F[2] =~ /^\(?((?:[ACW])?GL[A-Z]*_\w+)([+-]\d+(?:\.\d*)?(?:e\d+)?)\)?$/) {
558
0
                push @macros, [$api, $F[1], $1, $2];
559            }
560            elsif ( $F[2] =~ /^0x[0-9a-fA-F]+$/
561                   || $F[2] =~ /^\d+(?:\.\d*)?(?:e\d+)?$/) {
562
12555
                $defs{$api}{$F[1]} = $F[2];
563            }
564            else {
565
138
                $non_numeric{$F[1]}++;
566
138
                $conf->debug("Non-numeric value for '$F[1]': '$F[2]'\n");
567            }
568        }
569    }
570
571
3
    foreach my $macro (@macros) {
572
81
        my ($api, $define, $value, $offset) = @$macro;
573
81
        my ($val_api) = $value =~ /^((?:[ACW])?GL[A-Z]*)_/;
574
575
81
50
        unless (defined $defs{$val_api}{$value}) {
576
0
0
            next if $non_numeric{$define};
577
578
0
            die "'$define' is defined using '$value', but no '$value' has been defined";
579        }
580
581
81
        $defs{$api}{$define} = $defs{$val_api}{$value};
582
81
50
        $defs{$api}{$define} += $offset if defined $offset;
583    }
584
585
3
50
    open my $macros, '>', $MACRO_FILE
586        or die "Could not open macro file '$MACRO_FILE' for write: $!";
587
588
3
    print $macros $autogen_header;
589
3
    print $macros "\n\n";
590
591
3
    foreach my $api (sort keys %defs) {
592
12
        my $api_defs = $defs{$api};
593
594
12
        foreach my $define (sort keys %$api_defs) {
595
11595
        printf $macros ".macro_const %-${max_len}s %s\n",
596                       $define, $api_defs->{$define};
597        }
598    }
599
600
3
    $conf->append_configure_log($MACRO_FILE);
601
602
3
    return 1;
603}
604
605sub gen_opengl_wrappers {
606
3
3
    my ($self, $conf, $header_files, $autogen_header) = @_;
607
3
100
    my $verbose = $conf->options->get('verbose') || 0;
608
609
3
99
    my %IGNORE = map {($_ => 1)} @IGNORE;
610
611
3
    my (%pass, %fail, %ignore, %sigs, %funcs);
612
613    # PHASE 1: Parse Headers
614
3
    foreach my $file (@$header_files) {
615
27
50
        open my $header, '<', $file
616            or die "Could not open header '$file': $!";
617
618      PROTO:
619
27
        while (<$header>) {
620            # Get rid of C comments
621
35733
            s{/\*.*?\*/}{}g;
622
35733
100
            if (m{/\*}) {
623
1179
                chomp;
624
1179
                $_ .= <$header>;
625
1179
                redo;
626            }
627
628            # Make sure the entire parameter list is on a single line
629
34554
100
            next unless /\(/;
630
10890
100
            unless (/\)/) {
631
501
                chomp;
632
501
                $_ .= <$header>;
633
501
                redo;
634            }
635
636            # We only care about regular function prototypes
637
10389
100
75
            next unless /API/ or /\bextern\b/ or /\bmui[A-Z]/;
638
9918
100
            next if /^#/;
639
9885
100
            next if /\btypedef\b/;
640
641            # Work around bug in Mac OS X headers (glext.h as of 10.6.3, at least)
642
5937
50
            next if /^\s*extern\s+\w+\s+\(\*\s+/;
643
644            # Skip where we are explicitly told to do so
645
5937
50
            next if /\bFGUNUSED\b/;
646
647            # Save a (space compressed) copy of the source line
648            # for later error reporting
649
5937
            my $orig = $_;
650
5937
               $orig =~ s/\s+/ /g;
651
5937
               $orig =~ s/ $/\n/;
652
653            # Get rid of junk needed for C, but not for Parrot NCI;
654            # also do general cleanup to make parsing easier
655
5937
            s/\b(?:AVAILABLE|DEPRECATED_(?:IN|FOR))_MAC_OS_X_VERSION_\d+_\d+_AND_LATER\b\s*//;
656
5937
            s/\bAVAILABLE_MAC_OS_X_VERSION_\d+_\d+_AND_LATER_BUT_DEPRECATED_IN_MAC_OS_X_VERSION_\d+_\d+\b\s*//;
657
5937
            s/\b__cdecl\b\s*//;
658
5937
            s/\b__stdcall\b\s*//;
659
5937
            s/\b_CRTIMP\b\s*//;
660
5937
            s/\bextern\b\s*//;
661
5937
            s/\bstatic\b\s*//;
662
5937
            s/\bconst\b\s*//g;
663
5937
            s/\benum\b\s*//g;
664
5937
            s/\bstruct\b\s*//g;
665
5937
            s/\b[_A-Z]*API[_A-Z]*\s*//g;
666
5937
            s/\s*\*\s*/* /g;
667
5937
            s/\* \*/**/g;
668
5937
            s/\s*,\s*/, /g;
669
5937
            s/\s*\(\s*/(/g;
670
5937
            s/\s*\)\s*/)/g;
671
5937
            s/\s+/ /g;
672
5937
            s/\s+$//;
673
5937
            s/^\s+//;
674
675            # Canonicalize types
676
5937
34320
100
            s/\b(\w+)\b/$C_TYPE{$1} || $1/eg;
677
5937
            s/\b(?:un)?signed (char|short|int|long)\b/$1/g;
678
5937
            s/\b(?:un)?signed /int /g;
679
5937
            s/\blong long\b/longlong/g;
680
681            # Parse the function prototype, trying hard to capture name
682
5937
            my ($return, $name, $params) = /^(\w+\**) (\w+)\(([^)]*)\);$/;
683
5937
100
            ($name) = /^\w+\(?\** (\w+)\)?/ unless defined $name;
684
685            # Is this a function we're ignoring for now or handling elsewhere?
686
5937
50
            if (defined $name) {
687                # Callback reg functions handled by gen_*_callbacks()
688
5937
100
                $pass {$file}++, next if /\bglut[A-Z][a-zA-Z]+Func\b/;
689
5847
50
                $ignore{$file}++, next if /\bsmap[A-Z][a-zA-Z]+Func\b/;
690
691                # Ignore all library-internal functions
692
5847
50
                $ignore{$file}++, next if $name =~ /^__/;
693
5847
50
                $ignore{$file}++, next if $name =~ /_ATEXIT_HACK$/;
694
695                # Miscellaneous ignores
696
5847
100
                $ignore{$file}++, next if $IGNORE{$name};
697            }
698
699            # Successful parse?
700
5811
50
25
            unless (defined $return and defined $name and defined $params) {
701
0
                $fail{$file}++;
702
0
0
                $name ||= '';
703
0
                warn "In OpenGL header '$file', can't parse canonicalized prototype for '$name':\n $_\nOriginal prototype:\n $orig\n";
704
0
                next;
705            }
706
707            # Figure out what group/library this function belongs to
708
5811
            my ($group) = $name =~ /^(agl|CGL|wgl|glX|mui|smap|gl[a-z]*)/;
709
710
5811
50
            unless ($group) {
711
0
                $fail{$file}++;
712
0
                warn "In OpenGL header '$file', found a non-OpenGL function: '$name'\n";
713
0
                next;
714            }
715
716
5811
            $group = lc $group;
717
718            # Convert return and param types to NCI signature
719
5811
5811
5811
100
100
            my @nci_sig = @{${$OVERRIDE{$name} or []}[0] or []};
720
5811
5811
5811
100
100
            my @cstr_trans = @{${$OVERRIDE{$name} or []}[1] or []};
721
722
5811
100
            unless (@nci_sig) {
723
5808
100
                $params = '' if $params eq 'void';
724
5808
                my @params = split /, / => $params;
725
5808
                unshift @params, $return;
726
727
5808
                foreach my $param (@params) {
728
22287
                    1 while $param =~ s/(\w+\**) (\w+)\s*\[\d*\]/$1* $2/;
729
22287
100
                    $param =~ s/ \w+$// unless $NCI_TYPE{$param};
730
22287
50
                    unless ($NCI_TYPE{$param}) {
731
0
                        $fail{$file}++;
732
0
0
                        warn "In OpenGL header '$file', prototype '$name', can't handle type '$param'; original prototype:\n $orig\n"
733                          if $verbose;
734
0
                        next PROTO;
735                    }
736
22287
                    push @nci_sig, $NCI_TYPE{$param};
737
22287
                    push @cstr_trans, $param eq 'char*';
738                }
739
740
5808
16479
50
16479
                if (any sub { $_ eq 'void' }, @nci_sig[1..$#nci_sig]) {
741
0
                    $fail{$file}++;
742
0
0
                    warn "In OpenGL header '$file', prototype '$name', there is a void parameter; original prototype:\n $orig\n"
743                      if $verbose;
744
0
                    next PROTO;
745                }
746            }
747
748            # Success! Save results.
749
5811
            $pass{$file}++;
750
5811
            $sigs{join ',', @nci_sig} = [@nci_sig];
751
5811
5811
            push @{$funcs{$group}}, [$name, [@nci_sig], [@cstr_trans]];
752
753
5811
            my $nci_sig = '[' . (join ',', @nci_sig) . ']';
754
5811
100
            print "$group\t$nci_sig\t$return $name($params);\n"
755                if $verbose >= 3;
756        }
757    }
758
759    # PHASE 2: Write unique signatures to NCI signatures file
760
3
    my @sigs = values %sigs;
761
762
3
50
    open my $sigs, '>', $SIGS_FILE
763        or die "Could not open NCI signatures file '$SIGS_FILE' for write: $!";
764
765
3
    print $sigs <<"HEADER";
766# Used by OpenGL (including GLU and GLUT)
767#
768$autogen_header
769
770# GLUT callbacks
771v pP
772v pPi
773v pPii
774
775# Generated signatures
776HEADER
777
778
3
    foreach my $nci_sig (@sigs) {
779
642
        my ($return, @params) = ($$nci_sig[0], @$nci_sig[1..$#$nci_sig]);
780
781
642
        print $sigs "$return (", (join ',', @params), ")\n";
782    }
783
784
3
    close $sigs;
785
3
    $conf->append_configure_log($SIGS_FILE);
786
787    # PHASE 3: Write function lists for each OpenGL-related library
788
789
3
50
    open my $funcs, '>', $FUNCS_FILE
790        or die "Could not open function list file '$FUNCS_FILE' for write: $!";
791
792
3
    print $funcs $autogen_header;
793
3
    print $funcs <<'GLUTCB_FUNCS';
794
795
796.sub _glutcb_func_list
797    .local pmc glutcb_funcs
798    glutcb_funcs = new 'ResizableStringArray'
799    push glutcb_funcs, 'Parrot_glut_nci_loader'
800    push glutcb_funcs, 'void,ptr'
801    push glutcb_funcs, ''
802    push glutcb_funcs, 'glutcbCloseFunc'
803    push glutcb_funcs, 'void,ptr,PMC'
804    push glutcb_funcs, ''
805    push glutcb_funcs, 'glutcbDisplayFunc'
806    push glutcb_funcs, 'void,ptr,PMC'
807    push glutcb_funcs, ''
808    push glutcb_funcs, 'glutcbIdleFunc'
809    push glutcb_funcs, 'void,ptr,PMC'
810    push glutcb_funcs, ''
811    push glutcb_funcs, 'glutcbMenuDestroyFunc'
812    push glutcb_funcs, 'void,ptr,PMC'
813    push glutcb_funcs, ''
814    push glutcb_funcs, 'glutcbOverlayDisplayFunc'
815    push glutcb_funcs, 'void,ptr,PMC'
816    push glutcb_funcs, ''
817    push glutcb_funcs, 'glutcbWMCloseFunc'
818    push glutcb_funcs, 'void,ptr,PMC'
819    push glutcb_funcs, ''
820    push glutcb_funcs, 'glutcbEntryFunc'
821    push glutcb_funcs, 'void,ptr,PMC'
822    push glutcb_funcs, ''
823    push glutcb_funcs, 'glutcbMenuStateFunc'
824    push glutcb_funcs, 'void,ptr,PMC'
825    push glutcb_funcs, ''
826    push glutcb_funcs, 'glutcbVisibilityFunc'
827    push glutcb_funcs, 'void,ptr,PMC'
828    push glutcb_funcs, ''
829    push glutcb_funcs, 'glutcbWindowStatusFunc'
830    push glutcb_funcs, 'void,ptr,PMC'
831    push glutcb_funcs, ''
832    push glutcb_funcs, 'glutcbButtonBoxFunc'
833    push glutcb_funcs, 'void,ptr,PMC'
834    push glutcb_funcs, ''
835    push glutcb_funcs, 'glutcbDialsFunc'
836    push glutcb_funcs, 'void,ptr,PMC'
837    push glutcb_funcs, ''
838    push glutcb_funcs, 'glutcbMotionFunc'
839    push glutcb_funcs, 'void,ptr,PMC'
840    push glutcb_funcs, ''
841    push glutcb_funcs, 'glutcbPassiveMotionFunc'
842    push glutcb_funcs, 'void,ptr,PMC'
843    push glutcb_funcs, ''
844    push glutcb_funcs, 'glutcbReshapeFunc'
845    push glutcb_funcs, 'void,ptr,PMC'
846    push glutcb_funcs, ''
847    push glutcb_funcs, 'glutcbSpaceballButtonFunc'
848    push glutcb_funcs, 'void,ptr,PMC'
849    push glutcb_funcs, ''
850    push glutcb_funcs, 'glutcbTabletMotionFunc'
851    push glutcb_funcs, 'void,ptr,PMC'
852    push glutcb_funcs, ''
853    push glutcb_funcs, 'glutcbKeyboardFunc'
854    push glutcb_funcs, 'void,ptr,PMC'
855    push glutcb_funcs, ''
856    push glutcb_funcs, 'glutcbKeyboardUpFunc'
857    push glutcb_funcs, 'void,ptr,PMC'
858    push glutcb_funcs, ''
859    push glutcb_funcs, 'glutcbMenuStatusFunc'
860    push glutcb_funcs, 'void,ptr,PMC'
861    push glutcb_funcs, ''
862    push glutcb_funcs, 'glutcbSpaceballMotionFunc'
863    push glutcb_funcs, 'void,ptr,PMC'
864    push glutcb_funcs, ''
865    push glutcb_funcs, 'glutcbSpaceballRotateFunc'
866    push glutcb_funcs, 'void,ptr,PMC'
867    push glutcb_funcs, ''
868    push glutcb_funcs, 'glutcbSpecialFunc'
869    push glutcb_funcs, 'void,ptr,PMC'
870    push glutcb_funcs, ''
871    push glutcb_funcs, 'glutcbSpecialUpFunc'
872    push glutcb_funcs, 'void,ptr,PMC'
873    push glutcb_funcs, ''
874    push glutcb_funcs, 'glutcbMouseFunc'
875    push glutcb_funcs, 'void,ptr,PMC'
876    push glutcb_funcs, ''
877    push glutcb_funcs, 'glutcbMouseWheelFunc'
878    push glutcb_funcs, 'void,ptr,PMC'
879    push glutcb_funcs, ''
880    push glutcb_funcs, 'glutcbTabletButtonFunc'
881    push glutcb_funcs, 'void,ptr,PMC'
882    push glutcb_funcs, ''
883    push glutcb_funcs, 'glutcbTimerFunc'
884    push glutcb_funcs, 'void,ptr,PMC,int,int'
885    push glutcb_funcs, ''
886    push glutcb_funcs, 'glutcbJoystickFunc'
887    push glutcb_funcs, 'void,ptr,PMC,int'
888    push glutcb_funcs, ''
889
890    .return (glutcb_funcs)
891.end
892GLUTCB_FUNCS
893
894
3
    foreach my $group (sort keys %funcs) {
895
12
        my $sub_name = "_${group}_func_list";
896
12
        my $list_name = "${group}_funcs";
897
898
12
        print $funcs <<"SUB_HEADER";
899
900
901.sub $sub_name
902    .local pmc $list_name
903    $list_name = new 'ResizableStringArray'
904
905SUB_HEADER
906
907
12
40680
12
        my @funcs = sort {$a->[0] cmp $b->[0]} @{$funcs{$group}};
908
12
        foreach my $func (@funcs) {
909
5811
            my ($name, $sig, $cstr) = @$func;
910
911
5811
            my $sig_str = join ',', @$sig;
912
5811
            my $cstr_str = do {
913
5811
                my $i = -1;
914
5811
                join ',', map $_->[1], grep $_->[0], map [$_, $i++], @$cstr;
915            };
916
917
5811
            print $funcs <<"FUNCTION"
918    push $list_name, '$name'
919    push $list_name, '$sig_str'
920    push $list_name, '$cstr_str'
921FUNCTION
922        }
923
12
        print $funcs <<"SUB_FOOTER";
924
925    .return ($list_name)
926.end
927SUB_FOOTER
928    }
929
930
3
    close $funcs;
931
3
    $conf->append_configure_log($FUNCS_FILE);
932
933    # PHASE 4: Print statistical info on parse results if verbose
934
3
100
    if ($verbose) {
935
2
        print "\nPASS FAIL IGNORE HEADER\n";
936
2
        foreach my $file (@$header_files, 'TOTAL') {
937
20
100
            my $pass = $pass {$file} || 0;
938
20
50
            my $fail = $fail {$file} || 0;
939
20
100
            my $ignore = $ignore{$file} || 0;
940
941
20
            printf "%4d %4d %4d %s\n", $pass, $fail, $ignore, $file;
942
943
20
            $pass {TOTAL} += $pass;
944
20
            $fail {TOTAL} += $fail;
945
20
            $ignore{TOTAL} += $ignore;
946        }
947
948
2
100
        print "\nCOUNT NCI SIGNATURE\n" if $verbose >= 2;
949
2
        foreach my $nci_sig (@sigs, 'TOTAL') {
950
430
100
            printf "%5d %s\n", $sigs{$nci_sig}, $nci_sig if $verbose >= 2;
951
430
            $sigs{TOTAL} += $sigs{$nci_sig};
952        }
953
954
2
        printf "\n===> %d unique signatures successfully translated.\n",
955               scalar @sigs
956    }
957
958
3
    return 1;
959}
960
961sub gen_glut_callbacks {
962
3
3
    my ( $self, $conf ) = @_;
963
964
3
    my $glut_api = $conf->data->get('has_glut');
965
3
    my $glut_brand = $conf->data->get('glut_brand');
966
967
3
    my @glut_callbacks = @GLUT_1_CALLBACKS;
968
3
50
    push @glut_callbacks, @GLUT_2_CALLBACKS if $glut_api >= 2;
969
3
50
    push @glut_callbacks, @GLUT_3_CALLBACKS if $glut_api >= 3;
970
3
50
    push @glut_callbacks, @GLUT_4_CALLBACKS if $glut_api >= 4;
971
3
50
    push @glut_callbacks, @FREEGLUT_CALLBACKS if $glut_brand eq 'freeglut';
972
3
50
33
    push @glut_callbacks, @MACOSXGLUT_CALLBACKS if $glut_brand eq 'freeglut'
973                                                 or $glut_brand eq 'MacOSX_GLUT';
974
975
3
50
50
50
    my $glut_header = $glut_brand eq 'MacOSX_GLUT' ? 'GLUT/glut.h' :
976                      $glut_brand eq 'OpenGLUT' ? 'GL/openglut.h' :
977                      $glut_brand eq 'freeglut' ? 'GL/freeglut.h' :
978                                                     'GL/glut.h' ;
979
980
3
    my @callbacks;
981
3
    foreach my $raw (@glut_callbacks) {
982
81
        my ($friendly, $params) = @$raw;
983
984
81
        my $args = $params;
985
81
           $args =~ s/void//;
986
81
           $args =~ s/unsigned //;
987
81
           $args =~ s/(^|, )((?:\w+ )+)/$1$PCC_CAST{$PCC_TYPE{$NCI_TYPE{(split ' ', $2)[0]}}}/g;
988
81
100
           $args = ", $args" if $args;
989
81
        my $proto = $params;
990
81
           $proto =~ s/ \w+(,|$)/$1/g;
991
81
        my $sig = $proto;
992
81
           $sig =~ s/void//;
993
81
           $sig =~ s/unsigned //;
994
81
           $sig =~ s/(\w+)\W*/$PCC_TYPE{$NCI_TYPE{$1}}/g;
995
81
           $sig = "$sig->";
996
997
81
        my $glutcb = "glutcb${friendly}Func";
998
81
           $glutcb =~ s/ //g;
999
81
        my $glut = $glutcb;
1000
81
           $glut =~ s/glutcb/glut/;
1001
81
        my $thunk = 'glut_' . lc($friendly) . '_func';
1002
81
           $thunk =~ s/ /_/g;
1003
81
        my $enum = 'GLUT_CB_' . uc($friendly);
1004
81
           $enum =~ s/ /_/g;
1005
1006
81
        push @callbacks, {
1007            friendly => $friendly,
1008            params => $params,
1009            proto => $proto,
1010            args => $args,
1011            sig => $sig,
1012            glutcb => $glutcb,
1013            glut => $glut,
1014            thunk => $thunk,
1015            enum => $enum,
1016        };
1017    }
1018
1019
3
    my $enums = '';
1020
3
    my $thunks = '';
1021
3
    my $reg_funcs = '';
1022
3
    my $std_cbs = '';
1023
1024
3
   foreach (@callbacks) {
1025
81
        $enums .= " $_->{enum},\n";
1026
81
        $thunks .= " void $_->{thunk}($_->{proto});\n";
1027
81
        $reg_funcs .= "PARROT_DYNEXT_EXPORT void $_->{glutcb}(Parrot_Interp, PMC *);\n";
1028   }
1029
1030
3
    my $header = <<"HEADER";
1031/*
1032# DO NOT EDIT THIS FILE.
1033#
1034# Any changes made here will be lost.
1035#
1036# This file is generated automatically by config/gen/opengl.pm
1037
1038Copyright (C) 2008, Parrot Foundation.
1039
1040 - 1054
=head1 NAME

$C_FILE - GLUT Callback Function Handling

=head1 DESCRIPTION

GLUT callbacks are always synchronous and have void return type.  None
of them accept user data parameters, so normal Parrot callback handling
cannot be used.

=head2 Functions

=over 4

=cut
1055
1056*/
1057
1058#define PARROT_IN_EXTENSION
1059
1060#include "parrot/parrot.h"
1061#include "parrot/extend.h"
1062#include <$glut_header>
1063
1064
1065typedef enum {
1066$enums
1067    GLUT_CB_TIMER,
1068
1069#if GLUT_API_VERSION >= 4
1070    GLUT_CB_JOYSTICK,
1071#endif
1072
1073    GLUT_NUM_CALLBACKS
1074} GLUT_CALLBACKS;
1075
1076typedef struct GLUT_CB_data {
1077    Parrot_Interp interp;
1078    PMC *sub;
1079} GLUT_CB_data;
1080
1081GLUT_CB_data callback_data[GLUT_NUM_CALLBACKS];
1082
1083
1084                     int is_safe(Parrot_Interp, PMC *);
1085
1086                     void glut_timer_func(int);
1087PARROT_DYNEXT_EXPORT void glutcbTimerFunc(Parrot_Interp, PMC *, unsigned int, int);
1088
1089#if GLUT_API_VERSION >= 4
1090                void glut_joystick_func(unsigned int, int, int, int);
1091PARROT_DYNEXT_EXPORT void glutcbJoystickFunc(Parrot_Interp, PMC *, int);
1092#endif
1093
1094$thunks
1095$reg_funcs
1096
1097/* Make sure that interp and sub are sane before running callback sub */
1098/* XXXX: Should this do the moral equivalent of PANIC? */
1099int
1100is_safe(SHIM_INTERP, PMC *sub)
1101{
1102    /* XXXX: Verify that interp still exists */
1103
1104    /* XXXX: Verify that sub exists in interp */
1105
1106    return PMC_IS_NULL(sub) ? 0 : 1;
1107}
1108
1109
1110/*
1111
1112# glutTimerFunc and glutJoystickFunc must be hardcoded because they have
1113# special timer-related arguments that do not follow the template of all
1114# of the other GLUT callbacks
1115
1116 - 1120
=item C<void glutcbTimerFunc(PARROT_INTERP, sub, milliseconds, data)>

Register a Sub PMC to handle GLUT Timer callbacks.

=cut
1121
1122*/
1123
1124void
1125glut_timer_func(int data)
1126{
1127    Parrot_Interp interp = callback_data[GLUT_CB_TIMER].interp;
1128    PMC *sub = callback_data[GLUT_CB_TIMER].sub;
1129
1130    if (is_safe(interp, sub))
1131        Parrot_ext_call(interp, sub, "I->", (INTVAL) data);
1132}
1133
1134PARROT_DYNEXT_EXPORT
1135void
1136glutcbTimerFunc(PARROT_INTERP, PMC *sub, unsigned int milliseconds, int data)
1137{
1138    callback_data[GLUT_CB_TIMER].interp = interp;
1139    callback_data[GLUT_CB_TIMER].sub = sub;
1140
1141    if (PMC_IS_NULL(sub))
1142        glutTimerFunc(0, NULL, 0);
1143    else
1144        glutTimerFunc(milliseconds, glut_timer_func, data);
1145}
1146
1147
1148#if GLUT_API_VERSION >= 4
1149/*
1150
1151 - 1155
=item C<void glutcbJoystickFunc(PARROT_INTERP, sub, pollinterval)>

Register a Sub PMC to handle GLUT Joystick callbacks.

=cut
1156
1157*/
1158
1159void
1160glut_joystick_func(unsigned int buttons, int xaxis, int yaxis, int zaxis)
1161{
1162    Parrot_Interp interp = callback_data[GLUT_CB_JOYSTICK].interp;
1163    PMC *sub = callback_data[GLUT_CB_JOYSTICK].sub;
1164
1165    if (is_safe(interp, sub))
1166        Parrot_ext_call(interp, sub, "IIII->",
1167            (INTVAL) buttons, (INTVAL) xaxis, (INTVAL) yaxis, (INTVAL) zaxis);
1168}
1169
1170PARROT_DYNEXT_EXPORT
1171void
1172glutcbJoystickFunc(PARROT_INTERP, PMC *sub, int pollinterval)
1173{
1174    callback_data[GLUT_CB_JOYSTICK].interp = interp;
1175    callback_data[GLUT_CB_JOYSTICK].sub = sub;
1176
1177    if (PMC_IS_NULL(sub))
1178        glutJoystickFunc(NULL, 0);
1179    else
1180        glutJoystickFunc(glut_joystick_func, pollinterval);
1181}
1182#endif
1183HEADER
1184
1185
1186
3
    foreach (@callbacks) {
1187
81
        $std_cbs .= <<"IMPLEMENTATION"
1188
1189
1190/*
1191
1192 - 1196
=item C<void $_->{glutcb}(PARROT_INTERP, sub)>

Register a Sub PMC to handle GLUT $_->{friendly} callbacks.

=cut
1197
1198*/
1199
1200void
1201$_->{thunk}($_->{params})
1202{
1203    Parrot_Interp interp = callback_data[$_->{enum}].interp;
1204    PMC *sub = callback_data[$_->{enum}].sub;
1205
1206    if (is_safe(interp, sub))
1207        Parrot_ext_call(interp, sub, "$_->{sig}"$_->{args});
1208}
1209
1210PARROT_DYNEXT_EXPORT
1211void
1212$_->{glutcb}(PARROT_INTERP, PMC *sub)
1213{
1214    callback_data[$_->{enum}].interp = interp;
1215    callback_data[$_->{enum}].sub = sub;
1216
1217    if (PMC_IS_NULL(sub))
1218        $_->{glut}(NULL);
1219    else
1220        $_->{glut}($_->{thunk});
1221}
1222IMPLEMENTATION
1223    }
1224
1225
1226
3
    my $footer = <<'FOOTER';
1227
1228/*
1229
1230=back
1231
1232=cut
1233
1234*/
1235FOOTER
1236
1237
1238    ###
1239    ### ACTUALLY WRITE FILE
1240    ###
1241
1242
3
50
    open my $c_file, '>', $C_FILE
1243        or die "Could not open '$C_FILE' for write: $!";
1244
1245
3
    print $c_file $header;
1246
3
    print $c_file $std_cbs;
1247
3
    print $c_file $footer;
1248
1249
3
    $conf->append_configure_log($C_FILE);
1250
1251
1252
3
    return 1;
1253}
1254
12551;
1256
1257# Local Variables:
1258# mode: cperl
1259# cperl-indent-level: 4
1260# fill-column: 100
1261# End:
1262# vim: expandtab shiftwidth=4: