1 /* universal.c 2 * 3 * Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4 * 2005, 2006, by Larry Wall and others 5 * 6 * You may distribute under the terms of either the GNU General Public 7 * License or the Artistic License, as specified in the README file. 8 * 9 */ 10 11 /* 12 * "The roots of those mountains must be roots indeed; there must be 13 * great secrets buried there which have not been discovered since the 14 * beginning." --Gandalf, relating Gollum's story 15 */ 16 17 /* This file contains the code that implements the functions in Perl's 18 * UNIVERSAL package, such as UNIVERSAL->can(). 19 */ 20 21 #include "EXTERN.h" 22 #define PERL_IN_UNIVERSAL_C 23 #include "perl.h" 24 25 #ifdef USE_PERLIO 26 #include "perliol.h" /* For the PERLIO_F_XXX */ 27 #endif 28 29 /* 30 * Contributed by Graham Barr <Graham.Barr@tiuk.ti.com> 31 * The main guts of traverse_isa was actually copied from gv_fetchmeth 32 */ 33 34 STATIC SV * 35 S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash, 36 int len, int level) 37 { 38 AV* av; 39 GV* gv; 40 GV** gvp; 41 HV* hv = Nullhv; 42 SV* subgen = Nullsv; 43 const char *hvname; 44 45 /* A stash/class can go by many names (ie. User == main::User), so 46 we compare the stash itself just in case */ 47 if (name_stash && (stash == name_stash)) 48 return &PL_sv_yes; 49 50 hvname = HvNAME_get(stash); 51 52 if (strEQ(hvname, name)) 53 return &PL_sv_yes; 54 55 if (strEQ(name, "UNIVERSAL")) 56 return &PL_sv_yes; 57 58 if (level > 100) 59 Perl_croak(aTHX_ "Recursive inheritance detected in package '%s'", 60 hvname); 61 62 gvp = (GV**)hv_fetch(stash, "::ISA::CACHE::", 14, FALSE); 63 64 if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (subgen = GvSV(gv)) 65 && (hv = GvHV(gv))) 66 { 67 if (SvIV(subgen) == (IV)PL_sub_generation) { 68 SV* sv; 69 SV** svp = (SV**)hv_fetch(hv, name, len, FALSE); 70 if (svp && (sv = *svp) != (SV*)&PL_sv_undef) { 71 DEBUG_o( Perl_deb(aTHX_ "Using cached ISA %s for package %s\n", 72 name, hvname) ); 73 return sv; 74 } 75 } 76 else { 77 DEBUG_o( Perl_deb(aTHX_ "ISA Cache in package %s is stale\n", 78 hvname) ); 79 hv_clear(hv); 80 sv_setiv(subgen, PL_sub_generation); 81 } 82 } 83 84 gvp = (GV**)hv_fetch(stash,"ISA",3,FALSE); 85 86 if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (av = GvAV(gv))) { 87 if (!hv || !subgen) { 88 gvp = (GV**)hv_fetch(stash, "::ISA::CACHE::", 14, TRUE); 89 90 gv = *gvp; 91 92 if (SvTYPE(gv) != SVt_PVGV) 93 gv_init(gv, stash, "::ISA::CACHE::", 14, TRUE); 94 95 if (!hv) 96 hv = GvHVn(gv); 97 if (!subgen) { 98 subgen = newSViv(PL_sub_generation); 99 GvSV(gv) = subgen; 100 } 101 } 102 if (hv) { 103 SV** svp = AvARRAY(av); 104 /* NOTE: No support for tied ISA */ 105 I32 items = AvFILLp(av) + 1; 106 while (items--) { 107 SV* sv = *svp++; 108 HV* basestash = gv_stashsv(sv, FALSE); 109 if (!basestash) { 110 if (ckWARN(WARN_MISC)) 111 Perl_warner(aTHX_ packWARN(WARN_SYNTAX), 112 "Can't locate package %"SVf" for @%s::ISA", 113 sv, hvname); 114 continue; 115 } 116 if (&PL_sv_yes == isa_lookup(basestash, name, name_stash, 117 len, level + 1)) { 118 (void)hv_store(hv,name,len,&PL_sv_yes,0); 119 return &PL_sv_yes; 120 } 121 } 122 (void)hv_store(hv,name,len,&PL_sv_no,0); 123 } 124 } 125 return &PL_sv_no; 126 } 127 128 /* 129 =head1 SV Manipulation Functions 130 131 =for apidoc sv_derived_from 132 133 Returns a boolean indicating whether the SV is derived from the specified 134 class. This is the function that implements C<UNIVERSAL::isa>. It works 135 for class names as well as for objects. 136 137 =cut 138 */ 139 140 bool 141 Perl_sv_derived_from(pTHX_ SV *sv, const char *name) 142 { 143 const char *type = Nullch; 144 HV *stash = Nullhv; 145 HV *name_stash; 146 147 if (SvGMAGICAL(sv)) 148 mg_get(sv) ; 149 150 if (SvROK(sv)) { 151 sv = SvRV(sv); 152 type = sv_reftype(sv,0); 153 if (SvOBJECT(sv)) 154 stash = SvSTASH(sv); 155 } 156 else { 157 stash = gv_stashsv(sv, FALSE); 158 } 159 160 name_stash = gv_stashpv(name, FALSE); 161 162 return (type && strEQ(type,name)) || 163 (stash && isa_lookup(stash, name, name_stash, strlen(name), 0) 164 == &PL_sv_yes) 165 ? TRUE 166 : FALSE ; 167 } 168 169 #include "XSUB.h" 170 171 PERL_XS_EXPORT_C void XS_UNIVERSAL_isa(pTHX_ CV *cv); 172 PERL_XS_EXPORT_C void XS_UNIVERSAL_can(pTHX_ CV *cv); 173 PERL_XS_EXPORT_C void XS_UNIVERSAL_VERSION(pTHX_ CV *cv); 174 XS(XS_utf8_is_utf8); 175 XS(XS_utf8_valid); 176 XS(XS_utf8_encode); 177 XS(XS_utf8_decode); 178 XS(XS_utf8_upgrade); 179 XS(XS_utf8_downgrade); 180 XS(XS_utf8_unicode_to_native); 181 XS(XS_utf8_native_to_unicode); 182 XS(XS_Internals_SvREADONLY); 183 XS(XS_Internals_SvREFCNT); 184 XS(XS_Internals_hv_clear_placehold); 185 XS(XS_PerlIO_get_layers); 186 XS(XS_Regexp_DESTROY); 187 XS(XS_Internals_hash_seed); 188 XS(XS_Internals_rehash_seed); 189 XS(XS_Internals_HvREHASH); 190 191 void 192 Perl_boot_core_UNIVERSAL(pTHX) 193 { 194 const char file[] = __FILE__; 195 196 newXS("UNIVERSAL::isa", XS_UNIVERSAL_isa, (char *)file); 197 newXS("UNIVERSAL::can", XS_UNIVERSAL_can, (char *)file); 198 newXS("UNIVERSAL::VERSION", XS_UNIVERSAL_VERSION, (char *)file); 199 newXS("utf8::is_utf8", XS_utf8_is_utf8, (char *)file); 200 newXS("utf8::valid", XS_utf8_valid, (char *)file); 201 newXS("utf8::encode", XS_utf8_encode, (char *)file); 202 newXS("utf8::decode", XS_utf8_decode, (char *)file); 203 newXS("utf8::upgrade", XS_utf8_upgrade, (char *)file); 204 newXS("utf8::downgrade", XS_utf8_downgrade, (char *)file); 205 newXS("utf8::native_to_unicode", XS_utf8_native_to_unicode, (char *)file); 206 newXS("utf8::unicode_to_native", XS_utf8_unicode_to_native, (char *)file); 207 newXSproto("Internals::SvREADONLY",XS_Internals_SvREADONLY, (char *)file, "\\[$%@];$"); 208 newXSproto("Internals::SvREFCNT",XS_Internals_SvREFCNT, (char *)file, "\\[$%@];$"); 209 newXSproto("Internals::hv_clear_placeholders", 210 XS_Internals_hv_clear_placehold, (char *)file, "\\%"); 211 newXSproto("PerlIO::get_layers", 212 XS_PerlIO_get_layers, (char *)file, "*;@"); 213 newXS("Regexp::DESTROY", XS_Regexp_DESTROY, (char *)file); 214 newXSproto("Internals::hash_seed",XS_Internals_hash_seed, (char *)file, ""); 215 newXSproto("Internals::rehash_seed",XS_Internals_rehash_seed, (char *)file, ""); 216 newXSproto("Internals::HvREHASH", XS_Internals_HvREHASH, (char *)file, "\\%"); 217 } 218 219 220 XS(XS_UNIVERSAL_isa) 221 { 222 dXSARGS; 223 SV *sv; 224 const char *name; 225 226 if (items != 2) 227 Perl_croak(aTHX_ "Usage: UNIVERSAL::isa(reference, kind)"); 228 229 sv = ST(0); 230 231 if (SvGMAGICAL(sv)) 232 mg_get(sv); 233 234 if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv)) 235 || (SvGMAGICAL(sv) && SvPOKp(sv) && SvCUR(sv)))) 236 XSRETURN_UNDEF; 237 238 name = SvPV_nolen_const(ST(1)); 239 240 ST(0) = boolSV(sv_derived_from(sv, name)); 241 XSRETURN(1); 242 } 243 244 XS(XS_UNIVERSAL_can) 245 { 246 dXSARGS; 247 SV *sv; 248 const char *name; 249 SV *rv; 250 HV *pkg = NULL; 251 252 if (items != 2) 253 Perl_croak(aTHX_ "Usage: UNIVERSAL::can(object-ref, method)"); 254 255 sv = ST(0); 256 257 if (SvGMAGICAL(sv)) 258 mg_get(sv); 259 260 if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv)) 261 || (SvGMAGICAL(sv) && SvPOKp(sv) && SvCUR(sv)))) 262 XSRETURN_UNDEF; 263 264 name = SvPV_nolen_const(ST(1)); 265 rv = &PL_sv_undef; 266 267 if (SvROK(sv)) { 268 sv = (SV*)SvRV(sv); 269 if (SvOBJECT(sv)) 270 pkg = SvSTASH(sv); 271 } 272 else { 273 pkg = gv_stashsv(sv, FALSE); 274 } 275 276 if (pkg) { 277 GV *gv = gv_fetchmethod_autoload(pkg, name, FALSE); 278 if (gv && isGV(gv)) 279 rv = sv_2mortal(newRV((SV*)GvCV(gv))); 280 } 281 282 ST(0) = rv; 283 XSRETURN(1); 284 } 285 286 XS(XS_UNIVERSAL_VERSION) 287 { 288 dXSARGS; 289 HV *pkg; 290 GV **gvp; 291 GV *gv; 292 SV *sv; 293 const char *undef; 294 295 if (SvROK(ST(0))) { 296 sv = (SV*)SvRV(ST(0)); 297 if (!SvOBJECT(sv)) 298 Perl_croak(aTHX_ "Cannot find version of an unblessed reference"); 299 pkg = SvSTASH(sv); 300 } 301 else { 302 pkg = gv_stashsv(ST(0), FALSE); 303 } 304 305 gvp = pkg ? (GV**)hv_fetch(pkg,"VERSION",7,FALSE) : Null(GV**); 306 307 if (gvp && isGV(gv = *gvp) && (sv = GvSV(gv)) && SvOK(sv)) { 308 SV *nsv = sv_newmortal(); 309 sv_setsv(nsv, sv); 310 sv = nsv; 311 undef = Nullch; 312 } 313 else { 314 sv = (SV*)&PL_sv_undef; 315 undef = "(undef)"; 316 } 317 318 if (items > 1) { 319 SV *req = ST(1); 320 321 if (undef) { 322 if (pkg) { 323 const char *name = HvNAME_get(pkg); 324 Perl_croak(aTHX_ 325 "%s does not define $%s::VERSION--version check failed", 326 name, name); 327 } else { 328 Perl_croak(aTHX_ 329 "%s defines neither package nor VERSION--version check failed", 330 SvPVx_nolen_const(ST(0)) ); 331 } 332 } 333 if (!SvNIOK(sv) && SvPOK(sv)) { 334 STRLEN len; 335 char *str = SvPVx(sv,len); 336 while (len) { 337 --len; 338 /* XXX could DWIM "1.2.3" here */ 339 if (!isDIGIT(str[len]) && str[len] != '.' && str[len] != '_') 340 break; 341 } 342 if (len) { 343 if (SvNOK(req) && SvPOK(req)) { 344 /* they said C<use Foo v1.2.3> and $Foo::VERSION 345 * doesn't look like a float: do string compare */ 346 if (sv_cmp(req,sv) == 1) { 347 Perl_croak(aTHX_ "%s v%"VDf" required--" 348 "this is only v%"VDf, 349 HvNAME(pkg), req, sv); 350 } 351 goto finish; 352 } 353 /* they said C<use Foo 1.002_003> and $Foo::VERSION 354 * doesn't look like a float: force numeric compare */ 355 (void)SvUPGRADE(sv, SVt_PVNV); 356 SvNVX(sv) = str_to_version(sv); 357 SvPOK_off(sv); 358 SvNOK_on(sv); 359 } 360 } 361 /* if we get here, we're looking for a numeric comparison, 362 * so force the required version into a float, even if they 363 * said C<use Foo v1.2.3> */ 364 if (SvNOK(req) && SvPOK(req)) { 365 NV n = SvNV(req); 366 req = sv_newmortal(); 367 sv_setnv(req, n); 368 } 369 370 if (SvNV(req) > SvNV(sv)) 371 Perl_croak(aTHX_ "%s version %s required--this is only version %s", 372 HvNAME_get(pkg), SvPV_nolen(req), SvPV_nolen(sv)); 373 } 374 375 finish: 376 ST(0) = sv; 377 378 XSRETURN(1); 379 } 380 381 XS(XS_utf8_is_utf8) 382 { 383 dXSARGS; 384 if (items != 1) 385 Perl_croak(aTHX_ "Usage: utf8::is_utf8(sv)"); 386 { 387 const SV *sv = ST(0); 388 { 389 if (SvUTF8(sv)) 390 XSRETURN_YES; 391 else 392 XSRETURN_NO; 393 } 394 } 395 XSRETURN_EMPTY; 396 } 397 398 XS(XS_utf8_valid) 399 { 400 dXSARGS; 401 if (items != 1) 402 Perl_croak(aTHX_ "Usage: utf8::valid(sv)"); 403 { 404 SV * sv = ST(0); 405 { 406 STRLEN len; 407 const char *s = SvPV_const(sv,len); 408 if (!SvUTF8(sv) || is_utf8_string((U8*)s,len)) 409 XSRETURN_YES; 410 else 411 XSRETURN_NO; 412 } 413 } 414 XSRETURN_EMPTY; 415 } 416 417 XS(XS_utf8_encode) 418 { 419 dXSARGS; 420 if (items != 1) 421 Perl_croak(aTHX_ "Usage: utf8::encode(sv)"); 422 { 423 SV * sv = ST(0); 424 425 sv_utf8_encode(sv); 426 } 427 XSRETURN_EMPTY; 428 } 429 430 XS(XS_utf8_decode) 431 { 432 dXSARGS; 433 if (items != 1) 434 Perl_croak(aTHX_ "Usage: utf8::decode(sv)"); 435 { 436 SV * sv = ST(0); 437 const bool RETVAL = sv_utf8_decode(sv); 438 ST(0) = boolSV(RETVAL); 439 sv_2mortal(ST(0)); 440 } 441 XSRETURN(1); 442 } 443 444 XS(XS_utf8_upgrade) 445 { 446 dXSARGS; 447 if (items != 1) 448 Perl_croak(aTHX_ "Usage: utf8::upgrade(sv)"); 449 { 450 SV * sv = ST(0); 451 STRLEN RETVAL; 452 dXSTARG; 453 454 RETVAL = sv_utf8_upgrade(sv); 455 XSprePUSH; PUSHi((IV)RETVAL); 456 } 457 XSRETURN(1); 458 } 459 460 XS(XS_utf8_downgrade) 461 { 462 dXSARGS; 463 if (items < 1 || items > 2) 464 Perl_croak(aTHX_ "Usage: utf8::downgrade(sv, failok=0)"); 465 { 466 SV * sv = ST(0); 467 const bool failok = (items < 2) ? 0 : (int)SvIV(ST(1)); 468 const bool RETVAL = sv_utf8_downgrade(sv, failok); 469 470 ST(0) = boolSV(RETVAL); 471 sv_2mortal(ST(0)); 472 } 473 XSRETURN(1); 474 } 475 476 XS(XS_utf8_native_to_unicode) 477 { 478 dXSARGS; 479 const UV uv = SvUV(ST(0)); 480 481 if (items > 1) 482 Perl_croak(aTHX_ "Usage: utf8::native_to_unicode(sv)"); 483 484 ST(0) = sv_2mortal(newSViv(NATIVE_TO_UNI(uv))); 485 XSRETURN(1); 486 } 487 488 XS(XS_utf8_unicode_to_native) 489 { 490 dXSARGS; 491 const UV uv = SvUV(ST(0)); 492 493 if (items > 1) 494 Perl_croak(aTHX_ "Usage: utf8::unicode_to_native(sv)"); 495 496 ST(0) = sv_2mortal(newSViv(UNI_TO_NATIVE(uv))); 497 XSRETURN(1); 498 } 499 500 XS(XS_Internals_SvREADONLY) /* This is dangerous stuff. */ 501 { 502 dXSARGS; 503 SV *sv = SvRV(ST(0)); 504 505 if (items == 1) { 506 if (SvREADONLY(sv)) 507 XSRETURN_YES; 508 else 509 XSRETURN_NO; 510 } 511 else if (items == 2) { 512 if (SvTRUE(ST(1))) { 513 SvREADONLY_on(sv); 514 XSRETURN_YES; 515 } 516 else { 517 /* I hope you really know what you are doing. */ 518 SvREADONLY_off(sv); 519 XSRETURN_NO; 520 } 521 } 522 XSRETURN_UNDEF; /* Can't happen. */ 523 } 524 525 XS(XS_Internals_SvREFCNT) /* This is dangerous stuff. */ 526 { 527 dXSARGS; 528 SV *sv = SvRV(ST(0)); 529 530 if (items == 1) 531 XSRETURN_IV(SvREFCNT(sv) - 1); /* Minus the ref created for us. */ 532 else if (items == 2) { 533 /* I hope you really know what you are doing. */ 534 SvREFCNT(sv) = SvIV(ST(1)); 535 XSRETURN_IV(SvREFCNT(sv)); 536 } 537 XSRETURN_UNDEF; /* Can't happen. */ 538 } 539 540 XS(XS_Internals_hv_clear_placehold) 541 { 542 dXSARGS; 543 HV *hv = (HV *) SvRV(ST(0)); 544 545 if (items != 1) 546 Perl_croak(aTHX_ "Usage: UNIVERSAL::hv_clear_placeholders(hv)"); 547 hv_clear_placeholders(hv); 548 XSRETURN(0); 549 } 550 551 XS(XS_Regexp_DESTROY) 552 { 553 PERL_UNUSED_ARG(cv); 554 } 555 556 XS(XS_PerlIO_get_layers) 557 { 558 dXSARGS; 559 if (items < 1 || items % 2 == 0) 560 Perl_croak(aTHX_ "Usage: PerlIO_get_layers(filehandle[,args])"); 561 #ifdef USE_PERLIO 562 { 563 SV * sv; 564 GV * gv; 565 IO * io; 566 bool input = TRUE; 567 bool details = FALSE; 568 569 if (items > 1) { 570 SV **svp; 571 572 for (svp = MARK + 2; svp <= SP; svp += 2) { 573 SV **varp = svp; 574 SV **valp = svp + 1; 575 STRLEN klen; 576 const char *key = SvPV_const(*varp, klen); 577 578 switch (*key) { 579 case 'i': 580 if (klen == 5 && memEQ(key, "input", 5)) { 581 input = SvTRUE(*valp); 582 break; 583 } 584 goto fail; 585 case 'o': 586 if (klen == 6 && memEQ(key, "output", 6)) { 587 input = !SvTRUE(*valp); 588 break; 589 } 590 goto fail; 591 case 'd': 592 if (klen == 7 && memEQ(key, "details", 7)) { 593 details = SvTRUE(*valp); 594 break; 595 } 596 goto fail; 597 default: 598 fail: 599 Perl_croak(aTHX_ 600 "get_layers: unknown argument '%s'", 601 key); 602 } 603 } 604 605 SP -= (items - 1); 606 } 607 608 sv = POPs; 609 gv = (GV*)sv; 610 611 if (!isGV(sv)) { 612 if (SvROK(sv) && isGV(SvRV(sv))) 613 gv = (GV*)SvRV(sv); 614 else if (SvPOKp(sv)) 615 gv = gv_fetchpv(SvPVX(sv), FALSE, SVt_PVIO); 616 } 617 618 if (gv && (io = GvIO(gv))) { 619 dTARGET; 620 AV* av = PerlIO_get_layers(aTHX_ input ? 621 IoIFP(io) : IoOFP(io)); 622 I32 i; 623 I32 last = av_len(av); 624 I32 nitem = 0; 625 626 for (i = last; i >= 0; i -= 3) { 627 SV **namsvp; 628 SV **argsvp; 629 SV **flgsvp; 630 bool namok, argok, flgok; 631 632 namsvp = av_fetch(av, i - 2, FALSE); 633 argsvp = av_fetch(av, i - 1, FALSE); 634 flgsvp = av_fetch(av, i, FALSE); 635 636 namok = namsvp && *namsvp && SvPOK(*namsvp); 637 argok = argsvp && *argsvp && SvPOK(*argsvp); 638 flgok = flgsvp && *flgsvp && SvIOK(*flgsvp); 639 640 if (details) { 641 XPUSHs(namok 642 ? newSVpvn(SvPVX_const(*namsvp), SvCUR(*namsvp)) 643 : &PL_sv_undef); 644 XPUSHs(argok 645 ? newSVpvn(SvPVX_const(*argsvp), SvCUR(*argsvp)) 646 : &PL_sv_undef); 647 if (flgok) 648 XPUSHi(SvIVX(*flgsvp)); 649 else 650 XPUSHs(&PL_sv_undef); 651 nitem += 3; 652 } 653 else { 654 if (namok && argok) 655 XPUSHs(Perl_newSVpvf(aTHX_ "%"SVf"(%"SVf")", 656 *namsvp, *argsvp)); 657 else if (namok) 658 XPUSHs(Perl_newSVpvf(aTHX_ "%"SVf, *namsvp)); 659 else 660 XPUSHs(&PL_sv_undef); 661 nitem++; 662 if (flgok) { 663 IV flags = SvIVX(*flgsvp); 664 665 if (flags & PERLIO_F_UTF8) { 666 XPUSHs(newSVpvn("utf8", 4)); 667 nitem++; 668 } 669 } 670 } 671 } 672 673 SvREFCNT_dec(av); 674 675 XSRETURN(nitem); 676 } 677 } 678 #endif 679 680 XSRETURN(0); 681 } 682 683 XS(XS_Internals_hash_seed) 684 { 685 /* Using dXSARGS would also have dITEM and dSP, 686 * which define 2 unused local variables. */ 687 dAXMARK; 688 PERL_UNUSED_ARG(cv); 689 PERL_UNUSED_VAR(mark); 690 XSRETURN_UV(PERL_HASH_SEED); 691 } 692 693 XS(XS_Internals_rehash_seed) 694 { 695 /* Using dXSARGS would also have dITEM and dSP, 696 * which define 2 unused local variables. */ 697 dAXMARK; 698 PERL_UNUSED_ARG(cv); 699 PERL_UNUSED_VAR(mark); 700 XSRETURN_UV(PL_rehash_seed); 701 } 702 703 XS(XS_Internals_HvREHASH) /* Subject to change */ 704 { 705 dXSARGS; 706 if (SvROK(ST(0))) { 707 const HV *hv = (HV *) SvRV(ST(0)); 708 if (items == 1 && SvTYPE(hv) == SVt_PVHV) { 709 if (HvREHASH(hv)) 710 XSRETURN_YES; 711 else 712 XSRETURN_NO; 713 } 714 } 715 Perl_croak(aTHX_ "Internals::HvREHASH $hashref"); 716 } 717 718 /* 719 * Local variables: 720 * c-indentation-style: bsd 721 * c-basic-offset: 4 722 * indent-tabs-mode: t 723 * End: 724 * 725 * ex: set ts=8 sts=4 sw=4 noet: 726 */ 727