3 * Copyright (C) 2021 by Paul Evans and others
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.
10 /* This file contains the code that implements functions in perl's "builtin::"
19 struct BuiltinFuncDescriptor {
22 OP *(*checker)(pTHX_ OP *, GV *, SV *);
26 #define warn_experimental_builtin(name, prefix) S_warn_experimental_builtin(aTHX_ name, prefix)
27 static void S_warn_experimental_builtin(pTHX_ const char *name, bool prefix)
29 /* diag_listed_as: Built-in function '%s' is experimental */
30 Perl_ck_warner_d(aTHX_ packWARN(WARN_EXPERIMENTAL__BUILTIN),
31 "Built-in function '%s%s' is experimental",
32 prefix ? "builtin::" : "", name);
39 warn_experimental_builtin("true", true);
41 croak_xs_usage(cv, "");
49 warn_experimental_builtin("false", true);
51 croak_xs_usage(cv, "");
60 static OP *ck_builtin_const(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
62 const struct BuiltinFuncDescriptor *builtin = NUM2PTR(const struct BuiltinFuncDescriptor *, SvUV(ckobj));
64 warn_experimental_builtin(builtin->name, false);
66 SV *prototype = newSVpvs("");
67 SAVEFREESV(prototype);
69 assert(entersubop->op_type == OP_ENTERSUB);
71 entersubop = ck_entersub_args_proto(entersubop, namegv, prototype);
74 switch(builtin->ckval) {
75 case BUILTIN_CONST_FALSE: constval = &PL_sv_no; break;
76 case BUILTIN_CONST_TRUE: constval = &PL_sv_yes; break;
78 DIE(aTHX_ "panic: unrecognised builtin_const value %" IVdf,
85 return newSVOP(OP_CONST, 0, constval);
88 XS(XS_builtin_func1_scalar);
89 XS(XS_builtin_func1_scalar)
94 warn_experimental_builtin(PL_op_name[ix], true);
97 croak_xs_usage(cv, "arg");
101 Perl_pp_is_bool(aTHX);
105 Perl_pp_is_weak(aTHX);
109 Perl_pp_blessed(aTHX);
113 Perl_pp_refaddr(aTHX);
117 Perl_pp_reftype(aTHX);
129 Perl_die(aTHX_ "panic: unhandled opcode %" IVdf
130 " for xs_builtin_func1_scalar()", (IV) ix);
141 warn_experimental_builtin("trim", true);
144 croak_xs_usage(cv, "arg");
156 start = (const U8*)SvPV_nomg_const(source, len);
158 if (ckWARN(WARN_UNINITIALIZED))
159 report_uninit(source);
160 start = (const U8*)"";
164 if (DO_UTF8(source)) {
165 const U8 *end = start + len;
167 /* Find the first non-space */
170 if (!isSPACE_utf8_safe(start, end))
172 start += (thislen = UTF8SKIP(start));
176 /* Find the final non-space */
178 const U8 *cur_end = end;
179 while ((thislen = is_SPACE_utf8_safe_backwards(cur_end, start))) {
182 len -= (end - cur_end);
186 if (!isSPACE_L1(*start))
193 if (!isSPACE_L1(start[len-1]))
201 if (SvPOK(dest) && (dest == source)) {
202 sv_chop(dest, (const char *)start);
203 SvCUR_set(dest, len);
206 SvUPGRADE(dest, SVt_PV);
207 SvGROW(dest, len + 1);
209 Copy(start, SvPVX(dest), len, U8);
210 SvPVX(dest)[len] = '\0';
212 SvCUR_set(dest, len);
219 if (SvTAINTED(source))
230 XS(XS_builtin_func1_void);
231 XS(XS_builtin_func1_void)
236 warn_experimental_builtin(PL_op_name[ix], true);
239 croak_xs_usage(cv, "arg");
243 Perl_pp_weaken(aTHX);
247 Perl_pp_unweaken(aTHX);
251 Perl_die(aTHX_ "panic: unhandled opcode %" IVdf
252 " for xs_builtin_func1_void()", (IV) ix);
258 XS(XS_builtin_created_as_string)
263 croak_xs_usage(cv, "arg");
268 /* SV was created as string if it has POK and isn't bool */
269 ST(0) = boolSV(SvPOK(arg) && !SvIsBOOL(arg));
273 XS(XS_builtin_created_as_number)
278 croak_xs_usage(cv, "arg");
283 /* SV was created as number if it has NOK or IOK but not POK and is not bool */
284 ST(0) = boolSV(SvNIOK(arg) && !SvPOK(arg) && !SvIsBOOL(arg));
288 static OP *ck_builtin_func1(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
290 const struct BuiltinFuncDescriptor *builtin = NUM2PTR(const struct BuiltinFuncDescriptor *, SvUV(ckobj));
292 warn_experimental_builtin(builtin->name, false);
294 SV *prototype = newSVpvs("$");
295 SAVEFREESV(prototype);
297 assert(entersubop->op_type == OP_ENTERSUB);
299 entersubop = ck_entersub_args_proto(entersubop, namegv, prototype);
301 OPCODE opcode = builtin->ckval;
305 OP *parent = entersubop, *pushop, *argop;
307 pushop = cUNOPx(entersubop)->op_first;
308 if (!OpHAS_SIBLING(pushop)) {
309 pushop = cUNOPx(pushop)->op_first;
312 argop = OpSIBLING(pushop);
314 if (!argop || !OpHAS_SIBLING(argop) || OpHAS_SIBLING(OpSIBLING(argop)))
317 (void)op_sibling_splice(parent, pushop, 1, NULL);
319 U8 wantflags = entersubop->op_flags & OPf_WANT;
323 return newUNOP(opcode, wantflags, argop);
326 XS(XS_builtin_indexed)
332 Perl_ck_warner(aTHX_ packWARN(WARN_VOID),
333 "Useless use of %s in void context", "builtin::indexed");
337 Perl_ck_warner(aTHX_ packWARN(WARN_SCALAR),
338 "Useless use of %s in scalar context", "builtin::indexed");
339 ST(0) = sv_2mortal(newSViv(items * 2));
346 SSize_t retcount = items * 2;
347 EXTEND(SP, retcount);
349 /* Copy from [items-1] down to [0] so we don't have to make
350 * temporary copies */
351 for(SSize_t index = items - 1; index >= 0; index--) {
352 /* Copy, not alias */
353 ST(index * 2 + 1) = sv_mortalcopy(ST(index));
354 ST(index * 2) = sv_2mortal(newSViv(index));
360 static OP *ck_builtin_funcN(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
362 const struct BuiltinFuncDescriptor *builtin = NUM2PTR(const struct BuiltinFuncDescriptor *, SvUV(ckobj));
364 warn_experimental_builtin(builtin->name, false);
366 SV *prototype = newSVpvs("@");
367 SAVEFREESV(prototype);
369 assert(entersubop->op_type == OP_ENTERSUB);
371 entersubop = ck_entersub_args_proto(entersubop, namegv, prototype);
375 static const char builtin_not_recognised[] = "'%" SVf "' is not recognised as a builtin function";
377 static const struct BuiltinFuncDescriptor builtins[] = {
379 { "builtin::true", &XS_builtin_true, &ck_builtin_const, BUILTIN_CONST_TRUE },
380 { "builtin::false", &XS_builtin_false, &ck_builtin_const, BUILTIN_CONST_FALSE },
382 /* unary functions */
383 { "builtin::is_bool", &XS_builtin_func1_scalar, &ck_builtin_func1, OP_IS_BOOL },
384 { "builtin::weaken", &XS_builtin_func1_void, &ck_builtin_func1, OP_WEAKEN },
385 { "builtin::unweaken", &XS_builtin_func1_void, &ck_builtin_func1, OP_UNWEAKEN },
386 { "builtin::is_weak", &XS_builtin_func1_scalar, &ck_builtin_func1, OP_IS_WEAK },
387 { "builtin::blessed", &XS_builtin_func1_scalar, &ck_builtin_func1, OP_BLESSED },
388 { "builtin::refaddr", &XS_builtin_func1_scalar, &ck_builtin_func1, OP_REFADDR },
389 { "builtin::reftype", &XS_builtin_func1_scalar, &ck_builtin_func1, OP_REFTYPE },
390 { "builtin::ceil", &XS_builtin_func1_scalar, &ck_builtin_func1, OP_CEIL },
391 { "builtin::floor", &XS_builtin_func1_scalar, &ck_builtin_func1, OP_FLOOR },
392 { "builtin::trim", &XS_builtin_trim, NULL, 0 },
394 { "builtin::created_as_string", &XS_builtin_created_as_string, &ck_builtin_func1, 0 },
395 { "builtin::created_as_number", &XS_builtin_created_as_number, &ck_builtin_func1, 0 },
398 { "builtin::indexed", &XS_builtin_indexed, &ck_builtin_funcN, 0 },
402 XS(XS_builtin_import);
403 XS(XS_builtin_import)
409 "builtin::import can only be called at compile time");
411 /* We need to have PL_comppad / PL_curpad set correctly for lexical importing */
413 SAVESPTR(PL_comppad_name); PL_comppad_name = PadlistNAMES(CvPADLIST(PL_compcv));
414 SAVESPTR(PL_comppad); PL_comppad = PadlistARRAY(CvPADLIST(PL_compcv))[1];
415 SAVESPTR(PL_curpad); PL_curpad = PadARRAY(PL_comppad);
417 for(int i = 1; i < items; i++) {
419 if(strEQ(SvPV_nolen(sym), "import"))
420 Perl_croak(aTHX_ builtin_not_recognised, sym);
422 SV *ampname = sv_2mortal(Perl_newSVpvf(aTHX_ "&%" SVf, SVfARG(sym)));
423 SV *fqname = sv_2mortal(Perl_newSVpvf(aTHX_ "builtin::%" SVf, SVfARG(sym)));
425 CV *cv = get_cv(SvPV_nolen(fqname), SvUTF8(fqname) ? SVf_UTF8 : 0);
427 Perl_croak(aTHX_ builtin_not_recognised, sym);
429 PADOFFSET off = pad_add_name_sv(ampname, padadd_STATE, 0, 0);
430 SvREFCNT_dec(PL_curpad[off]);
431 PL_curpad[off] = SvREFCNT_inc(cv);
440 Perl_boot_core_builtin(pTHX)
443 for(i = 0; builtins[i].name; i++) {
444 const struct BuiltinFuncDescriptor *builtin = &builtins[i];
446 const char *proto = NULL;
447 if(builtin->checker == &ck_builtin_const)
449 else if(builtin->checker == &ck_builtin_func1)
452 CV *cv = newXS_flags(builtin->name, builtin->xsub, __FILE__, proto, 0);
453 XSANY.any_i32 = builtin->ckval;
455 if(builtin->checker) {
456 cv_set_call_checker_flags(cv, builtin->checker, newSVuv(PTR2UV(builtin)), 0);
460 newXS_flags("builtin::import", &XS_builtin_import, __FILE__, NULL, 0);
464 * ex: set ts=8 sts=4 sw=4 et: