#define OLDLOP(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)LSTOP)
static int
-ao(toketype)
-int toketype;
+ao(int toketype)
{
if (*bufptr == '=') {
bufptr++;
}
static void
-no_op(what, s)
-char *what;
-char *s;
+no_op(char *what, char *s)
{
char *oldbp = bufptr;
bool is_first = (oldbufptr == linestart);
}
static void
-missingterm(s)
-char *s;
+missingterm(char *s)
{
char tmpbuf[3];
char q;
if (s) {
char *nl = strrchr(s,'\n');
- if (nl)
+ if (nl)
*nl = '\0';
}
else if (multi_close < 32 || multi_close == 127) {
}
void
-deprecate(s)
-char *s;
+deprecate(char *s)
{
if (dowarn)
warn("Use of %s is deprecated", s);
}
static void
-depcom()
+depcom(void)
{
deprecate("comma-less variable list");
}
+#ifdef WIN32
+
+static I32
+win32_textfilter(int idx, SV *sv, int maxlen)
+{
+ I32 count = FILTER_READ(idx+1, sv, maxlen);
+ if (count > 0 && !maxlen)
+ win32_strip_return(sv);
+ return count;
+}
+#endif
+
+
void
-lex_start(line)
-SV *line;
+lex_start(SV *line)
{
dTHR;
char *s;
}
void
-lex_end()
+lex_end(void)
{
doextract = FALSE;
}
static void
-restore_rsfp(f)
-void *f;
+restore_rsfp(void *f)
{
PerlIO *fp = (PerlIO*)f;
}
static void
-incline(s)
-char *s;
+incline(char *s)
{
dTHR;
char *t;
}
static char *
-skipspace(s)
-register char *s;
+skipspace(register char *s)
{
dTHR;
if (lex_formbrack && lex_brackets <= lex_formbrack) {
}
static void
-check_uni() {
+check_uni(void) {
char *s;
char ch;
char *t;
#define UNI(f) return uni(f,s)
static int
-uni(f,s)
-I32 f;
-char *s;
+uni(I32 f, char *s)
{
yylval.ival = f;
expect = XTERM;
}
static void
-force_next(type)
-I32 type;
+force_next(I32 type)
{
nexttype[nexttoke] = type;
nexttoke++;
}
static char *
-force_word(start,token,check_keyword,allow_pack,allow_tick)
-register char *start;
-int token;
-int check_keyword;
-int allow_pack;
-int allow_tick;
+force_word(register char *start, int token, int check_keyword, int allow_pack, int allow_initial_tick)
{
register char *s;
STRLEN len;
s = start;
if (isIDFIRST(*s) ||
(allow_pack && *s == ':') ||
- (allow_tick && *s == '\'') )
+ (allow_initial_tick && *s == '\'') )
{
s = scan_word(s, tokenbuf, sizeof tokenbuf, allow_pack, &len);
if (check_keyword && keyword(tokenbuf, len))
}
static void
-force_ident(s, kind)
-register char *s;
-int kind;
+force_ident(register char *s, int kind)
{
if (s && *s) {
OP* o = (OP*)newSVOP(OP_CONST, 0, newSVpv(s,0));
}
static char *
-force_version(s)
-char *s;
+force_version(char *s)
{
OP *version = Nullop;
}
static SV *
-q(sv)
-SV *sv;
+q(SV *sv)
{
register char *s;
register char *send;
}
static I32
-sublex_start()
+sublex_start(void)
{
register I32 op_type = yylval.ival;
}
static I32
-sublex_push()
+sublex_push(void)
{
dTHR;
push_scope();
}
static I32
-sublex_done()
+sublex_done(void)
{
if (!lex_starts++) {
expect = XOPERATOR;
}
static char *
-scan_const(start)
-char *start;
+scan_const(char *start)
{
register char *send = bufend;
SV *sv = NEWSV(93, send - start);
else if (*s == '$') {
if (!lex_inpat) /* not a regexp, so $ must be var */
break;
- if (s + 1 < send && !strchr(")| \n\t", s[1]))
+ if (s + 1 < send && !strchr("()| \n\t", s[1]))
break; /* in regexp, $ might be tail anchor */
}
if (*s == '\\' && s+1 < send) {
/* This is the one truly awful dwimmer necessary to conflate C and sed. */
static int
-intuit_more(s)
-register char *s;
+intuit_more(register char *s)
{
if (lex_brackets)
return TRUE;
}
static int
-intuit_method(start,gv)
-char *start;
-GV *gv;
+intuit_method(char *start, GV *gv)
{
char *s = start + (*start == '$');
char tmpbuf[sizeof tokenbuf];
}
static char*
-incl_perldb()
+incl_perldb(void)
{
if (perldb) {
char *pdb = getenv("PERL5DB");
static int filter_debug = 0;
SV *
-filter_add(funcp, datasv)
- filter_t funcp;
- SV *datasv;
+filter_add(filter_t funcp, SV *datasv)
{
if (!funcp){ /* temporary handy debugging hack to be deleted */
filter_debug = atoi((char*)datasv);
/* Delete most recently added instance of this filter function. */
void
-filter_del(funcp)
- filter_t funcp;
+filter_del(filter_t funcp)
{
if (filter_debug)
warn("filter_del func %p", funcp);
if (!rsfp_filters || AvFILL(rsfp_filters)<0)
return;
/* if filter is on top of stack (usual case) just pop it off */
- if (IoDIRP(FILTER_DATA(0)) == (void*)funcp){
- /* sv_free(av_pop(rsfp_filters)); */
- sv_free(av_shift(rsfp_filters));
+ if (IoDIRP(FILTER_DATA(AvFILL(rsfp_filters))) == (void*)funcp){
+ sv_free(av_pop(rsfp_filters));
return;
}
/* Invoke the n'th filter function for the current rsfp. */
I32
-filter_read(idx, buf_sv, maxlen)
- int idx;
- SV *buf_sv;
- int maxlen; /* 0 = read one text line */
+filter_read(int idx, SV *buf_sv, int maxlen)
+
+
+ /* 0 = read one text line */
{
filter_t funcp;
SV *datasv = NULL;
else
return 0 ; /* end of file */
}
+
}
return SvCUR(buf_sv);
}
return (*funcp)(idx, buf_sv, maxlen);
}
+
static char *
-filter_gets(sv,fp, append)
-register SV *sv;
-register PerlIO *fp;
-STRLEN append;
+filter_gets(register SV *sv, register FILE *fp, STRLEN append)
{
+#ifdef WIN32FILTER
+ if (!rsfp_filters) {
+ filter_add(win32_textfilter,NULL);
+ }
+#endif
if (rsfp_filters) {
if (!append)
}
else
return (sv_gets(sv, fp, append));
-
}
EXT int yychar; /* last token */
int
-yylex()
+yylex(void)
{
dTHR;
register char *s;
register char *d;
register I32 tmp;
STRLEN len;
+ GV *gv = Nullgv;
+ GV **gvp = 0;
if (pending_ident) {
char pit = pending_ident;
if (!strchr(tokenbuf,':')) {
#ifdef USE_THREADS
- /* Check for single character per-thread magicals */
+ /* Check for single character per-thread SVs */
if (tokenbuf[0] == '$' && tokenbuf[2] == '\0'
- && !isALPHA(tokenbuf[1]) /* Rule out obvious non-magicals */
- && (tmp = find_thread_magical(&tokenbuf[1])) != NOT_IN_PAD)
+ && !isALPHA(tokenbuf[1]) /* Rule out obvious non-threadsvs */
+ && (tmp = find_threadsv(&tokenbuf[1])) != NOT_IN_PAD)
{
- yylval.opval = newOP(OP_SPECIFIC, 0);
+ yylval.opval = newOP(OP_THREADSV, 0);
yylval.opval->op_targ = tmp;
return PRIVATEREF;
}
nextval[nexttoke].ival = 0;
force_next(',');
#ifdef USE_THREADS
- nextval[nexttoke].opval = newOP(OP_SPECIFIC, 0);
- nextval[nexttoke].opval->op_targ = find_thread_magical("\"");
+ nextval[nexttoke].opval = newOP(OP_THREADSV, 0);
+ nextval[nexttoke].opval->op_targ = find_threadsv("\"");
force_next(PRIVATEREF);
#else
force_ident("\"", '$');
}
goto retry;
case '\r':
+#ifndef WIN32CHEAT
warn("Illegal character \\%03o (carriage return)", '\r');
croak(
"(Maybe you didn't strip carriage returns after a network transfer?)\n");
+#endif
case ' ': case '\t': case '\f': case 013:
s++;
goto retry;
case '/': /* may either be division or pattern */
case '?': /* may either be conditional or pattern */
if (expect != XOPERATOR) {
- check_uni();
+ /* Disable warning on "study /blah/" */
+ if (oldoldbufptr == last_uni
+ && (*last_uni != 's' || s - last_uni < 5
+ || memNE(last_uni, "study", 5) || isALNUM(last_uni[5])))
+ check_uni();
s = scan_pat(s);
TERM(sublex_start());
}
case 'z': case 'Z':
keylookup: {
- GV *gv = Nullgv;
- GV **gvp = 0;
+ gv = Nullgv;
+ gvp = 0;
bufptr = s;
s = scan_word(s, tokenbuf, sizeof tokenbuf, FALSE, &len);
(oldoldbufptr == last_lop || oldoldbufptr == last_uni) &&
/* NO SKIPSPACE BEFORE HERE! */
(expect == XREF ||
- (opargs[last_lop_op] >> OASHIFT & 7) == OA_FILEREF) )
+ ((opargs[last_lop_op] >> OASHIFT)& 7) == OA_FILEREF) )
{
bool immediate_paren = *s == '(';
if (*s == ';' || *s == ')') /* probably a close */
croak("sort is now a reserved word");
expect = XTERM;
- s = force_word(s,WORD,TRUE,TRUE,TRUE);
+ s = force_word(s,WORD,TRUE,TRUE,FALSE);
LOP(OP_SORT,XREF);
case KEY_split:
}
I32
-keyword(d, len)
-register char *d;
-I32 len;
+keyword(register char *d, I32 len)
{
switch (*d) {
case '_':
}
static void
-checkcomma(s,name,what)
-register char *s;
-char *name;
-char *what;
+checkcomma(register char *s, char *name, char *what)
{
char *w;
}
static char *
-scan_word(s, dest, destlen, allow_package, slp)
-register char *s;
-char *dest;
-STRLEN destlen;
-int allow_package;
-STRLEN *slp;
+scan_word(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(s, send, dest, destlen, ck_uni)
-register char *s;
-register char *send;
-char *dest;
-STRLEN destlen;
-I32 ck_uni;
+scan_ident(register char *s, register char *send, char *dest, STRLEN destlen, I32 ck_uni)
{
register char *d;
register char *e;
return s;
}
-void pmflag(pmfl,ch)
-U16* pmfl;
-int ch;
+void pmflag(U16 *pmfl, int ch)
{
if (ch == 'i')
*pmfl |= PMf_FOLD;
}
static char *
-scan_pat(start)
-char *start;
+scan_pat(char *start)
{
PMOP *pm;
char *s;
}
static char *
-scan_subst(start)
-char *start;
+scan_subst(char *start)
{
register char *s;
register PMOP *pm;
return s;
}
-void
-hoistmust(pm)
-register PMOP *pm;
-{
- dTHR;
- if (!pm->op_pmshort && pm->op_pmregexp->regstart &&
- (!pm->op_pmregexp->regmust || pm->op_pmregexp->reganch & ROPT_ANCH)
- ) {
- if (!(pm->op_pmregexp->reganch & ROPT_ANCH))
- pm->op_pmflags |= PMf_SCANFIRST;
- pm->op_pmshort = SvREFCNT_inc(pm->op_pmregexp->regstart);
- pm->op_pmslen = SvCUR(pm->op_pmshort);
- }
- else if (pm->op_pmregexp->regmust) {/* is there a better short-circuit? */
- if (pm->op_pmshort &&
- sv_eq(pm->op_pmshort,pm->op_pmregexp->regmust))
- {
- if (pm->op_pmflags & PMf_SCANFIRST) {
- SvREFCNT_dec(pm->op_pmshort);
- pm->op_pmshort = Nullsv;
- }
- else {
- SvREFCNT_dec(pm->op_pmregexp->regmust);
- pm->op_pmregexp->regmust = Nullsv;
- return;
- }
- }
- /* promote the better string */
- if ((!pm->op_pmshort &&
- !(pm->op_pmregexp->reganch & ROPT_ANCH_GPOS)) ||
- ((pm->op_pmflags & PMf_SCANFIRST) &&
- (SvCUR(pm->op_pmshort) < SvCUR(pm->op_pmregexp->regmust)))) {
- SvREFCNT_dec(pm->op_pmshort); /* ok if null */
- pm->op_pmshort = pm->op_pmregexp->regmust;
- pm->op_pmslen = SvCUR(pm->op_pmshort);
- pm->op_pmregexp->regmust = Nullsv;
- pm->op_pmflags |= PMf_SCANFIRST;
- }
- }
-}
-
static char *
-scan_trans(start)
-char *start;
+scan_trans(char *start)
{
register char* s;
OP *o;
short *tbl;
I32 squash;
- I32 delete;
+ I32 Delete;
I32 complement;
yylval.ival = OP_NULL;
New(803,tbl,256,short);
o = newPVOP(OP_TRANS, 0, (char*)tbl);
- complement = delete = squash = 0;
+ complement = Delete = squash = 0;
while (*s == 'c' || *s == 'd' || *s == 's') {
if (*s == 'c')
complement = OPpTRANS_COMPLEMENT;
else if (*s == 'd')
- delete = OPpTRANS_DELETE;
+ Delete = OPpTRANS_DELETE;
else
squash = OPpTRANS_SQUASH;
s++;
}
- o->op_private = delete|squash|complement;
+ o->op_private = Delete|squash|complement;
lex_op = o;
yylval.ival = OP_TRANS;
}
static char *
-scan_heredoc(s)
-register char *s;
+scan_heredoc(register char *s)
{
dTHR;
SV *herewas;
}
static char *
-scan_inputsymbol(start)
-char *start;
+scan_inputsymbol(char *start)
{
register char *s = start;
register char *d;
}
static char *
-scan_str(start)
-char *start;
+scan_str(char *start)
{
dTHR;
SV *sv;
}
char *
-scan_num(start)
-char *start;
+scan_num(char *start)
{
register char *s = start;
register char *d;
}
static char *
-scan_formline(s)
-register char *s;
+scan_formline(register char *s)
{
dTHR;
register char *eol;
}
static void
-set_csh()
+set_csh(void)
{
#ifdef CSH
if (!cshlen)
}
I32
-start_subparse(is_format, flags)
-I32 is_format;
-U32 flags;
+start_subparse(I32 is_format, U32 flags)
{
dTHR;
I32 oldsavestack_ix = savestack_ix;
}
int
-yywarn(s)
-char *s;
+yywarn(char *s)
{
dTHR;
--error_count;
}
int
-yyerror(s)
-char *s;
+yyerror(char *s)
{
dTHR;
char *where = NULL;
if (in_eval & 2)
warn("%_", msg);
else if (in_eval)
- sv_catsv(errsv, msg);
+ sv_catsv(ERRSV, msg);
else
PerlIO_write(PerlIO_stderr(), SvPVX(msg), SvCUR(msg));
if (++error_count >= 10)
in_my_stash = Nullhv;
return 0;
}
+
+
projects / p5sagit/p5-mst-13.2.git / blobdiff