mirror of
				https://github.com/nigels-com/glew.git
				synced 2025-11-03 22:04:10 +00:00 
			
		
		
		
	
		
			
				
	
	
		
			411 lines
		
	
	
		
			14 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
			
		
		
	
	
			411 lines
		
	
	
		
			14 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
#!/usr/bin/env perl
 | 
						|
##
 | 
						|
## Copyright (C) 2008-2025, Nigel Stewart <nigels[]nigels com>
 | 
						|
## Copyright (C) 2002-2008, Marcelo E. Magallon <mmagallo[]debian org>
 | 
						|
## Copyright (C) 2002-2008, Milan Ikits <milan ikits[]ieee org>
 | 
						|
##
 | 
						|
## This program is distributed under the terms and conditions of the GNU
 | 
						|
## General Public License Version 2 as published by the Free Software
 | 
						|
## Foundation or, at your option, any later version.
 | 
						|
 | 
						|
use strict;
 | 
						|
use warnings;
 | 
						|
 | 
						|
sub compile_regex
 | 
						|
{
 | 
						|
    my $regex = join('', @_);
 | 
						|
    return qr/$regex/
 | 
						|
}
 | 
						|
 | 
						|
my @sections = (
 | 
						|
    "Name",
 | 
						|
    "Name Strings?",
 | 
						|
    "New Procedures and Functions",
 | 
						|
    "New Tokens.*",                    # Optional (GL/WGL/GLX/...) suffix
 | 
						|
    "Additions to Chapter.*",
 | 
						|
);
 | 
						|
 | 
						|
my %typemap = (
 | 
						|
    bitfield => "GLbitfield",
 | 
						|
    boolean  => "GLboolean",
 | 
						|
    # fsck up in EXT_vertex_array
 | 
						|
    Boolean  => "GLboolean",
 | 
						|
    byte     => "GLbyte",
 | 
						|
    clampd   => "GLclampd",
 | 
						|
    clampf   => "GLclampf",
 | 
						|
    double   => "GLdouble",
 | 
						|
    enum     => "GLenum",
 | 
						|
    # Intel fsck up
 | 
						|
    Glenum   => "GLenum",
 | 
						|
    float    => "GLfloat",
 | 
						|
    half     => "GLhalf",
 | 
						|
    int      => "GLint",
 | 
						|
    short    => "GLshort",
 | 
						|
    sizei    => "GLsizei",
 | 
						|
    ubyte    => "GLubyte",
 | 
						|
    uint     => "GLuint",
 | 
						|
    ushort   => "GLushort",
 | 
						|
    DMbuffer => "void *",
 | 
						|
    # Nvidia video output fsck up
 | 
						|
    int64EXT => "GLint64EXT",
 | 
						|
    uint64EXT=> "GLuint64EXT",
 | 
						|
 | 
						|
    # ARB VBO introduces these.
 | 
						|
 | 
						|
    sizeiptr => "GLsizeiptr",
 | 
						|
    intptr   => "GLintptr",
 | 
						|
    sizeiptrARB => "GLsizeiptrARB",
 | 
						|
    intptrARB   => "GLintptrARB",
 | 
						|
 | 
						|
    # ARB shader objects introduces these, charARB is at least 8 bits,
 | 
						|
    # handleARB is at least 32 bits
 | 
						|
    charARB => "GLcharARB",
 | 
						|
    handleARB => "GLhandleARB",
 | 
						|
 | 
						|
    char => "GLchar",
 | 
						|
 | 
						|
    # OpenGL 3.2 and GL_ARB_sync
 | 
						|
 | 
						|
    int64  => "GLint64",
 | 
						|
    uint64 => "GLuint64",
 | 
						|
    sync   => "GLsync",
 | 
						|
 | 
						|
    # GL_EXT_EGL_image_storage
 | 
						|
 | 
						|
    eglImageOES => "GLeglImageOES",
 | 
						|
 | 
						|
    # AMD_debug_output
 | 
						|
 | 
						|
    DEBUGPROCAMD => "GLDEBUGPROCAMD",
 | 
						|
 | 
						|
    # ARB_debug_output
 | 
						|
 | 
						|
    DEBUGPROCARB => "GLDEBUGPROCARB",
 | 
						|
 | 
						|
    # KHR_debug
 | 
						|
 | 
						|
    DEBUGPROC => "GLDEBUGPROC",
 | 
						|
 | 
						|
    VULKANPROCNV => "GLVULKANPROCNV",
 | 
						|
 | 
						|
    vdpauSurfaceNV => "GLvdpauSurfaceNV",
 | 
						|
    
 | 
						|
    # GLX 1.3 defines new types which might not be available at compile time
 | 
						|
 | 
						|
    #GLXFBConfig   => "void*",
 | 
						|
    #GLXFBConfigID => "XID",
 | 
						|
    #GLXContextID  => "XID",
 | 
						|
    #GLXWindow     => "XID",
 | 
						|
    #GLXPbuffer    => "XID",
 | 
						|
 | 
						|
    # Weird stuff to some SGIX extension
 | 
						|
 | 
						|
    #GLXFBConfigSGIX   => "void*",
 | 
						|
    #GLXFBConfigIDSGIX => "XID",
 | 
						|
 | 
						|
);
 | 
						|
 | 
						|
my %voidtypemap = (
 | 
						|
    void    => "GLvoid",
 | 
						|
);
 | 
						|
 | 
						|
my %taboo_tokens = (
 | 
						|
    GL_ZERO => 1,
 | 
						|
);
 | 
						|
 | 
						|
# list of function definitions to be ignored, unless they are being defined in
 | 
						|
# the given spec.  This is an ugly hack around the fact that people writing
 | 
						|
# spec files seem to shut down all brain activity while they are at this task.
 | 
						|
#
 | 
						|
# This will be moved to its own file eventually.
 | 
						|
#
 | 
						|
# (mem, 2003-03-19)
 | 
						|
 | 
						|
my %fnc_ignore_list = (
 | 
						|
    "BindProgramARB"                => "ARB_vertex_program",
 | 
						|
    "ColorSubTableEXT"              => "EXT_color_subtable",
 | 
						|
    "DeleteProgramsARB"             => "ARB_vertex_program",
 | 
						|
    "GenProgramsARB"                => "ARB_vertex_program",
 | 
						|
    "GetProgramEnvParameterdvARB"   => "ARB_vertex_program",
 | 
						|
    "GetProgramEnvParameterfvARB"   => "ARB_vertex_program",
 | 
						|
    "GetProgramLocalParameterdvARB" => "ARB_vertex_program",
 | 
						|
    "GetProgramLocalParameterfvARB" => "ARB_vertex_program",
 | 
						|
    "GetProgramStringARB"           => "ARB_vertex_program",
 | 
						|
    "GetProgramivARB"               => "ARB_vertex_program",
 | 
						|
    "IsProgramARB"                  => "ARB_vertex_program",
 | 
						|
    "ProgramEnvParameter4dARB"      => "ARB_vertex_program",
 | 
						|
    "ProgramEnvParameter4dvARB"     => "ARB_vertex_program",
 | 
						|
    "ProgramEnvParameter4fARB"      => "ARB_vertex_program",
 | 
						|
    "ProgramEnvParameter4fvARB"     => "ARB_vertex_program",
 | 
						|
    "ProgramLocalParameter4dARB"    => "ARB_vertex_program",
 | 
						|
    "ProgramLocalParameter4dvARB"   => "ARB_vertex_program",
 | 
						|
    "ProgramLocalParameter4fARB"    => "ARB_vertex_program",
 | 
						|
    "ProgramLocalParameter4fvARB"   => "ARB_vertex_program",
 | 
						|
    "ProgramStringARB"              => "ARB_vertex_program",
 | 
						|
    "EGLImageTargetTexture2DOES"    => "OES_EGL_image",
 | 
						|
    "FramebufferTextureOES"         => "GL_OES_geometry_shader",
 | 
						|
    "PatchParameteriOES"            => "GL_OES_tessellation_shader",
 | 
						|
    "PointSizePointerOES"           => "GL_OES_point_size_array",
 | 
						|
    "LockArraysEXT"                 => "EXT_compiled_vertex_array",
 | 
						|
    "UnlockArraysEXT"               => "EXT_compiled_vertex_array",
 | 
						|
    "CoverageMaskNV"                => "NV_coverage_sample",
 | 
						|
    "CoverageOperationNV"           => "NV_coverage_sample",
 | 
						|
    "glXCreateContextAttribsARB"    => "ARB_create_context_profile",
 | 
						|
    "wglCreateContextAttribsARB"    => "WGL_ARB_create_context_profile",
 | 
						|
);
 | 
						|
 | 
						|
my %regex = (
 | 
						|
    eofnc    => qr/(?:\);?$|^$)/, # )$ | );$ | ^$
 | 
						|
    extname  => qr/^[A-Z][A-Za-z0-9_]+$/,
 | 
						|
    none     => qr/^\(none\)$/,
 | 
						|
    function => qr/^(.+) ([a-z][a-z0-9_]*) \((.*)\)$/i,
 | 
						|
    prefix   => qr/^(?:[aw]?gl|glX|egl)/, # gl | agl | wgl | glX
 | 
						|
    tprefix  => qr/^(?:[AW]?GL|GLX|EGL)_/, # GL_ | AGL_ | WGL_ | GLX_
 | 
						|
    section  => compile_regex('^(', join('|', @sections), ')$'), # sections in spec
 | 
						|
    token    => qr/^([A-Z0-9][A-Z0-9_x]*):?\s+((?:0x)?[0-9A-Fa-f]+(u(ll)?)?)(|\s[^\?]*)$/, # define tokens
 | 
						|
    types    => compile_regex('\b(', join('|', keys %typemap), ')\b'), # var types
 | 
						|
    voidtype => compile_regex('\b(', keys %voidtypemap, ')\b '), # void type
 | 
						|
);
 | 
						|
 | 
						|
# reshapes the the function declaration from multiline to single line form
 | 
						|
sub normalize_prototype
 | 
						|
{
 | 
						|
    local $_ = join(" ", @_);
 | 
						|
    s/\s+/ /g;                # multiple whitespace -> single space
 | 
						|
    s/\<.*\>//g;              # remove <comments> from direct state access extension
 | 
						|
    s/\<.*$//g;               # remove incomplete <comments> from direct state access extension
 | 
						|
    s#/\*.*\*/##g;            # remove /* ... */ comments
 | 
						|
    s/\s*\(\s*/ \(/;          # exactly one space before ( and none after
 | 
						|
    s/\s*\)\s*/\)/;           # no space before or after )
 | 
						|
    s/\s*\*([a-zA-Z])/\* $1/; # "* identifier"
 | 
						|
    s/\*wgl/\* wgl/;          # "* wgl"
 | 
						|
    s/\*glX/\* glX/;          # "* glX"
 | 
						|
    s/\.\.\./void/;           # ... -> void
 | 
						|
    s/;$//;                   # remove ; at the end of the line
 | 
						|
    return $_;
 | 
						|
}
 | 
						|
 | 
						|
# Ugly hack to work around the fact that functions are declared in more
 | 
						|
# than one spec file.
 | 
						|
sub ignore_function($$)
 | 
						|
{
 | 
						|
    return exists($fnc_ignore_list{$_[0]}) && $fnc_ignore_list{$_[0]} ne $_[1]
 | 
						|
}
 | 
						|
 | 
						|
sub parse_spec($)
 | 
						|
{
 | 
						|
    my $filename = shift;
 | 
						|
    my $extname = "";
 | 
						|
    my $vendortag = "";
 | 
						|
    my @extnames = ();
 | 
						|
    my %functions = ();
 | 
						|
    my %tokens = ();
 | 
						|
 | 
						|
    my $section = "";
 | 
						|
    my @fnc = ();
 | 
						|
 | 
						|
    my %proc = (
 | 
						|
        "Name" => sub {
 | 
						|
            if (/^([a-z0-9]+)_([a-z0-9_]+)/i)
 | 
						|
            {
 | 
						|
                $extname = "$1_$2";
 | 
						|
                $vendortag = $1;
 | 
						|
            }
 | 
						|
        },
 | 
						|
 | 
						|
        "Name Strings" => sub {
 | 
						|
            # Add extension name to extension list
 | 
						|
        
 | 
						|
           # Initially use $extname if (none) specified
 | 
						|
            if (/$regex{none}/)
 | 
						|
            {
 | 
						|
                $_ = $extname;
 | 
						|
            }
 | 
						|
 | 
						|
            if (/$regex{extname}/)
 | 
						|
            {
 | 
						|
                # prefix with "GL_" if prefix not present
 | 
						|
                s/^/GL_/ unless /$regex{tprefix}/o;
 | 
						|
                # Add extension name to extension list
 | 
						|
                push @extnames, $_;
 | 
						|
            }
 | 
						|
        },
 | 
						|
 | 
						|
        "New Procedures and Functions" => sub {
 | 
						|
            # if line matches end of function
 | 
						|
            if (/$regex{eofnc}/)
 | 
						|
            {
 | 
						|
                # add line to function declaration
 | 
						|
                push @fnc, $_;
 | 
						|
 | 
						|
                # if normalized version of function looks like a function
 | 
						|
                if (normalize_prototype(@fnc) =~ /$regex{function}/)
 | 
						|
                {
 | 
						|
                    # get return type, name, and arguments from regex
 | 
						|
                    my ($return, $name, $parms) = ($1, $2, $3);
 | 
						|
                    if (!ignore_function($name, $extname))
 | 
						|
                    {
 | 
						|
                        # prefix with "gl" if prefix not present
 | 
						|
                        $name =~ s/^/gl/ unless $name =~ /$regex{prefix}/;
 | 
						|
                        # is this a pure GL function?
 | 
						|
                        if ($name =~ /^gl/ && $name !~ /^glX/)
 | 
						|
                        {
 | 
						|
                            # apply typemaps
 | 
						|
                            $return =~ s/$regex{types}/$typemap{$1}/og;
 | 
						|
                            $return =~ s/GLvoid/void/og;
 | 
						|
                            $return =~ s/void\*/void */og;
 | 
						|
                            $parms =~ s/$regex{types}/$typemap{$1}/og;
 | 
						|
                            $parms =~ s/$regex{voidtype}/$voidtypemap{$1}/og;
 | 
						|
                            $parms =~ s/GLvoid/void/og;
 | 
						|
                            $parms =~ s/ void\* / void */og;
 | 
						|
                            if ($parms eq "")
 | 
						|
                            {
 | 
						|
                                $parms = "void";  # NVX_progress_fence and others
 | 
						|
                            }
 | 
						|
                        }
 | 
						|
                        # add to functions hash
 | 
						|
                        $functions{$name} = {
 | 
						|
                            rtype => $return,
 | 
						|
                            parms => $parms,
 | 
						|
                        };
 | 
						|
                    }
 | 
						|
                }
 | 
						|
                # reset function declaration
 | 
						|
                @fnc = ();
 | 
						|
            } elsif ($_ ne "" and $_ ne "None") {
 | 
						|
                # if not eof, add line to function declaration
 | 
						|
                push @fnc, $_
 | 
						|
            }
 | 
						|
        },
 | 
						|
 | 
						|
        "New Tokens" => sub {
 | 
						|
            if (/$regex{token}/)
 | 
						|
            {
 | 
						|
                my ($name, $value) = ($1, $2);
 | 
						|
                # prefix with "GL_" if prefix not present
 | 
						|
                $name =~ s/^/GL_/ unless $name =~ /$regex{tprefix}/;
 | 
						|
                # Add (name, value) pair to tokens hash, unless it's taboo
 | 
						|
                $tokens{$name} = $value unless exists $taboo_tokens{$name};
 | 
						|
            }
 | 
						|
        },
 | 
						|
    );
 | 
						|
 | 
						|
    # Some people can't read, the template clearly says "Name String_s_"
 | 
						|
    $proc{"Name String"} = $proc{"Name Strings"};
 | 
						|
 | 
						|
    # Open spec file
 | 
						|
    open SPEC, "<$filename" or return;
 | 
						|
 | 
						|
    # For each line of SPEC
 | 
						|
    while(<SPEC>)
 | 
						|
    {
 | 
						|
        # Delete trailing newline character
 | 
						|
        chomp;
 | 
						|
        # Remove trailing white spaces
 | 
						|
        s/\s+$//;
 | 
						|
        # If starts with a capital letter, it must be a new section
 | 
						|
        if (/^[A-Z]/)
 | 
						|
        {
 | 
						|
            # Match section name with one of the predefined names 
 | 
						|
            $section = /$regex{section}/o ? $1 : "default";
 | 
						|
        } else {
 | 
						|
            # Line is internal to a section
 | 
						|
            # Remove leading whitespace
 | 
						|
            s/^\s+//;
 | 
						|
            # Call appropriate section processing function if it exists
 | 
						|
            &{$proc{$section}} if exists $proc{$section};
 | 
						|
        }
 | 
						|
    }
 | 
						|
 | 
						|
    close SPEC;
 | 
						|
 | 
						|
    return ($extname, \@extnames, \%tokens, \%functions);
 | 
						|
}
 | 
						|
 | 
						|
#----------------------------------------------------------------------------------------
 | 
						|
 | 
						|
my @speclist = ();
 | 
						|
my %extensions = ();
 | 
						|
 | 
						|
my $ext_dir = shift;
 | 
						|
my $reg_http = "https://www.khronos.org/registry/OpenGL/extensions/";
 | 
						|
 | 
						|
# Take command line arguments or read list from file
 | 
						|
if (@ARGV)
 | 
						|
{
 | 
						|
    @speclist = @ARGV;
 | 
						|
} else {
 | 
						|
    local $/; #???
 | 
						|
    @speclist = split "\n", (<>);
 | 
						|
}
 | 
						|
 | 
						|
foreach my $spec (sort @speclist)
 | 
						|
{
 | 
						|
    my ($extname, $extnames, $tokens, $functions) = parse_spec($spec);
 | 
						|
 | 
						|
    foreach my $ext (@{$extnames})
 | 
						|
    {
 | 
						|
        my $info = "$ext_dir/" . $ext;
 | 
						|
        open EXT, ">$info";
 | 
						|
        print EXT $ext . "\n";                       # Extension name
 | 
						|
        my $specname = $spec;
 | 
						|
        $specname =~ s/OpenGL-Registry\/extensions\///;
 | 
						|
        print EXT $reg_http . $specname . "\n";      # Extension info URL
 | 
						|
        print EXT $ext . "\n";                       # Extension string
 | 
						|
        print EXT "\n";                              # Resuses nothing by default
 | 
						|
 | 
						|
        my $prefix = $ext;
 | 
						|
        $prefix =~ s/^(.+?)(_.+)$/$1/;
 | 
						|
        foreach my $token (sort { 
 | 
						|
                if (${$tokens}{$a} eq ${$tokens}{$b}) {
 | 
						|
                        $a cmp $b
 | 
						|
                } else {
 | 
						|
                    if (${$tokens}{$a} =~ /_/) {
 | 
						|
                        if (${$tokens}{$b} =~ /_/) {
 | 
						|
                            $a cmp $b
 | 
						|
                        } else {
 | 
						|
                            -1
 | 
						|
                        }
 | 
						|
                    } else {
 | 
						|
                        if (${$tokens}{$b} =~ /_/) {
 | 
						|
                            1
 | 
						|
                        } else {
 | 
						|
                            if (${$tokens}{$a} =~ /u(ll)?$/) {
 | 
						|
                                if (${$tokens}{$b} =~ /u(ll)?$/) {
 | 
						|
                                    $a cmp $b
 | 
						|
                                } else {
 | 
						|
                                    -1
 | 
						|
                                }
 | 
						|
			    } else {
 | 
						|
                                if (${$tokens}{$b} =~ /u(ll)?$/) {
 | 
						|
                                    1
 | 
						|
                                } else {
 | 
						|
                                    if (hex ${$tokens}{$a} eq hex ${$tokens}{$b})
 | 
						|
                                    {
 | 
						|
                                        $a cmp $b
 | 
						|
                                    } else {
 | 
						|
                                        hex ${$tokens}{$a} <=> hex ${$tokens}{$b}
 | 
						|
                                    }
 | 
						|
                                }
 | 
						|
                            }
 | 
						|
                        }                    
 | 
						|
                    }
 | 
						|
                }
 | 
						|
            } keys %{$tokens})
 | 
						|
            {
 | 
						|
            if ($token =~ /^$prefix\_.*/i)
 | 
						|
            {
 | 
						|
                print EXT "\t" . $token . " " . ${\%{$tokens}}{$token} . "\n";
 | 
						|
            }
 | 
						|
        }
 | 
						|
        foreach my $function (sort keys %{$functions})
 | 
						|
        {
 | 
						|
            if ($function =~ /^$prefix.*/i)
 | 
						|
            {
 | 
						|
                print EXT "\t" . ${$functions}{$function}{rtype} . " " . $function . " (" . ${$functions}{$function}{parms} . ")" . "\n";
 | 
						|
            }
 | 
						|
        }
 | 
						|
        close EXT;
 | 
						|
    }
 | 
						|
}
 |