File Coverage

blib/lib/X11/Protocol/Ext/XFree86_DGA.pm

Criterion	Covered	Total	%
statement	27	93	29.0
branch	0	18	0.0
condition	0	3	0.0
subroutine	9	20	45.0
pod	0	1	0.0
total	36	135	26.6

# Copyright 2011, 2012, 2013, 2014 Kevin Ryde

# This file is part of X11-Protocol-Other.
#
# X11-Protocol-Other is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation; either version 3, or (at your option) any
# later version.
#
# X11-Protocol-Other is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General
# Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with X11-Protocol-Other.  If not, see .


# 2.0 bits:
# SetMode two flags fields
# byte_order "Significance" ?

# Protocol 1.0:
#   http://cvsweb.xfree86.org/cvsweb/xc/programs/Xserver/hw/xfree86/doc/man/Attic/XF86DGA.man?rev=3.10&hideattic=0&sortby=log&content-type=text/vnd.viewcvs-markup
#
#   /so/xfree/xfree86-3.3.2.3a/programs/Xserver/hw/xfree86/doc/README.DGA
#   /so/xfree/xfree86-3.3.2.3a/lib/Xxf86dga/XF86DGA.c
#       Xlib
#
#   /so/xfree/xfree86-3.3.2.3a/include/extensions/xf86dga.h
#   /so/xfree/xfree86-3.3.2.3a/include/extensions/xf86dgastr.h
#
#   /usr/include/X11/extensions/xf86dga1const.h
#   /usr/include/X11/extensions/xf86dga1proto.h
#
#   /so/xf86dga/XF86DGA.man
#
#   /so/xfree/xfree86-3.3.2.3a/programs/Xserver/Xext/xf86dga.c
#       server code
#
# Protocol 2.0:
#   /usr/share/doc/xserver-xfree86/README.DGA.gz
#   /so/xfree4/unpacked/usr/share/doc/xserver-xfree86/README.DGA.gz
#
#   /usr/include/X11/extensions/xf86dgaconst.h
#   /usr/include/X11/extensions/xf86dgaproto.h
#
#   /so/xorg/xorg-server-1.10.0/hw/xfree86/dixmods/extmod/xf86dga2.c
#   /so/xorg/xorg-server-1.10.0/hw/xfree86/common/xf86DGA.c
#        server code
#
#   XDGA(3) man page
#   /so/xf86dga/libXxf86dga-1.1.2/src/XF86DGA2.c
#        Xlib
#
# Other:
#   /usr/share/doc/x11proto-core-dev/x11protocol.txt.gz



BEGIN { require 5 }
package X11::Protocol::Ext::XFree86_DGA;
use strict;
use Carp;
use X11::Protocol;

use vars '$VERSION', '@CARP_NOT';
$VERSION = 30;
@CARP_NOT = ('X11::Protocol');

# uncomment this to run the ### lines
# use Smart::Comments;


# these not documented yet ...
use constant CLIENT_MAJOR_VERSION => 1;
use constant CLIENT_MINOR_VERSION => 0;

#------------------------------------------------------------------------------
# symbolic constants

use constant constants_list =>
  (XDGAPixmapMode =>  ['Large','Small'],
  );

sub _ext_constants_install {
  my ($X, $constants_arrayref) = @_;
  foreach (my $i = 0; $i <= $#$constants_arrayref; $i+=2) {
    my $name = $constants_arrayref->[$i];
    my $aref = $constants_arrayref->[$i+1];
    $X->{'ext_const'}->{$name} = $aref;
    $X->{'ext_const_num'}->{$name} = { X11::Protocol::make_num_hash($aref) };
  }
}

#------------------------------------------------------------------------------
# events

# =head1 EVENTS
#
# Protocol version 2.0 sends key, button and pointer motion events selected
# by C described above.
#
# Each event has the usual fields
#
#     name             "SyncCounterNotify" etc
#     synthetic        true if from a SendEvent
#     code             integer opcode
#     sequence_number  integer
#
# plus event-specific fields described below.
#
# =over
#
# =item C, C
#
# The "detail", "time" and "state" fields are the same as the core KeyPress
# and KeyRelease events,
#
#     detail           keycode (integer)
#     time             server timestamp (integer)
#     screen           screen number (integer)
#     state            keyboard modifiers (integer shift, control, etc)
#
# =item C, C
#
# The "detail", "time" and "state" fields are the same as the core
# ButtonPress and ButtonRelease events,
#
#     detail           button number 1 to 5
#     time             server timestamp (integer)
#     screen           screen number (integer)
#     state            keyboard modifiers (integer shift, control, etc)
#
# =item C
#
# The "time" and "state" fields are the same as the core key press and
# release events,
#
#     dx               \ pointer move in pixels, integer + or -
#     dy               /
#     time             server timestamp (integer)
#     screen           screen number (integer)
#     state            keyboard modifiers (integer shift, control, etc)
#
# =back

# xf86dgaproto.h struct dgaEvent has INT16 for screen, so "s" here, though
# normally a screen number will be >=0.
#
use constant events_list =>
  do {
    # struct dgaEvent has dx,dy fields for key and button events, but server
    # DGAStealButtonEvent() and DGAStealKeyEvent() always puts 0 in them, so
    # omit.
    #
    my $kb = [ 'xCxxLxxxxsSx16',
               'detail',
               'time',
               'screen',
               'state',
             ];
    (XDGAKeyPress      => $kb,   # +2
     XDGAKeyRelease    => $kb,   # +3
     XDGAButtonPress   => $kb,   # +4
     XDGAButtonRelease => $kb,   # +5

     # struct dgaEvent has a "detail" field for motion event, but server
     # DGAStealMotionEvent() always puts 0 in it, so omit.
     #
     XDGAMotionNotify  =>        # +6
     [ 'xxxxLsssSx16',
       'time',
       'dx',
       'dy',
       'screen',
       'state',
     ])
  };

sub _ext_events_install {
  my ($X, $event_num, $events_arrayref) = @_;
  foreach (my $i = 0; $i <= $#$events_arrayref; $i += 2) {
    my $name = $events_arrayref->[$i];
    if (defined (my $already = $X->{'ext_const'}->{'Events'}->[$event_num])) {
      carp "Event $event_num $already overwritten with $name";
    }
    $X->{'ext_const'}->{'Events'}->[$event_num] = $name;
    $X->{'ext_events'}->[$event_num] = $events_arrayref->[$i+1]; # pack/unpack
    $event_num++;
  }
}

#------------------------------------------------------------------------------
# requests

my $reqs =
  [
   ['XF86DGAQueryVersion',  # 0
    \&_request_empty,
    sub {
      my ($X, $data) = @_;
      ### XF86DGAQueryVersion() reply ...
      return unpack 'x8SS', $data;
    }],

   ['XF86DGAGetVideoLL',  # 1
    \&_request_screen16,
    sub {
      my ($X, $data) = @_;
      return unpack 'x8L4', $data; # (address,width,bank_size,ram_size)
    },
   ],

   ['XF86DGADirectVideo',  # 2
    sub {
      my ($X, $screen, $enable) = @_;
      return pack 'SS', $screen, $enable;
    } ],

   ['XF86DGAGetViewPortSize',  # 3
    \&_request_screen16,
    sub {
      my ($X, $data) = @_;
      return unpack 'x8LL', $data; # (width,height)
    },
   ],

   ['XF86DGASetViewPort',  # 4
    sub {
      shift;  # ($X, $screen, $x, $y)
      return pack 'SxxLL', @_;
    },
   ],

   ['XF86DGAGetVidPage',  # 5
    \&_request_screen16,
    sub {
      my ($X, $data) = @_;
      return unpack 'x8L', $data; # (vidpage)
    },
   ],

   ['XF86DGASetVidPage',  # 6
    sub {
      shift;  # ($X, $screen, $vidpage)
      return pack 'SS', @_;
    },
   ],

   ['XF86DGAInstallColormap',  # 7
    sub {
      my ($X, $screen, $colormap) = @_;
      return pack 'SxxL', $screen, $colormap;
    }],

   ['XF86DGAQueryDirectVideo',  # 8
    \&_request_screen16,
    sub {
      my ($X, $data) = @_;
      return unpack 'x8L', $data; # (flags)
    },
   ],

   ['XF86DGAViewPortChanged',  # 9
    sub {
      shift;  # ($X, $screen, $num_pages)
      return pack 'SS', @_;
    },
    sub {
      my ($X, $data) = @_;
      return unpack 'x8L', $data; # (bool)
    } ],


   #---------------------------------------------------------------------------
   # version 2.0

   undef,  # 10
   undef,  # 11

   # =item C<($mode_num =E $hashref, ...) = $X-EXDGAQueryModes($screen_num)>
   #
   # Return a list of available DGA modes and information.  Each mode is
   # returned as a pair
   #
   #    $mode_num => $hashref
   #
   # where C<$hashref> contains the following fields
   #
   #     mode_num
   #     byte_order         Significance enum
   #                          "LeastSignificant" or "MostSignificant"
   #     depth              bits per pixel with usable data, eg. 24
   #     bpp                bits per pixel including padding, eg. 32
   #     name               string name of mode from xorg.conf
   #     vsync_num          \ vertical refresh rate as fraction num/den
   #     vsync_den          /   retraces per second (Hertz)
   #     flags              bits
   #                        1    Concurrent Access
   #                        2    Solid Fill Rect
   #                        4    Blit Rect
   #                        8    Blit Trans Rect
   #                        16   Pixmap
   #     image_width        \
   #     image_height       /
   #     pixmap_width       \ size of the video part accessible by
   #     pixmap_height      /   pixmap of XDGASetMode()
   #     bytes_per_scanline
   #     red_mask           \ pixel bit-masks as per a visual
   #     green_mask         |
   #     blue_mask          /
   #     visual_class       VisualClass enum "TrueColor", "PseudoColor", etc
   #     viewport_width     \ size of the visible part of the video
   #     viewport_height    /
   #     viewport_xstep     \ granularity of X,Y position
   #     viewport_ystep     /   for XDGASetViewport()
   #     viewport_xmax      \ maximum X,Y position
   #     viewport_ymax      /   for XDGASetViewport()
   #     viewport_flags
   #
   # The return list can be put into a hash to lookup by mode number,
   #
   #    my %h = $X->XDGAQueryModes($screen_num);
   #    my $info = $h{$mode_num};
   #    print "$mode_num name is ",$info->{'name'},"\n";
   #

   ['XDGAQueryModes',   # 12
    \&_request_card32s,
    sub {
      my ($X, $data) = @_;
      my ($num_modes) = unpack 'x8L', $data;
      my $pos = 32;

      # use Data::HexDump::XXD;
      # print scalar(Data::HexDump::XXD::xxd($data));
      # print "\n";

      return map {my $h = _unpack_info($X,$data,$pos);
                  $pos += 72;
                  ($h->{'num'} => $h)
                } 1 .. $num_modes;
    } ],

   # =item C<(key=Evalue,...) = $X-EXDGASetMode($screen_num, $mode_num, $pixmap)>
   #
   # Put screen C<$screen_num> into DGA mode C<$mode_num>.  Or if
   # C<$mode_num> is 0 then leave DGA mode.
   #
   # C<$pixmap> is a new integer XID which is for X protocol access to the
   # video memory while in DGA mode.  This is only possible if the "Pixmap"
   # bit is set in the mode flags (C above).
   #
   # The return is a list of key/value pairs with mode information.  The
   # fields are C above for C<$mode_num>, and in addition
   #
   #     offset     => offset into video memory (integer)
   #     set_flags  => ... (integer)
   #
   ['XDGASetMode',  # 13
    sub {
      shift;  # ($X, $screen_num, $mode_num, $pixmap)
      return pack 'L3', @_;
    },
    sub {
      my ($X, $data) = @_;
      my ($offset, $flags) = unpack 'x8LL', $data;
      my $h = _unpack_info($X, $data, 32);
      return (offset    => $offset,
              set_flags => $flags,
              %$h);
    },
   ],

   # =item C<$X-EXDGASetViewport($screen_num, $x, $y, $flags)>
   #
   # Set the C<$x,$y> position of the top-left corner of the visible part of
   # the video memory.
   #
   # The hardware might support only certain positions, as per
   # C,C fields of C
   # above.  C<$x,$y> will round them to the next step if necessary.
   #
   # C<$flags> (an integer) can be bits
   #
   #     1    Flip Immediate
   #     2    Flip Retrace
   #
   # Flip retrace means to queue the viewport change to occur on the next
   # vertical retrace, so as not to flicker in the middle of the screen.
   #
   [ 'XDGASetViewport',  # 14
     sub {
       shift;  # ($X, $screen, $x, $y, $flags)
       return pack 'LSSL', @_;
     },
   ],

   # =item C<$X-EXDGAInstallColormap($screen_num, $colormap)>
   #
   # Install C<$colormap> in DGA mode.  The core
   # C<$X-EInstallColormap()> cannot be used in DGA mode.
   #
   [ 'XDGAInstallColormap', # 15
     sub {
       shift; # ($X, $screen, $colormap)
       return pack 'SxxL', @_;
     } ],

   # =item C<$X-EXDGASelectInput($screen_num, $event_mask)>
   #
   # Select key, button and mouse motion events while in DGA mode.
   # C<$event_mask> is as per the core C<$X-Epack_event()> with mask
   # bits
   #
   #     KeyPress
   #     KeyRelease
   #     ButtonPress
   #     ButtonRelease
   #     PointerMotion
   #     Button1Motion
   #     Button2Motion
   #     Button3Motion
   #     Button4Motion
   #     Button5Motion
   #     ButtonMotion
   #
   [ 'XDGASelectInput', # 16
     \&_request_card32s ],  # ($X, $screen, $mask)

   # =item C<$X-EXDGAFillRectangle($screen_num, $x,$y, $width,$height, $pixel)>
   #
   # Fill the rectangle C<$x,$y, $width,$height> with pixel value C<$pixel>.
   #
   # This request is supported if the "Solid Fill Rect" bit is set in the
   # mode flags (C above).
   #
   [ 'XDGAFillRectangle', # 17
     sub {
       shift;  # ($X, $screen, $x, $y, $width, $height, $color)
       return pack 'LSSSSL', @_;
     } ],

   # =item C<$X-EXDGACopyArea($screen_num, $src_x,$src_y, $width,$height, $dst_x,$dst_y)>
   #
   # Copy the rectangle C<$src_x,$src_y, $width,$height> to
   # C<$dst_x,$dst_y>.
   #
   # This request is supported if the "Blit Rect" bit is set in the mode
   # flags (C above).
   #
   [ 'XDGACopyArea',  # 18
     sub {
       shift;  # ($X, $screen, $src_x,$src_y, $width,$height, $dst_x,$dst_y)
       return pack 'LS*', @_;  # x,y's are CARD16s, so unsigned
     } ],

   # This request is supported if the "Blit Trans Rect" bit is set in the
   # mode flags (C above).
   #
   [ 'XDGACopyTransparentArea',  # 19
     sub {
       shift;
       # ($X, $screen, $src_x,$src_y, $width,$height, $dst_x,$dst_y, $key)
       return pack 'LS6L', @_;  # x,y's are CARD16s, so unsigned
     } ],

   # =item C<$status = $X-EXDGAGetViewportStatus($screen_num)>
   #
   [ 'XDGAGetViewportStatus',  # 20
     \&_request_card32s, # ($X,$screen_num)
     sub {
       my ($X, $data) = @_;
       return unpack 'x8L', $data;
     } ],

   # =item C<$X-EXDGASync($screen_num)>
   #
   # Block until all server drawing to the video memory is complete, either
   # ordinary X drawing or the Copy and Fill requests above.
   #
   # The server or hardware might queue drawing requests.  C is
   # a round-trip which ensures the video memory contains all drawing
   # requested.
   #
   # If "Concurrent Access" is set in the mode flags (C
   # above) then a client and the server can act on the video concurrently,
   # though care would be needed not to make a mess of each other's drawing.
   #
   # If "Concurrent Access" is not set then the client and server must not
   # act on the video concurrently.  The client must C to ensure
   # the server has finished.
   #
   [ 'XDGASync',  # 21
     \&_request_card32s, # ($X,$screen_num)
     sub {  # ($X, $data)  empty
       return;
     } ],

   # =item C<($device_name, $addr, $size, $offset, $extra) = $X-EXDGAOpenFramebuffer($screen_num)>
   #
   # Get the location of the video RAM memory framebuffer.  The client can
   # use this to open the framebuffer by an C or other means for use
   # when in DGA mode.
   #
   # C<$device_name> (a string) is the name of a device file to access the
   # framebuffer.  If it's an empty string then the framebuffer is in
   # physical memory (so whatever system-dependent device F or
   # F etc).
   #
   # C<$addr> (an integer) is the address within the device or physical
   # memory.  This might be 64-bits on a 64-bit system.  If Perl has only
   # 32-bit UV when the address is 64-bits then C<$addr> is returned as a
   # C.
   #
   # C<$offset> is an offset from C<$addr>.  C<$size> is the size of the
   # framebuffer memory, in bytes, at that C<$addr+$offset> location.
   #
   # C<$extra> is extra information.  It can be a bit
   #
   #     1      client will need root permissions
   #
   [ 'XDGAOpenFramebuffer',  # 22
     \&_request_card32s,
     sub {
       my ($X, $data) = @_;
       ### head: unpack('CCSL', $data)
       ### data: unpack('x8L5', $data)
       ### devname: substr($data,32)

       # (devlen,mem1,mem2,size,offset,extra)
       my ($length, $mem_lo, $mem_hi, @rest) = unpack 'x4L6', $data;

       # "\0" terminated within $length many CARD32s
       (my $devname = substr($data,32,4*$length)) =~ s/\0.*//;

       return ($devname,
               _hilo_to_card64($mem_hi,$mem_lo),
               @rest);
     } ],

   # =item C<$X-EXDGACloseFramebuffer($screen_num)>
   #
   # Tell the server that the client is no longer accessing the framebuffer
   # memory of C above.
   #
   [ 'XDGACloseFramebuffer', # 23
     \&_request_card32s ],

   # =item C<$X-EXDGASetClientVersion($client_major, $client_minor)>
   #
   [ 'XDGASetClientVersion', # 24
     sub {
       shift; # ($X, $client_major, $client_minor)
       return pack 'SS', @_;
     } ],

   # =item C<($x,$y) = $X-EXDGAChangePixmapMode($screen_num, $x,$y, $mode)>
   #
   # Change the position of the C<$pixmap> of C within the
   # video memory.
   #
   # C<$mode> is a XDGAPixmapMode enum,
   #
   #     "Large" (0)    pixmap_width,pixmap_height
   #     "Small" (1)    viewport_width,viewport_height and $x,$y
   #
   # Large mode means the pixmap is as big as possible, the C
   # and C per the mode info.
   #
   # Small mode means the pixmap is only the size of the viewport,
   # C and C per the mode info.  In this
   # case C<$x> and C<$y> are the top-left corner of the pixmap within the
   # full memory.  The position can be different from the visible viewport,
   # but it must be within the C,C limit.
   #
   [ 'XDGAChangePixmapMode',  # 25
     sub {
       my ($X, $screen_num, $x, $y, $mode) = @_;
       return pack 'LSSL',
         $screen_num, $x, $y, $X->interp('XDGAPixmapMode',$mode);
     },
     sub {
       my ($X, $data) = @_;
       return unpack 'x8SS', $data; # (x,y)
     },
   ],

   # =item C<$X-EXDGACreateColormap($screen_num, $colormap, $mode_num, $alloc)>
   #
   # Create C<$colormap> (a new XID) as a colormap for use with DGA
   # C<$screen_num> and C<$mode_num>.
   #
   # This is similar to the core C, but there might not
   # be a core visual corresponding to C<$mode_num> depth etc, hence this
   # separate way to create a colormap.
   #
   # C<$colormap> can be used the same as core protocol colormaps and can
   # be freed with C<$X-EFreeColormap($colormap)>.
   #
   #
   [ 'XDGACreateColormap',  # 26
     sub {
       shift;  # ($X, $screen, $id, $mode, $alloc)
       return pack 'LLLCxxx', @_;
     } ],
  ];

sub new {
  my ($class, $X, $request_num, $event_num, $error_num) = @_;
  ### XF86DGA new() ...

  my $self = bless { }, $class;
  _ext_requests_install ($X, $request_num, $reqs);
  _ext_constants_install ($X, [ $self->constants_list ]);

  my ($server_major, $server_minor) = $X->XF86DGAQueryVersion;
  $self->{'major'} = $server_major;
  $self->{'minor'} = $server_minor;

  _ext_const_error_install ($X, $error_num,
                            'XF86DGAClientNotLocal',        # 0
                            'XF86DGANoDirectVideoMode',     # 1
                            'XF86DGAScreenNotActive',       # 2
                            'XF86DGADirectNotActivated',    # 3
                            ($server_major >= 2
                             ? 'XF86DGAOperationNotSupported' # 4
                             : ()));
  if ($server_major >= 2) {
    _ext_events_install ($X,
                         $event_num+2,  # to start at $event_num+2
                         [ $self->events_list ]);
  }

  return $self;
}

sub _unpack_info {
  my ($X, $data, $pos) = @_;
  my %h;
  @h{qw(byte_order depth
        num bpp name_len
        vsync_num vsync_den flags
        image_width image_height pixmap_width pixmap_height
        bytes_per_scanline red_mask green_mask blue_mask
        visual_class
        viewport_width viewport_height
        viewport_xstep viewport_ystep
        viewport_xmax viewport_ymax
        viewport_flags
      )}
    = unpack 'C2S3L3S4L4SxxS6L', substr($data,$pos,72);
  $pos += 72;
  ### %h

  # name_len a multiple of 4, string \0 nul-terminated
  # within that length
  my $name_len = delete $h{'name_len'};
  ($h{'name'} = substr($data, $pos, $name_len)) =~ s/\0.*//;
  # cf unpack 'Z', new in perl 5.6
  # $h{'name'} = unpack 'Z*', substr($data, $pos, $name_len);
  $pos += $name_len;
  ### $name_len
  ### name: $h{'name'}

  $h{'byte_order'}   = $X->interp('Significance', $h{'byte_order'});
  $h{'visual_class'} = $X->interp('VisualClass',  $h{'visual_class'});

  return \%h;
}

#------------------------------------------------------------------------------
# 64-bits

{
  my $uv = ~0;
  my $bits = 0;
  while ($uv && $bits < 64) {
    $uv >>= 1;
    $bits++;
  }

  if ($bits >= 64) {
     eval "\n#line ".(__LINE__+1)." \"".__FILE__."\"\n" . <<'HERE' or die;
sub _hilo_to_card64 {
  my ($hi,$lo) = @_;
  ### _hilo_to_sv(): "$hi $lo, result ".(($hi << 32) + $lo)
  return ($hi << 32) + $lo;
}
1;
HERE
  } else {
     eval "\n#line ".(__LINE__+1)." \"".__FILE__."\"\n" . <<'HERE' or die;
sub _hilo_to_card64 {
  my ($hi,$lo) = @_;
  if ($hi) {
     require Math::BigInt;
     return Math::BigInt->new($hi)->blsft(32)->badd($lo);
  } else {
     return $lo;
  }
}
1;
HERE
  }
}

#------------------------------------------------------------------------------
# generic

sub _request_card32s {
  shift;
  ### _request_card32s(): @_
  return pack 'L*', @_;
}

sub _request_screen16 {
  shift;  # ($X, $screen)
  @_ == 1 or croak "Single screen number parameter expected";
  return pack 'Sxx', @_;
}

sub _num_none {
  my ($xid) = @_;
  if (defined $xid && $xid eq "None") {
    return 0;
  } else {
    return $xid;
  }
}

sub _request_empty {
  # ($X)
  ### _request_empty() ...
  if (@_ > 1) {
    croak "No parameters in this request";
  }
  return '';
}

sub _ext_requests_install {
  my ($X, $request_num, $reqs) = @_;

  $X->{'ext_request'}->{$request_num} = $reqs;
  my $href = $X->{'ext_request_num'};
  my $i;
  foreach $i (0 .. $#$reqs) {
    if (defined $reqs->[$i]) {
      $href->{$reqs->[$i]->[0]} = [$request_num, $i];
    }
  }
}
sub _ext_const_error_install {
  my $X = shift;  # ($X, $errname1,$errname2,...)
  ### _ext_const_error_install: @_
  my $error_num = shift;
  my $aref = $X->{'ext_const'}{'Error'}  # copy
    = [ @{$X->{'ext_const'}{'Error'} || []} ];
  my $href = $X->{'ext_const_num'}{'Error'}  # copy
    = { %{$X->{'ext_const_num'}{'Error'} || {}} };
  my $i;
  foreach $i (0 .. $#_) {
    $aref->[$error_num + $i] = $_[$i];
    $href->{$_[$i]} = $error_num + $i;
  }
}

1;
__END__