summaryrefslogtreecommitdiff
path: root/ext/Safe/Safe.xs
blob: 8296262dd7d3aa02769046fadc626a1418b3d130 (plain)
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
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

MODULE = Safe	PACKAGE = Safe

void
safe_call_sv(package, mask, codesv)
	char *	package
	SV *	mask
	SV *	codesv
    CODE:
	int i;
	char *str;
	STRLEN len;

	ENTER;
	SAVETMPS;
	save_hptr(&defstash);
	save_aptr(&endav);
	SAVEPPTR(op_mask);
	Newz(666, op_mask, maxo, char);
	SAVEFREEPV(op_mask);
	str = SvPV(mask, len);
	if (maxo != len)
	    croak("Bad mask length");
	for (i = 0; i < maxo; i++)
	    op_mask[i] = str[i];
	defstash = gv_stashpv(package, TRUE);
	endav = (AV*)sv_2mortal((SV*)newAV()); /* Ignore END blocks for now */
	GvHV(gv_fetchpv("main::", TRUE, SVt_PVHV)) = defstash;
	PUSHMARK(sp);
	i = perl_call_sv(codesv, G_SCALAR|G_EVAL|G_KEEPERR);
	SPAGAIN;
	ST(0) = i ? newSVsv(POPs) : &sv_undef;
	PUTBACK;
	FREETMPS;
	LEAVE;
	sv_2mortal(ST(0));

void
op_mask()
    CODE:
	ST(0) = sv_newmortal();
	if (op_mask)
	    sv_setpvn(ST(0), op_mask, maxo);

void
mask_to_ops(mask)
	SV *	mask
    PPCODE:
	STRLEN len;
	char *maskstr = SvPV(mask, len);
	int i;
	if (maxo != len)
	    croak("Bad mask length");
	for (i = 0; i < maxo; i++)
	    if (maskstr[i])
		XPUSHs(sv_2mortal(newSVpv(op_name[i], 0)));

void
ops_to_mask(...)
    CODE:
	int i, j;
	char *mask, *op;
	Newz(666, mask, maxo, char);
	for (i = 0; i < items; i++)
	{
	    op = SvPV(ST(i), na);
	    for (j = 0; j < maxo && strNE(op, op_name[j]); j++) /* nothing */ ;
	    if (j < maxo)
		mask[j] = 1;
	    else
	    {
		Safefree(mask);
		croak("bad op name \"%s\" in mask", op);
	    }
	}
	ST(0) = sv_newmortal();
	sv_usepvn(ST(0), mask, maxo);

void
opname(...)
    PPCODE:
	int i, myopcode;
	for (i = 0; i < items; i++)
	{
	    myopcode = SvIV(ST(i));
	    if (myopcode < 0 || myopcode >= maxo)
		croak("opcode out of range");
	    XPUSHs(sv_2mortal(newSVpv(op_name[myopcode], 0)));
	}

void
opdesc(...)
    PPCODE:
	int i, myopcode;
	for (i = 0; i < items; i++)
	{
	    myopcode = SvIV(ST(i));
	    if (myopcode < 0 || myopcode >= maxo)
		croak("opcode out of range");
	    XPUSHs(sv_2mortal(newSVpv(op_desc[myopcode], 0)));
	}

void
opcode(...)
    PPCODE:
	int i, j;
	char *op;
	for (i = 0; i < items; i++)
	{
	    op = SvPV(ST(i), na);
	    for (j = 0; j < maxo; j++) {
		if (strEQ(op, op_name[j]) || strEQ(op, op_desc[j]))
		    break;
	    }
	    if (j == maxo)
		croak("bad op name \"%s\"", op);
	    XPUSHs(sv_2mortal(newSViv(j)));
	}

int
MAXO()
    CODE:
	RETVAL = maxo;
    OUTPUT:
	RETVAL