14c2e067c0db78a4d385a54dfa36b3d80f11880d
[perl.git] / do / study
1 int                                     /*SUPPRESS 590*/
2 do_study(TARG,arg,gimme,arglast)
3 STR *TARG;
4 ARG *arg;
5 int gimme;
6 int *arglast;
7 {
8     register unsigned char *s;
9     register int pos = TARG->str_cur;
10     register int ch;
11     register int *sfirst;
12     register int *snext;
13     int retval;
14     int retarg = arglast[0] + 1;
15
16 #ifndef lint
17     s = (unsigned char*)(str_get(TARG));
18 #else
19     s = Null(unsigned char*);
20 #endif
21     if (lastscream)
22         lastscream->str_pok &= ~SP_STUDIED;
23     lastscream = TARG;
24     if (pos <= 0) {
25         retval = 0;
26         goto ret;
27     }
28     if (pos > maxscream) {
29         if (maxscream < 0) {
30             maxscream = pos + 80;
31             New(301,screamfirst, 256, int);
32             New(302,screamnext, maxscream, int);
33         }
34         else {
35             maxscream = pos + pos / 4;
36             Renew(screamnext, maxscream, int);
37         }
38     }
39
40     sfirst = screamfirst;
41     snext = screamnext;
42
43     if (!sfirst || !snext)
44         fatal("do_study: out of memory");
45
46     for (ch = 256; ch; --ch)
47         *sfirst++ = -1;
48     sfirst -= 256;
49
50     while (--pos >= 0) {
51         ch = s[pos];
52         if (sfirst[ch] >= 0)
53             snext[pos] = sfirst[ch] - pos;
54         else
55             snext[pos] = -pos;
56         sfirst[ch] = pos;
57
58         /* If there were any case insensitive searches, we must assume they
59          * all are.  This speeds up insensitive searches much more than
60          * it slows down sensitive ones.
61          */
62         if (sawi)
63             sfirst[fold[ch]] = pos;
64     }
65
66     TARG->str_pok |= SP_STUDIED;
67     retval = 1;
68   ret:
69     str_numset(ARGTARG,(double)retval);
70     stack->ary_array[retarg] = ARGTARG;
71     return retarg;
72 }
73