1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
/* builtin.c
*
* Copyright (C) 2021 by Paul Evans and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/* This file contains the code that implements functions in perl's "builtin::"
* namespace
*/
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
XS(XS_builtin_true);
XS(XS_builtin_true)
{
dXSARGS;
if(items)
croak_xs_usage(cv, "");
XSRETURN_YES;
}
XS(XS_builtin_false);
XS(XS_builtin_false)
{
dXSARGS;
if(items)
croak_xs_usage(cv, "");
XSRETURN_NO;
}
XS(XS_builtin_isbool);
XS(XS_builtin_isbool)
{
dXSARGS;
if(items != 1)
croak_xs_usage(cv, "sv");
SV *sv = ST(0);
if(SvIsBOOL(sv))
XSRETURN_YES;
else
XSRETURN_NO;
}
XS(XS_builtin_import);
XS(XS_builtin_import)
{
dXSARGS;
if(!PL_compcv)
Perl_croak(aTHX_
"builtin::import can only be called at compiletime");
/* We need to have PL_comppad / PL_curpad set correctly for lexical importing */
ENTER;
SAVESPTR(PL_comppad_name); PL_comppad_name = PadlistNAMES(CvPADLIST(PL_compcv));
SAVESPTR(PL_comppad); PL_comppad = PadlistARRAY(CvPADLIST(PL_compcv))[1];
SAVESPTR(PL_curpad); PL_curpad = PadARRAY(PL_comppad);
for(int i = 1; i < items; i++) {
SV *sym = ST(i);
if(strEQ(SvPV_nolen(sym), "import")) goto unavailable;
SV *ampname = sv_2mortal(Perl_newSVpvf(aTHX_ "&%" SVf, SVfARG(sym)));
SV *fqname = sv_2mortal(Perl_newSVpvf(aTHX_ "builtin::%" SVf, SVfARG(sym)));
CV *cv = get_cv(SvPV_nolen(fqname), SvUTF8(fqname) ? SVf_UTF8 : 0);
if(!cv) goto unavailable;
PADOFFSET off = pad_add_name_sv(ampname, padadd_STATE, 0, 0);
SvREFCNT_dec(PL_curpad[off]);
PL_curpad[off] = SvREFCNT_inc(cv);
continue;
unavailable:
Perl_croak(aTHX_
"'%" SVf "' is not recognised as a builtin function", sym);
}
intro_my();
LEAVE;
}
void
Perl_boot_core_builtin(pTHX)
{
newXS_flags("builtin::true", &XS_builtin_true, __FILE__, NULL, 0);
newXS_flags("builtin::false", &XS_builtin_false, __FILE__, NULL, 0);
newXS_flags("builtin::isbool", &XS_builtin_isbool, __FILE__, NULL, 0);
newXS_flags("builtin::import", &XS_builtin_import, __FILE__, NULL, 0);
}
/*
* ex: set ts=8 sts=4 sw=4 et:
*/
|
