Commit | Line | Data |
fe14fcc3 |
1 | /* $Header: dolist.c,v 4.0 91/03/20 01:08:03 lwall Locked $ |
a687059c |
2 | * |
3 | * Copyright (c) 1989, Larry Wall |
4 | * |
5 | * You may distribute under the terms of the GNU General Public License |
6 | * as specified in the README file that comes with the perl 3.0 kit. |
7 | * |
8 | * $Log: dolist.c,v $ |
fe14fcc3 |
9 | * Revision 4.0 91/03/20 01:08:03 lwall |
10 | * 4.0 baseline. |
a687059c |
11 | * |
12 | */ |
13 | |
14 | #include "EXTERN.h" |
15 | #include "perl.h" |
16 | |
17 | |
b1248f16 |
18 | #ifdef BUGGY_MSC |
19 | #pragma function(memcmp) |
20 | #endif /* BUGGY_MSC */ |
21 | |
a687059c |
22 | int |
23 | do_match(str,arg,gimme,arglast) |
24 | STR *str; |
25 | register ARG *arg; |
26 | int gimme; |
27 | int *arglast; |
28 | { |
29 | register STR **st = stack->ary_array; |
30 | register SPAT *spat = arg[2].arg_ptr.arg_spat; |
31 | register char *t; |
32 | register int sp = arglast[0] + 1; |
33 | STR *srchstr = st[sp]; |
34 | register char *s = str_get(st[sp]); |
35 | char *strend = s + st[sp]->str_cur; |
36 | STR *tmpstr; |
62b28dd9 |
37 | char *myhint = hint; |
a687059c |
38 | |
62b28dd9 |
39 | hint = Nullch; |
a687059c |
40 | if (!spat) { |
41 | if (gimme == G_ARRAY) |
42 | return --sp; |
43 | str_set(str,Yes); |
44 | STABSET(str); |
45 | st[sp] = str; |
46 | return sp; |
47 | } |
48 | if (!s) |
49 | fatal("panic: do_match"); |
50 | if (spat->spat_flags & SPAT_USED) { |
51 | #ifdef DEBUGGING |
52 | if (debug & 8) |
53 | deb("2.SPAT USED\n"); |
54 | #endif |
55 | if (gimme == G_ARRAY) |
56 | return --sp; |
57 | str_set(str,No); |
58 | STABSET(str); |
59 | st[sp] = str; |
60 | return sp; |
61 | } |
62 | --sp; |
63 | if (spat->spat_runtime) { |
64 | nointrp = "|)"; |
65 | sp = eval(spat->spat_runtime,G_SCALAR,sp); |
66 | st = stack->ary_array; |
67 | t = str_get(tmpstr = st[sp--]); |
68 | nointrp = ""; |
69 | #ifdef DEBUGGING |
70 | if (debug & 8) |
71 | deb("2.SPAT /%s/\n",t); |
72 | #endif |
fe14fcc3 |
73 | if (spat->spat_regexp) { |
a687059c |
74 | regfree(spat->spat_regexp); |
fe14fcc3 |
75 | spat->spat_regexp = Null(REGEXP*); /* crucial if regcomp aborts */ |
76 | } |
a687059c |
77 | spat->spat_regexp = regcomp(t,t+tmpstr->str_cur, |
62b28dd9 |
78 | spat->spat_flags & SPAT_FOLD); |
a687059c |
79 | if (!*spat->spat_regexp->precomp && lastspat) |
80 | spat = lastspat; |
81 | if (spat->spat_flags & SPAT_KEEP) { |
663a0e37 |
82 | if (spat->spat_runtime) |
83 | arg_free(spat->spat_runtime); /* it won't change, so */ |
a687059c |
84 | spat->spat_runtime = Nullarg; /* no point compiling again */ |
85 | } |
86 | if (!spat->spat_regexp->nparens) |
87 | gimme = G_SCALAR; /* accidental array context? */ |
88 | if (regexec(spat->spat_regexp, s, strend, s, 0, |
89 | srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr, |
90 | gimme == G_ARRAY)) { |
91 | if (spat->spat_regexp->subbase) |
92 | curspat = spat; |
93 | lastspat = spat; |
94 | goto gotcha; |
95 | } |
96 | else { |
97 | if (gimme == G_ARRAY) |
98 | return sp; |
99 | str_sset(str,&str_no); |
100 | STABSET(str); |
101 | st[++sp] = str; |
102 | return sp; |
103 | } |
104 | } |
105 | else { |
106 | #ifdef DEBUGGING |
107 | if (debug & 8) { |
108 | char ch; |
109 | |
110 | if (spat->spat_flags & SPAT_ONCE) |
111 | ch = '?'; |
112 | else |
113 | ch = '/'; |
114 | deb("2.SPAT %c%s%c\n",ch,spat->spat_regexp->precomp,ch); |
115 | } |
116 | #endif |
117 | if (!*spat->spat_regexp->precomp && lastspat) |
118 | spat = lastspat; |
119 | t = s; |
62b28dd9 |
120 | if (myhint) { |
121 | if (myhint < s || myhint > strend) |
a687059c |
122 | fatal("panic: hint in do_match"); |
62b28dd9 |
123 | s = myhint; |
a687059c |
124 | if (spat->spat_regexp->regback >= 0) { |
125 | s -= spat->spat_regexp->regback; |
126 | if (s < t) |
127 | s = t; |
128 | } |
129 | else |
130 | s = t; |
131 | } |
132 | else if (spat->spat_short) { |
133 | if (spat->spat_flags & SPAT_SCANFIRST) { |
134 | if (srchstr->str_pok & SP_STUDIED) { |
135 | if (screamfirst[spat->spat_short->str_rare] < 0) |
136 | goto nope; |
137 | else if (!(s = screaminstr(srchstr,spat->spat_short))) |
138 | goto nope; |
139 | else if (spat->spat_flags & SPAT_ALL) |
140 | goto yup; |
141 | } |
142 | #ifndef lint |
143 | else if (!(s = fbminstr((unsigned char*)s, |
144 | (unsigned char*)strend, spat->spat_short))) |
145 | goto nope; |
146 | #endif |
147 | else if (spat->spat_flags & SPAT_ALL) |
148 | goto yup; |
149 | if (s && spat->spat_regexp->regback >= 0) { |
150 | ++spat->spat_short->str_u.str_useful; |
151 | s -= spat->spat_regexp->regback; |
152 | if (s < t) |
153 | s = t; |
154 | } |
155 | else |
156 | s = t; |
157 | } |
158 | else if (!multiline && (*spat->spat_short->str_ptr != *s || |
159 | bcmp(spat->spat_short->str_ptr, s, spat->spat_slen) )) |
160 | goto nope; |
161 | if (--spat->spat_short->str_u.str_useful < 0) { |
162 | str_free(spat->spat_short); |
163 | spat->spat_short = Nullstr; /* opt is being useless */ |
164 | } |
165 | } |
166 | if (!spat->spat_regexp->nparens) |
167 | gimme = G_SCALAR; /* accidental array context? */ |
168 | if (regexec(spat->spat_regexp, s, strend, t, 0, |
169 | srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr, |
170 | gimme == G_ARRAY)) { |
171 | if (spat->spat_regexp->subbase) |
172 | curspat = spat; |
173 | lastspat = spat; |
174 | if (spat->spat_flags & SPAT_ONCE) |
175 | spat->spat_flags |= SPAT_USED; |
176 | goto gotcha; |
177 | } |
178 | else { |
179 | if (gimme == G_ARRAY) |
180 | return sp; |
181 | str_sset(str,&str_no); |
182 | STABSET(str); |
183 | st[++sp] = str; |
184 | return sp; |
185 | } |
186 | } |
187 | /*NOTREACHED*/ |
188 | |
189 | gotcha: |
190 | if (gimme == G_ARRAY) { |
191 | int iters, i, len; |
192 | |
193 | iters = spat->spat_regexp->nparens; |
194 | if (sp + iters >= stack->ary_max) { |
195 | astore(stack,sp + iters, Nullstr); |
196 | st = stack->ary_array; /* possibly realloced */ |
197 | } |
198 | |
199 | for (i = 1; i <= iters; i++) { |
fe14fcc3 |
200 | st[++sp] = str_mortal(&str_no); |
a687059c |
201 | if (s = spat->spat_regexp->startp[i]) { |
202 | len = spat->spat_regexp->endp[i] - s; |
203 | if (len > 0) |
204 | str_nset(st[sp],s,len); |
205 | } |
206 | } |
207 | return sp; |
208 | } |
209 | else { |
210 | str_sset(str,&str_yes); |
211 | STABSET(str); |
212 | st[++sp] = str; |
213 | return sp; |
214 | } |
215 | |
216 | yup: |
217 | ++spat->spat_short->str_u.str_useful; |
218 | lastspat = spat; |
219 | if (spat->spat_flags & SPAT_ONCE) |
220 | spat->spat_flags |= SPAT_USED; |
221 | if (sawampersand) { |
222 | char *tmps; |
223 | |
b1248f16 |
224 | if (spat->spat_regexp->subbase) |
225 | Safefree(spat->spat_regexp->subbase); |
a687059c |
226 | tmps = spat->spat_regexp->subbase = nsavestr(t,strend-t); |
62b28dd9 |
227 | spat->spat_regexp->subend = tmps + (strend-t); |
a687059c |
228 | tmps = spat->spat_regexp->startp[0] = tmps + (s - t); |
229 | spat->spat_regexp->endp[0] = tmps + spat->spat_short->str_cur; |
230 | curspat = spat; |
231 | } |
232 | str_sset(str,&str_yes); |
233 | STABSET(str); |
234 | st[++sp] = str; |
235 | return sp; |
236 | |
237 | nope: |
238 | ++spat->spat_short->str_u.str_useful; |
239 | if (gimme == G_ARRAY) |
240 | return sp; |
241 | str_sset(str,&str_no); |
242 | STABSET(str); |
243 | st[++sp] = str; |
244 | return sp; |
245 | } |
246 | |
b1248f16 |
247 | #ifdef BUGGY_MSC |
248 | #pragma intrinsic(memcmp) |
249 | #endif /* BUGGY_MSC */ |
250 | |
a687059c |
251 | int |
252 | do_split(str,spat,limit,gimme,arglast) |
253 | STR *str; |
254 | register SPAT *spat; |
255 | register int limit; |
256 | int gimme; |
257 | int *arglast; |
258 | { |
259 | register ARRAY *ary = stack; |
260 | STR **st = ary->ary_array; |
261 | register int sp = arglast[0] + 1; |
262 | register char *s = str_get(st[sp]); |
263 | char *strend = s + st[sp--]->str_cur; |
264 | register STR *dstr; |
265 | register char *m; |
266 | int iters = 0; |
afd9f252 |
267 | int maxiters = (strend - s) + 10; |
a687059c |
268 | int i; |
269 | char *orig; |
270 | int origlimit = limit; |
271 | int realarray = 0; |
272 | |
273 | if (!spat || !s) |
274 | fatal("panic: do_split"); |
275 | else if (spat->spat_runtime) { |
276 | nointrp = "|)"; |
277 | sp = eval(spat->spat_runtime,G_SCALAR,sp); |
278 | st = stack->ary_array; |
279 | m = str_get(dstr = st[sp--]); |
280 | nointrp = ""; |
ff2452de |
281 | if (*m == ' ' && dstr->str_cur == 1) { |
a687059c |
282 | str_set(dstr,"\\s+"); |
283 | m = dstr->str_ptr; |
284 | spat->spat_flags |= SPAT_SKIPWHITE; |
285 | } |
fe14fcc3 |
286 | if (spat->spat_regexp) { |
a687059c |
287 | regfree(spat->spat_regexp); |
fe14fcc3 |
288 | spat->spat_regexp = Null(REGEXP*); /* avoid possible double free */ |
289 | } |
a687059c |
290 | spat->spat_regexp = regcomp(m,m+dstr->str_cur, |
62b28dd9 |
291 | spat->spat_flags & SPAT_FOLD); |
a687059c |
292 | if (spat->spat_flags & SPAT_KEEP || |
293 | (spat->spat_runtime->arg_type == O_ITEM && |
294 | (spat->spat_runtime[1].arg_type & A_MASK) == A_SINGLE) ) { |
295 | arg_free(spat->spat_runtime); /* it won't change, so */ |
296 | spat->spat_runtime = Nullarg; /* no point compiling again */ |
297 | } |
298 | } |
299 | #ifdef DEBUGGING |
300 | if (debug & 8) { |
301 | deb("2.SPAT /%s/\n",spat->spat_regexp->precomp); |
302 | } |
303 | #endif |
304 | ary = stab_xarray(spat->spat_repl[1].arg_ptr.arg_stab); |
afd9f252 |
305 | if (ary && (gimme != G_ARRAY || (spat->spat_flags & SPAT_ONCE))) { |
a687059c |
306 | realarray = 1; |
03a14243 |
307 | if (!(ary->ary_flags & ARF_REAL)) { |
308 | ary->ary_flags |= ARF_REAL; |
309 | for (i = ary->ary_fill; i >= 0; i--) |
310 | ary->ary_array[i] = Nullstr; /* don't free mere refs */ |
311 | } |
a687059c |
312 | ary->ary_fill = -1; |
313 | sp = -1; /* temporarily switch stacks */ |
314 | } |
315 | else |
316 | ary = stack; |
317 | orig = s; |
318 | if (spat->spat_flags & SPAT_SKIPWHITE) { |
fe14fcc3 |
319 | while (isascii(*s) && isspace(*s)) |
a687059c |
320 | s++; |
321 | } |
322 | if (!limit) |
afd9f252 |
323 | limit = maxiters + 2; |
62b28dd9 |
324 | if (strEQ("\\s+",spat->spat_regexp->precomp)) { |
325 | while (--limit) { |
fe14fcc3 |
326 | for (m = s; m < strend && !(isascii(*m)&&isspace(*m)); m++) ; |
62b28dd9 |
327 | if (m >= strend) |
328 | break; |
57ebbfd0 |
329 | dstr = Str_new(30,m-s); |
62b28dd9 |
330 | str_nset(dstr,s,m-s); |
57ebbfd0 |
331 | if (!realarray) |
fe14fcc3 |
332 | str_2mortal(dstr); |
62b28dd9 |
333 | (void)astore(ary, ++sp, dstr); |
fe14fcc3 |
334 | for (s = m + 1; s < strend && isascii(*s) && isspace(*s); s++) ; |
62b28dd9 |
335 | } |
336 | } |
337 | else if (strEQ("^",spat->spat_regexp->precomp)) { |
338 | while (--limit) { |
339 | for (m = s; m < strend && *m != '\n'; m++) ; |
340 | m++; |
341 | if (m >= strend) |
342 | break; |
57ebbfd0 |
343 | dstr = Str_new(30,m-s); |
62b28dd9 |
344 | str_nset(dstr,s,m-s); |
57ebbfd0 |
345 | if (!realarray) |
fe14fcc3 |
346 | str_2mortal(dstr); |
62b28dd9 |
347 | (void)astore(ary, ++sp, dstr); |
348 | s = m; |
349 | } |
350 | } |
351 | else if (spat->spat_short) { |
a687059c |
352 | i = spat->spat_short->str_cur; |
353 | if (i == 1) { |
62b28dd9 |
354 | int fold = (spat->spat_flags & SPAT_FOLD); |
355 | |
a687059c |
356 | i = *spat->spat_short->str_ptr; |
62b28dd9 |
357 | if (fold && isupper(i)) |
358 | i = tolower(i); |
a687059c |
359 | while (--limit) { |
62b28dd9 |
360 | if (fold) { |
361 | for ( m = s; |
362 | m < strend && *m != i && |
363 | (!isupper(*m) || tolower(*m) != i); |
364 | m++) |
365 | ; |
366 | } |
367 | else |
368 | for (m = s; m < strend && *m != i; m++) ; |
a687059c |
369 | if (m >= strend) |
370 | break; |
57ebbfd0 |
371 | dstr = Str_new(30,m-s); |
a687059c |
372 | str_nset(dstr,s,m-s); |
57ebbfd0 |
373 | if (!realarray) |
fe14fcc3 |
374 | str_2mortal(dstr); |
a687059c |
375 | (void)astore(ary, ++sp, dstr); |
376 | s = m + 1; |
377 | } |
378 | } |
379 | else { |
380 | #ifndef lint |
381 | while (s < strend && --limit && |
382 | (m=fbminstr((unsigned char*)s, (unsigned char*)strend, |
383 | spat->spat_short)) ) |
384 | #endif |
385 | { |
57ebbfd0 |
386 | dstr = Str_new(31,m-s); |
a687059c |
387 | str_nset(dstr,s,m-s); |
57ebbfd0 |
388 | if (!realarray) |
fe14fcc3 |
389 | str_2mortal(dstr); |
a687059c |
390 | (void)astore(ary, ++sp, dstr); |
391 | s = m + i; |
392 | } |
393 | } |
394 | } |
395 | else { |
afd9f252 |
396 | maxiters += (strend - s) * spat->spat_regexp->nparens; |
a687059c |
397 | while (s < strend && --limit && |
398 | regexec(spat->spat_regexp, s, strend, orig, 1, Nullstr, TRUE) ) { |
399 | if (spat->spat_regexp->subbase |
400 | && spat->spat_regexp->subbase != orig) { |
401 | m = s; |
402 | s = orig; |
403 | orig = spat->spat_regexp->subbase; |
404 | s = orig + (m - s); |
405 | strend = s + (strend - m); |
406 | } |
407 | m = spat->spat_regexp->startp[0]; |
57ebbfd0 |
408 | dstr = Str_new(32,m-s); |
a687059c |
409 | str_nset(dstr,s,m-s); |
57ebbfd0 |
410 | if (!realarray) |
fe14fcc3 |
411 | str_2mortal(dstr); |
a687059c |
412 | (void)astore(ary, ++sp, dstr); |
413 | if (spat->spat_regexp->nparens) { |
414 | for (i = 1; i <= spat->spat_regexp->nparens; i++) { |
415 | s = spat->spat_regexp->startp[i]; |
416 | m = spat->spat_regexp->endp[i]; |
57ebbfd0 |
417 | dstr = Str_new(33,m-s); |
a687059c |
418 | str_nset(dstr,s,m-s); |
57ebbfd0 |
419 | if (!realarray) |
fe14fcc3 |
420 | str_2mortal(dstr); |
a687059c |
421 | (void)astore(ary, ++sp, dstr); |
422 | } |
423 | } |
424 | s = spat->spat_regexp->endp[0]; |
425 | } |
426 | } |
427 | if (realarray) |
428 | iters = sp + 1; |
429 | else |
430 | iters = sp - arglast[0]; |
afd9f252 |
431 | if (iters > maxiters) |
a687059c |
432 | fatal("Split loop"); |
433 | if (s < strend || origlimit) { /* keep field after final delim? */ |
57ebbfd0 |
434 | dstr = Str_new(34,strend-s); |
a687059c |
435 | str_nset(dstr,s,strend-s); |
57ebbfd0 |
436 | if (!realarray) |
fe14fcc3 |
437 | str_2mortal(dstr); |
a687059c |
438 | (void)astore(ary, ++sp, dstr); |
439 | iters++; |
440 | } |
441 | else { |
62b28dd9 |
442 | #ifndef I286x |
a687059c |
443 | while (iters > 0 && ary->ary_array[sp]->str_cur == 0) |
444 | iters--,sp--; |
445 | #else |
446 | char *zaps; |
447 | int zapb; |
448 | |
449 | if (iters > 0) { |
450 | zaps = str_get(afetch(ary,sp,FALSE)); |
451 | zapb = (int) *zaps; |
452 | } |
453 | |
454 | while (iters > 0 && (!zapb)) { |
455 | iters--,sp--; |
456 | if (iters > 0) { |
457 | zaps = str_get(afetch(ary,iters-1,FALSE)); |
458 | zapb = (int) *zaps; |
459 | } |
460 | } |
461 | #endif |
462 | } |
463 | if (realarray) { |
464 | ary->ary_fill = sp; |
465 | if (gimme == G_ARRAY) { |
466 | sp++; |
467 | astore(stack, arglast[0] + 1 + sp, Nullstr); |
468 | Copy(ary->ary_array, stack->ary_array + arglast[0] + 1, sp, STR*); |
469 | return arglast[0] + sp; |
470 | } |
471 | } |
472 | else { |
473 | if (gimme == G_ARRAY) |
474 | return sp; |
475 | } |
476 | sp = arglast[0] + 1; |
477 | str_numset(str,(double)iters); |
478 | STABSET(str); |
479 | st[sp] = str; |
480 | return sp; |
481 | } |
482 | |
483 | int |
484 | do_unpack(str,gimme,arglast) |
485 | STR *str; |
486 | int gimme; |
487 | int *arglast; |
488 | { |
489 | STR **st = stack->ary_array; |
490 | register int sp = arglast[0] + 1; |
491 | register char *pat = str_get(st[sp++]); |
492 | register char *s = str_get(st[sp]); |
493 | char *strend = s + st[sp--]->str_cur; |
62b28dd9 |
494 | char *strbeg = s; |
a687059c |
495 | register char *patend = pat + st[sp]->str_cur; |
496 | int datumtype; |
497 | register int len; |
c623bd54 |
498 | register int bits; |
a687059c |
499 | |
500 | /* These must not be in registers: */ |
a687059c |
501 | short ashort; |
502 | int aint; |
503 | long along; |
a687059c |
504 | unsigned short aushort; |
505 | unsigned int auint; |
506 | unsigned long aulong; |
507 | char *aptr; |
62b28dd9 |
508 | float afloat; |
509 | double adouble; |
510 | int checksum = 0; |
511 | unsigned long culong; |
512 | double cdouble; |
a687059c |
513 | |
afd9f252 |
514 | if (gimme != G_ARRAY) { /* arrange to do first one only */ |
62b28dd9 |
515 | for (patend = pat; !isalpha(*patend); patend++); |
c623bd54 |
516 | if (index("aAbBhH", *patend) || *pat == '%') { |
62b28dd9 |
517 | patend++; |
518 | while (isdigit(*patend) || *patend == '*') |
afd9f252 |
519 | patend++; |
520 | } |
62b28dd9 |
521 | else |
522 | patend++; |
a687059c |
523 | } |
524 | sp--; |
525 | while (pat < patend) { |
62b28dd9 |
526 | reparse: |
a687059c |
527 | datumtype = *pat++; |
62b28dd9 |
528 | if (pat >= patend) |
529 | len = 1; |
c623bd54 |
530 | else if (*pat == '*') { |
62b28dd9 |
531 | len = strend - strbeg; /* long enough */ |
c623bd54 |
532 | pat++; |
533 | } |
62b28dd9 |
534 | else if (isdigit(*pat)) { |
afd9f252 |
535 | len = *pat++ - '0'; |
a687059c |
536 | while (isdigit(*pat)) |
afd9f252 |
537 | len = (len * 10) + (*pat++ - '0'); |
a687059c |
538 | } |
539 | else |
62b28dd9 |
540 | len = (datumtype != '@'); |
a687059c |
541 | switch(datumtype) { |
542 | default: |
543 | break; |
62b28dd9 |
544 | case '%': |
545 | if (len == 1 && pat[-1] != '1') |
546 | len = 16; |
547 | checksum = len; |
548 | culong = 0; |
549 | cdouble = 0; |
550 | if (pat < patend) |
551 | goto reparse; |
552 | break; |
553 | case '@': |
554 | if (len > strend - s) |
555 | fatal("@ outside of string"); |
556 | s = strbeg + len; |
557 | break; |
558 | case 'X': |
559 | if (len > s - strbeg) |
560 | fatal("X outside of string"); |
561 | s -= len; |
562 | break; |
a687059c |
563 | case 'x': |
62b28dd9 |
564 | if (len > strend - s) |
565 | fatal("x outside of string"); |
a687059c |
566 | s += len; |
567 | break; |
568 | case 'A': |
569 | case 'a': |
62b28dd9 |
570 | if (len > strend - s) |
a687059c |
571 | len = strend - s; |
62b28dd9 |
572 | if (checksum) |
573 | goto uchar_checksum; |
a687059c |
574 | str = Str_new(35,len); |
575 | str_nset(str,s,len); |
576 | s += len; |
577 | if (datumtype == 'A') { |
578 | aptr = s; /* borrow register */ |
579 | s = str->str_ptr + len - 1; |
fe14fcc3 |
580 | while (s >= str->str_ptr && (!*s || (isascii(*s)&&isspace(*s)))) |
a687059c |
581 | s--; |
582 | *++s = '\0'; |
583 | str->str_cur = s - str->str_ptr; |
584 | s = aptr; /* unborrow register */ |
585 | } |
fe14fcc3 |
586 | (void)astore(stack, ++sp, str_2mortal(str)); |
a687059c |
587 | break; |
c623bd54 |
588 | case 'B': |
589 | case 'b': |
590 | if (pat[-1] == '*' || len > (strend - s) * 8) |
591 | len = (strend - s) * 8; |
592 | str = Str_new(35, len + 1); |
593 | str->str_cur = len; |
594 | str->str_pok = 1; |
595 | aptr = pat; /* borrow register */ |
596 | pat = str->str_ptr; |
597 | if (datumtype == 'b') { |
598 | aint = len; |
599 | for (len = 0; len < aint; len++) { |
600 | if (len & 7) |
601 | bits >>= 1; |
602 | else |
603 | bits = *s++; |
604 | *pat++ = '0' + (bits & 1); |
605 | } |
606 | } |
607 | else { |
608 | aint = len; |
609 | for (len = 0; len < aint; len++) { |
610 | if (len & 7) |
611 | bits <<= 1; |
612 | else |
613 | bits = *s++; |
614 | *pat++ = '0' + ((bits & 128) != 0); |
615 | } |
616 | } |
617 | *pat = '\0'; |
618 | pat = aptr; /* unborrow register */ |
fe14fcc3 |
619 | (void)astore(stack, ++sp, str_2mortal(str)); |
c623bd54 |
620 | break; |
621 | case 'H': |
622 | case 'h': |
623 | if (pat[-1] == '*' || len > (strend - s) * 2) |
624 | len = (strend - s) * 2; |
fe14fcc3 |
625 | str = Str_new(35, len + 1); |
c623bd54 |
626 | str->str_cur = len; |
627 | str->str_pok = 1; |
628 | aptr = pat; /* borrow register */ |
629 | pat = str->str_ptr; |
630 | if (datumtype == 'h') { |
631 | aint = len; |
632 | for (len = 0; len < aint; len++) { |
633 | if (len & 1) |
634 | bits >>= 4; |
635 | else |
636 | bits = *s++; |
fe14fcc3 |
637 | *pat++ = hexdigit[bits & 15]; |
c623bd54 |
638 | } |
639 | } |
640 | else { |
641 | aint = len; |
642 | for (len = 0; len < aint; len++) { |
643 | if (len & 1) |
644 | bits <<= 4; |
645 | else |
646 | bits = *s++; |
fe14fcc3 |
647 | *pat++ = hexdigit[(bits >> 4) & 15]; |
c623bd54 |
648 | } |
649 | } |
650 | *pat = '\0'; |
651 | pat = aptr; /* unborrow register */ |
fe14fcc3 |
652 | (void)astore(stack, ++sp, str_2mortal(str)); |
c623bd54 |
653 | break; |
a687059c |
654 | case 'c': |
62b28dd9 |
655 | if (len > strend - s) |
656 | len = strend - s; |
657 | if (checksum) { |
658 | while (len-- > 0) { |
659 | aint = *s++; |
660 | if (aint >= 128) /* fake up signed chars */ |
661 | aint -= 256; |
662 | culong += aint; |
663 | } |
664 | } |
665 | else { |
666 | while (len-- > 0) { |
667 | aint = *s++; |
668 | if (aint >= 128) /* fake up signed chars */ |
669 | aint -= 256; |
670 | str = Str_new(36,0); |
671 | str_numset(str,(double)aint); |
fe14fcc3 |
672 | (void)astore(stack, ++sp, str_2mortal(str)); |
a687059c |
673 | } |
a687059c |
674 | } |
675 | break; |
676 | case 'C': |
62b28dd9 |
677 | if (len > strend - s) |
678 | len = strend - s; |
679 | if (checksum) { |
680 | uchar_checksum: |
681 | while (len-- > 0) { |
682 | auint = *s++ & 255; |
683 | culong += auint; |
684 | } |
685 | } |
686 | else { |
687 | while (len-- > 0) { |
688 | auint = *s++ & 255; |
689 | str = Str_new(37,0); |
690 | str_numset(str,(double)auint); |
fe14fcc3 |
691 | (void)astore(stack, ++sp, str_2mortal(str)); |
a687059c |
692 | } |
a687059c |
693 | } |
694 | break; |
695 | case 's': |
62b28dd9 |
696 | along = (strend - s) / sizeof(short); |
697 | if (len > along) |
698 | len = along; |
699 | if (checksum) { |
700 | while (len-- > 0) { |
a687059c |
701 | bcopy(s,(char*)&ashort,sizeof(short)); |
702 | s += sizeof(short); |
62b28dd9 |
703 | culong += ashort; |
704 | } |
705 | } |
706 | else { |
707 | while (len-- > 0) { |
708 | bcopy(s,(char*)&ashort,sizeof(short)); |
709 | s += sizeof(short); |
710 | str = Str_new(38,0); |
711 | str_numset(str,(double)ashort); |
fe14fcc3 |
712 | (void)astore(stack, ++sp, str_2mortal(str)); |
a687059c |
713 | } |
a687059c |
714 | } |
715 | break; |
716 | case 'n': |
717 | case 'S': |
62b28dd9 |
718 | along = (strend - s) / sizeof(unsigned short); |
719 | if (len > along) |
720 | len = along; |
721 | if (checksum) { |
722 | while (len-- > 0) { |
a687059c |
723 | bcopy(s,(char*)&aushort,sizeof(unsigned short)); |
724 | s += sizeof(unsigned short); |
fe14fcc3 |
725 | #ifdef HAS_NTOHS |
62b28dd9 |
726 | if (datumtype == 'n') |
727 | aushort = ntohs(aushort); |
728 | #endif |
729 | culong += aushort; |
a687059c |
730 | } |
62b28dd9 |
731 | } |
732 | else { |
733 | while (len-- > 0) { |
734 | bcopy(s,(char*)&aushort,sizeof(unsigned short)); |
735 | s += sizeof(unsigned short); |
736 | str = Str_new(39,0); |
fe14fcc3 |
737 | #ifdef HAS_NTOHS |
62b28dd9 |
738 | if (datumtype == 'n') |
739 | aushort = ntohs(aushort); |
a687059c |
740 | #endif |
62b28dd9 |
741 | str_numset(str,(double)aushort); |
fe14fcc3 |
742 | (void)astore(stack, ++sp, str_2mortal(str)); |
62b28dd9 |
743 | } |
a687059c |
744 | } |
745 | break; |
746 | case 'i': |
62b28dd9 |
747 | along = (strend - s) / sizeof(int); |
748 | if (len > along) |
749 | len = along; |
750 | if (checksum) { |
751 | while (len-- > 0) { |
a687059c |
752 | bcopy(s,(char*)&aint,sizeof(int)); |
753 | s += sizeof(int); |
62b28dd9 |
754 | if (checksum > 32) |
755 | cdouble += (double)aint; |
756 | else |
757 | culong += aint; |
758 | } |
759 | } |
760 | else { |
761 | while (len-- > 0) { |
762 | bcopy(s,(char*)&aint,sizeof(int)); |
763 | s += sizeof(int); |
764 | str = Str_new(40,0); |
765 | str_numset(str,(double)aint); |
fe14fcc3 |
766 | (void)astore(stack, ++sp, str_2mortal(str)); |
a687059c |
767 | } |
a687059c |
768 | } |
769 | break; |
770 | case 'I': |
62b28dd9 |
771 | along = (strend - s) / sizeof(unsigned int); |
772 | if (len > along) |
773 | len = along; |
774 | if (checksum) { |
775 | while (len-- > 0) { |
a687059c |
776 | bcopy(s,(char*)&auint,sizeof(unsigned int)); |
777 | s += sizeof(unsigned int); |
62b28dd9 |
778 | if (checksum > 32) |
779 | cdouble += (double)auint; |
780 | else |
781 | culong += auint; |
782 | } |
783 | } |
784 | else { |
785 | while (len-- > 0) { |
786 | bcopy(s,(char*)&auint,sizeof(unsigned int)); |
787 | s += sizeof(unsigned int); |
788 | str = Str_new(41,0); |
789 | str_numset(str,(double)auint); |
fe14fcc3 |
790 | (void)astore(stack, ++sp, str_2mortal(str)); |
a687059c |
791 | } |
a687059c |
792 | } |
793 | break; |
794 | case 'l': |
62b28dd9 |
795 | along = (strend - s) / sizeof(long); |
796 | if (len > along) |
797 | len = along; |
798 | if (checksum) { |
799 | while (len-- > 0) { |
a687059c |
800 | bcopy(s,(char*)&along,sizeof(long)); |
801 | s += sizeof(long); |
62b28dd9 |
802 | if (checksum > 32) |
803 | cdouble += (double)along; |
804 | else |
805 | culong += along; |
806 | } |
807 | } |
808 | else { |
809 | while (len-- > 0) { |
810 | bcopy(s,(char*)&along,sizeof(long)); |
811 | s += sizeof(long); |
812 | str = Str_new(42,0); |
813 | str_numset(str,(double)along); |
fe14fcc3 |
814 | (void)astore(stack, ++sp, str_2mortal(str)); |
a687059c |
815 | } |
a687059c |
816 | } |
817 | break; |
818 | case 'N': |
819 | case 'L': |
62b28dd9 |
820 | along = (strend - s) / sizeof(unsigned long); |
821 | if (len > along) |
822 | len = along; |
823 | if (checksum) { |
824 | while (len-- > 0) { |
a687059c |
825 | bcopy(s,(char*)&aulong,sizeof(unsigned long)); |
826 | s += sizeof(unsigned long); |
fe14fcc3 |
827 | #ifdef HAS_NTOHL |
62b28dd9 |
828 | if (datumtype == 'N') |
829 | aulong = ntohl(aulong); |
830 | #endif |
831 | if (checksum > 32) |
832 | cdouble += (double)aulong; |
833 | else |
834 | culong += aulong; |
a687059c |
835 | } |
62b28dd9 |
836 | } |
837 | else { |
838 | while (len-- > 0) { |
839 | bcopy(s,(char*)&aulong,sizeof(unsigned long)); |
840 | s += sizeof(unsigned long); |
841 | str = Str_new(43,0); |
fe14fcc3 |
842 | #ifdef HAS_NTOHL |
62b28dd9 |
843 | if (datumtype == 'N') |
844 | aulong = ntohl(aulong); |
a687059c |
845 | #endif |
62b28dd9 |
846 | str_numset(str,(double)aulong); |
fe14fcc3 |
847 | (void)astore(stack, ++sp, str_2mortal(str)); |
62b28dd9 |
848 | } |
a687059c |
849 | } |
850 | break; |
851 | case 'p': |
62b28dd9 |
852 | along = (strend - s) / sizeof(char*); |
853 | if (len > along) |
854 | len = along; |
a687059c |
855 | while (len-- > 0) { |
62b28dd9 |
856 | if (sizeof(char*) > strend - s) |
857 | break; |
a687059c |
858 | else { |
859 | bcopy(s,(char*)&aptr,sizeof(char*)); |
860 | s += sizeof(char*); |
861 | } |
862 | str = Str_new(44,0); |
863 | if (aptr) |
864 | str_set(str,aptr); |
fe14fcc3 |
865 | (void)astore(stack, ++sp, str_2mortal(str)); |
a687059c |
866 | } |
867 | break; |
62b28dd9 |
868 | /* float and double added gnb@melba.bby.oz.au 22/11/89 */ |
869 | case 'f': |
870 | case 'F': |
871 | along = (strend - s) / sizeof(float); |
872 | if (len > along) |
873 | len = along; |
874 | if (checksum) { |
875 | while (len-- > 0) { |
876 | bcopy(s, (char *)&afloat, sizeof(float)); |
877 | s += sizeof(float); |
878 | cdouble += afloat; |
879 | } |
880 | } |
881 | else { |
882 | while (len-- > 0) { |
883 | bcopy(s, (char *)&afloat, sizeof(float)); |
884 | s += sizeof(float); |
885 | str = Str_new(47, 0); |
886 | str_numset(str, (double)afloat); |
fe14fcc3 |
887 | (void)astore(stack, ++sp, str_2mortal(str)); |
62b28dd9 |
888 | } |
889 | } |
890 | break; |
891 | case 'd': |
892 | case 'D': |
893 | along = (strend - s) / sizeof(double); |
894 | if (len > along) |
895 | len = along; |
896 | if (checksum) { |
897 | while (len-- > 0) { |
898 | bcopy(s, (char *)&adouble, sizeof(double)); |
899 | s += sizeof(double); |
900 | cdouble += adouble; |
901 | } |
902 | } |
903 | else { |
904 | while (len-- > 0) { |
905 | bcopy(s, (char *)&adouble, sizeof(double)); |
906 | s += sizeof(double); |
907 | str = Str_new(48, 0); |
908 | str_numset(str, (double)adouble); |
fe14fcc3 |
909 | (void)astore(stack, ++sp, str_2mortal(str)); |
62b28dd9 |
910 | } |
911 | } |
912 | break; |
913 | case 'u': |
914 | along = (strend - s) * 3 / 4; |
915 | str = Str_new(42,along); |
916 | while (s < strend && *s > ' ' && *s < 'a') { |
917 | int a,b,c,d; |
918 | char hunk[4]; |
919 | |
920 | hunk[3] = '\0'; |
921 | len = (*s++ - ' ') & 077; |
922 | while (len > 0) { |
923 | if (s < strend && *s >= ' ') |
924 | a = (*s++ - ' ') & 077; |
925 | else |
926 | a = 0; |
927 | if (s < strend && *s >= ' ') |
928 | b = (*s++ - ' ') & 077; |
929 | else |
930 | b = 0; |
931 | if (s < strend && *s >= ' ') |
932 | c = (*s++ - ' ') & 077; |
933 | else |
934 | c = 0; |
935 | if (s < strend && *s >= ' ') |
936 | d = (*s++ - ' ') & 077; |
937 | else |
938 | d = 0; |
939 | hunk[0] = a << 2 | b >> 4; |
940 | hunk[1] = b << 4 | c >> 2; |
941 | hunk[2] = c << 6 | d; |
942 | str_ncat(str,hunk, len > 3 ? 3 : len); |
943 | len -= 3; |
944 | } |
945 | if (*s == '\n') |
946 | s++; |
947 | else if (s[1] == '\n') /* possible checksum byte */ |
948 | s += 2; |
949 | } |
fe14fcc3 |
950 | (void)astore(stack, ++sp, str_2mortal(str)); |
62b28dd9 |
951 | break; |
952 | } |
953 | if (checksum) { |
954 | str = Str_new(42,0); |
955 | if (index("fFdD", datumtype) || |
956 | (checksum > 32 && index("iIlLN", datumtype)) ) { |
957 | double modf(); |
958 | double trouble; |
959 | |
960 | adouble = 1.0; |
961 | while (checksum >= 16) { |
962 | checksum -= 16; |
963 | adouble *= 65536.0; |
964 | } |
965 | while (checksum >= 4) { |
966 | checksum -= 4; |
967 | adouble *= 16.0; |
968 | } |
969 | while (checksum--) |
970 | adouble *= 2.0; |
971 | along = (1 << checksum) - 1; |
972 | while (cdouble < 0.0) |
973 | cdouble += adouble; |
974 | cdouble = modf(cdouble / adouble, &trouble) * adouble; |
975 | str_numset(str,cdouble); |
976 | } |
977 | else { |
fe14fcc3 |
978 | if (checksum < 32) { |
979 | along = (1 << checksum) - 1; |
980 | culong &= (unsigned long)along; |
981 | } |
62b28dd9 |
982 | str_numset(str,(double)culong); |
983 | } |
fe14fcc3 |
984 | (void)astore(stack, ++sp, str_2mortal(str)); |
62b28dd9 |
985 | checksum = 0; |
a687059c |
986 | } |
987 | } |
988 | return sp; |
989 | } |
990 | |
991 | int |
ff2452de |
992 | do_slice(stab,str,numarray,lval,gimme,arglast) |
993 | STAB *stab; |
994 | STR *str; |
a687059c |
995 | int numarray; |
996 | int lval; |
997 | int gimme; |
998 | int *arglast; |
999 | { |
1000 | register STR **st = stack->ary_array; |
1001 | register int sp = arglast[1]; |
1002 | register int max = arglast[2]; |
1003 | register char *tmps; |
1004 | register int len; |
1005 | register int magic = 0; |
ff2452de |
1006 | register ARRAY *ary; |
1007 | register HASH *hash; |
1008 | int oldarybase = arybase; |
a687059c |
1009 | |
ff2452de |
1010 | if (numarray) { |
1011 | if (numarray == 2) { /* a slice of a LIST */ |
1012 | ary = stack; |
1013 | ary->ary_fill = arglast[3]; |
1014 | arybase -= max + 1; |
1015 | st[sp] = str; /* make stack size available */ |
1016 | str_numset(str,(double)(sp - 1)); |
1017 | } |
1018 | else |
1019 | ary = stab_array(stab); /* a slice of an array */ |
1020 | } |
1021 | else { |
1022 | if (lval) { |
1023 | if (stab == envstab) |
1024 | magic = 'E'; |
1025 | else if (stab == sigstab) |
1026 | magic = 'S'; |
a687059c |
1027 | #ifdef SOME_DBM |
ff2452de |
1028 | else if (stab_hash(stab)->tbl_dbm) |
1029 | magic = 'D'; |
a687059c |
1030 | #endif /* SOME_DBM */ |
ff2452de |
1031 | } |
1032 | hash = stab_hash(stab); /* a slice of an associative array */ |
a687059c |
1033 | } |
1034 | |
1035 | if (gimme == G_ARRAY) { |
1036 | if (numarray) { |
1037 | while (sp < max) { |
1038 | if (st[++sp]) { |
ff2452de |
1039 | st[sp-1] = afetch(ary, |
afd9f252 |
1040 | ((int)str_gnum(st[sp])) - arybase, lval); |
a687059c |
1041 | } |
1042 | else |
bf38876a |
1043 | st[sp-1] = &str_undef; |
a687059c |
1044 | } |
1045 | } |
1046 | else { |
1047 | while (sp < max) { |
1048 | if (st[++sp]) { |
1049 | tmps = str_get(st[sp]); |
1050 | len = st[sp]->str_cur; |
ff2452de |
1051 | st[sp-1] = hfetch(hash,tmps,len, lval); |
a687059c |
1052 | if (magic) |
1053 | str_magic(st[sp-1],stab,magic,tmps,len); |
1054 | } |
1055 | else |
bf38876a |
1056 | st[sp-1] = &str_undef; |
a687059c |
1057 | } |
1058 | } |
1059 | sp--; |
1060 | } |
1061 | else { |
1062 | if (numarray) { |
1063 | if (st[max]) |
ff2452de |
1064 | st[sp] = afetch(ary, |
afd9f252 |
1065 | ((int)str_gnum(st[max])) - arybase, lval); |
a687059c |
1066 | else |
bf38876a |
1067 | st[sp] = &str_undef; |
a687059c |
1068 | } |
1069 | else { |
1070 | if (st[max]) { |
1071 | tmps = str_get(st[max]); |
1072 | len = st[max]->str_cur; |
ff2452de |
1073 | st[sp] = hfetch(hash,tmps,len, lval); |
a687059c |
1074 | if (magic) |
1075 | str_magic(st[sp],stab,magic,tmps,len); |
1076 | } |
1077 | else |
bf38876a |
1078 | st[sp] = &str_undef; |
a687059c |
1079 | } |
1080 | } |
ff2452de |
1081 | arybase = oldarybase; |
1082 | return sp; |
1083 | } |
1084 | |
1085 | int |
62b28dd9 |
1086 | do_splice(ary,gimme,arglast) |
ff2452de |
1087 | register ARRAY *ary; |
ff2452de |
1088 | int gimme; |
1089 | int *arglast; |
1090 | { |
1091 | register STR **st = stack->ary_array; |
1092 | register int sp = arglast[1]; |
1093 | int max = arglast[2] + 1; |
1094 | register STR **src; |
1095 | register STR **dst; |
1096 | register int i; |
1097 | register int offset; |
1098 | register int length; |
1099 | int newlen; |
1100 | int after; |
1101 | int diff; |
1102 | STR **tmparyval; |
1103 | |
1104 | if (++sp < max) { |
1105 | offset = ((int)str_gnum(st[sp])) - arybase; |
1106 | if (offset < 0) |
1107 | offset += ary->ary_fill + 1; |
1108 | if (++sp < max) { |
1109 | length = (int)str_gnum(st[sp++]); |
1110 | if (length < 0) |
1111 | length = 0; |
1112 | } |
1113 | else |
1114 | length = ary->ary_max; /* close enough to infinity */ |
1115 | } |
1116 | else { |
1117 | offset = 0; |
1118 | length = ary->ary_max; |
1119 | } |
1120 | if (offset < 0) { |
1121 | length += offset; |
1122 | offset = 0; |
1123 | if (length < 0) |
1124 | length = 0; |
1125 | } |
1126 | if (offset > ary->ary_fill + 1) |
1127 | offset = ary->ary_fill + 1; |
1128 | after = ary->ary_fill + 1 - (offset + length); |
1129 | if (after < 0) { /* not that much array */ |
1130 | length += after; /* offset+length now in array */ |
1131 | after = 0; |
6eb13c3b |
1132 | if (!ary->ary_alloc) { |
1133 | afill(ary,0); |
1134 | afill(ary,-1); |
1135 | } |
ff2452de |
1136 | } |
1137 | |
1138 | /* At this point, sp .. max-1 is our new LIST */ |
1139 | |
1140 | newlen = max - sp; |
1141 | diff = newlen - length; |
1142 | |
1143 | if (diff < 0) { /* shrinking the area */ |
1144 | if (newlen) { |
1145 | New(451, tmparyval, newlen, STR*); /* so remember insertion */ |
1146 | Copy(st+sp, tmparyval, newlen, STR*); |
1147 | } |
1148 | |
1149 | sp = arglast[0] + 1; |
1150 | if (gimme == G_ARRAY) { /* copy return vals to stack */ |
1151 | if (sp + length >= stack->ary_max) { |
1152 | astore(stack,sp + length, Nullstr); |
1153 | st = stack->ary_array; |
1154 | } |
1155 | Copy(ary->ary_array+offset, st+sp, length, STR*); |
1156 | if (ary->ary_flags & ARF_REAL) { |
1157 | for (i = length, dst = st+sp; i; i--) |
fe14fcc3 |
1158 | str_2mortal(*dst++); /* free them eventualy */ |
ff2452de |
1159 | } |
1160 | sp += length - 1; |
1161 | } |
1162 | else { |
1163 | st[sp] = ary->ary_array[offset+length-1]; |
1164 | if (ary->ary_flags & ARF_REAL) |
fe14fcc3 |
1165 | str_2mortal(st[sp]); |
ff2452de |
1166 | } |
1167 | ary->ary_fill += diff; |
1168 | |
1169 | /* pull up or down? */ |
1170 | |
1171 | if (offset < after) { /* easier to pull up */ |
1172 | if (offset) { /* esp. if nothing to pull */ |
1173 | src = &ary->ary_array[offset-1]; |
1174 | dst = src - diff; /* diff is negative */ |
1175 | for (i = offset; i > 0; i--) /* can't trust Copy */ |
1176 | *dst-- = *src--; |
1177 | } |
b1248f16 |
1178 | Zero(ary->ary_array, -diff, STR*); |
ff2452de |
1179 | ary->ary_array -= diff; /* diff is negative */ |
1180 | ary->ary_max += diff; |
1181 | } |
1182 | else { |
1183 | if (after) { /* anything to pull down? */ |
1184 | src = ary->ary_array + offset + length; |
1185 | dst = src + diff; /* diff is negative */ |
1186 | Copy(src, dst, after, STR*); |
1187 | } |
1188 | Zero(&ary->ary_array[ary->ary_fill+1], -diff, STR*); |
1189 | /* avoid later double free */ |
1190 | } |
1191 | if (newlen) { |
1192 | for (src = tmparyval, dst = ary->ary_array + offset; |
1193 | newlen; newlen--) { |
1194 | *dst = Str_new(46,0); |
1195 | str_sset(*dst++,*src++); |
1196 | } |
1197 | Safefree(tmparyval); |
1198 | } |
1199 | } |
1200 | else { /* no, expanding (or same) */ |
1201 | if (length) { |
1202 | New(452, tmparyval, length, STR*); /* so remember deletion */ |
1203 | Copy(ary->ary_array+offset, tmparyval, length, STR*); |
1204 | } |
1205 | |
1206 | if (diff > 0) { /* expanding */ |
1207 | |
1208 | /* push up or down? */ |
1209 | |
1210 | if (offset < after && diff <= ary->ary_array - ary->ary_alloc) { |
1211 | if (offset) { |
1212 | src = ary->ary_array; |
1213 | dst = src - diff; |
1214 | Copy(src, dst, offset, STR*); |
1215 | } |
1216 | ary->ary_array -= diff; /* diff is positive */ |
1217 | ary->ary_max += diff; |
1218 | ary->ary_fill += diff; |
1219 | } |
1220 | else { |
1221 | if (ary->ary_fill + diff >= ary->ary_max) /* oh, well */ |
1222 | astore(ary, ary->ary_fill + diff, Nullstr); |
1223 | else |
1224 | ary->ary_fill += diff; |
1225 | if (after) { |
1226 | dst = ary->ary_array + ary->ary_fill; |
1227 | src = dst - diff; |
1228 | for (i = after; i; i--) { |
1229 | if (*dst) /* str was hanging around */ |
1230 | str_free(*dst); /* after $#foo */ |
1231 | *dst-- = *src; |
1232 | *src-- = Nullstr; |
1233 | } |
1234 | } |
1235 | } |
1236 | } |
1237 | |
1238 | for (src = st+sp, dst = ary->ary_array + offset; newlen; newlen--) { |
1239 | *dst = Str_new(46,0); |
1240 | str_sset(*dst++,*src++); |
1241 | } |
1242 | sp = arglast[0] + 1; |
1243 | if (gimme == G_ARRAY) { /* copy return vals to stack */ |
1244 | if (length) { |
1245 | Copy(tmparyval, st+sp, length, STR*); |
1246 | if (ary->ary_flags & ARF_REAL) { |
1247 | for (i = length, dst = st+sp; i; i--) |
fe14fcc3 |
1248 | str_2mortal(*dst++); /* free them eventualy */ |
ff2452de |
1249 | } |
1250 | Safefree(tmparyval); |
1251 | } |
1252 | sp += length - 1; |
1253 | } |
1254 | else if (length) { |
1255 | st[sp] = tmparyval[length-1]; |
1256 | if (ary->ary_flags & ARF_REAL) |
fe14fcc3 |
1257 | str_2mortal(st[sp]); |
ff2452de |
1258 | Safefree(tmparyval); |
1259 | } |
1260 | else |
1261 | st[sp] = &str_undef; |
1262 | } |
a687059c |
1263 | return sp; |
1264 | } |
1265 | |
1266 | int |
1267 | do_grep(arg,str,gimme,arglast) |
1268 | register ARG *arg; |
1269 | STR *str; |
1270 | int gimme; |
1271 | int *arglast; |
1272 | { |
1273 | STR **st = stack->ary_array; |
0d3e774c |
1274 | register int dst = arglast[1]; |
1275 | register int src = dst + 1; |
a687059c |
1276 | register int sp = arglast[2]; |
1277 | register int i = sp - arglast[1]; |
1278 | int oldsave = savestack->ary_fill; |
afd9f252 |
1279 | SPAT *oldspat = curspat; |
c623bd54 |
1280 | int oldtmps_base = tmps_base; |
a687059c |
1281 | |
1282 | savesptr(&stab_val(defstab)); |
c623bd54 |
1283 | tmps_base = tmps_max; |
663a0e37 |
1284 | if ((arg[1].arg_type & A_MASK) != A_EXPR) { |
1285 | arg[1].arg_type &= A_MASK; |
a687059c |
1286 | dehoist(arg,1); |
663a0e37 |
1287 | arg[1].arg_type |= A_DONT; |
1288 | } |
a687059c |
1289 | arg = arg[1].arg_ptr.arg_arg; |
1290 | while (i-- > 0) { |
b1248f16 |
1291 | if (st[src]) |
1292 | stab_val(defstab) = st[src]; |
1293 | else |
fe14fcc3 |
1294 | stab_val(defstab) = str_mortal(&str_undef); |
a687059c |
1295 | (void)eval(arg,G_SCALAR,sp); |
0d3e774c |
1296 | st = stack->ary_array; |
a687059c |
1297 | if (str_true(st[sp+1])) |
0d3e774c |
1298 | st[dst++] = st[src]; |
a687059c |
1299 | src++; |
afd9f252 |
1300 | curspat = oldspat; |
a687059c |
1301 | } |
1302 | restorelist(oldsave); |
c623bd54 |
1303 | tmps_base = oldtmps_base; |
a687059c |
1304 | if (gimme != G_ARRAY) { |
afd9f252 |
1305 | str_numset(str,(double)(dst - arglast[1])); |
a687059c |
1306 | STABSET(str); |
1307 | st[arglast[0]+1] = str; |
1308 | return arglast[0]+1; |
1309 | } |
0d3e774c |
1310 | return arglast[0] + (dst - arglast[1]); |
a687059c |
1311 | } |
1312 | |
1313 | int |
57ebbfd0 |
1314 | do_reverse(arglast) |
a687059c |
1315 | int *arglast; |
1316 | { |
1317 | STR **st = stack->ary_array; |
1318 | register STR **up = &st[arglast[1]]; |
1319 | register STR **down = &st[arglast[2]]; |
1320 | register int i = arglast[2] - arglast[1]; |
1321 | |
a687059c |
1322 | while (i-- > 0) { |
1323 | *up++ = *down; |
03a14243 |
1324 | if (i-- > 0) |
1325 | *down-- = *up; |
a687059c |
1326 | } |
03a14243 |
1327 | i = arglast[2] - arglast[1]; |
1328 | Copy(down+1,up,i/2,STR*); |
a687059c |
1329 | return arglast[2] - 1; |
1330 | } |
1331 | |
c2ab57d4 |
1332 | int |
57ebbfd0 |
1333 | do_sreverse(str,arglast) |
c2ab57d4 |
1334 | STR *str; |
c2ab57d4 |
1335 | int *arglast; |
1336 | { |
1337 | STR **st = stack->ary_array; |
1338 | register char *up; |
1339 | register char *down; |
1340 | register int tmp; |
1341 | |
1342 | str_sset(str,st[arglast[2]]); |
1343 | up = str_get(str); |
1344 | if (str->str_cur > 1) { |
1345 | down = str->str_ptr + str->str_cur - 1; |
1346 | while (down > up) { |
1347 | tmp = *up; |
1348 | *up++ = *down; |
1349 | *down-- = tmp; |
1350 | } |
1351 | } |
1352 | STABSET(str); |
1353 | st[arglast[0]+1] = str; |
1354 | return arglast[0]+1; |
1355 | } |
1356 | |
a687059c |
1357 | static CMD *sortcmd; |
57ebbfd0 |
1358 | static HASH *sortstash = Null(HASH*); |
a687059c |
1359 | static STAB *firststab = Nullstab; |
1360 | static STAB *secondstab = Nullstab; |
1361 | |
1362 | int |
1363 | do_sort(str,stab,gimme,arglast) |
1364 | STR *str; |
1365 | STAB *stab; |
1366 | int gimme; |
1367 | int *arglast; |
1368 | { |
62b28dd9 |
1369 | register STR **st = stack->ary_array; |
a687059c |
1370 | int sp = arglast[1]; |
1371 | register STR **up; |
1372 | register int max = arglast[2] - sp; |
1373 | register int i; |
1374 | int sortcmp(); |
1375 | int sortsub(); |
1376 | STR *oldfirst; |
1377 | STR *oldsecond; |
1378 | ARRAY *oldstack; |
1379 | static ARRAY *sortstack = Null(ARRAY*); |
1380 | |
1381 | if (gimme != G_ARRAY) { |
1382 | str_sset(str,&str_undef); |
1383 | STABSET(str); |
1384 | st[sp] = str; |
1385 | return sp; |
1386 | } |
1387 | up = &st[sp]; |
62b28dd9 |
1388 | st += sp; /* temporarily make st point to args */ |
1389 | for (i = 1; i <= max; i++) { |
1390 | if (*up = st[i]) { |
1391 | if (!(*up)->str_pok) |
1392 | (void)str_2ptr(*up); |
c623bd54 |
1393 | else |
1394 | (*up)->str_pok &= ~SP_TEMP; |
62b28dd9 |
1395 | up++; |
1396 | } |
a687059c |
1397 | } |
62b28dd9 |
1398 | st -= sp; |
1399 | max = up - &st[sp]; |
a687059c |
1400 | sp--; |
1401 | if (max > 1) { |
c2ab57d4 |
1402 | if (stab) { |
a687059c |
1403 | int oldtmps_base = tmps_base; |
1404 | |
c2ab57d4 |
1405 | if (!stab_sub(stab) || !(sortcmd = stab_sub(stab)->cmd)) |
1406 | fatal("Undefined subroutine \"%s\" in sort", stab_name(stab)); |
a687059c |
1407 | if (!sortstack) { |
1408 | sortstack = anew(Nullstab); |
57ebbfd0 |
1409 | astore(sortstack, 0, Nullstr); |
1410 | aclear(sortstack); |
a687059c |
1411 | sortstack->ary_flags = 0; |
1412 | } |
1413 | oldstack = stack; |
1414 | stack = sortstack; |
1415 | tmps_base = tmps_max; |
57ebbfd0 |
1416 | if (sortstash != stab_stash(stab)) { |
a687059c |
1417 | firststab = stabent("a",TRUE); |
1418 | secondstab = stabent("b",TRUE); |
57ebbfd0 |
1419 | sortstash = stab_stash(stab); |
a687059c |
1420 | } |
1421 | oldfirst = stab_val(firststab); |
1422 | oldsecond = stab_val(secondstab); |
1423 | #ifndef lint |
1424 | qsort((char*)(st+sp+1),max,sizeof(STR*),sortsub); |
1425 | #else |
1426 | qsort(Nullch,max,sizeof(STR*),sortsub); |
1427 | #endif |
1428 | stab_val(firststab) = oldfirst; |
1429 | stab_val(secondstab) = oldsecond; |
1430 | tmps_base = oldtmps_base; |
1431 | stack = oldstack; |
1432 | } |
1433 | #ifndef lint |
1434 | else |
1435 | qsort((char*)(st+sp+1),max,sizeof(STR*),sortcmp); |
1436 | #endif |
1437 | } |
a687059c |
1438 | return sp+max; |
1439 | } |
1440 | |
1441 | int |
1442 | sortsub(str1,str2) |
1443 | STR **str1; |
1444 | STR **str2; |
1445 | { |
a687059c |
1446 | stab_val(firststab) = *str1; |
1447 | stab_val(secondstab) = *str2; |
1448 | cmd_exec(sortcmd,G_SCALAR,-1); |
1449 | return (int)str_gnum(*stack->ary_array); |
1450 | } |
1451 | |
1452 | sortcmp(strp1,strp2) |
1453 | STR **strp1; |
1454 | STR **strp2; |
1455 | { |
1456 | register STR *str1 = *strp1; |
1457 | register STR *str2 = *strp2; |
1458 | int retval; |
1459 | |
a687059c |
1460 | if (str1->str_cur < str2->str_cur) { |
1461 | if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur)) |
1462 | return retval; |
1463 | else |
1464 | return -1; |
1465 | } |
1466 | else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur)) |
1467 | return retval; |
1468 | else if (str1->str_cur == str2->str_cur) |
1469 | return 0; |
1470 | else |
1471 | return 1; |
1472 | } |
1473 | |
1474 | int |
1475 | do_range(gimme,arglast) |
1476 | int gimme; |
1477 | int *arglast; |
1478 | { |
1479 | STR **st = stack->ary_array; |
1480 | register int sp = arglast[0]; |
b1248f16 |
1481 | register int i; |
a687059c |
1482 | register ARRAY *ary = stack; |
1483 | register STR *str; |
b1248f16 |
1484 | int max; |
a687059c |
1485 | |
1486 | if (gimme != G_ARRAY) |
1487 | fatal("panic: do_range"); |
1488 | |
fe14fcc3 |
1489 | if (st[sp+1]->str_nok || !st[sp+1]->str_pok || |
b1248f16 |
1490 | (looks_like_number(st[sp+1]) && *st[sp+1]->str_ptr != '0') ) { |
1491 | i = (int)str_gnum(st[sp+1]); |
1492 | max = (int)str_gnum(st[sp+2]); |
1493 | while (i <= max) { |
fe14fcc3 |
1494 | (void)astore(ary, ++sp, str = str_mortal(&str_no)); |
b1248f16 |
1495 | str_numset(str,(double)i++); |
1496 | } |
1497 | } |
1498 | else { |
fe14fcc3 |
1499 | STR *final = str_mortal(st[sp+2]); |
b1248f16 |
1500 | char *tmps = str_get(final); |
1501 | |
fe14fcc3 |
1502 | str = str_mortal(st[sp+1]); |
b1248f16 |
1503 | while (!str->str_nok && str->str_cur <= final->str_cur && |
1504 | strNE(str->str_ptr,tmps) ) { |
1505 | (void)astore(ary, ++sp, str); |
fe14fcc3 |
1506 | str = str_2mortal(str_smake(str)); |
b1248f16 |
1507 | str_inc(str); |
1508 | } |
1509 | if (strEQ(str->str_ptr,tmps)) |
1510 | (void)astore(ary, ++sp, str); |
a687059c |
1511 | } |
1512 | return sp; |
1513 | } |
1514 | |
1515 | int |
fe14fcc3 |
1516 | do_repeatary(arglast) |
1517 | int *arglast; |
1518 | { |
1519 | STR **st = stack->ary_array; |
1520 | register int sp = arglast[0]; |
1521 | register int items = arglast[1] - sp; |
1522 | register int count = (int) str_gnum(st[arglast[2]]); |
1523 | register ARRAY *ary = stack; |
1524 | register int i; |
1525 | int max; |
1526 | |
1527 | max = items * count; |
1528 | if (max > 0 && sp + max > stack->ary_max) { |
1529 | astore(stack, sp + max, Nullstr); |
1530 | st = stack->ary_array; |
1531 | } |
1532 | if (count > 1) { |
1533 | for (i = arglast[1]; i > sp; i--) |
1534 | st[i]->str_pok &= ~SP_TEMP; |
1535 | repeatcpy((char*)&st[arglast[1]+1], (char*)&st[sp+1], |
1536 | items * sizeof(STR*), count); |
1537 | } |
1538 | sp += max; |
1539 | |
1540 | return sp; |
1541 | } |
1542 | |
1543 | int |
c2ab57d4 |
1544 | do_caller(arg,maxarg,gimme,arglast) |
1545 | ARG *arg; |
1546 | int maxarg; |
1547 | int gimme; |
1548 | int *arglast; |
1549 | { |
1550 | STR **st = stack->ary_array; |
1551 | register int sp = arglast[0]; |
1552 | register CSV *csv = curcsv; |
1553 | STR *str; |
1554 | int count = 0; |
1555 | |
1556 | if (!csv) |
1557 | fatal("There is no caller"); |
1558 | if (maxarg) |
1559 | count = (int) str_gnum(st[sp+1]); |
1560 | for (;;) { |
1561 | if (!csv) |
1562 | return sp; |
c623bd54 |
1563 | if (DBsub && csv->curcsv && csv->curcsv->sub == stab_sub(DBsub)) |
c2ab57d4 |
1564 | count++; |
1565 | if (!count--) |
1566 | break; |
1567 | csv = csv->curcsv; |
1568 | } |
1569 | if (gimme != G_ARRAY) { |
1570 | STR *str = arg->arg_ptr.arg_str; |
1571 | str_set(str,csv->curcmd->c_stash->tbl_name); |
1572 | STABSET(str); |
1573 | st[++sp] = str; |
1574 | return sp; |
1575 | } |
1576 | |
1577 | #ifndef lint |
1578 | (void)astore(stack,++sp, |
fe14fcc3 |
1579 | str_2mortal(str_make(csv->curcmd->c_stash->tbl_name,0)) ); |
c2ab57d4 |
1580 | (void)astore(stack,++sp, |
fe14fcc3 |
1581 | str_2mortal(str_make(stab_val(csv->curcmd->c_filestab)->str_ptr,0)) ); |
c2ab57d4 |
1582 | (void)astore(stack,++sp, |
fe14fcc3 |
1583 | str_2mortal(str_nmake((double)csv->curcmd->c_line)) ); |
c2ab57d4 |
1584 | if (!maxarg) |
1585 | return sp; |
57ebbfd0 |
1586 | str = Str_new(49,0); |
c2ab57d4 |
1587 | stab_fullname(str, csv->stab); |
fe14fcc3 |
1588 | (void)astore(stack,++sp, str_2mortal(str)); |
c2ab57d4 |
1589 | (void)astore(stack,++sp, |
fe14fcc3 |
1590 | str_2mortal(str_nmake((double)csv->hasargs)) ); |
c2ab57d4 |
1591 | (void)astore(stack,++sp, |
fe14fcc3 |
1592 | str_2mortal(str_nmake((double)csv->wantarray)) ); |
c2ab57d4 |
1593 | if (csv->hasargs) { |
1594 | ARRAY *ary = csv->argarray; |
1595 | |
1596 | if (dbargs->ary_max < ary->ary_fill) |
1597 | astore(dbargs,ary->ary_fill,Nullstr); |
1598 | Copy(ary->ary_array, dbargs->ary_array, ary->ary_fill+1, STR*); |
1599 | dbargs->ary_fill = ary->ary_fill; |
1600 | } |
1601 | #else |
1602 | (void)astore(stack,++sp, |
fe14fcc3 |
1603 | str_2mortal(str_make("",0))); |
c2ab57d4 |
1604 | #endif |
1605 | return sp; |
1606 | } |
1607 | |
1608 | int |
a687059c |
1609 | do_tms(str,gimme,arglast) |
1610 | STR *str; |
1611 | int gimme; |
1612 | int *arglast; |
1613 | { |
c2ab57d4 |
1614 | #ifdef MSDOS |
1615 | return -1; |
1616 | #else |
a687059c |
1617 | STR **st = stack->ary_array; |
1618 | register int sp = arglast[0]; |
1619 | |
1620 | if (gimme != G_ARRAY) { |
1621 | str_sset(str,&str_undef); |
1622 | STABSET(str); |
1623 | st[++sp] = str; |
1624 | return sp; |
1625 | } |
1626 | (void)times(×buf); |
1627 | |
1628 | #ifndef HZ |
1629 | #define HZ 60 |
1630 | #endif |
1631 | |
1632 | #ifndef lint |
1633 | (void)astore(stack,++sp, |
fe14fcc3 |
1634 | str_2mortal(str_nmake(((double)timesbuf.tms_utime)/HZ))); |
a687059c |
1635 | (void)astore(stack,++sp, |
fe14fcc3 |
1636 | str_2mortal(str_nmake(((double)timesbuf.tms_stime)/HZ))); |
a687059c |
1637 | (void)astore(stack,++sp, |
fe14fcc3 |
1638 | str_2mortal(str_nmake(((double)timesbuf.tms_cutime)/HZ))); |
a687059c |
1639 | (void)astore(stack,++sp, |
fe14fcc3 |
1640 | str_2mortal(str_nmake(((double)timesbuf.tms_cstime)/HZ))); |
a687059c |
1641 | #else |
1642 | (void)astore(stack,++sp, |
fe14fcc3 |
1643 | str_2mortal(str_nmake(0.0))); |
a687059c |
1644 | #endif |
1645 | return sp; |
c2ab57d4 |
1646 | #endif |
a687059c |
1647 | } |
1648 | |
1649 | int |
1650 | do_time(str,tmbuf,gimme,arglast) |
1651 | STR *str; |
1652 | struct tm *tmbuf; |
1653 | int gimme; |
1654 | int *arglast; |
1655 | { |
1656 | register ARRAY *ary = stack; |
1657 | STR **st = ary->ary_array; |
1658 | register int sp = arglast[0]; |
1659 | |
1660 | if (!tmbuf || gimme != G_ARRAY) { |
1661 | str_sset(str,&str_undef); |
1662 | STABSET(str); |
1663 | st[++sp] = str; |
1664 | return sp; |
1665 | } |
fe14fcc3 |
1666 | (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_sec))); |
1667 | (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_min))); |
1668 | (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_hour))); |
1669 | (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_mday))); |
1670 | (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_mon))); |
1671 | (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_year))); |
1672 | (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_wday))); |
1673 | (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_yday))); |
1674 | (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_isdst))); |
a687059c |
1675 | return sp; |
1676 | } |
1677 | |
1678 | int |
1679 | do_kv(str,hash,kv,gimme,arglast) |
1680 | STR *str; |
1681 | HASH *hash; |
1682 | int kv; |
1683 | int gimme; |
1684 | int *arglast; |
1685 | { |
1686 | register ARRAY *ary = stack; |
1687 | STR **st = ary->ary_array; |
1688 | register int sp = arglast[0]; |
1689 | int i; |
1690 | register HENT *entry; |
1691 | char *tmps; |
1692 | STR *tmpstr; |
1693 | int dokeys = (kv == O_KEYS || kv == O_HASH); |
1694 | int dovalues = (kv == O_VALUES || kv == O_HASH); |
1695 | |
1696 | if (gimme != G_ARRAY) { |
1697 | str_sset(str,&str_undef); |
1698 | STABSET(str); |
1699 | st[++sp] = str; |
1700 | return sp; |
1701 | } |
1702 | (void)hiterinit(hash); |
1703 | while (entry = hiternext(hash)) { |
1704 | if (dokeys) { |
1705 | tmps = hiterkey(entry,&i); |
62b28dd9 |
1706 | if (!i) |
1707 | tmps = ""; |
fe14fcc3 |
1708 | (void)astore(ary,++sp,str_2mortal(str_make(tmps,i))); |
a687059c |
1709 | } |
1710 | if (dovalues) { |
1711 | tmpstr = Str_new(45,0); |
1712 | #ifdef DEBUGGING |
1713 | if (debug & 8192) { |
1714 | sprintf(buf,"%d%%%d=%d\n",entry->hent_hash, |
1715 | hash->tbl_max+1,entry->hent_hash & hash->tbl_max); |
1716 | str_set(tmpstr,buf); |
1717 | } |
1718 | else |
1719 | #endif |
1720 | str_sset(tmpstr,hiterval(hash,entry)); |
fe14fcc3 |
1721 | (void)astore(ary,++sp,str_2mortal(tmpstr)); |
a687059c |
1722 | } |
1723 | } |
1724 | return sp; |
1725 | } |
1726 | |
1727 | int |
1728 | do_each(str,hash,gimme,arglast) |
1729 | STR *str; |
1730 | HASH *hash; |
1731 | int gimme; |
1732 | int *arglast; |
1733 | { |
1734 | STR **st = stack->ary_array; |
1735 | register int sp = arglast[0]; |
1736 | static STR *mystrk = Nullstr; |
1737 | HENT *entry = hiternext(hash); |
1738 | int i; |
1739 | char *tmps; |
1740 | |
1741 | if (mystrk) { |
1742 | str_free(mystrk); |
1743 | mystrk = Nullstr; |
1744 | } |
1745 | |
1746 | if (entry) { |
1747 | if (gimme == G_ARRAY) { |
1748 | tmps = hiterkey(entry, &i); |
62b28dd9 |
1749 | if (!i) |
1750 | tmps = ""; |
a687059c |
1751 | st[++sp] = mystrk = str_make(tmps,i); |
1752 | } |
1753 | st[++sp] = str; |
1754 | str_sset(str,hiterval(hash,entry)); |
1755 | STABSET(str); |
1756 | return sp; |
1757 | } |
1758 | else |
1759 | return sp; |
1760 | } |