1 /*
   2  * Copyright (c) 2002, Oracle and/or its affiliates. All rights reserved.
   3  */
   4 
   5 /*
   6  * Catalog.xs contains XS code for exacct catalog tag manipulation.  This
   7  * consists of code to create the @_Constants array and %_Constants hash used
   8  * for defining constants on the fly via AUTOLOAD, and utility functions for
   9  * creaing double-typed SVs.
  10  */
  11 
  12 #include "../exacct_common.xh"
  13 
  14 /* Pull in the file generated by extract_defines. */
  15 #include "CatalogDefs.xi"
  16 
  17 /*
  18  * This function populates the %_Constants hash and @_Constants array based on
  19  * the values extracted from the exacct header files by the extract_defines
  20  * script and written to the .xi file which is included above.  It also creates
  21  * a const sub for each constant that returns the associcated value.  It should
  22  * be called from the BOOT section of this module.  The structure of the
  23  * %_Constants hash is given below - this is used to map between the symbolic
  24  * and numeric values of the various EX[CTD] constants.  The register() method
  25  * extends the %_Constants hash with values for the foreign catalog, so that it
  26  * can be handled in exactly the same way as the built-in catalog.
  27  *
  28  * $Constants{catlg}{name}{EXC_DEFAULT} => 0
  29  *                  ...
  30  *                  {value}{0} => 'EXC_DEFAULT'
  31  *                  ...
  32  *                           *A*
  33  *           {id}{name}{EXD}{name}{EXD_CREATOR} => 3
  34  *                          ...
  35  *                          {value}{3} => 'EXD_CREATOR'
  36  *                          ...
  37  *               {value}{0} => *A*
  38  *               ...
  39  *           {other}{name}{EXC_CATALOG_MASK} => 251658240
  40  *                  ...
  41  *                  {value}{251658240} => 'EXC_CATALOG_MASK'
  42  *                  ...
  43  *           {type}{name}{EXT_DOUBLE} => 1342177280
  44  *                 ...
  45  *                 {value}{1342177280} => 'EXT_DOUBLE'
  46  *                 ...
  47  */
  48 #define CONST_NAME "::Catalog::_Constants"
  49 static void
  50 define_catalog_constants()
  51 {
  52         HV              *const_hash, *hv1, *hv2, *hv3;
  53         AV              *const_ary;
  54         HV              *type_by_name,  *type_by_value;
  55         HV              *catlg_by_name, *catlg_by_value;
  56         HV              *id_by_name,    *id_by_value;
  57         HV              *other_by_name, *other_by_value;
  58         constval_t      *cvp;
  59 
  60         /* Create the two new perl variables. */
  61         const_hash = perl_get_hv(PKGBASE CONST_NAME, TRUE);
  62         const_ary = perl_get_av(PKGBASE CONST_NAME, TRUE);
  63 
  64         /* Create the 'type' subhash. */
  65         type_by_name = newHV();
  66         type_by_value = newHV();
  67         hv1 = newHV();
  68         hv_store(const_hash, "type", 4, newRV_noinc((SV*)hv1), 0);
  69         hv_store(hv1, "name", 4, newRV_noinc((SV*)type_by_name), 0);
  70         hv_store(hv1, "value", 5, newRV_noinc((SV*)type_by_value), 0);
  71 
  72         /* Create the 'catlg' subhash. */
  73         catlg_by_name = newHV();
  74         catlg_by_value = newHV();
  75         hv1 = newHV();
  76         hv_store(const_hash, "catlg", 5, newRV_noinc((SV*)hv1), 0);
  77         hv_store(hv1, "name", 4, newRV_noinc((SV*)catlg_by_name), 0);
  78         hv_store(hv1, "value", 5, newRV_noinc((SV*)catlg_by_value), 0);
  79 
  80         /*
  81          * The 'id' subhash has an extra level of name/value subhashes,
  82          * where the upper level is indexed by the catalog prefix (EXD for
  83          * the default catalog).  The lower two levels are actually the same
  84          * hashes referenced by two parents, and hold the catalog id numeric
  85          * values and corresponding string values.
  86          */
  87         id_by_name = newHV();
  88         id_by_value = newHV();
  89         hv1 = newHV();
  90         hv_store(const_hash, "id", 2, newRV_noinc((SV*)hv1), 0);
  91         hv2 = newHV();
  92         hv_store(hv1, "name", 4, newRV_noinc((SV*)hv2), 0);
  93         hv3 = newHV();
  94         hv_store(hv2, "EXD", 3, newRV_noinc((SV*)hv3), 0);
  95         hv_store(hv3, "name", 4, newRV_noinc((SV*)id_by_name), 0);
  96         hv_store(hv3, "value", 5, newRV_noinc((SV*)id_by_value), 0);
  97         IdValueHash = newHV();
  98         hv_store(hv1, "value", 5, newRV_noinc((SV*)IdValueHash), 0);
  99         hv_store_ent(IdValueHash, newSVuv(EXC_DEFAULT), newRV_inc((SV*)hv3), 0);
 100 
 101         /* Create the 'other' subhash, for non-catalog #defines. */
 102         other_by_name = newHV();
 103         other_by_value = newHV();
 104         hv1 = newHV();
 105         hv_store(const_hash, "other", 5, newRV_noinc((SV*)hv1), 0);
 106         hv_store(hv1, "name", 4, newRV_noinc((SV*)other_by_name), 0);
 107         hv_store(hv1, "value", 5, newRV_noinc((SV*)other_by_value), 0);
 108 
 109         /*
 110          * Populate %_Constants and %_Constants from the contents of the
 111          * generated constants array.
 112          */
 113         for (cvp = constants; cvp->name != NULL; cvp++) {
 114                 HV      *name_hv, *value_hv;
 115                 SV      *name, *value;
 116 
 117                 /* Create the name/value SVs, save the name in @_Constants. */
 118                 name = newSVpvn((char *)cvp->name, cvp->len);
 119                 value = newSVuv(cvp->value);
 120                 av_push(const_ary, SvREFCNT_inc(name));
 121 
 122                 /*
 123                  * Decide which hash the name/value belong in,
 124                  * based on consttype .
 125                  */
 126                 switch (cvp->consttype) {
 127                 case type:
 128                         name_hv  = type_by_name;
 129                         value_hv = type_by_value;
 130                         break;
 131                 case catlg:
 132                         name_hv = catlg_by_name;
 133                         /* Special case for duplicated-value EXC_NONE tag. */
 134                         if (cvp->value == EXC_NONE &&
 135                             strcmp(cvp->name, "EXC_NONE") == 0) {
 136                                 value_hv = NULL;
 137                         } else {
 138                                 value_hv = catlg_by_value;
 139                         }
 140                         break;
 141                 case id:
 142                         name_hv  = id_by_name;
 143                         value_hv = id_by_value;
 144                         break;
 145                 case other:
 146                         name_hv  = other_by_name;
 147                         value_hv = other_by_value;
 148                         break;
 149                 }
 150 
 151                 /* Store in the appropriate name & value hashes. */
 152                 if (name_hv) {
 153                         hv_store_ent(name_hv, name, value, 0);
 154                 }
 155                 if (value_hv) {
 156                         hv_store_ent(value_hv, value, name, 0);
 157                 }
 158 
 159                 /* Free the name and/or value if they weren't used. */
 160                 if (! name_hv) {
 161                         SvREFCNT_dec(value);
 162                 }
 163                 if (! value_hv) {
 164                         SvREFCNT_dec(name);
 165                 }
 166         }
 167 }
 168 #undef CONST_NAME
 169 
 170 /*
 171  * The XS code exported to perl is below here.  Note that the XS preprocessor
 172  * has its own commenting syntax, so all comments from this point on are in
 173  * that form.
 174  *
 175  * All the following are private functions.
 176  */
 177 
 178 MODULE = Sun::Solaris::Exacct::Catalog PACKAGE = Sun::Solaris::Exacct::Catalog
 179 PROTOTYPES: ENABLE
 180 
 181  #
 182  # Define the stash pointers if required and create and populate @_Constants.
 183  #
 184 BOOT:
 185         init_stashes();
 186         define_catalog_constants();
 187 
 188  #
 189  # Create and return a double-typed SV.
 190  #
 191 SV*
 192 _double_type(i, c)
 193         unsigned int    i;
 194         char            *c;
 195 CODE:
 196         RETVAL = newSVuv(i);
 197         sv_setpv(RETVAL, c);
 198         SvIOK_on(RETVAL);
 199 OUTPUT:
 200         RETVAL
 201 
 202  #
 203  # Return true if the SV contains an IV.
 204  #
 205 int
 206 _is_iv(sv)
 207         SV      *sv;
 208 CODE:
 209         RETVAL = SvIOK(sv);
 210 OUTPUT:
 211         RETVAL
 212 
 213  #
 214  # Return true if the SV contains a PV.
 215  #
 216 int
 217 _is_pv(sv)
 218         SV      *sv;
 219 CODE:
 220         RETVAL = SvPOK(sv);
 221 OUTPUT:
 222         RETVAL
 223 
 224  #
 225  # Return a blessed reference to a readonly copy of the passed IV
 226  #
 227 SV*
 228 _new_catalog(sv)
 229         SV      *sv;
 230 CODE:
 231         RETVAL = new_catalog(SvUV(sv));
 232 OUTPUT:
 233         RETVAL
 234 
 235  #
 236  # Return the integer catalog value from the passed object or SV.
 237  #
 238 int
 239 _catalog_value(sv)
 240         SV      *sv;
 241 CODE:
 242         RETVAL = catalog_value(sv);
 243 OUTPUT:
 244         RETVAL