| Commit | Line | Data |
|---|
| 03a14243 |
1 | /* $Header: dolist.c,v 3.0.1.1 89/10/26 23:11:51 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 $ |
| 03a14243 |
9 | * Revision 3.0.1.1 89/10/26 23:11:51 lwall |
| 10 | * patch1: split in a subroutine wrongly freed referenced arguments |
| 11 | * patch1: reverse didn't work |
| 12 | * |
| a687059c |
13 | * Revision 3.0 89/10/18 15:11:02 lwall |
| 14 | * 3.0 baseline |
| 15 | * |
| 16 | */ |
| 17 | |
| 18 | #include "EXTERN.h" |
| 19 | #include "perl.h" |
| 20 | |
| 21 | |
| 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; |
| 37 | |
| 38 | if (!spat) { |
| 39 | if (gimme == G_ARRAY) |
| 40 | return --sp; |
| 41 | str_set(str,Yes); |
| 42 | STABSET(str); |
| 43 | st[sp] = str; |
| 44 | return sp; |
| 45 | } |
| 46 | if (!s) |
| 47 | fatal("panic: do_match"); |
| 48 | if (spat->spat_flags & SPAT_USED) { |
| 49 | #ifdef DEBUGGING |
| 50 | if (debug & 8) |
| 51 | deb("2.SPAT USED\n"); |
| 52 | #endif |
| 53 | if (gimme == G_ARRAY) |
| 54 | return --sp; |
| 55 | str_set(str,No); |
| 56 | STABSET(str); |
| 57 | st[sp] = str; |
| 58 | return sp; |
| 59 | } |
| 60 | --sp; |
| 61 | if (spat->spat_runtime) { |
| 62 | nointrp = "|)"; |
| 63 | sp = eval(spat->spat_runtime,G_SCALAR,sp); |
| 64 | st = stack->ary_array; |
| 65 | t = str_get(tmpstr = st[sp--]); |
| 66 | nointrp = ""; |
| 67 | #ifdef DEBUGGING |
| 68 | if (debug & 8) |
| 69 | deb("2.SPAT /%s/\n",t); |
| 70 | #endif |
| 71 | if (spat->spat_regexp) |
| 72 | regfree(spat->spat_regexp); |
| 73 | spat->spat_regexp = regcomp(t,t+tmpstr->str_cur, |
| 74 | spat->spat_flags & SPAT_FOLD,1); |
| 75 | if (!*spat->spat_regexp->precomp && lastspat) |
| 76 | spat = lastspat; |
| 77 | if (spat->spat_flags & SPAT_KEEP) { |
| 78 | arg_free(spat->spat_runtime); /* it won't change, so */ |
| 79 | spat->spat_runtime = Nullarg; /* no point compiling again */ |
| 80 | } |
| 81 | if (!spat->spat_regexp->nparens) |
| 82 | gimme = G_SCALAR; /* accidental array context? */ |
| 83 | if (regexec(spat->spat_regexp, s, strend, s, 0, |
| 84 | srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr, |
| 85 | gimme == G_ARRAY)) { |
| 86 | if (spat->spat_regexp->subbase) |
| 87 | curspat = spat; |
| 88 | lastspat = spat; |
| 89 | goto gotcha; |
| 90 | } |
| 91 | else { |
| 92 | if (gimme == G_ARRAY) |
| 93 | return sp; |
| 94 | str_sset(str,&str_no); |
| 95 | STABSET(str); |
| 96 | st[++sp] = str; |
| 97 | return sp; |
| 98 | } |
| 99 | } |
| 100 | else { |
| 101 | #ifdef DEBUGGING |
| 102 | if (debug & 8) { |
| 103 | char ch; |
| 104 | |
| 105 | if (spat->spat_flags & SPAT_ONCE) |
| 106 | ch = '?'; |
| 107 | else |
| 108 | ch = '/'; |
| 109 | deb("2.SPAT %c%s%c\n",ch,spat->spat_regexp->precomp,ch); |
| 110 | } |
| 111 | #endif |
| 112 | if (!*spat->spat_regexp->precomp && lastspat) |
| 113 | spat = lastspat; |
| 114 | t = s; |
| 115 | if (hint) { |
| 116 | if (hint < s || hint > strend) |
| 117 | fatal("panic: hint in do_match"); |
| 118 | s = hint; |
| 119 | hint = Nullch; |
| 120 | if (spat->spat_regexp->regback >= 0) { |
| 121 | s -= spat->spat_regexp->regback; |
| 122 | if (s < t) |
| 123 | s = t; |
| 124 | } |
| 125 | else |
| 126 | s = t; |
| 127 | } |
| 128 | else if (spat->spat_short) { |
| 129 | if (spat->spat_flags & SPAT_SCANFIRST) { |
| 130 | if (srchstr->str_pok & SP_STUDIED) { |
| 131 | if (screamfirst[spat->spat_short->str_rare] < 0) |
| 132 | goto nope; |
| 133 | else if (!(s = screaminstr(srchstr,spat->spat_short))) |
| 134 | goto nope; |
| 135 | else if (spat->spat_flags & SPAT_ALL) |
| 136 | goto yup; |
| 137 | } |
| 138 | #ifndef lint |
| 139 | else if (!(s = fbminstr((unsigned char*)s, |
| 140 | (unsigned char*)strend, spat->spat_short))) |
| 141 | goto nope; |
| 142 | #endif |
| 143 | else if (spat->spat_flags & SPAT_ALL) |
| 144 | goto yup; |
| 145 | if (s && spat->spat_regexp->regback >= 0) { |
| 146 | ++spat->spat_short->str_u.str_useful; |
| 147 | s -= spat->spat_regexp->regback; |
| 148 | if (s < t) |
| 149 | s = t; |
| 150 | } |
| 151 | else |
| 152 | s = t; |
| 153 | } |
| 154 | else if (!multiline && (*spat->spat_short->str_ptr != *s || |
| 155 | bcmp(spat->spat_short->str_ptr, s, spat->spat_slen) )) |
| 156 | goto nope; |
| 157 | if (--spat->spat_short->str_u.str_useful < 0) { |
| 158 | str_free(spat->spat_short); |
| 159 | spat->spat_short = Nullstr; /* opt is being useless */ |
| 160 | } |
| 161 | } |
| 162 | if (!spat->spat_regexp->nparens) |
| 163 | gimme = G_SCALAR; /* accidental array context? */ |
| 164 | if (regexec(spat->spat_regexp, s, strend, t, 0, |
| 165 | srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr, |
| 166 | gimme == G_ARRAY)) { |
| 167 | if (spat->spat_regexp->subbase) |
| 168 | curspat = spat; |
| 169 | lastspat = spat; |
| 170 | if (spat->spat_flags & SPAT_ONCE) |
| 171 | spat->spat_flags |= SPAT_USED; |
| 172 | goto gotcha; |
| 173 | } |
| 174 | else { |
| 175 | if (gimme == G_ARRAY) |
| 176 | return sp; |
| 177 | str_sset(str,&str_no); |
| 178 | STABSET(str); |
| 179 | st[++sp] = str; |
| 180 | return sp; |
| 181 | } |
| 182 | } |
| 183 | /*NOTREACHED*/ |
| 184 | |
| 185 | gotcha: |
| 186 | if (gimme == G_ARRAY) { |
| 187 | int iters, i, len; |
| 188 | |
| 189 | iters = spat->spat_regexp->nparens; |
| 190 | if (sp + iters >= stack->ary_max) { |
| 191 | astore(stack,sp + iters, Nullstr); |
| 192 | st = stack->ary_array; /* possibly realloced */ |
| 193 | } |
| 194 | |
| 195 | for (i = 1; i <= iters; i++) { |
| 196 | st[++sp] = str_static(&str_no); |
| 197 | if (s = spat->spat_regexp->startp[i]) { |
| 198 | len = spat->spat_regexp->endp[i] - s; |
| 199 | if (len > 0) |
| 200 | str_nset(st[sp],s,len); |
| 201 | } |
| 202 | } |
| 203 | return sp; |
| 204 | } |
| 205 | else { |
| 206 | str_sset(str,&str_yes); |
| 207 | STABSET(str); |
| 208 | st[++sp] = str; |
| 209 | return sp; |
| 210 | } |
| 211 | |
| 212 | yup: |
| 213 | ++spat->spat_short->str_u.str_useful; |
| 214 | lastspat = spat; |
| 215 | if (spat->spat_flags & SPAT_ONCE) |
| 216 | spat->spat_flags |= SPAT_USED; |
| 217 | if (sawampersand) { |
| 218 | char *tmps; |
| 219 | |
| 220 | tmps = spat->spat_regexp->subbase = nsavestr(t,strend-t); |
| 221 | tmps = spat->spat_regexp->startp[0] = tmps + (s - t); |
| 222 | spat->spat_regexp->endp[0] = tmps + spat->spat_short->str_cur; |
| 223 | curspat = spat; |
| 224 | } |
| 225 | str_sset(str,&str_yes); |
| 226 | STABSET(str); |
| 227 | st[++sp] = str; |
| 228 | return sp; |
| 229 | |
| 230 | nope: |
| 231 | ++spat->spat_short->str_u.str_useful; |
| 232 | if (gimme == G_ARRAY) |
| 233 | return sp; |
| 234 | str_sset(str,&str_no); |
| 235 | STABSET(str); |
| 236 | st[++sp] = str; |
| 237 | return sp; |
| 238 | } |
| 239 | |
| 240 | int |
| 241 | do_split(str,spat,limit,gimme,arglast) |
| 242 | STR *str; |
| 243 | register SPAT *spat; |
| 244 | register int limit; |
| 245 | int gimme; |
| 246 | int *arglast; |
| 247 | { |
| 248 | register ARRAY *ary = stack; |
| 249 | STR **st = ary->ary_array; |
| 250 | register int sp = arglast[0] + 1; |
| 251 | register char *s = str_get(st[sp]); |
| 252 | char *strend = s + st[sp--]->str_cur; |
| 253 | register STR *dstr; |
| 254 | register char *m; |
| 255 | int iters = 0; |
| 256 | int i; |
| 257 | char *orig; |
| 258 | int origlimit = limit; |
| 259 | int realarray = 0; |
| 260 | |
| 261 | if (!spat || !s) |
| 262 | fatal("panic: do_split"); |
| 263 | else if (spat->spat_runtime) { |
| 264 | nointrp = "|)"; |
| 265 | sp = eval(spat->spat_runtime,G_SCALAR,sp); |
| 266 | st = stack->ary_array; |
| 267 | m = str_get(dstr = st[sp--]); |
| 268 | nointrp = ""; |
| 269 | if (!dstr->str_cur || (*m == ' ' && dstr->str_cur == 1)) { |
| 270 | str_set(dstr,"\\s+"); |
| 271 | m = dstr->str_ptr; |
| 272 | spat->spat_flags |= SPAT_SKIPWHITE; |
| 273 | } |
| 274 | if (spat->spat_regexp) |
| 275 | regfree(spat->spat_regexp); |
| 276 | spat->spat_regexp = regcomp(m,m+dstr->str_cur, |
| 277 | spat->spat_flags & SPAT_FOLD,1); |
| 278 | if (spat->spat_flags & SPAT_KEEP || |
| 279 | (spat->spat_runtime->arg_type == O_ITEM && |
| 280 | (spat->spat_runtime[1].arg_type & A_MASK) == A_SINGLE) ) { |
| 281 | arg_free(spat->spat_runtime); /* it won't change, so */ |
| 282 | spat->spat_runtime = Nullarg; /* no point compiling again */ |
| 283 | } |
| 284 | } |
| 285 | #ifdef DEBUGGING |
| 286 | if (debug & 8) { |
| 287 | deb("2.SPAT /%s/\n",spat->spat_regexp->precomp); |
| 288 | } |
| 289 | #endif |
| 290 | ary = stab_xarray(spat->spat_repl[1].arg_ptr.arg_stab); |
| 291 | if (ary && ((ary->ary_flags & ARF_REAL) || gimme != G_ARRAY)) { |
| a687059c |
292 | realarray = 1; |
| 03a14243 |
293 | if (!(ary->ary_flags & ARF_REAL)) { |
| 294 | ary->ary_flags |= ARF_REAL; |
| 295 | for (i = ary->ary_fill; i >= 0; i--) |
| 296 | ary->ary_array[i] = Nullstr; /* don't free mere refs */ |
| 297 | } |
| a687059c |
298 | ary->ary_fill = -1; |
| 299 | sp = -1; /* temporarily switch stacks */ |
| 300 | } |
| 301 | else |
| 302 | ary = stack; |
| 303 | orig = s; |
| 304 | if (spat->spat_flags & SPAT_SKIPWHITE) { |
| 305 | while (isspace(*s)) |
| 306 | s++; |
| 307 | } |
| 308 | if (!limit) |
| 309 | limit = 10001; |
| 310 | if (spat->spat_short) { |
| 311 | i = spat->spat_short->str_cur; |
| 312 | if (i == 1) { |
| 313 | i = *spat->spat_short->str_ptr; |
| 314 | while (--limit) { |
| 315 | for (m = s; m < strend && *m != i; m++) ; |
| 316 | if (m >= strend) |
| 317 | break; |
| 318 | if (realarray) |
| 319 | dstr = Str_new(30,m-s); |
| 320 | else |
| 321 | dstr = str_static(&str_undef); |
| 322 | str_nset(dstr,s,m-s); |
| 323 | (void)astore(ary, ++sp, dstr); |
| 324 | s = m + 1; |
| 325 | } |
| 326 | } |
| 327 | else { |
| 328 | #ifndef lint |
| 329 | while (s < strend && --limit && |
| 330 | (m=fbminstr((unsigned char*)s, (unsigned char*)strend, |
| 331 | spat->spat_short)) ) |
| 332 | #endif |
| 333 | { |
| 334 | if (realarray) |
| 335 | dstr = Str_new(31,m-s); |
| 336 | else |
| 337 | dstr = str_static(&str_undef); |
| 338 | str_nset(dstr,s,m-s); |
| 339 | (void)astore(ary, ++sp, dstr); |
| 340 | s = m + i; |
| 341 | } |
| 342 | } |
| 343 | } |
| 344 | else { |
| 345 | while (s < strend && --limit && |
| 346 | regexec(spat->spat_regexp, s, strend, orig, 1, Nullstr, TRUE) ) { |
| 347 | if (spat->spat_regexp->subbase |
| 348 | && spat->spat_regexp->subbase != orig) { |
| 349 | m = s; |
| 350 | s = orig; |
| 351 | orig = spat->spat_regexp->subbase; |
| 352 | s = orig + (m - s); |
| 353 | strend = s + (strend - m); |
| 354 | } |
| 355 | m = spat->spat_regexp->startp[0]; |
| 356 | if (realarray) |
| 357 | dstr = Str_new(32,m-s); |
| 358 | else |
| 359 | dstr = str_static(&str_undef); |
| 360 | str_nset(dstr,s,m-s); |
| 361 | (void)astore(ary, ++sp, dstr); |
| 362 | if (spat->spat_regexp->nparens) { |
| 363 | for (i = 1; i <= spat->spat_regexp->nparens; i++) { |
| 364 | s = spat->spat_regexp->startp[i]; |
| 365 | m = spat->spat_regexp->endp[i]; |
| 366 | if (realarray) |
| 367 | dstr = Str_new(33,m-s); |
| 368 | else |
| 369 | dstr = str_static(&str_undef); |
| 370 | str_nset(dstr,s,m-s); |
| 371 | (void)astore(ary, ++sp, dstr); |
| 372 | } |
| 373 | } |
| 374 | s = spat->spat_regexp->endp[0]; |
| 375 | } |
| 376 | } |
| 377 | if (realarray) |
| 378 | iters = sp + 1; |
| 379 | else |
| 380 | iters = sp - arglast[0]; |
| 381 | if (iters > 9999) |
| 382 | fatal("Split loop"); |
| 383 | if (s < strend || origlimit) { /* keep field after final delim? */ |
| 384 | if (realarray) |
| 385 | dstr = Str_new(34,strend-s); |
| 386 | else |
| 387 | dstr = str_static(&str_undef); |
| 388 | str_nset(dstr,s,strend-s); |
| 389 | (void)astore(ary, ++sp, dstr); |
| 390 | iters++; |
| 391 | } |
| 392 | else { |
| 393 | #ifndef I286 |
| 394 | while (iters > 0 && ary->ary_array[sp]->str_cur == 0) |
| 395 | iters--,sp--; |
| 396 | #else |
| 397 | char *zaps; |
| 398 | int zapb; |
| 399 | |
| 400 | if (iters > 0) { |
| 401 | zaps = str_get(afetch(ary,sp,FALSE)); |
| 402 | zapb = (int) *zaps; |
| 403 | } |
| 404 | |
| 405 | while (iters > 0 && (!zapb)) { |
| 406 | iters--,sp--; |
| 407 | if (iters > 0) { |
| 408 | zaps = str_get(afetch(ary,iters-1,FALSE)); |
| 409 | zapb = (int) *zaps; |
| 410 | } |
| 411 | } |
| 412 | #endif |
| 413 | } |
| 414 | if (realarray) { |
| 415 | ary->ary_fill = sp; |
| 416 | if (gimme == G_ARRAY) { |
| 417 | sp++; |
| 418 | astore(stack, arglast[0] + 1 + sp, Nullstr); |
| 419 | Copy(ary->ary_array, stack->ary_array + arglast[0] + 1, sp, STR*); |
| 420 | return arglast[0] + sp; |
| 421 | } |
| 422 | } |
| 423 | else { |
| 424 | if (gimme == G_ARRAY) |
| 425 | return sp; |
| 426 | } |
| 427 | sp = arglast[0] + 1; |
| 428 | str_numset(str,(double)iters); |
| 429 | STABSET(str); |
| 430 | st[sp] = str; |
| 431 | return sp; |
| 432 | } |
| 433 | |
| 434 | int |
| 435 | do_unpack(str,gimme,arglast) |
| 436 | STR *str; |
| 437 | int gimme; |
| 438 | int *arglast; |
| 439 | { |
| 440 | STR **st = stack->ary_array; |
| 441 | register int sp = arglast[0] + 1; |
| 442 | register char *pat = str_get(st[sp++]); |
| 443 | register char *s = str_get(st[sp]); |
| 444 | char *strend = s + st[sp--]->str_cur; |
| 445 | register char *patend = pat + st[sp]->str_cur; |
| 446 | int datumtype; |
| 447 | register int len; |
| 448 | |
| 449 | /* These must not be in registers: */ |
| 450 | char achar; |
| 451 | short ashort; |
| 452 | int aint; |
| 453 | long along; |
| 454 | unsigned char auchar; |
| 455 | unsigned short aushort; |
| 456 | unsigned int auint; |
| 457 | unsigned long aulong; |
| 458 | char *aptr; |
| 459 | |
| 460 | if (gimme != G_ARRAY) { |
| 461 | str_sset(str,&str_undef); |
| 462 | STABSET(str); |
| 463 | st[sp] = str; |
| 464 | return sp; |
| 465 | } |
| 466 | sp--; |
| 467 | while (pat < patend) { |
| 468 | datumtype = *pat++; |
| 469 | if (isdigit(*pat)) { |
| 470 | len = atoi(pat); |
| 471 | while (isdigit(*pat)) |
| 472 | pat++; |
| 473 | } |
| 474 | else |
| 475 | len = 1; |
| 476 | switch(datumtype) { |
| 477 | default: |
| 478 | break; |
| 479 | case 'x': |
| 480 | s += len; |
| 481 | break; |
| 482 | case 'A': |
| 483 | case 'a': |
| 484 | if (s + len > strend) |
| 485 | len = strend - s; |
| 486 | str = Str_new(35,len); |
| 487 | str_nset(str,s,len); |
| 488 | s += len; |
| 489 | if (datumtype == 'A') { |
| 490 | aptr = s; /* borrow register */ |
| 491 | s = str->str_ptr + len - 1; |
| 492 | while (s >= str->str_ptr && (!*s || isspace(*s))) |
| 493 | s--; |
| 494 | *++s = '\0'; |
| 495 | str->str_cur = s - str->str_ptr; |
| 496 | s = aptr; /* unborrow register */ |
| 497 | } |
| 498 | (void)astore(stack, ++sp, str_2static(str)); |
| 499 | break; |
| 500 | case 'c': |
| 501 | while (len-- > 0) { |
| 502 | if (s + sizeof(char) > strend) |
| 503 | achar = 0; |
| 504 | else { |
| 505 | bcopy(s,(char*)&achar,sizeof(char)); |
| 506 | s += sizeof(char); |
| 507 | } |
| 508 | str = Str_new(36,0); |
| 509 | aint = achar; |
| 510 | if (aint >= 128) /* fake up signed chars */ |
| 511 | aint -= 256; |
| 512 | str_numset(str,(double)aint); |
| 513 | (void)astore(stack, ++sp, str_2static(str)); |
| 514 | } |
| 515 | break; |
| 516 | case 'C': |
| 517 | while (len-- > 0) { |
| 518 | if (s + sizeof(unsigned char) > strend) |
| 519 | auchar = 0; |
| 520 | else { |
| 521 | bcopy(s,(char*)&auchar,sizeof(unsigned char)); |
| 522 | s += sizeof(unsigned char); |
| 523 | } |
| 524 | str = Str_new(37,0); |
| 525 | auint = auchar; /* some can't cast uchar to double */ |
| 526 | str_numset(str,(double)auint); |
| 527 | (void)astore(stack, ++sp, str_2static(str)); |
| 528 | } |
| 529 | break; |
| 530 | case 's': |
| 531 | while (len-- > 0) { |
| 532 | if (s + sizeof(short) > strend) |
| 533 | ashort = 0; |
| 534 | else { |
| 535 | bcopy(s,(char*)&ashort,sizeof(short)); |
| 536 | s += sizeof(short); |
| 537 | } |
| 538 | str = Str_new(38,0); |
| 539 | str_numset(str,(double)ashort); |
| 540 | (void)astore(stack, ++sp, str_2static(str)); |
| 541 | } |
| 542 | break; |
| 543 | case 'n': |
| 544 | case 'S': |
| 545 | while (len-- > 0) { |
| 546 | if (s + sizeof(unsigned short) > strend) |
| 547 | aushort = 0; |
| 548 | else { |
| 549 | bcopy(s,(char*)&aushort,sizeof(unsigned short)); |
| 550 | s += sizeof(unsigned short); |
| 551 | } |
| 552 | str = Str_new(39,0); |
| 553 | #ifdef NTOHS |
| 554 | if (datumtype == 'n') |
| 555 | aushort = ntohs(aushort); |
| 556 | #endif |
| 557 | str_numset(str,(double)aushort); |
| 558 | (void)astore(stack, ++sp, str_2static(str)); |
| 559 | } |
| 560 | break; |
| 561 | case 'i': |
| 562 | while (len-- > 0) { |
| 563 | if (s + sizeof(int) > strend) |
| 564 | aint = 0; |
| 565 | else { |
| 566 | bcopy(s,(char*)&aint,sizeof(int)); |
| 567 | s += sizeof(int); |
| 568 | } |
| 569 | str = Str_new(40,0); |
| 570 | str_numset(str,(double)aint); |
| 571 | (void)astore(stack, ++sp, str_2static(str)); |
| 572 | } |
| 573 | break; |
| 574 | case 'I': |
| 575 | while (len-- > 0) { |
| 576 | if (s + sizeof(unsigned int) > strend) |
| 577 | auint = 0; |
| 578 | else { |
| 579 | bcopy(s,(char*)&auint,sizeof(unsigned int)); |
| 580 | s += sizeof(unsigned int); |
| 581 | } |
| 582 | str = Str_new(41,0); |
| 583 | str_numset(str,(double)auint); |
| 584 | (void)astore(stack, ++sp, str_2static(str)); |
| 585 | } |
| 586 | break; |
| 587 | case 'l': |
| 588 | while (len-- > 0) { |
| 589 | if (s + sizeof(long) > strend) |
| 590 | along = 0; |
| 591 | else { |
| 592 | bcopy(s,(char*)&along,sizeof(long)); |
| 593 | s += sizeof(long); |
| 594 | } |
| 595 | str = Str_new(42,0); |
| 596 | str_numset(str,(double)along); |
| 597 | (void)astore(stack, ++sp, str_2static(str)); |
| 598 | } |
| 599 | break; |
| 600 | case 'N': |
| 601 | case 'L': |
| 602 | while (len-- > 0) { |
| 603 | if (s + sizeof(unsigned long) > strend) |
| 604 | aulong = 0; |
| 605 | else { |
| 606 | bcopy(s,(char*)&aulong,sizeof(unsigned long)); |
| 607 | s += sizeof(unsigned long); |
| 608 | } |
| 609 | str = Str_new(43,0); |
| 610 | #ifdef NTOHL |
| 611 | if (datumtype == 'N') |
| 612 | aulong = ntohl(aulong); |
| 613 | #endif |
| 614 | str_numset(str,(double)aulong); |
| 615 | (void)astore(stack, ++sp, str_2static(str)); |
| 616 | } |
| 617 | break; |
| 618 | case 'p': |
| 619 | while (len-- > 0) { |
| 620 | if (s + sizeof(char*) > strend) |
| 621 | aptr = 0; |
| 622 | else { |
| 623 | bcopy(s,(char*)&aptr,sizeof(char*)); |
| 624 | s += sizeof(char*); |
| 625 | } |
| 626 | str = Str_new(44,0); |
| 627 | if (aptr) |
| 628 | str_set(str,aptr); |
| 629 | (void)astore(stack, ++sp, str_2static(str)); |
| 630 | } |
| 631 | break; |
| 632 | } |
| 633 | } |
| 634 | return sp; |
| 635 | } |
| 636 | |
| 637 | int |
| 638 | do_slice(stab,numarray,lval,gimme,arglast) |
| 639 | register STAB *stab; |
| 640 | int numarray; |
| 641 | int lval; |
| 642 | int gimme; |
| 643 | int *arglast; |
| 644 | { |
| 645 | register STR **st = stack->ary_array; |
| 646 | register int sp = arglast[1]; |
| 647 | register int max = arglast[2]; |
| 648 | register char *tmps; |
| 649 | register int len; |
| 650 | register int magic = 0; |
| 651 | |
| 652 | if (lval && !numarray) { |
| 653 | if (stab == envstab) |
| 654 | magic = 'E'; |
| 655 | else if (stab == sigstab) |
| 656 | magic = 'S'; |
| 657 | #ifdef SOME_DBM |
| 658 | else if (stab_hash(stab)->tbl_dbm) |
| 659 | magic = 'D'; |
| 660 | #endif /* SOME_DBM */ |
| 661 | } |
| 662 | |
| 663 | if (gimme == G_ARRAY) { |
| 664 | if (numarray) { |
| 665 | while (sp < max) { |
| 666 | if (st[++sp]) { |
| 667 | st[sp-1] = afetch(stab_array(stab),(int)str_gnum(st[sp]), |
| 668 | lval); |
| 669 | } |
| 670 | else |
| 671 | st[sp-1] = Nullstr; |
| 672 | } |
| 673 | } |
| 674 | else { |
| 675 | while (sp < max) { |
| 676 | if (st[++sp]) { |
| 677 | tmps = str_get(st[sp]); |
| 678 | len = st[sp]->str_cur; |
| 679 | st[sp-1] = hfetch(stab_hash(stab),tmps,len, lval); |
| 680 | if (magic) |
| 681 | str_magic(st[sp-1],stab,magic,tmps,len); |
| 682 | } |
| 683 | else |
| 684 | st[sp-1] = Nullstr; |
| 685 | } |
| 686 | } |
| 687 | sp--; |
| 688 | } |
| 689 | else { |
| 690 | if (numarray) { |
| 691 | if (st[max]) |
| 692 | st[sp] = afetch(stab_array(stab),(int)str_gnum(st[max]), lval); |
| 693 | else |
| 694 | st[sp] = Nullstr; |
| 695 | } |
| 696 | else { |
| 697 | if (st[max]) { |
| 698 | tmps = str_get(st[max]); |
| 699 | len = st[max]->str_cur; |
| 700 | st[sp] = hfetch(stab_hash(stab),tmps,len, lval); |
| 701 | if (magic) |
| 702 | str_magic(st[sp],stab,magic,tmps,len); |
| 703 | } |
| 704 | else |
| 705 | st[sp] = Nullstr; |
| 706 | } |
| 707 | } |
| 708 | return sp; |
| 709 | } |
| 710 | |
| 711 | int |
| 712 | do_grep(arg,str,gimme,arglast) |
| 713 | register ARG *arg; |
| 714 | STR *str; |
| 715 | int gimme; |
| 716 | int *arglast; |
| 717 | { |
| 718 | STR **st = stack->ary_array; |
| 719 | register STR **dst = &st[arglast[1]]; |
| 720 | register STR **src = dst + 1; |
| 721 | register int sp = arglast[2]; |
| 722 | register int i = sp - arglast[1]; |
| 723 | int oldsave = savestack->ary_fill; |
| 724 | |
| 725 | savesptr(&stab_val(defstab)); |
| 726 | if ((arg[1].arg_type & A_MASK) != A_EXPR) |
| 727 | dehoist(arg,1); |
| 728 | arg = arg[1].arg_ptr.arg_arg; |
| 729 | while (i-- > 0) { |
| 730 | stab_val(defstab) = *src; |
| 731 | (void)eval(arg,G_SCALAR,sp); |
| 732 | if (str_true(st[sp+1])) |
| 733 | *dst++ = *src; |
| 734 | src++; |
| 735 | } |
| 736 | restorelist(oldsave); |
| 737 | if (gimme != G_ARRAY) { |
| 738 | str_sset(str,&str_undef); |
| 739 | STABSET(str); |
| 740 | st[arglast[0]+1] = str; |
| 741 | return arglast[0]+1; |
| 742 | } |
| 743 | return arglast[0] + (dst - &st[arglast[1]]); |
| 744 | } |
| 745 | |
| 746 | int |
| 747 | do_reverse(str,gimme,arglast) |
| 748 | STR *str; |
| 749 | int gimme; |
| 750 | int *arglast; |
| 751 | { |
| 752 | STR **st = stack->ary_array; |
| 753 | register STR **up = &st[arglast[1]]; |
| 754 | register STR **down = &st[arglast[2]]; |
| 755 | register int i = arglast[2] - arglast[1]; |
| 756 | |
| 757 | if (gimme != G_ARRAY) { |
| 758 | str_sset(str,&str_undef); |
| 759 | STABSET(str); |
| 760 | st[arglast[0]+1] = str; |
| 761 | return arglast[0]+1; |
| 762 | } |
| 763 | while (i-- > 0) { |
| 764 | *up++ = *down; |
| 03a14243 |
765 | if (i-- > 0) |
| 766 | *down-- = *up; |
| a687059c |
767 | } |
| 03a14243 |
768 | i = arglast[2] - arglast[1]; |
| 769 | Copy(down+1,up,i/2,STR*); |
| a687059c |
770 | return arglast[2] - 1; |
| 771 | } |
| 772 | |
| 773 | static CMD *sortcmd; |
| 774 | static STAB *firststab = Nullstab; |
| 775 | static STAB *secondstab = Nullstab; |
| 776 | |
| 777 | int |
| 778 | do_sort(str,stab,gimme,arglast) |
| 779 | STR *str; |
| 780 | STAB *stab; |
| 781 | int gimme; |
| 782 | int *arglast; |
| 783 | { |
| 784 | STR **st = stack->ary_array; |
| 785 | int sp = arglast[1]; |
| 786 | register STR **up; |
| 787 | register int max = arglast[2] - sp; |
| 788 | register int i; |
| 789 | int sortcmp(); |
| 790 | int sortsub(); |
| 791 | STR *oldfirst; |
| 792 | STR *oldsecond; |
| 793 | ARRAY *oldstack; |
| 794 | static ARRAY *sortstack = Null(ARRAY*); |
| 795 | |
| 796 | if (gimme != G_ARRAY) { |
| 797 | str_sset(str,&str_undef); |
| 798 | STABSET(str); |
| 799 | st[sp] = str; |
| 800 | return sp; |
| 801 | } |
| 802 | up = &st[sp]; |
| 803 | for (i = 0; i < max; i++) { |
| 804 | if ((*up = up[1]) && !(*up)->str_pok) |
| 805 | (void)str_2ptr(*up); |
| 806 | up++; |
| 807 | } |
| 808 | sp--; |
| 809 | if (max > 1) { |
| 810 | if (stab_sub(stab) && (sortcmd = stab_sub(stab)->cmd)) { |
| 811 | int oldtmps_base = tmps_base; |
| 812 | |
| 813 | if (!sortstack) { |
| 814 | sortstack = anew(Nullstab); |
| 815 | sortstack->ary_flags = 0; |
| 816 | } |
| 817 | oldstack = stack; |
| 818 | stack = sortstack; |
| 819 | tmps_base = tmps_max; |
| 820 | if (!firststab) { |
| 821 | firststab = stabent("a",TRUE); |
| 822 | secondstab = stabent("b",TRUE); |
| 823 | } |
| 824 | oldfirst = stab_val(firststab); |
| 825 | oldsecond = stab_val(secondstab); |
| 826 | #ifndef lint |
| 827 | qsort((char*)(st+sp+1),max,sizeof(STR*),sortsub); |
| 828 | #else |
| 829 | qsort(Nullch,max,sizeof(STR*),sortsub); |
| 830 | #endif |
| 831 | stab_val(firststab) = oldfirst; |
| 832 | stab_val(secondstab) = oldsecond; |
| 833 | tmps_base = oldtmps_base; |
| 834 | stack = oldstack; |
| 835 | } |
| 836 | #ifndef lint |
| 837 | else |
| 838 | qsort((char*)(st+sp+1),max,sizeof(STR*),sortcmp); |
| 839 | #endif |
| 840 | } |
| 841 | up = &st[arglast[1]]; |
| 842 | while (max > 0 && !*up) |
| 843 | max--,up--; |
| 844 | return sp+max; |
| 845 | } |
| 846 | |
| 847 | int |
| 848 | sortsub(str1,str2) |
| 849 | STR **str1; |
| 850 | STR **str2; |
| 851 | { |
| 852 | if (!*str1) |
| 853 | return -1; |
| 854 | if (!*str2) |
| 855 | return 1; |
| 856 | stab_val(firststab) = *str1; |
| 857 | stab_val(secondstab) = *str2; |
| 858 | cmd_exec(sortcmd,G_SCALAR,-1); |
| 859 | return (int)str_gnum(*stack->ary_array); |
| 860 | } |
| 861 | |
| 862 | sortcmp(strp1,strp2) |
| 863 | STR **strp1; |
| 864 | STR **strp2; |
| 865 | { |
| 866 | register STR *str1 = *strp1; |
| 867 | register STR *str2 = *strp2; |
| 868 | int retval; |
| 869 | |
| 870 | if (!str1) |
| 871 | return -1; |
| 872 | if (!str2) |
| 873 | return 1; |
| 874 | |
| 875 | if (str1->str_cur < str2->str_cur) { |
| 876 | if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur)) |
| 877 | return retval; |
| 878 | else |
| 879 | return -1; |
| 880 | } |
| 881 | else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur)) |
| 882 | return retval; |
| 883 | else if (str1->str_cur == str2->str_cur) |
| 884 | return 0; |
| 885 | else |
| 886 | return 1; |
| 887 | } |
| 888 | |
| 889 | int |
| 890 | do_range(gimme,arglast) |
| 891 | int gimme; |
| 892 | int *arglast; |
| 893 | { |
| 894 | STR **st = stack->ary_array; |
| 895 | register int sp = arglast[0]; |
| 896 | register int i = (int)str_gnum(st[sp+1]); |
| 897 | register ARRAY *ary = stack; |
| 898 | register STR *str; |
| 899 | int max = (int)str_gnum(st[sp+2]); |
| 900 | |
| 901 | if (gimme != G_ARRAY) |
| 902 | fatal("panic: do_range"); |
| 903 | |
| 904 | while (i <= max) { |
| 905 | (void)astore(ary, ++sp, str = str_static(&str_no)); |
| 906 | str_numset(str,(double)i++); |
| 907 | } |
| 908 | return sp; |
| 909 | } |
| 910 | |
| 911 | int |
| 912 | do_tms(str,gimme,arglast) |
| 913 | STR *str; |
| 914 | int gimme; |
| 915 | int *arglast; |
| 916 | { |
| 917 | STR **st = stack->ary_array; |
| 918 | register int sp = arglast[0]; |
| 919 | |
| 920 | if (gimme != G_ARRAY) { |
| 921 | str_sset(str,&str_undef); |
| 922 | STABSET(str); |
| 923 | st[++sp] = str; |
| 924 | return sp; |
| 925 | } |
| 926 | (void)times(×buf); |
| 927 | |
| 928 | #ifndef HZ |
| 929 | #define HZ 60 |
| 930 | #endif |
| 931 | |
| 932 | #ifndef lint |
| 933 | (void)astore(stack,++sp, |
| 934 | str_2static(str_nmake(((double)timesbuf.tms_utime)/HZ))); |
| 935 | (void)astore(stack,++sp, |
| 936 | str_2static(str_nmake(((double)timesbuf.tms_stime)/HZ))); |
| 937 | (void)astore(stack,++sp, |
| 938 | str_2static(str_nmake(((double)timesbuf.tms_cutime)/HZ))); |
| 939 | (void)astore(stack,++sp, |
| 940 | str_2static(str_nmake(((double)timesbuf.tms_cstime)/HZ))); |
| 941 | #else |
| 942 | (void)astore(stack,++sp, |
| 943 | str_2static(str_nmake(0.0))); |
| 944 | #endif |
| 945 | return sp; |
| 946 | } |
| 947 | |
| 948 | int |
| 949 | do_time(str,tmbuf,gimme,arglast) |
| 950 | STR *str; |
| 951 | struct tm *tmbuf; |
| 952 | int gimme; |
| 953 | int *arglast; |
| 954 | { |
| 955 | register ARRAY *ary = stack; |
| 956 | STR **st = ary->ary_array; |
| 957 | register int sp = arglast[0]; |
| 958 | |
| 959 | if (!tmbuf || gimme != G_ARRAY) { |
| 960 | str_sset(str,&str_undef); |
| 961 | STABSET(str); |
| 962 | st[++sp] = str; |
| 963 | return sp; |
| 964 | } |
| 965 | (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_sec))); |
| 966 | (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_min))); |
| 967 | (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_hour))); |
| 968 | (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_mday))); |
| 969 | (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_mon))); |
| 970 | (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_year))); |
| 971 | (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_wday))); |
| 972 | (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_yday))); |
| 973 | (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_isdst))); |
| 974 | return sp; |
| 975 | } |
| 976 | |
| 977 | int |
| 978 | do_kv(str,hash,kv,gimme,arglast) |
| 979 | STR *str; |
| 980 | HASH *hash; |
| 981 | int kv; |
| 982 | int gimme; |
| 983 | int *arglast; |
| 984 | { |
| 985 | register ARRAY *ary = stack; |
| 986 | STR **st = ary->ary_array; |
| 987 | register int sp = arglast[0]; |
| 988 | int i; |
| 989 | register HENT *entry; |
| 990 | char *tmps; |
| 991 | STR *tmpstr; |
| 992 | int dokeys = (kv == O_KEYS || kv == O_HASH); |
| 993 | int dovalues = (kv == O_VALUES || kv == O_HASH); |
| 994 | |
| 995 | if (gimme != G_ARRAY) { |
| 996 | str_sset(str,&str_undef); |
| 997 | STABSET(str); |
| 998 | st[++sp] = str; |
| 999 | return sp; |
| 1000 | } |
| 1001 | (void)hiterinit(hash); |
| 1002 | while (entry = hiternext(hash)) { |
| 1003 | if (dokeys) { |
| 1004 | tmps = hiterkey(entry,&i); |
| 1005 | (void)astore(ary,++sp,str_2static(str_make(tmps,i))); |
| 1006 | } |
| 1007 | if (dovalues) { |
| 1008 | tmpstr = Str_new(45,0); |
| 1009 | #ifdef DEBUGGING |
| 1010 | if (debug & 8192) { |
| 1011 | sprintf(buf,"%d%%%d=%d\n",entry->hent_hash, |
| 1012 | hash->tbl_max+1,entry->hent_hash & hash->tbl_max); |
| 1013 | str_set(tmpstr,buf); |
| 1014 | } |
| 1015 | else |
| 1016 | #endif |
| 1017 | str_sset(tmpstr,hiterval(hash,entry)); |
| 1018 | (void)astore(ary,++sp,str_2static(tmpstr)); |
| 1019 | } |
| 1020 | } |
| 1021 | return sp; |
| 1022 | } |
| 1023 | |
| 1024 | int |
| 1025 | do_each(str,hash,gimme,arglast) |
| 1026 | STR *str; |
| 1027 | HASH *hash; |
| 1028 | int gimme; |
| 1029 | int *arglast; |
| 1030 | { |
| 1031 | STR **st = stack->ary_array; |
| 1032 | register int sp = arglast[0]; |
| 1033 | static STR *mystrk = Nullstr; |
| 1034 | HENT *entry = hiternext(hash); |
| 1035 | int i; |
| 1036 | char *tmps; |
| 1037 | |
| 1038 | if (mystrk) { |
| 1039 | str_free(mystrk); |
| 1040 | mystrk = Nullstr; |
| 1041 | } |
| 1042 | |
| 1043 | if (entry) { |
| 1044 | if (gimme == G_ARRAY) { |
| 1045 | tmps = hiterkey(entry, &i); |
| 1046 | st[++sp] = mystrk = str_make(tmps,i); |
| 1047 | } |
| 1048 | st[++sp] = str; |
| 1049 | str_sset(str,hiterval(hash,entry)); |
| 1050 | STABSET(str); |
| 1051 | return sp; |
| 1052 | } |
| 1053 | else |
| 1054 | return sp; |
| 1055 | } |
projects / p5sagit/p5-mst-13.2.git / blame