universal.c

   1 /*    universal.c
   2  *
   3  *    Copyright (c) 1997-2003, Larry Wall
   4  *
   5  *    You may distribute under the terms of either the GNU General Public
   6  *    License or the Artistic License, as specified in the README file.
   7  *
   8  */
   9
  10 /*
  11  * "The roots of those mountains must be roots indeed; there must be
  12  * great secrets buried there which have not been discovered since the
  13  * beginning." --Gandalf, relating Gollum's story
  14  */
  15
  16 #include "EXTERN.h"
  17 #define PERL_IN_UNIVERSAL_C
  18 #include "perl.h"
  19
  20 /*
  21  * Contributed by Graham Barr  <Graham.Barr@tiuk.ti.com>
  22  * The main guts of traverse_isa was actually copied from gv_fetchmeth
  23  */
  24
  25 STATIC SV *
  26 S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash,
  27              int len, int level)
  28 {
  29     AV* av;
  30     GV* gv;
  31     GV** gvp;
  32     HV* hv = Nullhv;
  33     SV* subgen = Nullsv;
  34
  35     /* A stash/class can go by many names (ie. User == main::User), so
  36        we compare the stash itself just in case */
  37     if (name_stash && (stash == name_stash))
  38         return &PL_sv_yes;
  39
  40     if (strEQ(HvNAME(stash), name))
  41         return &PL_sv_yes;
  42
  43     if (level > 100)
  44         Perl_croak(aTHX_ "Recursive inheritance detected in package '%s'",
  45                    HvNAME(stash));
  46
  47     gvp = (GV**)hv_fetch(stash, "::ISA::CACHE::", 14, FALSE);
  48
  49     if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (subgen = GvSV(gv))
  50         && (hv = GvHV(gv)))
  51     {
  52         if (SvIV(subgen) == (IV)PL_sub_generation) {
  53             SV* sv;
  54             SV** svp = (SV**)hv_fetch(hv, name, len, FALSE);
  55             if (svp && (sv = *svp) != (SV*)&PL_sv_undef) {
  56                 DEBUG_o( Perl_deb(aTHX_ "Using cached ISA %s for package %s\n",
  57                                   name, HvNAME(stash)) );
  58                 return sv;
  59             }
  60         }
  61         else {
  62             DEBUG_o( Perl_deb(aTHX_ "ISA Cache in package %s is stale\n",
  63                               HvNAME(stash)) );
  64             hv_clear(hv);
  65             sv_setiv(subgen, PL_sub_generation);
  66         }
  67     }
  68
  69     gvp = (GV**)hv_fetch(stash,"ISA",3,FALSE);
  70
  71     if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (av = GvAV(gv))) {
  72         if (!hv || !subgen) {
  73             gvp = (GV**)hv_fetch(stash, "::ISA::CACHE::", 14, TRUE);
  74
  75             gv = *gvp;
  76
  77             if (SvTYPE(gv) != SVt_PVGV)
  78                 gv_init(gv, stash, "::ISA::CACHE::", 14, TRUE);
  79
  80             if (!hv)
  81                 hv = GvHVn(gv);
  82             if (!subgen) {
  83                 subgen = newSViv(PL_sub_generation);
  84                 GvSV(gv) = subgen;
  85             }
  86         }
  87         if (hv) {
  88             SV** svp = AvARRAY(av);
  89             /* NOTE: No support for tied ISA */
  90             I32 items = AvFILLp(av) + 1;
  91             while (items--) {
  92                 SV* sv = *svp++;
  93                 HV* basestash = gv_stashsv(sv, FALSE);
  94                 if (!basestash) {
  95                     if (ckWARN(WARN_MISC))
  96                         Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
  97                              "Can't locate package %"SVf" for @%s::ISA",
  98                             sv, HvNAME(stash));
  99                     continue;
 100                 }
 101                 if (&PL_sv_yes == isa_lookup(basestash, name, name_stash,
 102                                              len, level + 1)) {
 103                     (void)hv_store(hv,name,len,&PL_sv_yes,0);
 104                     return &PL_sv_yes;
 105                 }
 106             }
 107             (void)hv_store(hv,name,len,&PL_sv_no,0);
 108         }
 109     }
 110
 111     return boolSV(strEQ(name, "UNIVERSAL"));
 112 }
 113
 114 /*
 115 =head1 SV Manipulation Functions
 116
 117 =for apidoc sv_derived_from
 118
 119 Returns a boolean indicating whether the SV is derived from the specified
 120 class.  This is the function that implements C<UNIVERSAL::isa>.  It works
 121 for class names as well as for objects.
 122
 123 =cut
 124 */
 125
 126 bool
 127 Perl_sv_derived_from(pTHX_ SV *sv, const char *name)
 128 {
 129     char *type;
 130     HV *stash;
 131     HV *name_stash;
 132
 133     stash = Nullhv;
 134     type = Nullch;
 135
 136     if (SvGMAGICAL(sv))
 137         mg_get(sv) ;
 138
 139     if (SvROK(sv)) {
 140         sv = SvRV(sv);
 141         type = sv_reftype(sv,0);
 142         if (SvOBJECT(sv))
 143             stash = SvSTASH(sv);
 144     }
 145     else {
 146         stash = gv_stashsv(sv, FALSE);
 147     }
 148
 149     name_stash = gv_stashpv(name, FALSE);
 150
 151     return (type && strEQ(type,name)) ||
 152             (stash && isa_lookup(stash, name, name_stash, strlen(name), 0)
 153              == &PL_sv_yes)
 154         ? TRUE
 155         : FALSE ;
 156 }
 157
 158 #include "XSUB.h"
 159
 160 void XS_UNIVERSAL_isa(pTHX_ CV *cv);
 161 void XS_UNIVERSAL_can(pTHX_ CV *cv);
 162 void XS_UNIVERSAL_VERSION(pTHX_ CV *cv);
 163 XS(XS_version_new);
 164 XS(XS_version_stringify);
 165 XS(XS_version_numify);
 166 XS(XS_version_vcmp);
 167 XS(XS_version_boolean);
 168 XS(XS_version_noop);
 169 XS(XS_utf8_valid);
 170 XS(XS_utf8_encode);
 171 XS(XS_utf8_decode);
 172 XS(XS_utf8_upgrade);
 173 XS(XS_utf8_downgrade);
 174 XS(XS_utf8_unicode_to_native);
 175 XS(XS_utf8_native_to_unicode);
 176 XS(XS_Internals_SvREADONLY);
 177 XS(XS_Internals_SvREFCNT);
 178 XS(XS_Internals_hv_clear_placehold);
 179
 180 void
 181 Perl_boot_core_UNIVERSAL(pTHX)
 182 {
 183     char *file = __FILE__;
 184
 185     newXS("UNIVERSAL::isa",             XS_UNIVERSAL_isa,         file);
 186     newXS("UNIVERSAL::can",             XS_UNIVERSAL_can,         file);
 187     newXS("UNIVERSAL::VERSION",         XS_UNIVERSAL_VERSION,     file);
 188     {
 189         /* register the overloading (type 'A') magic */
 190         PL_amagic_generation++;
 191         /* Make it findable via fetchmethod */
 192         newXS("version::()", XS_version_noop, file);
 193         newXS("version::new", XS_version_new, file);
 194         newXS("version::(\"\"", XS_version_stringify, file);
 195         newXS("version::stringify", XS_version_stringify, file);
 196         newXS("version::(0+", XS_version_numify, file);
 197         newXS("version::numify", XS_version_numify, file);
 198         newXS("version::(cmp", XS_version_vcmp, file);
 199         newXS("version::(<=>", XS_version_vcmp, file);
 200         newXS("version::vcmp", XS_version_vcmp, file);
 201         newXS("version::(bool", XS_version_boolean, file);
 202         newXS("version::boolean", XS_version_boolean, file);
 203         newXS("version::(nomethod", XS_version_noop, file);
 204         newXS("version::noop", XS_version_noop, file);
 205     }
 206     newXS("utf8::valid", XS_utf8_valid, file);
 207     newXS("utf8::encode", XS_utf8_encode, file);
 208     newXS("utf8::decode", XS_utf8_decode, file);
 209     newXS("utf8::upgrade", XS_utf8_upgrade, file);
 210     newXS("utf8::downgrade", XS_utf8_downgrade, file);
 211     newXS("utf8::native_to_unicode", XS_utf8_native_to_unicode, file);
 212     newXS("utf8::unicode_to_native", XS_utf8_unicode_to_native, file);
 213     newXSproto("Internals::SvREADONLY",XS_Internals_SvREADONLY, file, "\\[$%@];$");
 214     newXSproto("Internals::SvREFCNT",XS_Internals_SvREFCNT, file, "\\[$%@];$");
 215     newXSproto("Internals::hv_clear_placeholders",
 216                XS_Internals_hv_clear_placehold, file, "\\%");
 217 }
 218
 219
 220 XS(XS_UNIVERSAL_isa)
 221 {
 222     dXSARGS;
 223     SV *sv;
 224     char *name;
 225     STRLEN n_a;
 226
 227     if (items != 2)
 228         Perl_croak(aTHX_ "Usage: UNIVERSAL::isa(reference, kind)");
 229
 230     sv = ST(0);
 231
 232     if (SvGMAGICAL(sv))
 233         mg_get(sv);
 234
 235     if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv))
 236                 || (SvGMAGICAL(sv) && SvPOKp(sv) && SvCUR(sv))))
 237         XSRETURN_UNDEF;
 238
 239     name = (char *)SvPV(ST(1),n_a);
 240
 241     ST(0) = boolSV(sv_derived_from(sv, name));
 242     XSRETURN(1);
 243 }
 244
 245 XS(XS_UNIVERSAL_can)
 246 {
 247     dXSARGS;
 248     SV   *sv;
 249     char *name;
 250     SV   *rv;
 251     HV   *pkg = NULL;
 252     STRLEN n_a;
 253
 254     if (items != 2)
 255         Perl_croak(aTHX_ "Usage: UNIVERSAL::can(object-ref, method)");
 256
 257     sv = ST(0);
 258
 259     if (SvGMAGICAL(sv))
 260         mg_get(sv);
 261
 262     if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv))
 263                 || (SvGMAGICAL(sv) && SvPOKp(sv) && SvCUR(sv))))
 264         XSRETURN_UNDEF;
 265
 266     name = (char *)SvPV(ST(1),n_a);
 267     rv = &PL_sv_undef;
 268
 269     if (SvROK(sv)) {
 270         sv = (SV*)SvRV(sv);
 271         if (SvOBJECT(sv))
 272             pkg = SvSTASH(sv);
 273     }
 274     else {
 275         pkg = gv_stashsv(sv, FALSE);
 276     }
 277
 278     if (pkg) {
 279         GV *gv = gv_fetchmethod_autoload(pkg, name, FALSE);
 280         if (gv && isGV(gv))
 281             rv = sv_2mortal(newRV((SV*)GvCV(gv)));
 282     }
 283
 284     ST(0) = rv;
 285     XSRETURN(1);
 286 }
 287
 288 XS(XS_UNIVERSAL_VERSION)
 289 {
 290     dXSARGS;
 291     HV *pkg;
 292     GV **gvp;
 293     GV *gv;
 294     SV *sv;
 295     char *undef;
 296
 297     if (SvROK(ST(0))) {
 298         sv = (SV*)SvRV(ST(0));
 299         if (!SvOBJECT(sv))
 300             Perl_croak(aTHX_ "Cannot find version of an unblessed reference");
 301         pkg = SvSTASH(sv);
 302     }
 303     else {
 304         pkg = gv_stashsv(ST(0), FALSE);
 305     }
 306
 307     gvp = pkg ? (GV**)hv_fetch(pkg,"VERSION",7,FALSE) : Null(GV**);
 308
 309     if (gvp && isGV(gv = *gvp) && SvOK(sv = GvSV(gv))) {
 310         SV *nsv = sv_newmortal();
 311         sv_setsv(nsv, sv);
 312         sv = nsv;
 313         undef = Nullch;
 314     }
 315     else {
 316         sv = (SV*)&PL_sv_undef;
 317         undef = "(undef)";
 318     }
 319
 320     if (items > 1) {
 321         STRLEN len;
 322         SV *req = ST(1);
 323
 324         if (undef) {
 325              if (pkg)
 326                   Perl_croak(aTHX_
 327                              "%s does not define $%s::VERSION--version check failed",
 328                              HvNAME(pkg), HvNAME(pkg));
 329              else {
 330                   char *str = SvPVx(ST(0), len);
 331
 332                   Perl_croak(aTHX_
 333                              "%s defines neither package nor VERSION--version check failed", str);
 334              }
 335         }
 336         if ( !sv_derived_from(sv, "version"))
 337             sv = new_version(sv);
 338
 339         if ( !sv_derived_from(req, "version"))
 340             req = new_version(req);
 341
 342         if ( vcmp( SvRV(req), SvRV(sv) ) > 0 )
 343             Perl_croak(aTHX_
 344                 "%s version %"SVf" required--this is only version %"SVf,
 345                 HvNAME(pkg), req, sv);
 346     }
 347
 348     ST(0) = sv;
 349
 350     XSRETURN(1);
 351 }
 352
 353 XS(XS_version_new)
 354 {
 355     dXSARGS;
 356     if (items > 3)
 357         Perl_croak(aTHX_ "Usage: version::new(class, version)");
 358     SP -= items;
 359     {
 360 /*      char *  class = (char *)SvPV_nolen(ST(0)); */
 361         SV *version = ST(1);
 362         if (items == 3 )
 363         {
 364             char *vs = savepvn(SvPVX(ST(2)),SvCUR(ST(2)));
 365             version = Perl_newSVpvf(aTHX_ "v%s",vs);
 366         }
 367
 368         PUSHs(new_version(version));
 369         PUTBACK;
 370         return;
 371     }
 372 }
 373
 374 XS(XS_version_stringify)
 375 {
 376     dXSARGS;
 377     if (items < 1)
 378         Perl_croak(aTHX_ "Usage: version::stringify(lobj, ...)");
 379     SP -= items;
 380     {
 381         SV *    lobj;
 382
 383         if (sv_derived_from(ST(0), "version")) {
 384                 SV *tmp = SvRV(ST(0));
 385                 lobj = tmp;
 386         }
 387         else
 388                 Perl_croak(aTHX_ "lobj is not of type version");
 389
 390 {
 391     PUSHs(vstringify(lobj));
 392 }
 393
 394         PUTBACK;
 395         return;
 396     }
 397 }
 398
 399 XS(XS_version_numify)
 400 {
 401     dXSARGS;
 402     if (items < 1)
 403         Perl_croak(aTHX_ "Usage: version::numify(lobj, ...)");
 404     SP -= items;
 405     {
 406         SV *    lobj;
 407
 408         if (sv_derived_from(ST(0), "version")) {
 409                 SV *tmp = SvRV(ST(0));
 410                 lobj = tmp;
 411         }
 412         else
 413                 Perl_croak(aTHX_ "lobj is not of type version");
 414
 415 {
 416     PUSHs(vnumify(lobj));
 417 }
 418
 419         PUTBACK;
 420         return;
 421     }
 422 }
 423
 424 XS(XS_version_vcmp)
 425 {
 426     dXSARGS;
 427     if (items < 1)
 428         Perl_croak(aTHX_ "Usage: version::vcmp(lobj, ...)");
 429     SP -= items;
 430     {
 431         SV *    lobj;
 432
 433         if (sv_derived_from(ST(0), "version")) {
 434                 SV *tmp = SvRV(ST(0));
 435                 lobj = tmp;
 436         }
 437         else
 438                 Perl_croak(aTHX_ "lobj is not of type version");
 439
 440 {
 441     SV  *rs;
 442     SV  *rvs;
 443     SV * robj = ST(1);
 444     IV   swap = (IV)SvIV(ST(2));
 445
 446     if ( ! sv_derived_from(robj, "version") )
 447     {
 448         robj = new_version(robj);
 449     }
 450     rvs = SvRV(robj);
 451
 452     if ( swap )
 453     {
 454         rs = newSViv(vcmp(rvs,lobj));
 455     }
 456     else
 457     {
 458         rs = newSViv(vcmp(lobj,rvs));
 459     }
 460
 461     PUSHs(rs);
 462 }
 463
 464         PUTBACK;
 465         return;
 466     }
 467 }
 468
 469 XS(XS_version_boolean)
 470 {
 471     dXSARGS;
 472     if (items < 1)
 473         Perl_croak(aTHX_ "Usage: version::boolean(lobj, ...)");
 474     SP -= items;
 475     {
 476         SV *    lobj;
 477
 478         if (sv_derived_from(ST(0), "version")) {
 479                 SV *tmp = SvRV(ST(0));
 480                 lobj = tmp;
 481         }
 482         else
 483                 Perl_croak(aTHX_ "lobj is not of type version");
 484
 485 {
 486     SV  *rs;
 487     rs = newSViv( vcmp(lobj,new_version(newSVpvn("0",1))) );
 488     PUSHs(rs);
 489 }
 490
 491         PUTBACK;
 492         return;
 493     }
 494 }
 495
 496 XS(XS_version_noop)
 497 {
 498     dXSARGS;
 499     if (items < 1)
 500         Perl_croak(aTHX_ "Usage: version::noop(lobj, ...)");
 501     {
 502         SV *    lobj;
 503
 504         if (sv_derived_from(ST(0), "version")) {
 505                 SV *tmp = SvRV(ST(0));
 506                 lobj = tmp;
 507         }
 508         else
 509                 Perl_croak(aTHX_ "lobj is not of type version");
 510
 511 {
 512     Perl_croak(aTHX_ "operation not supported with version object");
 513 }
 514
 515     }
 516     XSRETURN_EMPTY;
 517 }
 518
 519 XS(XS_utf8_valid)
 520 {
 521     dXSARGS;
 522     if (items != 1)
 523         Perl_croak(aTHX_ "Usage: utf8::valid(sv)");
 524     {
 525         SV *    sv = ST(0);
 526  {
 527   STRLEN len;
 528   char *s = SvPV(sv,len);
 529   if (!SvUTF8(sv) || is_utf8_string((U8*)s,len))
 530    XSRETURN_YES;
 531   else
 532    XSRETURN_NO;
 533  }
 534     }
 535     XSRETURN_EMPTY;
 536 }
 537
 538 XS(XS_utf8_encode)
 539 {
 540     dXSARGS;
 541     if (items != 1)
 542         Perl_croak(aTHX_ "Usage: utf8::encode(sv)");
 543     {
 544         SV *    sv = ST(0);
 545
 546         sv_utf8_encode(sv);
 547     }
 548     XSRETURN_EMPTY;
 549 }
 550
 551 XS(XS_utf8_decode)
 552 {
 553     dXSARGS;
 554     if (items != 1)
 555         Perl_croak(aTHX_ "Usage: utf8::decode(sv)");
 556     {
 557         SV *    sv = ST(0);
 558         bool    RETVAL;
 559
 560         RETVAL = sv_utf8_decode(sv);
 561         ST(0) = boolSV(RETVAL);
 562         sv_2mortal(ST(0));
 563     }
 564     XSRETURN(1);
 565 }
 566
 567 XS(XS_utf8_upgrade)
 568 {
 569     dXSARGS;
 570     if (items != 1)
 571         Perl_croak(aTHX_ "Usage: utf8::upgrade(sv)");
 572     {
 573         SV *    sv = ST(0);
 574         STRLEN  RETVAL;
 575         dXSTARG;
 576
 577         RETVAL = sv_utf8_upgrade(sv);
 578         XSprePUSH; PUSHi((IV)RETVAL);
 579     }
 580     XSRETURN(1);
 581 }
 582
 583 XS(XS_utf8_downgrade)
 584 {
 585     dXSARGS;
 586     if (items < 1 || items > 2)
 587         Perl_croak(aTHX_ "Usage: utf8::downgrade(sv, failok=0)");
 588     {
 589         SV *    sv = ST(0);
 590         bool    failok;
 591         bool    RETVAL;
 592
 593         if (items < 2)
 594             failok = 0;
 595         else {
 596             failok = (int)SvIV(ST(1));
 597         }
 598
 599         RETVAL = sv_utf8_downgrade(sv, failok);
 600         ST(0) = boolSV(RETVAL);
 601         sv_2mortal(ST(0));
 602     }
 603     XSRETURN(1);
 604 }
 605
 606 XS(XS_utf8_native_to_unicode)
 607 {
 608  dXSARGS;
 609  UV uv = SvUV(ST(0));
 610
 611  if (items > 1)
 612      Perl_croak(aTHX_ "Usage: utf8::native_to_unicode(sv)");
 613
 614  ST(0) = sv_2mortal(newSViv(NATIVE_TO_UNI(uv)));
 615  XSRETURN(1);
 616 }
 617
 618 XS(XS_utf8_unicode_to_native)
 619 {
 620  dXSARGS;
 621  UV uv = SvUV(ST(0));
 622
 623  if (items > 1)
 624      Perl_croak(aTHX_ "Usage: utf8::unicode_to_native(sv)");
 625
 626  ST(0) = sv_2mortal(newSViv(UNI_TO_NATIVE(uv)));
 627  XSRETURN(1);
 628 }
 629
 630 XS(XS_Internals_SvREADONLY)     /* This is dangerous stuff. */
 631 {
 632     dXSARGS;
 633     SV *sv = SvRV(ST(0));
 634     if (items == 1) {
 635          if (SvREADONLY(sv))
 636              XSRETURN_YES;
 637          else
 638              XSRETURN_NO;
 639     }
 640     else if (items == 2) {
 641         if (SvTRUE(ST(1))) {
 642             SvREADONLY_on(sv);
 643             XSRETURN_YES;
 644         }
 645         else {
 646             /* I hope you really know what you are doing. */
 647             SvREADONLY_off(sv);
 648             XSRETURN_NO;
 649         }
 650     }
 651     XSRETURN_UNDEF; /* Can't happen. */
 652 }
 653
 654 XS(XS_Internals_SvREFCNT)       /* This is dangerous stuff. */
 655 {
 656     dXSARGS;
 657     SV *sv = SvRV(ST(0));
 658     if (items == 1)
 659          XSRETURN_IV(SvREFCNT(sv) - 1); /* Minus the ref created for us. */
 660     else if (items == 2) {
 661          /* I hope you really know what you are doing. */
 662          SvREFCNT(sv) = SvIV(ST(1));
 663          XSRETURN_IV(SvREFCNT(sv));
 664     }
 665     XSRETURN_UNDEF; /* Can't happen. */
 666 }
 667
 668 /* Maybe this should return the number of placeholders found in scalar context,
 669    and a list of them in list context.  */
 670 XS(XS_Internals_hv_clear_placehold)
 671 {
 672     dXSARGS;
 673     HV *hv = (HV *) SvRV(ST(0));
 674
 675     /* I don't care how many parameters were passed in, but I want to avoid
 676        the unused variable warning. */
 677
 678     items = (I32)HvPLACEHOLDERS(hv);
 679
 680     if (items) {
 681         HE *entry;
 682         I32 riter = HvRITER(hv);
 683         HE *eiter = HvEITER(hv);
 684         hv_iterinit(hv);
 685         /* This may look suboptimal with the items *after* the iternext, but
 686            it's quite deliberate. We only get here with items==0 if we've
 687            just deleted the last placeholder in the hash. If we've just done
 688            that then it means that the hash is in lazy delete mode, and the
 689            HE is now only referenced in our iterator. If we just quit the loop
 690            and discarded our iterator then the HE leaks. So we do the && the
 691            other way to ensure iternext is called just one more time, which
 692            has the side effect of triggering the lazy delete.  */
 693         while ((entry = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))
 694             && items) {
 695             SV *val = hv_iterval(hv, entry);
 696
 697             if (val == &PL_sv_undef) {
 698
 699                 /* It seems that I have to go back in the front of the hash
 700                    API to delete a hash, even though I have a HE structure
 701                    pointing to the very entry I want to delete, and could hold
 702                    onto the previous HE that points to it. And it's easier to
 703                    go in with SVs as I can then specify the precomputed hash,
 704                    and don't have fun and games with utf8 keys.  */
 705                 SV *key = hv_iterkeysv(entry);
 706
 707                 hv_delete_ent (hv, key, G_DISCARD, HeHASH(entry));
 708                 items--;
 709             }
 710         }
 711         HvRITER(hv) = riter;
 712         HvEITER(hv) = eiter;
 713     }
 714
 715     XSRETURN(0);
 716 }