[asperl] added AS patch#2

p4raw-id: //depot/asperl@443

1 files changed, 55 insertions, 43 deletions

diff --git a/toke.c b/toke.c
index f1d20c7fbd..4ab4ef90e1 100644
--- a/toke.c
+++ b/toke.c
@@ -14,11 +14,12 @@
 #include "EXTERN.h"
 #include "perl.h"
 
+#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 *q _((SV *sv));
+static SV *tokeq _((SV *sv));
 static char *scan_const _((char *start));
 static char *scan_formline _((char *s));
 static char *scan_heredoc _((char *s));
@@ -49,6 +50,7 @@ static int uni _((I32 f, char *s));
 #endif
 static char * filter_gets _((SV *sv, PerlIO *fp, STRLEN append));
 static void restore_rsfp _((void *f));
+#endif /* PERL_OBJECT */
 
 static char ident_too_long[] = "Identifier too long";
 
@@ -143,7 +145,17 @@ static struct {
 /* grandfather return to old style */
 #define OLDLOP(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)LSTOP)
 
-static int
+#ifdef PERL_OBJECT
+static void RestoreRsfp(void *pPerl, void *ptr)
+{
+    ((CPerlObj*)pPerl)->restore_rsfp(ptr);
+}
+#define RESTORERSFP RestoreRsfp
+#else
+#define RESTORERSFP restore_rsfp
+#endif
+
+STATIC int
 ao(int toketype)
 {
     if (*bufptr == '=') {
@@ -157,7 +169,7 @@ ao(int toketype)
     return toketype;
 }
 
-static void
+STATIC void
 no_op(char *what, char *s)
 {
     char *oldbp = bufptr;
@@ -180,7 +192,7 @@ no_op(char *what, char *s)
     bufptr = oldbp;
 }
 
-static void
+STATIC void
 missingterm(char *s)
 {
     char tmpbuf[3];
@@ -213,7 +225,7 @@ deprecate(char *s)
 	warn("Use of %s is deprecated", s);
 }
 
-static void
+STATIC void
 depcom(void)
 {
     deprecate("comma-less variable list");
@@ -221,7 +233,7 @@ depcom(void)
 
 #ifdef WIN32
 
-static I32
+STATIC I32
 win32_textfilter(int idx, SV *sv, int maxlen)
 {
  I32 count = FILTER_READ(idx+1, sv, maxlen);
@@ -256,7 +268,7 @@ lex_start(SV *line)
     SAVESPTR(linestr);
     SAVEPPTR(lex_brackstack);
     SAVEPPTR(lex_casestack);
-    SAVEDESTRUCTOR(restore_rsfp, rsfp);
+    SAVEDESTRUCTOR(RESTORERSFP, rsfp);
 
     lex_state = LEX_NORMAL;
     lex_defer = 0;
@@ -302,7 +314,7 @@ lex_end(void)
     doextract = FALSE;
 }
 
-static void
+STATIC void
 restore_rsfp(void *f)
 {
     PerlIO *fp = (PerlIO*)f;
@@ -314,7 +326,7 @@ restore_rsfp(void *f)
     rsfp = fp;
 }
 
-static void
+STATIC void
 incline(char *s)
 {
     dTHR;
@@ -355,7 +367,7 @@ incline(char *s)
     curcop->cop_line = atoi(n)-1;
 }
 
-static char *
+STATIC char *
 skipspace(register char *s)
 {
     dTHR;
@@ -413,7 +425,7 @@ skipspace(register char *s)
     }
 }
 
-static void
+STATIC void
 check_uni(void) {
     char *s;
     char ch;
@@ -437,7 +449,7 @@ check_uni(void) {
 #undef UNI
 #define UNI(f) return uni(f,s)
 
-static int
+STATIC int
 uni(I32 f, char *s)
 {
     yylval.ival = f;
@@ -458,7 +470,7 @@ uni(I32 f, char *s)
 
 #define LOP(f,x) return lop(f,x,s)
 
-static I32
+STATIC I32
 lop
 #ifdef CAN_PROTOTYPE
    (I32 f, expectation x, char *s)
@@ -487,7 +499,7 @@ char *s;
 	return LSTOP;
 }
 
-static void 
+STATIC void 
 force_next(I32 type)
 {
     nexttype[nexttoke] = type;
@@ -499,7 +511,7 @@ force_next(I32 type)
     }
 }
 
-static char *
+STATIC char *
 force_word(register char *start, int token, int check_keyword, int allow_pack, int allow_initial_tick)
 {
     register char *s;
@@ -531,7 +543,7 @@ force_word(register char *start, int token, int check_keyword, int allow_pack, i
     return s;
 }
 
-static void
+STATIC void
 force_ident(register char *s, int kind)
 {
     if (s && *s) {
@@ -554,7 +566,7 @@ force_ident(register char *s, int kind)
     }
 }
 
-static char *
+STATIC char *
 force_version(char *s)
 {
     OP *version = Nullop;
@@ -581,8 +593,8 @@ force_version(char *s)
     return (s);
 }
 
-static SV *
-q(SV *sv)
+STATIC SV *
+tokeq(SV *sv)
 {
     register char *s;
     register char *send;
@@ -614,7 +626,7 @@ q(SV *sv)
     return sv;
 }
 
-static I32
+STATIC I32
 sublex_start(void)
 {
     register I32 op_type = yylval.ival;
@@ -625,7 +637,7 @@ sublex_start(void)
 	return THING;
     }
     if (op_type == OP_CONST || op_type == OP_READLINE) {
-	SV *sv = q(lex_stuff);
+	SV *sv = tokeq(lex_stuff);
 	STRLEN len;
 	char *p = SvPV(sv, len);
 	yylval.opval = (OP*)newSVOP(op_type, 0, newSVpv(p, len));
@@ -649,7 +661,7 @@ sublex_start(void)
 	return FUNC;
 }
 
-static I32
+STATIC I32
 sublex_push(void)
 {
     dTHR;
@@ -702,7 +714,7 @@ sublex_push(void)
     return '(';
 }
 
-static I32
+STATIC I32
 sublex_done(void)
 {
     if (!lex_starts++) {
@@ -747,7 +759,7 @@ sublex_done(void)
     }
 }
 
-static char *
+STATIC char *
 scan_const(char *start)
 {
     register char *send = bufend;
@@ -886,7 +898,7 @@ scan_const(char *start)
 }
 
 /* This is the one truly awful dwimmer necessary to conflate C and sed. */
-static int
+STATIC int
 intuit_more(register char *s)
 {
     if (lex_brackets)
@@ -1014,7 +1026,7 @@ intuit_more(register char *s)
     return TRUE;
 }
 
-static int
+STATIC int
 intuit_method(char *start, GV *gv)
 {
     char *s = start + (*start == '$');
@@ -1060,11 +1072,11 @@ intuit_method(char *start, GV *gv)
     return 0;
 }
 
-static char*
+STATIC char*
 incl_perldb(void)
 {
     if (perldb) {
-	char *pdb = PerlENV_getenv("PERL5DB");
+	char *pdb = PerlEnv_getenv("PERL5DB");
 
 	if (pdb)
 	    return pdb;
@@ -1194,8 +1206,8 @@ filter_read(int idx, SV *buf_sv, int maxlen)
 }
 
 
-static char *
-filter_gets(register SV *sv, register FILE *fp, STRLEN append)
+STATIC char *
+filter_gets(register SV *sv, register PerlIO *fp, STRLEN append)
 {
 #ifdef WIN32FILTER
     if (!rsfp_filters) {
@@ -1438,7 +1450,7 @@ yylex(void)
 	if (SvIVX(linestr) == '\'') {
 	    SV *sv = newSVsv(linestr);
 	    if (!lex_inpat)
-		sv = q(sv);
+		sv = tokeq(sv);
 	    yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
 	    s = bufend;
 	}
@@ -3354,7 +3366,7 @@ yylex(void)
 		}
 	    }
 	    force_next(')');
-	    nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, q(lex_stuff));
+	    nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, tokeq(lex_stuff));
 	    lex_stuff = Nullsv;
 	    force_next(THING);
 	    force_next(',');
@@ -4408,7 +4420,7 @@ keyword(register char *d, I32 len)
     return 0;
 }
 
-static void
+STATIC void
 checkcomma(register char *s, char *name, char *what)
 {
     char *w;
@@ -4450,7 +4462,7 @@ checkcomma(register char *s, char *name, char *what)
     }
 }
 
-static char *
+STATIC char *
 scan_word(register char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp)
 {
     register char *d = dest;
@@ -4477,7 +4489,7 @@ scan_word(register char *s, char *dest, STRLEN destlen, int allow_package, STRLE
     }
 }
 
-static char *
+STATIC char *
 scan_ident(register char *s, register char *send, char *dest, STRLEN destlen, I32 ck_uni)
 {
     register char *d;
@@ -4612,7 +4624,7 @@ void pmflag(U16 *pmfl, int ch)
 	*pmfl |= PMf_EXTENDED;
 }
 
-static char *
+STATIC char *
 scan_pat(char *start)
 {
     PMOP *pm;
@@ -4638,7 +4650,7 @@ scan_pat(char *start)
     return s;
 }
 
-static char *
+STATIC char *
 scan_subst(char *start)
 {
     register char *s;
@@ -4703,7 +4715,7 @@ scan_subst(char *start)
     return s;
 }
 
-static char *
+STATIC char *
 scan_trans(char *start)
 {
     register char* s;
@@ -4756,7 +4768,7 @@ scan_trans(char *start)
     return s;
 }
 
-static char *
+STATIC char *
 scan_heredoc(register char *s)
 {
     dTHR;
@@ -4882,7 +4894,7 @@ scan_heredoc(register char *s)
     return s;
 }
 
-static char *
+STATIC char *
 scan_inputsymbol(char *start)
 {
     register char *s = start;
@@ -4938,7 +4950,7 @@ scan_inputsymbol(char *start)
     return s;
 }
 
-static char *
+STATIC char *
 scan_str(char *start)
 {
     dTHR;
@@ -5162,7 +5174,7 @@ scan_num(char *start)
     return s;
 }
 
-static char *
+STATIC char *
 scan_formline(register char *s)
 {
     dTHR;
@@ -5232,7 +5244,7 @@ scan_formline(register char *s)
     return s;
 }
 
-static void
+STATIC void
 set_csh(void)
 {
 #ifdef CSH