1 /*
2 * This file was generated automatically by ExtUtils::ParseXS version 3.43 from the
3 * contents of MiscXS.xs. Do not edit this file, edit MiscXS.xs instead.
4 *
5 * ANY CHANGES MADE HERE WILL BE LOST!
6 *
7 */
8
9 #line 1 "MiscXS.xs"
10 /* Copyright 2016-2023 Free Software Foundation, Inc.
11
12 This program is free software: you can redistribute it and/or modify
13 it under the terms of the GNU General Public License as published by
14 the Free Software Foundation, either version 3 of the License, or
15 (at your option) any later version.
16
17 This program is distributed in the hope that it will be useful,
18 but WITHOUT ANY WARRANTY; without even the implied warranty of
19 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 GNU General Public License for more details.
21
22 You should have received a copy of the GNU General Public License
23 along with this program. If not, see <http://www.gnu.org/licenses/>. */
24
25 #ifdef HAVE_CONFIG_H
26 #include <config.h>
27 #endif
28
29 #define PERL_NO_GET_CONTEXT
30 #include "EXTERN.h"
31 #include "perl.h"
32 #if defined _WIN32 && !defined __CYGWIN__
33 # undef free
34 #endif
35 #include "XSUB.h"
36
37 #include "ppport.h"
38
39 #include "miscxs.h"
40
41 #line 42 "MiscXS.c"
42 #ifndef PERL_UNUSED_VAR
43 # define PERL_UNUSED_VAR(var) if (0) var = var
44 #endif
45
46 #ifndef dVAR
47 # define dVAR dNOOP
48 #endif
49
50
51 /* This stuff is not part of the API! You have been warned. */
52 #ifndef PERL_VERSION_DECIMAL
53 # define PERL_VERSION_DECIMAL(r,v,s) (r*1000000 + v*1000 + s)
54 #endif
55 #ifndef PERL_DECIMAL_VERSION
56 # define PERL_DECIMAL_VERSION \
57 PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION)
58 #endif
59 #ifndef PERL_VERSION_GE
60 # define PERL_VERSION_GE(r,v,s) \
61 (PERL_DECIMAL_VERSION >= PERL_VERSION_DECIMAL(r,v,s))
62 #endif
63 #ifndef PERL_VERSION_LE
64 # define PERL_VERSION_LE(r,v,s) \
65 (PERL_DECIMAL_VERSION <= PERL_VERSION_DECIMAL(r,v,s))
66 #endif
67
68 /* XS_INTERNAL is the explicit static-linkage variant of the default
69 * XS macro.
70 *
71 * XS_EXTERNAL is the same as XS_INTERNAL except it does not include
72 * "STATIC", ie. it exports XSUB symbols. You probably don't want that
73 * for anything but the BOOT XSUB.
74 *
75 * See XSUB.h in core!
76 */
77
78
79 /* TODO: This might be compatible further back than 5.10.0. */
80 #if PERL_VERSION_GE(5, 10, 0) && PERL_VERSION_LE(5, 15, 1)
81 # undef XS_EXTERNAL
82 # undef XS_INTERNAL
83 # if defined(__CYGWIN__) && defined(USE_DYNAMIC_LOADING)
84 # define XS_EXTERNAL(name) __declspec(dllexport) XSPROTO(name)
85 # define XS_INTERNAL(name) STATIC XSPROTO(name)
86 # endif
87 # if defined(__SYMBIAN32__)
88 # define XS_EXTERNAL(name) EXPORT_C XSPROTO(name)
89 # define XS_INTERNAL(name) EXPORT_C STATIC XSPROTO(name)
90 # endif
91 # ifndef XS_EXTERNAL
92 # if defined(HASATTRIBUTE_UNUSED) && !defined(__cplusplus)
93 # define XS_EXTERNAL(name) void name(pTHX_ CV* cv __attribute__unused__)
94 # define XS_INTERNAL(name) STATIC void name(pTHX_ CV* cv __attribute__unused__)
95 # else
96 # ifdef __cplusplus
97 # define XS_EXTERNAL(name) extern "C" XSPROTO(name)
98 # define XS_INTERNAL(name) static XSPROTO(name)
99 # else
100 # define XS_EXTERNAL(name) XSPROTO(name)
101 # define XS_INTERNAL(name) STATIC XSPROTO(name)
102 # endif
103 # endif
104 # endif
105 #endif
106
107 /* perl >= 5.10.0 && perl <= 5.15.1 */
108
109
110 /* The XS_EXTERNAL macro is used for functions that must not be static
111 * like the boot XSUB of a module. If perl didn't have an XS_EXTERNAL
112 * macro defined, the best we can do is assume XS is the same.
113 * Dito for XS_INTERNAL.
114 */
115 #ifndef XS_EXTERNAL
116 # define XS_EXTERNAL(name) XS(name)
117 #endif
118 #ifndef XS_INTERNAL
119 # define XS_INTERNAL(name) XS(name)
120 #endif
121
122 /* Now, finally, after all this mess, we want an ExtUtils::ParseXS
123 * internal macro that we're free to redefine for varying linkage due
124 * to the EXPORT_XSUB_SYMBOLS XS keyword. This is internal, use
125 * XS_EXTERNAL(name) or XS_INTERNAL(name) in your code if you need to!
126 */
127
128 #undef XS_EUPXS
129 #if defined(PERL_EUPXS_ALWAYS_EXPORT)
130 # define XS_EUPXS(name) XS_EXTERNAL(name)
131 #else
132 /* default to internal */
133 # define XS_EUPXS(name) XS_INTERNAL(name)
134 #endif
135
136 #ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE
137 #define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params)
138
139 /* prototype to pass -Wmissing-prototypes */
140 STATIC void
141 S_croak_xs_usage(const CV *const cv, const char *const params);
142
143 STATIC void
144 S_croak_xs_usage(const CV *const cv, const char *const params)
145 {
146 const GV *const gv = CvGV(cv);
147
148 PERL_ARGS_ASSERT_CROAK_XS_USAGE;
149
150 if (gv) {
151 const char *const gvname = GvNAME(gv);
152 const HV *const stash = GvSTASH(gv);
153 const char *const hvname = stash ? HvNAME(stash) : NULL;
154
155 if (hvname)
156 Perl_croak_nocontext("Usage: %s::%s(%s)", hvname, gvname, params);
157 else
158 Perl_croak_nocontext("Usage: %s(%s)", gvname, params);
159 } else {
160 /* Pants. I don't think that it should be possible to get here. */
161 Perl_croak_nocontext("Usage: CODE(0x%" UVxf ")(%s)", PTR2UV(cv), params);
162 }
163 }
164 #undef PERL_ARGS_ASSERT_CROAK_XS_USAGE
165
166 #define croak_xs_usage S_croak_xs_usage
167
168 #endif
169
170 /* NOTE: the prototype of newXSproto() is different in versions of perls,
171 * so we define a portable version of newXSproto()
172 */
173 #ifdef newXS_flags
174 #define newXSproto_portable(name, c_impl, file, proto) newXS_flags(name, c_impl, file, proto, 0)
175 #else
176 #define newXSproto_portable(name, c_impl, file, proto) (PL_Sv=(SV*)newXS(name, c_impl, file), sv_setpv(PL_Sv, proto), (CV*)PL_Sv)
177 #endif /* !defined(newXS_flags) */
178
179 #if PERL_VERSION_LE(5, 21, 5)
180 # define newXS_deffile(a,b) Perl_newXS(aTHX_ a,b,file)
181 #else
182 # define newXS_deffile(a,b) Perl_newXS_deffile(aTHX_ a,b)
183 #endif
184
185 #line 186 "MiscXS.c"
186
187 XS_EUPXS(XS_Texinfo__MiscXS_process_text); /* prototype to pass -Wmissing-prototypes */
188 XS_EUPXS(XS_Texinfo__MiscXS_process_text)
189 {
190 dVAR; dXSARGS;
191 if (items != 1)
192 croak_xs_usage(cv, "text_in");
193 {
194 SV * text_in = ST(0)
195 ;
196 #line 40 "MiscXS.xs"
197 char *text;
198 char *retval;
199 #line 200 "MiscXS.c"
200 SV * RETVAL;
201 #line 43 "MiscXS.xs"
202 /* Make sure the input is in UTF8. */
203 if (!SvUTF8 (text_in))
204 sv_utf8_upgrade (text_in);
205
206 text = SvPV_nolen (text_in);
207
208 retval = xs_process_text (text);
209
210 RETVAL = newSVpv (retval, 0);
211 SvUTF8_on (RETVAL);
212 #line 213 "MiscXS.c"
213 RETVAL = sv_2mortal(RETVAL);
214 ST(0) = RETVAL;
215 }
216 XSRETURN(1);
217 }
218
219
220 XS_EUPXS(XS_Texinfo__MiscXS_unicode_text); /* prototype to pass -Wmissing-prototypes */
221 XS_EUPXS(XS_Texinfo__MiscXS_unicode_text)
222 {
223 dVAR; dXSARGS;
224 if (items < 1)
225 croak_xs_usage(cv, "text_in, ...");
226 {
227 SV * text_in = ST(0)
228 ;
229 #line 60 "MiscXS.xs"
230 int in_code = 0;
231 char *text;
232 char *retval;
233 #line 234 "MiscXS.c"
234 SV * RETVAL;
235 #line 64 "MiscXS.xs"
236 items--;
237 if (items > 0)
238 {
239 if (SvOK(ST(1)))
240 in_code = (int) SvIV(ST(1));
241 }
242 /* Make sure the input is in UTF-8. */
243 if (!SvUTF8 (text_in))
244 sv_utf8_upgrade (text_in);
245
246 text = SvPV_nolen (text_in);
247
248 retval = xs_unicode_text (text, in_code);
249
250 RETVAL = newSVpv (retval, 0);
251 SvUTF8_on (RETVAL);
252
253 #line 254 "MiscXS.c"
254 RETVAL = sv_2mortal(RETVAL);
255 ST(0) = RETVAL;
256 }
257 XSRETURN(1);
258 }
259
260
261 XS_EUPXS(XS_Texinfo__MiscXS_entity_text); /* prototype to pass -Wmissing-prototypes */
262 XS_EUPXS(XS_Texinfo__MiscXS_entity_text)
263 {
264 dVAR; dXSARGS;
265 if (items != 1)
266 croak_xs_usage(cv, "text_in");
267 {
268 SV * text_in = ST(0)
269 ;
270 #line 88 "MiscXS.xs"
271 char *text;
272 char *retval;
273 #line 274 "MiscXS.c"
274 SV * RETVAL;
275 #line 91 "MiscXS.xs"
276 /* Make sure the input is in UTF-8. */
277 if (!SvUTF8 (text_in))
278 sv_utf8_upgrade (text_in);
279
280 text = SvPV_nolen (text_in);
281
282 retval = xs_entity_text (text);
283
284 RETVAL = newSVpv (retval, 0);
285 SvUTF8_on (RETVAL);
286
287 #line 288 "MiscXS.c"
288 RETVAL = sv_2mortal(RETVAL);
289 ST(0) = RETVAL;
290 }
291 XSRETURN(1);
292 }
293
294
295 XS_EUPXS(XS_Texinfo__MiscXS_parse_command_name); /* prototype to pass -Wmissing-prototypes */
296 XS_EUPXS(XS_Texinfo__MiscXS_parse_command_name)
297 {
298 dVAR; dXSARGS;
299 if (items != 1)
300 croak_xs_usage(cv, "text");
301 PERL_UNUSED_VAR(ax); /* -Wall */
302 SP -= items;
303 {
304 SV * text = ST(0)
305 ;
306 #line 109 "MiscXS.xs"
307 char *command;
308 int is_single_letter;
309 #line 310 "MiscXS.c"
310 #line 112 "MiscXS.xs"
311 xs_parse_command_name(text, &command, &is_single_letter);
312 EXTEND(SP,2);
313 PUSHs(sv_newmortal());
314 sv_setpv((SV*)ST(0), command);
315 SvUTF8_on(ST(0));
316 PUSHs(sv_newmortal());
317 sv_setiv((SV*)ST(1), (IV)is_single_letter);
318 SvUTF8_on(ST(1));
319 #line 320 "MiscXS.c"
320 PUTBACK;
321 return;
322 }
323 }
324
325
326 XS_EUPXS(XS_Texinfo__MiscXS_parse_texi_regex); /* prototype to pass -Wmissing-prototypes */
327 XS_EUPXS(XS_Texinfo__MiscXS_parse_texi_regex)
328 {
329 dVAR; dXSARGS;
330 if (items != 1)
331 croak_xs_usage(cv, "text");
332 PERL_UNUSED_VAR(ax); /* -Wall */
333 SP -= items;
334 {
335 SV * text = ST(0)
336 ;
337 #line 126 "MiscXS.xs"
338 char *arobase;
339 char *open_brace;
340 char *close_brace;
341 char *comma;
342 char *asterisk;
343 char *form_feed;
344 char *menu_only_separator;
345 char *new_text;
346 #line 347 "MiscXS.c"
347 #line 135 "MiscXS.xs"
348 xs_parse_texi_regex(text, &arobase, &open_brace, &close_brace,
349 &comma, &asterisk, &form_feed,
350 &menu_only_separator, &new_text);
351 EXTEND(SP,7);
352 PUSHs(sv_newmortal());
353 sv_setpv((SV*)ST(0), arobase);
354 SvUTF8_on(ST(0));
355 PUSHs(sv_newmortal());
356 sv_setpv((SV*)ST(1), open_brace);
357 SvUTF8_on(ST(1));
358 PUSHs(sv_newmortal());
359 sv_setpv((SV*)ST(2), close_brace);
360 SvUTF8_on(ST(2));
361 PUSHs(sv_newmortal());
362 sv_setpv((SV*)ST(3), comma);
363 SvUTF8_on(ST(3));
364 PUSHs(sv_newmortal());
365 sv_setpv((SV*)ST(4), asterisk);
366 SvUTF8_on(ST(4));
367 PUSHs(sv_newmortal());
368 sv_setpv((SV*)ST(5), form_feed);
369 SvUTF8_on(ST(5));
370 PUSHs(sv_newmortal());
371 sv_setpv((SV*)ST(6), menu_only_separator);
372 SvUTF8_on(ST(6));
373 PUSHs(sv_newmortal());
374 sv_setpv((SV*)ST(7), new_text);
375 SvUTF8_on(ST(7));
376 #line 377 "MiscXS.c"
377 PUTBACK;
378 return;
379 }
380 }
381
382
383 XS_EUPXS(XS_Texinfo__MiscXS_default_format_protect_text); /* prototype to pass -Wmissing-prototypes */
384 XS_EUPXS(XS_Texinfo__MiscXS_default_format_protect_text)
385 {
386 dVAR; dXSARGS;
387 if (items != 2)
388 croak_xs_usage(cv, "self, text_in");
389 {
390 SV * self = ST(0)
391 ;
392 SV * text_in = ST(1)
393 ;
394 #line 169 "MiscXS.xs"
395 char *text;
396 char *retval;
397 #line 398 "MiscXS.c"
398 SV * RETVAL;
399 #line 172 "MiscXS.xs"
400 /* Make sure the input is in UTF-8. */
401 if (!SvUTF8 (text_in))
402 sv_utf8_upgrade (text_in);
403
404 text = SvPV_nolen (text_in);
405
406 retval = xs_default_format_protect_text (text);
407
408 RETVAL = newSVpv (retval, 0);
409 SvUTF8_on (RETVAL);
410
411 #line 412 "MiscXS.c"
412 RETVAL = sv_2mortal(RETVAL);
413 ST(0) = RETVAL;
414 }
415 XSRETURN(1);
416 }
417
418 #ifdef __cplusplus
419 extern "C"
420 #endif
421 XS_EXTERNAL(boot_Texinfo__MiscXS); /* prototype to pass -Wmissing-prototypes */
422 XS_EXTERNAL(boot_Texinfo__MiscXS)
423 {
424 #if PERL_VERSION_LE(5, 21, 5)
425 dVAR; dXSARGS;
426 #else
427 dVAR; dXSBOOTARGSXSAPIVERCHK;
428 #endif
429 #if PERL_VERSION_LE(5, 8, 999) /* PERL_VERSION_LT is 5.33+ */
430 char* file = __FILE__;
431 #else
432 const char* file = __FILE__;
433 #endif
434
435 PERL_UNUSED_VAR(file);
436
437 PERL_UNUSED_VAR(cv); /* -W */
438 PERL_UNUSED_VAR(items); /* -W */
439 #if PERL_VERSION_LE(5, 21, 5)
440 XS_VERSION_BOOTCHECK;
441 # ifdef XS_APIVERSION_BOOTCHECK
442 XS_APIVERSION_BOOTCHECK;
443 # endif
444 #endif
445
446 newXS_deffile("Texinfo::MiscXS::process_text", XS_Texinfo__MiscXS_process_text);
447 newXS_deffile("Texinfo::MiscXS::unicode_text", XS_Texinfo__MiscXS_unicode_text);
448 newXS_deffile("Texinfo::MiscXS::entity_text", XS_Texinfo__MiscXS_entity_text);
449 newXS_deffile("Texinfo::MiscXS::parse_command_name", XS_Texinfo__MiscXS_parse_command_name);
450 newXS_deffile("Texinfo::MiscXS::parse_texi_regex", XS_Texinfo__MiscXS_parse_texi_regex);
451 newXS_deffile("Texinfo::MiscXS::default_format_protect_text", XS_Texinfo__MiscXS_default_format_protect_text);
452 #if PERL_VERSION_LE(5, 21, 5)
453 # if PERL_VERSION_GE(5, 9, 0)
454 if (PL_unitcheckav)
455 call_list(PL_scopestack_ix, PL_unitcheckav);
456 # endif
457 XSRETURN_YES;
458 #else
459 Perl_xs_boot_epilog(aTHX_ ax);
460 #endif
461 }
462