*/
#include "EXTERN.h"
+#define PERL_IN_TOKE_C
#include "perl.h"
#define yychar PL_yychar
#define yylval PL_yylval
-#ifndef PERL_OBJECT
-static void check_uni (void);
-static void force_next (I32 type);
-static char *force_version (char *start);
-static char *force_word (char *start, int token, int check_keyword, int allow_pack, int allow_tick);
-static SV *tokeq (SV *sv);
-static char *scan_const (char *start);
-static char *scan_formline (char *s);
-static char *scan_heredoc (char *s);
-static char *scan_ident (char *s, char *send, char *dest, STRLEN destlen,
- I32 ck_uni);
-static char *scan_inputsymbol (char *start);
-static char *scan_pat (char *start, I32 type);
-static char *scan_str (char *start);
-static char *scan_subst (char *start);
-static char *scan_trans (char *start);
-static char *scan_word (char *s, char *dest, STRLEN destlen,
- int allow_package, STRLEN *slp);
-static char *skipspace (char *s);
-static void checkcomma (char *s, char *name, char *what);
-static void force_ident (char *s, int kind);
-static void incline (char *s);
-static int intuit_method (char *s, GV *gv);
-static int intuit_more (char *s);
-static I32 lop (I32 f, expectation x, char *s);
-static void missingterm (char *s);
-static void no_op (char *what, char *s);
-static void set_csh (void);
-static I32 sublex_done (void);
-static I32 sublex_push (void);
-static I32 sublex_start (void);
-#ifdef CRIPPLED_CC
-static int uni (I32 f, char *s);
-#endif
-static char * filter_gets (SV *sv, PerlIO *fp, STRLEN append);
-static void restore_rsfp (void *f);
-static SV *new_constant (char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type);
-static void restore_expect (void *e);
-static void restore_lex_expect (void *e);
-#endif /* PERL_OBJECT */
-
static char ident_too_long[] = "Identifier too long";
#define UTF (PL_hints & HINT_UTF8)
# define yylval (*yylval_pointer)
# define yychar (*yychar_pointer)
# define PERL_YYLEX_PARAM yylval_pointer,yychar_pointer
+# define yylex(a,b) Perl_yylex(aTHX_ a, b)
#else
# define PERL_YYLEX_PARAM
#endif
#define OLDLOP(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)LSTOP)
STATIC int
-ao(int toketype)
+ao(pTHX_ int toketype)
{
if (*PL_bufptr == '=') {
PL_bufptr++;
}
STATIC void
-no_op(char *what, char *s)
+no_op(pTHX_ char *what, char *s)
{
char *oldbp = PL_bufptr;
bool is_first = (PL_oldbufptr == PL_linestart);
}
STATIC void
-missingterm(char *s)
+missingterm(pTHX_ char *s)
{
char tmpbuf[3];
char q;
}
void
-deprecate(char *s)
+Perl_deprecate(pTHX_ char *s)
{
dTHR;
if (ckWARN(WARN_DEPRECATED))
}
STATIC void
-depcom(void)
+depcom(pTHX)
{
deprecate("comma-less variable list");
}
#ifdef WIN32
STATIC I32
-win32_textfilter(int idx, SV *sv, int maxlen)
+win32_textfilter(pTHX_ int idx, SV *sv, int maxlen)
{
I32 count = FILTER_READ(idx+1, sv, maxlen);
if (count > 0 && !maxlen)
}
#endif
-#ifndef PERL_OBJECT
-
STATIC I32
-utf16_textfilter(int idx, SV *sv, int maxlen)
+utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen)
{
I32 count = FILTER_READ(idx+1, sv, maxlen);
if (count) {
}
STATIC I32
-utf16rev_textfilter(int idx, SV *sv, int maxlen)
+utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen)
{
I32 count = FILTER_READ(idx+1, sv, maxlen);
if (count) {
return count;
}
-#endif
-
void
-lex_start(SV *line)
+Perl_lex_start(pTHX_ SV *line)
{
dTHR;
char *s;
}
void
-lex_end(void)
+Perl_lex_end(pTHX)
{
PL_doextract = FALSE;
}
STATIC void
-restore_rsfp(void *f)
+restore_rsfp(pTHX_ void *f)
{
PerlIO *fp = (PerlIO*)f;
}
STATIC void
-restore_expect(void *e)
+restore_expect(pTHX_ void *e)
{
/* a safe way to store a small integer in a pointer */
PL_expect = (expectation)((char *)e - PL_tokenbuf);
}
STATIC void
-restore_lex_expect(void *e)
+restore_lex_expect(pTHX_ void *e)
{
/* a safe way to store a small integer in a pointer */
PL_lex_expect = (expectation)((char *)e - PL_tokenbuf);
}
STATIC void
-incline(char *s)
+incline(pTHX_ char *s)
{
dTHR;
char *t;
}
STATIC char *
-skipspace(register char *s)
+skipspace(pTHX_ register char *s)
{
dTHR;
if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
}
STATIC void
-check_uni(void)
+check_uni(pTHX)
{
char *s;
char ch;
#define UNI(f) return uni(f,s)
STATIC int
-uni(I32 f, char *s)
+uni(pTHX_ I32 f, char *s)
{
yylval.ival = f;
PL_expect = XTERM;
#define LOP(f,x) return lop(f,x,s)
STATIC I32
-lop(I32 f, expectation x, char *s)
+lop(pTHX_ I32 f, expectation x, char *s)
{
dTHR;
yylval.ival = f;
}
STATIC void
-force_next(I32 type)
+force_next(pTHX_ I32 type)
{
PL_nexttype[PL_nexttoke] = type;
PL_nexttoke++;
}
STATIC char *
-force_word(register char *start, int token, int check_keyword, int allow_pack, int allow_initial_tick)
+force_word(pTHX_ register char *start, int token, int check_keyword, int allow_pack, int allow_initial_tick)
{
register char *s;
STRLEN len;
}
STATIC void
-force_ident(register char *s, int kind)
+force_ident(pTHX_ register char *s, int kind)
{
if (s && *s) {
OP* o = (OP*)newSVOP(OP_CONST, 0, newSVpv(s,0));
}
STATIC char *
-force_version(char *s)
+force_version(pTHX_ char *s)
{
OP *version = Nullop;
}
STATIC SV *
-tokeq(SV *sv)
+tokeq(pTHX_ SV *sv)
{
register char *s;
register char *send;
}
STATIC I32
-sublex_start(void)
+sublex_start(pTHX)
{
register I32 op_type = yylval.ival;
}
STATIC I32
-sublex_push(void)
+sublex_push(pTHX)
{
dTHR;
ENTER;
}
STATIC I32
-sublex_done(void)
+sublex_done(pTHX)
{
if (!PL_lex_starts++) {
PL_expect = XOPERATOR;
*/
STATIC char *
-scan_const(char *start)
+scan_const(pTHX_ char *start)
{
register char *send = PL_bufend; /* end of the constant */
SV *sv = NEWSV(93, send - start); /* sv for the constant */
/* This is the one truly awful dwimmer necessary to conflate C and sed. */
STATIC int
-intuit_more(register char *s)
+intuit_more(pTHX_ register char *s)
{
if (PL_lex_brackets)
return TRUE;
}
STATIC int
-intuit_method(char *start, GV *gv)
+intuit_method(pTHX_ char *start, GV *gv)
{
char *s = start + (*start == '$');
char tmpbuf[sizeof PL_tokenbuf];
}
STATIC char*
-incl_perldb(void)
+incl_perldb(pTHX)
{
if (PL_perldb) {
char *pdb = PerlEnv_getenv("PERL5DB");
*/
SV *
-filter_add(filter_t funcp, SV *datasv)
+Perl_filter_add(pTHX_ filter_t funcp, SV *datasv)
{
if (!funcp){ /* temporary handy debugging hack to be deleted */
PL_filter_debug = atoi((char*)datasv);
/* Delete most recently added instance of this filter function. */
void
-filter_del(filter_t funcp)
+Perl_filter_del(pTHX_ filter_t funcp)
{
if (PL_filter_debug)
warn("filter_del func %p", funcp);
/* Invoke the n'th filter function for the current rsfp. */
I32
-filter_read(int idx, SV *buf_sv, int maxlen)
+Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen)
/* 0 = read one text line */
}
STATIC char *
-filter_gets(register SV *sv, register PerlIO *fp, STRLEN append)
+filter_gets(pTHX_ register SV *sv, register PerlIO *fp, STRLEN append)
{
#ifdef WIN32FILTER
if (!PL_rsfp_filters) {
if we already built the token before, use it.
*/
-int yylex(PERL_YYLEX_PARAM_DECL)
+int
+#ifdef USE_PURE_BISON
+yylex(pTHX_ YYSTYPE *lvalp, int *lcharp)
+#else
+yylex(pTHX)
+#endif
{
dTHR;
register char *s;
if (isIDFIRST_lazy(t)) {
t = scan_word(t, tmpbuf, sizeof tmpbuf, TRUE, &len);
for (; isSPACE(*t); t++) ;
- if (*t == ';' && perl_get_cv(tmpbuf, FALSE))
+ if (*t == ';' && get_cv(tmpbuf, FALSE))
warner(WARN_SYNTAX,
"You need to quote \"%s\"", tmpbuf);
}
}
I32
-keyword(register char *d, I32 len)
+Perl_keyword(pTHX_ register char *d, I32 len)
{
switch (*d) {
case '_':
}
STATIC void
-checkcomma(register char *s, char *name, char *what)
+checkcomma(pTHX_ register char *s, char *name, char *what)
{
char *w;
if (*s == ',') {
int kw;
*s = '\0';
- kw = keyword(w, s - w) || perl_get_cv(w, FALSE) != 0;
+ kw = keyword(w, s - w) || get_cv(w, FALSE) != 0;
*s = ',';
if (kw)
return;
}
STATIC SV *
-new_constant(char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type)
+new_constant(pTHX_ char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type)
{
dSP;
HV *table = GvHV(PL_hintgv); /* ^H */
}
STATIC char *
-scan_word(register char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp)
+scan_word(pTHX_ register char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp)
{
register char *d = dest;
register char *e = d + destlen - 3; /* two-character token, ending NUL */
}
STATIC char *
-scan_ident(register char *s, register char *send, char *dest, STRLEN destlen, I32 ck_uni)
+scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN destlen, I32 ck_uni)
{
register char *d;
register char *e;
if (PL_lex_state == LEX_NORMAL) {
dTHR; /* only for ckWARN */
if (ckWARN(WARN_AMBIGUOUS) &&
- (keyword(dest, d - dest) || perl_get_cv(dest, FALSE)))
+ (keyword(dest, d - dest) || get_cv(dest, FALSE)))
{
warner(WARN_AMBIGUOUS,
"Ambiguous use of %c{%s} resolved to %c%s",
}
STATIC char *
-scan_pat(char *start, I32 type)
+scan_pat(pTHX_ char *start, I32 type)
{
PMOP *pm;
char *s;
}
STATIC char *
-scan_subst(char *start)
+scan_subst(pTHX_ char *start)
{
register char *s;
register PMOP *pm;
}
STATIC char *
-scan_trans(char *start)
+scan_trans(pTHX_ char *start)
{
register char* s;
OP *o;
}
STATIC char *
-scan_heredoc(register char *s)
+scan_heredoc(pTHX_ register char *s)
{
dTHR;
SV *herewas;
*/
STATIC char *
-scan_inputsymbol(char *start)
+scan_inputsymbol(pTHX_ char *start)
{
register char *s = start; /* current position in buffer */
register char *d;
*/
STATIC char *
-scan_str(char *start)
+scan_str(pTHX_ char *start)
{
dTHR;
SV *sv; /* scalar value: string */
*/
char *
-scan_num(char *start)
+Perl_scan_num(pTHX_ char *start)
{
register char *s = start; /* current position in buffer */
register char *d; /* destination in temp buffer */
}
STATIC char *
-scan_formline(register char *s)
+scan_formline(pTHX_ register char *s)
{
dTHR;
register char *eol;
}
STATIC void
-set_csh(void)
+set_csh(pTHX)
{
#ifdef CSH
if (!PL_cshlen)
}
I32
-start_subparse(I32 is_format, U32 flags)
+Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
{
dTHR;
I32 oldsavestack_ix = PL_savestack_ix;
}
int
-yywarn(char *s)
+Perl_yywarn(pTHX_ char *s)
{
dTHR;
--PL_error_count;
}
int
-yyerror(char *s)
+Perl_yyerror(pTHX_ char *s)
{
dTHR;
char *where = NULL;
projects / p5sagit/p5-mst-13.2.git / blobdiff