| 1 | /* $RCSfile: stab.c,v $$Revision: 4.0.1.5 $$Date: 1993/02/05 19:42:47 $ |
| 2 | * |
| 3 | * Copyright (c) 1991, Larry Wall |
| 4 | * |
| 5 | * You may distribute under the terms of either the GNU General Public |
| 6 | * License or the Artistic License, as specified in the README file. |
| 7 | * |
| 8 | * $Log: stab.c,v $ |
| 9 | * Revision 4.0.1.5 1993/02/05 19:42:47 lwall |
| 10 | * patch36: length returned wrong value on certain semi-magical variables |
| 11 | * |
| 12 | * Revision 4.0.1.4 92/06/08 15:32:19 lwall |
| 13 | * patch20: fixed confusion between a *var's real name and its effective name |
| 14 | * patch20: the debugger now warns you on lines that can't set a breakpoint |
| 15 | * patch20: the debugger made perl forget the last pattern used by // |
| 16 | * patch20: paragraph mode now skips extra newlines automatically |
| 17 | * patch20: ($<,$>) = ... didn't work on some architectures |
| 18 | * |
| 19 | * Revision 4.0.1.3 91/11/05 18:35:33 lwall |
| 20 | * patch11: length($x) was sometimes wrong for numeric $x |
| 21 | * patch11: perl now issues warning if $SIG{'ALARM'} is referenced |
| 22 | * patch11: *foo = undef coredumped |
| 23 | * patch11: solitary subroutine references no longer trigger typo warnings |
| 24 | * patch11: local(*FILEHANDLE) had a memory leak |
| 25 | * |
| 26 | * Revision 4.0.1.2 91/06/07 11:55:53 lwall |
| 27 | * patch4: new copyright notice |
| 28 | * patch4: added $^P variable to control calling of perldb routines |
| 29 | * patch4: added $^F variable to specify maximum system fd, default 2 |
| 30 | * patch4: $` was busted inside s/// |
| 31 | * patch4: default top-of-form format is now FILEHANDLE_TOP |
| 32 | * patch4: length($`), length($&), length($') now optimized to avoid string copy |
| 33 | * patch4: $^D |= 1024 now does syntax tree dump at run-time |
| 34 | * |
| 35 | * Revision 4.0.1.1 91/04/12 09:10:24 lwall |
| 36 | * patch1: Configure now differentiates getgroups() type from getgid() type |
| 37 | * patch1: you may now use "die" and "caller" in a signal handler |
| 38 | * |
| 39 | * Revision 4.0 91/03/20 01:39:41 lwall |
| 40 | * 4.0 baseline. |
| 41 | * |
| 42 | */ |
| 43 | |
| 44 | #include "EXTERN.h" |
| 45 | #include "perl.h" |
| 46 | |
| 47 | #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) |
| 48 | #include <signal.h> |
| 49 | #endif |
| 50 | |
| 51 | static char *sig_name[] = { |
| 52 | SIG_NAME,0 |
| 53 | }; |
| 54 | |
| 55 | #ifdef VOIDSIG |
| 56 | #define handlertype void |
| 57 | #else |
| 58 | #define handlertype int |
| 59 | #endif |
| 60 | |
| 61 | static handlertype sighandler(); |
| 62 | |
| 63 | static int origalen = 0; |
| 64 | |
| 65 | STR * |
| 66 | stab_str(str) |
| 67 | STR *str; |
| 68 | { |
| 69 | STAB *stab = str->str_u.str_stab; |
| 70 | register int paren; |
| 71 | register char *s; |
| 72 | register int i; |
| 73 | |
| 74 | if (str->str_rare) |
| 75 | return stab_val(stab); |
| 76 | |
| 77 | switch (*stab->str_magic->str_ptr) { |
| 78 | case '\004': /* ^D */ |
| 79 | #ifdef DEBUGGING |
| 80 | str_numset(stab_val(stab),(double)(debug & 32767)); |
| 81 | #endif |
| 82 | break; |
| 83 | case '\006': /* ^F */ |
| 84 | str_numset(stab_val(stab),(double)maxsysfd); |
| 85 | break; |
| 86 | case '\t': /* ^I */ |
| 87 | if (inplace) |
| 88 | str_set(stab_val(stab), inplace); |
| 89 | else |
| 90 | str_sset(stab_val(stab),&str_undef); |
| 91 | break; |
| 92 | case '\020': /* ^P */ |
| 93 | str_numset(stab_val(stab),(double)perldb); |
| 94 | break; |
| 95 | case '\024': /* ^T */ |
| 96 | str_numset(stab_val(stab),(double)basetime); |
| 97 | break; |
| 98 | case '\027': /* ^W */ |
| 99 | str_numset(stab_val(stab),(double)dowarn); |
| 100 | break; |
| 101 | case '1': case '2': case '3': case '4': |
| 102 | case '5': case '6': case '7': case '8': case '9': case '&': |
| 103 | if (curspat) { |
| 104 | paren = atoi(stab_ename(stab)); |
| 105 | getparen: |
| 106 | if (curspat->spat_regexp && |
| 107 | paren <= curspat->spat_regexp->nparens && |
| 108 | (s = curspat->spat_regexp->startp[paren]) ) { |
| 109 | i = curspat->spat_regexp->endp[paren] - s; |
| 110 | if (i >= 0) |
| 111 | str_nset(stab_val(stab),s,i); |
| 112 | else |
| 113 | str_sset(stab_val(stab),&str_undef); |
| 114 | } |
| 115 | else |
| 116 | str_sset(stab_val(stab),&str_undef); |
| 117 | } |
| 118 | break; |
| 119 | case '+': |
| 120 | if (curspat) { |
| 121 | paren = curspat->spat_regexp->lastparen; |
| 122 | goto getparen; |
| 123 | } |
| 124 | break; |
| 125 | case '`': |
| 126 | if (curspat) { |
| 127 | if (curspat->spat_regexp && |
| 128 | (s = curspat->spat_regexp->subbeg) ) { |
| 129 | i = curspat->spat_regexp->startp[0] - s; |
| 130 | if (i >= 0) |
| 131 | str_nset(stab_val(stab),s,i); |
| 132 | else |
| 133 | str_nset(stab_val(stab),"",0); |
| 134 | } |
| 135 | else |
| 136 | str_nset(stab_val(stab),"",0); |
| 137 | } |
| 138 | break; |
| 139 | case '\'': |
| 140 | if (curspat) { |
| 141 | if (curspat->spat_regexp && |
| 142 | (s = curspat->spat_regexp->endp[0]) ) { |
| 143 | str_nset(stab_val(stab),s, curspat->spat_regexp->subend - s); |
| 144 | } |
| 145 | else |
| 146 | str_nset(stab_val(stab),"",0); |
| 147 | } |
| 148 | break; |
| 149 | case '.': |
| 150 | #ifndef lint |
| 151 | if (last_in_stab && stab_io(last_in_stab)) { |
| 152 | str_numset(stab_val(stab),(double)stab_io(last_in_stab)->lines); |
| 153 | } |
| 154 | #endif |
| 155 | break; |
| 156 | case '?': |
| 157 | str_numset(stab_val(stab),(double)statusvalue); |
| 158 | break; |
| 159 | case '^': |
| 160 | s = stab_io(curoutstab)->top_name; |
| 161 | if (s) |
| 162 | str_set(stab_val(stab),s); |
| 163 | else { |
| 164 | str_set(stab_val(stab),stab_ename(curoutstab)); |
| 165 | str_cat(stab_val(stab),"_TOP"); |
| 166 | } |
| 167 | break; |
| 168 | case '~': |
| 169 | s = stab_io(curoutstab)->fmt_name; |
| 170 | if (!s) |
| 171 | s = stab_ename(curoutstab); |
| 172 | str_set(stab_val(stab),s); |
| 173 | break; |
| 174 | #ifndef lint |
| 175 | case '=': |
| 176 | str_numset(stab_val(stab),(double)stab_io(curoutstab)->page_len); |
| 177 | break; |
| 178 | case '-': |
| 179 | str_numset(stab_val(stab),(double)stab_io(curoutstab)->lines_left); |
| 180 | break; |
| 181 | case '%': |
| 182 | str_numset(stab_val(stab),(double)stab_io(curoutstab)->page); |
| 183 | break; |
| 184 | #endif |
| 185 | case ':': |
| 186 | break; |
| 187 | case '/': |
| 188 | break; |
| 189 | case '[': |
| 190 | str_numset(stab_val(stab),(double)arybase); |
| 191 | break; |
| 192 | case '|': |
| 193 | if (!stab_io(curoutstab)) |
| 194 | stab_io(curoutstab) = stio_new(); |
| 195 | str_numset(stab_val(stab), |
| 196 | (double)((stab_io(curoutstab)->flags & IOF_FLUSH) != 0) ); |
| 197 | break; |
| 198 | case ',': |
| 199 | str_nset(stab_val(stab),ofs,ofslen); |
| 200 | break; |
| 201 | case '\\': |
| 202 | str_nset(stab_val(stab),ors,orslen); |
| 203 | break; |
| 204 | case '#': |
| 205 | str_set(stab_val(stab),ofmt); |
| 206 | break; |
| 207 | case '!': |
| 208 | str_numset(stab_val(stab), (double)errno); |
| 209 | str_set(stab_val(stab), errno ? strerror(errno) : ""); |
| 210 | stab_val(stab)->str_nok = 1; /* what a wonderful hack! */ |
| 211 | break; |
| 212 | case '<': |
| 213 | str_numset(stab_val(stab),(double)uid); |
| 214 | break; |
| 215 | case '>': |
| 216 | str_numset(stab_val(stab),(double)euid); |
| 217 | break; |
| 218 | case '(': |
| 219 | s = buf; |
| 220 | (void)sprintf(s,"%d",(int)gid); |
| 221 | goto add_groups; |
| 222 | case ')': |
| 223 | s = buf; |
| 224 | (void)sprintf(s,"%d",(int)egid); |
| 225 | add_groups: |
| 226 | while (*s) s++; |
| 227 | #ifdef HAS_GETGROUPS |
| 228 | #ifndef NGROUPS |
| 229 | #define NGROUPS 32 |
| 230 | #endif |
| 231 | { |
| 232 | GROUPSTYPE gary[NGROUPS]; |
| 233 | |
| 234 | i = getgroups(NGROUPS,gary); |
| 235 | while (--i >= 0) { |
| 236 | (void)sprintf(s," %ld", (long)gary[i]); |
| 237 | while (*s) s++; |
| 238 | } |
| 239 | } |
| 240 | #endif |
| 241 | str_set(stab_val(stab),buf); |
| 242 | break; |
| 243 | case '*': |
| 244 | break; |
| 245 | case '0': |
| 246 | break; |
| 247 | default: |
| 248 | { |
| 249 | struct ufuncs *uf = (struct ufuncs *)str->str_ptr; |
| 250 | |
| 251 | if (uf && uf->uf_val) |
| 252 | (*uf->uf_val)(uf->uf_index, stab_val(stab)); |
| 253 | } |
| 254 | break; |
| 255 | } |
| 256 | return stab_val(stab); |
| 257 | } |
| 258 | |
| 259 | STRLEN |
| 260 | stab_len(str) |
| 261 | STR *str; |
| 262 | { |
| 263 | STAB *stab = str->str_u.str_stab; |
| 264 | int paren; |
| 265 | int i; |
| 266 | char *s; |
| 267 | |
| 268 | if (str->str_rare) |
| 269 | return str_len(stab_val(stab)); |
| 270 | |
| 271 | switch (*stab->str_magic->str_ptr) { |
| 272 | case '1': case '2': case '3': case '4': |
| 273 | case '5': case '6': case '7': case '8': case '9': case '&': |
| 274 | if (curspat) { |
| 275 | paren = atoi(stab_ename(stab)); |
| 276 | getparen: |
| 277 | if (curspat->spat_regexp && |
| 278 | paren <= curspat->spat_regexp->nparens && |
| 279 | (s = curspat->spat_regexp->startp[paren]) ) { |
| 280 | i = curspat->spat_regexp->endp[paren] - s; |
| 281 | if (i >= 0) |
| 282 | return i; |
| 283 | else |
| 284 | return 0; |
| 285 | } |
| 286 | else |
| 287 | return 0; |
| 288 | } |
| 289 | break; |
| 290 | case '+': |
| 291 | if (curspat) { |
| 292 | paren = curspat->spat_regexp->lastparen; |
| 293 | goto getparen; |
| 294 | } |
| 295 | break; |
| 296 | case '`': |
| 297 | if (curspat) { |
| 298 | if (curspat->spat_regexp && |
| 299 | (s = curspat->spat_regexp->subbeg) ) { |
| 300 | i = curspat->spat_regexp->startp[0] - s; |
| 301 | if (i >= 0) |
| 302 | return i; |
| 303 | else |
| 304 | return 0; |
| 305 | } |
| 306 | else |
| 307 | return 0; |
| 308 | } |
| 309 | break; |
| 310 | case '\'': |
| 311 | if (curspat) { |
| 312 | if (curspat->spat_regexp && |
| 313 | (s = curspat->spat_regexp->endp[0]) ) { |
| 314 | return (STRLEN) (curspat->spat_regexp->subend - s); |
| 315 | } |
| 316 | else |
| 317 | return 0; |
| 318 | } |
| 319 | break; |
| 320 | case ',': |
| 321 | return (STRLEN)ofslen; |
| 322 | case '\\': |
| 323 | return (STRLEN)orslen; |
| 324 | } |
| 325 | return str_len(stab_str(str)); |
| 326 | } |
| 327 | |
| 328 | void |
| 329 | stabset(mstr,str) |
| 330 | register STR *mstr; |
| 331 | STR *str; |
| 332 | { |
| 333 | STAB *stab; |
| 334 | register char *s; |
| 335 | int i; |
| 336 | |
| 337 | switch (mstr->str_rare) { |
| 338 | case 'E': |
| 339 | my_setenv(mstr->str_ptr,str_get(str)); |
| 340 | /* And you'll never guess what the dog had */ |
| 341 | /* in its mouth... */ |
| 342 | #ifdef TAINT |
| 343 | if (strEQ(mstr->str_ptr,"PATH")) { |
| 344 | char *strend = str->str_ptr + str->str_cur; |
| 345 | |
| 346 | s = str->str_ptr; |
| 347 | while (s < strend) { |
| 348 | s = cpytill(tokenbuf,s,strend,':',&i); |
| 349 | s++; |
| 350 | if (*tokenbuf != '/' |
| 351 | || (stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) ) |
| 352 | str->str_tainted = 2; |
| 353 | } |
| 354 | } |
| 355 | #endif |
| 356 | break; |
| 357 | case 'S': |
| 358 | s = str_get(str); |
| 359 | i = whichsig(mstr->str_ptr); /* ...no, a brick */ |
| 360 | if (!i && (dowarn || strEQ(mstr->str_ptr,"ALARM"))) |
| 361 | warn("No such signal: SIG%s", mstr->str_ptr); |
| 362 | if (strEQ(s,"IGNORE")) |
| 363 | #ifndef lint |
| 364 | (void)signal(i,SIG_IGN); |
| 365 | #else |
| 366 | ; |
| 367 | #endif |
| 368 | else if (strEQ(s,"DEFAULT") || !*s) |
| 369 | (void)signal(i,SIG_DFL); |
| 370 | else { |
| 371 | (void)signal(i,sighandler); |
| 372 | if (!index(s,'\'')) { |
| 373 | sprintf(tokenbuf, "main'%s",s); |
| 374 | str_set(str,tokenbuf); |
| 375 | } |
| 376 | } |
| 377 | break; |
| 378 | #ifdef SOME_DBM |
| 379 | case 'D': |
| 380 | stab = mstr->str_u.str_stab; |
| 381 | hdbmstore(stab_hash(stab),mstr->str_ptr,mstr->str_cur,str); |
| 382 | break; |
| 383 | #endif |
| 384 | case 'L': |
| 385 | { |
| 386 | CMD *cmd; |
| 387 | |
| 388 | stab = mstr->str_u.str_stab; |
| 389 | i = str_true(str); |
| 390 | str = afetch(stab_xarray(stab),atoi(mstr->str_ptr), FALSE); |
| 391 | if (str->str_magic && (cmd = str->str_magic->str_u.str_cmd)) { |
| 392 | cmd->c_flags &= ~CF_OPTIMIZE; |
| 393 | cmd->c_flags |= i? CFT_D1 : CFT_D0; |
| 394 | } |
| 395 | else |
| 396 | warn("Can't break at that line\n"); |
| 397 | } |
| 398 | break; |
| 399 | case '#': |
| 400 | stab = mstr->str_u.str_stab; |
| 401 | afill(stab_array(stab), (int)str_gnum(str) - arybase); |
| 402 | break; |
| 403 | case 'X': /* merely a copy of a * string */ |
| 404 | break; |
| 405 | case '*': |
| 406 | s = str->str_pok ? str_get(str) : ""; |
| 407 | if (strNE(s,"StB") || str->str_cur != sizeof(STBP)) { |
| 408 | stab = mstr->str_u.str_stab; |
| 409 | if (!*s) { |
| 410 | STBP *stbp; |
| 411 | |
| 412 | /*SUPPRESS 701*/ |
| 413 | (void)savenostab(stab); /* schedule a free of this stab */ |
| 414 | if (stab->str_len) |
| 415 | Safefree(stab->str_ptr); |
| 416 | Newz(601,stbp, 1, STBP); |
| 417 | stab->str_ptr = stbp; |
| 418 | stab->str_len = stab->str_cur = sizeof(STBP); |
| 419 | stab->str_pok = 1; |
| 420 | strcpy(stab_magic(stab),"StB"); |
| 421 | stab_val(stab) = Str_new(70,0); |
| 422 | stab_line(stab) = curcmd->c_line; |
| 423 | stab_estab(stab) = stab; |
| 424 | } |
| 425 | else { |
| 426 | stab = stabent(s,TRUE); |
| 427 | if (!stab_xarray(stab)) |
| 428 | aadd(stab); |
| 429 | if (!stab_xhash(stab)) |
| 430 | hadd(stab); |
| 431 | if (!stab_io(stab)) |
| 432 | stab_io(stab) = stio_new(); |
| 433 | } |
| 434 | str_sset(str, (STR*) stab); |
| 435 | } |
| 436 | break; |
| 437 | case 's': { |
| 438 | struct lstring *lstr = (struct lstring*)str; |
| 439 | char *tmps; |
| 440 | |
| 441 | mstr->str_rare = 0; |
| 442 | str->str_magic = Nullstr; |
| 443 | tmps = str_get(str); |
| 444 | str_insert(mstr,lstr->lstr_offset,lstr->lstr_len, |
| 445 | tmps,str->str_cur); |
| 446 | } |
| 447 | break; |
| 448 | |
| 449 | case 'v': |
| 450 | do_vecset(mstr,str); |
| 451 | break; |
| 452 | |
| 453 | case 0: |
| 454 | /*SUPPRESS 560*/ |
| 455 | if (!(stab = mstr->str_u.str_stab)) |
| 456 | break; |
| 457 | switch (*stab->str_magic->str_ptr) { |
| 458 | case '\004': /* ^D */ |
| 459 | #ifdef DEBUGGING |
| 460 | debug = (int)(str_gnum(str)) | 32768; |
| 461 | if (debug & 1024) |
| 462 | dump_all(); |
| 463 | #endif |
| 464 | break; |
| 465 | case '\006': /* ^F */ |
| 466 | maxsysfd = (int)str_gnum(str); |
| 467 | break; |
| 468 | case '\t': /* ^I */ |
| 469 | if (inplace) |
| 470 | Safefree(inplace); |
| 471 | if (str->str_pok || str->str_nok) |
| 472 | inplace = savestr(str_get(str)); |
| 473 | else |
| 474 | inplace = Nullch; |
| 475 | break; |
| 476 | case '\020': /* ^P */ |
| 477 | i = (int)str_gnum(str); |
| 478 | if (i != perldb) { |
| 479 | static SPAT *oldlastspat; |
| 480 | |
| 481 | if (perldb) |
| 482 | oldlastspat = lastspat; |
| 483 | else |
| 484 | lastspat = oldlastspat; |
| 485 | } |
| 486 | perldb = i; |
| 487 | break; |
| 488 | case '\024': /* ^T */ |
| 489 | basetime = (time_t)str_gnum(str); |
| 490 | break; |
| 491 | case '\027': /* ^W */ |
| 492 | dowarn = (bool)str_gnum(str); |
| 493 | break; |
| 494 | case '.': |
| 495 | if (localizing) |
| 496 | savesptr((STR**)&last_in_stab); |
| 497 | break; |
| 498 | case '^': |
| 499 | Safefree(stab_io(curoutstab)->top_name); |
| 500 | stab_io(curoutstab)->top_name = s = savestr(str_get(str)); |
| 501 | stab_io(curoutstab)->top_stab = stabent(s,TRUE); |
| 502 | break; |
| 503 | case '~': |
| 504 | Safefree(stab_io(curoutstab)->fmt_name); |
| 505 | stab_io(curoutstab)->fmt_name = s = savestr(str_get(str)); |
| 506 | stab_io(curoutstab)->fmt_stab = stabent(s,TRUE); |
| 507 | break; |
| 508 | case '=': |
| 509 | stab_io(curoutstab)->page_len = (long)str_gnum(str); |
| 510 | break; |
| 511 | case '-': |
| 512 | stab_io(curoutstab)->lines_left = (long)str_gnum(str); |
| 513 | if (stab_io(curoutstab)->lines_left < 0L) |
| 514 | stab_io(curoutstab)->lines_left = 0L; |
| 515 | break; |
| 516 | case '%': |
| 517 | stab_io(curoutstab)->page = (long)str_gnum(str); |
| 518 | break; |
| 519 | case '|': |
| 520 | if (!stab_io(curoutstab)) |
| 521 | stab_io(curoutstab) = stio_new(); |
| 522 | stab_io(curoutstab)->flags &= ~IOF_FLUSH; |
| 523 | if (str_gnum(str) != 0.0) { |
| 524 | stab_io(curoutstab)->flags |= IOF_FLUSH; |
| 525 | } |
| 526 | break; |
| 527 | case '*': |
| 528 | i = (int)str_gnum(str); |
| 529 | multiline = (i != 0); |
| 530 | break; |
| 531 | case '/': |
| 532 | if (str->str_pok) { |
| 533 | rs = str_get(str); |
| 534 | rslen = str->str_cur; |
| 535 | if (rspara = !rslen) { |
| 536 | rs = "\n\n"; |
| 537 | rslen = 2; |
| 538 | } |
| 539 | rschar = rs[rslen - 1]; |
| 540 | } |
| 541 | else { |
| 542 | rschar = 0777; /* fake a non-existent char */ |
| 543 | rslen = 1; |
| 544 | } |
| 545 | break; |
| 546 | case '\\': |
| 547 | if (ors) |
| 548 | Safefree(ors); |
| 549 | ors = savestr(str_get(str)); |
| 550 | orslen = str->str_cur; |
| 551 | break; |
| 552 | case ',': |
| 553 | if (ofs) |
| 554 | Safefree(ofs); |
| 555 | ofs = savestr(str_get(str)); |
| 556 | ofslen = str->str_cur; |
| 557 | break; |
| 558 | case '#': |
| 559 | if (ofmt) |
| 560 | Safefree(ofmt); |
| 561 | ofmt = savestr(str_get(str)); |
| 562 | break; |
| 563 | case '[': |
| 564 | arybase = (int)str_gnum(str); |
| 565 | break; |
| 566 | case '?': |
| 567 | statusvalue = U_S(str_gnum(str)); |
| 568 | break; |
| 569 | case '!': |
| 570 | errno = (int)str_gnum(str); /* will anyone ever use this? */ |
| 571 | break; |
| 572 | case '<': |
| 573 | uid = (int)str_gnum(str); |
| 574 | if (delaymagic) { |
| 575 | delaymagic |= DM_RUID; |
| 576 | break; /* don't do magic till later */ |
| 577 | } |
| 578 | #ifdef HAS_SETRUID |
| 579 | (void)setruid((UIDTYPE)uid); |
| 580 | #else |
| 581 | #ifdef HAS_SETREUID |
| 582 | (void)setreuid((UIDTYPE)uid, (UIDTYPE)-1); |
| 583 | #else |
| 584 | if (uid == euid) /* special case $< = $> */ |
| 585 | (void)setuid(uid); |
| 586 | else |
| 587 | fatal("setruid() not implemented"); |
| 588 | #endif |
| 589 | #endif |
| 590 | uid = (int)getuid(); |
| 591 | break; |
| 592 | case '>': |
| 593 | euid = (int)str_gnum(str); |
| 594 | if (delaymagic) { |
| 595 | delaymagic |= DM_EUID; |
| 596 | break; /* don't do magic till later */ |
| 597 | } |
| 598 | #ifdef HAS_SETEUID |
| 599 | (void)seteuid((UIDTYPE)euid); |
| 600 | #else |
| 601 | #ifdef HAS_SETREUID |
| 602 | (void)setreuid((UIDTYPE)-1, (UIDTYPE)euid); |
| 603 | #else |
| 604 | if (euid == uid) /* special case $> = $< */ |
| 605 | setuid(euid); |
| 606 | else |
| 607 | fatal("seteuid() not implemented"); |
| 608 | #endif |
| 609 | #endif |
| 610 | euid = (int)geteuid(); |
| 611 | break; |
| 612 | case '(': |
| 613 | gid = (int)str_gnum(str); |
| 614 | if (delaymagic) { |
| 615 | delaymagic |= DM_RGID; |
| 616 | break; /* don't do magic till later */ |
| 617 | } |
| 618 | #ifdef HAS_SETRGID |
| 619 | (void)setrgid((GIDTYPE)gid); |
| 620 | #else |
| 621 | #ifdef HAS_SETREGID |
| 622 | (void)setregid((GIDTYPE)gid, (GIDTYPE)-1); |
| 623 | #else |
| 624 | if (gid == egid) /* special case $( = $) */ |
| 625 | (void)setgid(gid); |
| 626 | else |
| 627 | fatal("setrgid() not implemented"); |
| 628 | #endif |
| 629 | #endif |
| 630 | gid = (int)getgid(); |
| 631 | break; |
| 632 | case ')': |
| 633 | egid = (int)str_gnum(str); |
| 634 | if (delaymagic) { |
| 635 | delaymagic |= DM_EGID; |
| 636 | break; /* don't do magic till later */ |
| 637 | } |
| 638 | #ifdef HAS_SETEGID |
| 639 | (void)setegid((GIDTYPE)egid); |
| 640 | #else |
| 641 | #ifdef HAS_SETREGID |
| 642 | (void)setregid((GIDTYPE)-1, (GIDTYPE)egid); |
| 643 | #else |
| 644 | if (egid == gid) /* special case $) = $( */ |
| 645 | (void)setgid(egid); |
| 646 | else |
| 647 | fatal("setegid() not implemented"); |
| 648 | #endif |
| 649 | #endif |
| 650 | egid = (int)getegid(); |
| 651 | break; |
| 652 | case ':': |
| 653 | chopset = str_get(str); |
| 654 | break; |
| 655 | case '0': |
| 656 | if (!origalen) { |
| 657 | s = origargv[0]; |
| 658 | s += strlen(s); |
| 659 | /* See if all the arguments are contiguous in memory */ |
| 660 | for (i = 1; i < origargc; i++) { |
| 661 | if (origargv[i] == s + 1) |
| 662 | s += strlen(++s); /* this one is ok too */ |
| 663 | } |
| 664 | if (origenviron[0] == s + 1) { /* can grab env area too? */ |
| 665 | my_setenv("NoNeSuCh", Nullch); |
| 666 | /* force copy of environment */ |
| 667 | for (i = 0; origenviron[i]; i++) |
| 668 | if (origenviron[i] == s + 1) |
| 669 | s += strlen(++s); |
| 670 | } |
| 671 | origalen = s - origargv[0]; |
| 672 | } |
| 673 | s = str_get(str); |
| 674 | i = str->str_cur; |
| 675 | if (i >= origalen) { |
| 676 | i = origalen; |
| 677 | str->str_cur = i; |
| 678 | str->str_ptr[i] = '\0'; |
| 679 | Copy(s, origargv[0], i, char); |
| 680 | } |
| 681 | else { |
| 682 | Copy(s, origargv[0], i, char); |
| 683 | s = origargv[0]+i; |
| 684 | *s++ = '\0'; |
| 685 | while (++i < origalen) |
| 686 | *s++ = ' '; |
| 687 | } |
| 688 | break; |
| 689 | default: |
| 690 | { |
| 691 | struct ufuncs *uf = (struct ufuncs *)str->str_magic->str_ptr; |
| 692 | |
| 693 | if (uf && uf->uf_set) |
| 694 | (*uf->uf_set)(uf->uf_index, str); |
| 695 | } |
| 696 | break; |
| 697 | } |
| 698 | break; |
| 699 | } |
| 700 | } |
| 701 | |
| 702 | int |
| 703 | whichsig(sig) |
| 704 | char *sig; |
| 705 | { |
| 706 | register char **sigv; |
| 707 | |
| 708 | for (sigv = sig_name+1; *sigv; sigv++) |
| 709 | if (strEQ(sig,*sigv)) |
| 710 | return sigv - sig_name; |
| 711 | #ifdef SIGCLD |
| 712 | if (strEQ(sig,"CHLD")) |
| 713 | return SIGCLD; |
| 714 | #endif |
| 715 | #ifdef SIGCHLD |
| 716 | if (strEQ(sig,"CLD")) |
| 717 | return SIGCHLD; |
| 718 | #endif |
| 719 | return 0; |
| 720 | } |
| 721 | |
| 722 | static handlertype |
| 723 | sighandler(sig) |
| 724 | int sig; |
| 725 | { |
| 726 | STAB *stab; |
| 727 | STR *str; |
| 728 | int oldsave = savestack->ary_fill; |
| 729 | int oldtmps_base = tmps_base; |
| 730 | register CSV *csv; |
| 731 | SUBR *sub; |
| 732 | |
| 733 | #ifdef OS2 /* or anybody else who requires SIG_ACK */ |
| 734 | signal(sig, SIG_ACK); |
| 735 | #endif |
| 736 | stab = stabent( |
| 737 | str_get(hfetch(stab_hash(sigstab),sig_name[sig],strlen(sig_name[sig]), |
| 738 | TRUE)), TRUE); |
| 739 | sub = stab_sub(stab); |
| 740 | if (!sub && *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) { |
| 741 | if (sig_name[sig][1] == 'H') |
| 742 | stab = stabent(str_get(hfetch(stab_hash(sigstab),"CLD",3,TRUE)), |
| 743 | TRUE); |
| 744 | else |
| 745 | stab = stabent(str_get(hfetch(stab_hash(sigstab),"CHLD",4,TRUE)), |
| 746 | TRUE); |
| 747 | sub = stab_sub(stab); /* gag */ |
| 748 | } |
| 749 | if (!sub) { |
| 750 | if (dowarn) |
| 751 | warn("SIG%s handler \"%s\" not defined.\n", |
| 752 | sig_name[sig], stab_ename(stab) ); |
| 753 | return; |
| 754 | } |
| 755 | /*SUPPRESS 701*/ |
| 756 | saveaptr(&stack); |
| 757 | str = Str_new(15, sizeof(CSV)); |
| 758 | str->str_state = SS_SCSV; |
| 759 | (void)apush(savestack,str); |
| 760 | csv = (CSV*)str->str_ptr; |
| 761 | csv->sub = sub; |
| 762 | csv->stab = stab; |
| 763 | csv->curcsv = curcsv; |
| 764 | csv->curcmd = curcmd; |
| 765 | csv->depth = sub->depth; |
| 766 | csv->wantarray = G_SCALAR; |
| 767 | csv->hasargs = TRUE; |
| 768 | csv->savearray = stab_xarray(defstab); |
| 769 | csv->argarray = stab_xarray(defstab) = stack = anew(defstab); |
| 770 | stack->ary_flags = 0; |
| 771 | curcsv = csv; |
| 772 | str = str_mortal(&str_undef); |
| 773 | str_set(str,sig_name[sig]); |
| 774 | (void)apush(stab_xarray(defstab),str); |
| 775 | sub->depth++; |
| 776 | if (sub->depth >= 2) { /* save temporaries on recursion? */ |
| 777 | if (sub->depth == 100 && dowarn) |
| 778 | warn("Deep recursion on subroutine \"%s\"",stab_ename(stab)); |
| 779 | savelist(sub->tosave->ary_array,sub->tosave->ary_fill); |
| 780 | } |
| 781 | |
| 782 | tmps_base = tmps_max; /* protect our mortal string */ |
| 783 | (void)cmd_exec(sub->cmd,G_SCALAR,0); /* so do it already */ |
| 784 | tmps_base = oldtmps_base; |
| 785 | |
| 786 | restorelist(oldsave); /* put everything back */ |
| 787 | } |
| 788 | |
| 789 | STAB * |
| 790 | aadd(stab) |
| 791 | register STAB *stab; |
| 792 | { |
| 793 | if (!stab_xarray(stab)) |
| 794 | stab_xarray(stab) = anew(stab); |
| 795 | return stab; |
| 796 | } |
| 797 | |
| 798 | STAB * |
| 799 | hadd(stab) |
| 800 | register STAB *stab; |
| 801 | { |
| 802 | if (!stab_xhash(stab)) |
| 803 | stab_xhash(stab) = hnew(COEFFSIZE); |
| 804 | return stab; |
| 805 | } |
| 806 | |
| 807 | STAB * |
| 808 | fstab(name) |
| 809 | char *name; |
| 810 | { |
| 811 | char tmpbuf[1200]; |
| 812 | STAB *stab; |
| 813 | |
| 814 | sprintf(tmpbuf,"'_<%s", name); |
| 815 | stab = stabent(tmpbuf, TRUE); |
| 816 | str_set(stab_val(stab), name); |
| 817 | if (perldb) |
| 818 | (void)hadd(aadd(stab)); |
| 819 | return stab; |
| 820 | } |
| 821 | |
| 822 | STAB * |
| 823 | stabent(name,add) |
| 824 | register char *name; |
| 825 | int add; |
| 826 | { |
| 827 | register STAB *stab; |
| 828 | register STBP *stbp; |
| 829 | int len; |
| 830 | register char *namend; |
| 831 | HASH *stash; |
| 832 | char *sawquote = Nullch; |
| 833 | char *prevquote = Nullch; |
| 834 | bool global = FALSE; |
| 835 | |
| 836 | if (isUPPER(*name)) { |
| 837 | if (*name > 'I') { |
| 838 | if (*name == 'S' && ( |
| 839 | strEQ(name, "SIG") || |
| 840 | strEQ(name, "STDIN") || |
| 841 | strEQ(name, "STDOUT") || |
| 842 | strEQ(name, "STDERR") )) |
| 843 | global = TRUE; |
| 844 | } |
| 845 | else if (*name > 'E') { |
| 846 | if (*name == 'I' && strEQ(name, "INC")) |
| 847 | global = TRUE; |
| 848 | } |
| 849 | else if (*name > 'A') { |
| 850 | if (*name == 'E' && strEQ(name, "ENV")) |
| 851 | global = TRUE; |
| 852 | } |
| 853 | else if (*name == 'A' && ( |
| 854 | strEQ(name, "ARGV") || |
| 855 | strEQ(name, "ARGVOUT") )) |
| 856 | global = TRUE; |
| 857 | } |
| 858 | for (namend = name; *namend; namend++) { |
| 859 | if (*namend == '\'' && namend[1]) |
| 860 | prevquote = sawquote, sawquote = namend; |
| 861 | } |
| 862 | if (sawquote == name && name[1]) { |
| 863 | stash = defstash; |
| 864 | sawquote = Nullch; |
| 865 | name++; |
| 866 | } |
| 867 | else if (!isALPHA(*name) || global) |
| 868 | stash = defstash; |
| 869 | else if ((CMD*)curcmd == &compiling) |
| 870 | stash = curstash; |
| 871 | else |
| 872 | stash = curcmd->c_stash; |
| 873 | if (sawquote) { |
| 874 | char tmpbuf[256]; |
| 875 | char *s, *d; |
| 876 | |
| 877 | *sawquote = '\0'; |
| 878 | /*SUPPRESS 560*/ |
| 879 | if (s = prevquote) { |
| 880 | strncpy(tmpbuf,name,s-name+1); |
| 881 | d = tmpbuf+(s-name+1); |
| 882 | *d++ = '_'; |
| 883 | strcpy(d,s+1); |
| 884 | } |
| 885 | else { |
| 886 | *tmpbuf = '_'; |
| 887 | strcpy(tmpbuf+1,name); |
| 888 | } |
| 889 | stab = stabent(tmpbuf,TRUE); |
| 890 | if (!(stash = stab_xhash(stab))) |
| 891 | stash = stab_xhash(stab) = hnew(0); |
| 892 | if (!stash->tbl_name) |
| 893 | stash->tbl_name = savestr(name); |
| 894 | name = sawquote+1; |
| 895 | *sawquote = '\''; |
| 896 | } |
| 897 | len = namend - name; |
| 898 | stab = (STAB*)hfetch(stash,name,len,add); |
| 899 | if (stab == (STAB*)&str_undef) |
| 900 | return Nullstab; |
| 901 | if (stab->str_pok) { |
| 902 | stab->str_pok |= SP_MULTI; |
| 903 | return stab; |
| 904 | } |
| 905 | else { |
| 906 | if (stab->str_len) |
| 907 | Safefree(stab->str_ptr); |
| 908 | Newz(602,stbp, 1, STBP); |
| 909 | stab->str_ptr = stbp; |
| 910 | stab->str_len = stab->str_cur = sizeof(STBP); |
| 911 | stab->str_pok = 1; |
| 912 | strcpy(stab_magic(stab),"StB"); |
| 913 | stab_val(stab) = Str_new(72,0); |
| 914 | stab_line(stab) = curcmd->c_line; |
| 915 | stab_estab(stab) = stab; |
| 916 | str_magic((STR*)stab, stab, '*', name, len); |
| 917 | stab_stash(stab) = stash; |
| 918 | if (isDIGIT(*name) && *name != '0') { |
| 919 | stab_flags(stab) = SF_VMAGIC; |
| 920 | str_magic(stab_val(stab), stab, 0, Nullch, 0); |
| 921 | } |
| 922 | if (add & 2) |
| 923 | stab->str_pok |= SP_MULTI; |
| 924 | return stab; |
| 925 | } |
| 926 | } |
| 927 | |
| 928 | void |
| 929 | stab_fullname(str,stab) |
| 930 | STR *str; |
| 931 | STAB *stab; |
| 932 | { |
| 933 | HASH *tb = stab_stash(stab); |
| 934 | |
| 935 | if (!tb) |
| 936 | return; |
| 937 | str_set(str,tb->tbl_name); |
| 938 | str_ncat(str,"'", 1); |
| 939 | str_scat(str,stab->str_magic); |
| 940 | } |
| 941 | |
| 942 | void |
| 943 | stab_efullname(str,stab) |
| 944 | STR *str; |
| 945 | STAB *stab; |
| 946 | { |
| 947 | HASH *tb = stab_estash(stab); |
| 948 | |
| 949 | if (!tb) |
| 950 | return; |
| 951 | str_set(str,tb->tbl_name); |
| 952 | str_ncat(str,"'", 1); |
| 953 | str_scat(str,stab_estab(stab)->str_magic); |
| 954 | } |
| 955 | |
| 956 | STIO * |
| 957 | stio_new() |
| 958 | { |
| 959 | STIO *stio; |
| 960 | |
| 961 | Newz(603,stio,1,STIO); |
| 962 | stio->page_len = 60; |
| 963 | return stio; |
| 964 | } |
| 965 | |
| 966 | void |
| 967 | stab_check(min,max) |
| 968 | int min; |
| 969 | register int max; |
| 970 | { |
| 971 | register HENT *entry; |
| 972 | register int i; |
| 973 | register STAB *stab; |
| 974 | |
| 975 | for (i = min; i <= max; i++) { |
| 976 | for (entry = defstash->tbl_array[i]; entry; entry = entry->hent_next) { |
| 977 | stab = (STAB*)entry->hent_val; |
| 978 | if (stab->str_pok & SP_MULTI) |
| 979 | continue; |
| 980 | curcmd->c_line = stab_line(stab); |
| 981 | warn("Possible typo: \"%s\"", stab_name(stab)); |
| 982 | } |
| 983 | } |
| 984 | } |
| 985 | |
| 986 | static int gensym = 0; |
| 987 | |
| 988 | STAB * |
| 989 | genstab() |
| 990 | { |
| 991 | (void)sprintf(tokenbuf,"_GEN_%d",gensym++); |
| 992 | return stabent(tokenbuf,TRUE); |
| 993 | } |
| 994 | |
| 995 | /* hopefully this is only called on local symbol table entries */ |
| 996 | |
| 997 | void |
| 998 | stab_clear(stab) |
| 999 | register STAB *stab; |
| 1000 | { |
| 1001 | STIO *stio; |
| 1002 | SUBR *sub; |
| 1003 | |
| 1004 | if (!stab || !stab->str_ptr) |
| 1005 | return; |
| 1006 | afree(stab_xarray(stab)); |
| 1007 | stab_xarray(stab) = Null(ARRAY*); |
| 1008 | (void)hfree(stab_xhash(stab), FALSE); |
| 1009 | stab_xhash(stab) = Null(HASH*); |
| 1010 | str_free(stab_val(stab)); |
| 1011 | stab_val(stab) = Nullstr; |
| 1012 | /*SUPPRESS 560*/ |
| 1013 | if (stio = stab_io(stab)) { |
| 1014 | do_close(stab,FALSE); |
| 1015 | Safefree(stio->top_name); |
| 1016 | Safefree(stio->fmt_name); |
| 1017 | Safefree(stio); |
| 1018 | } |
| 1019 | /*SUPPRESS 560*/ |
| 1020 | if (sub = stab_sub(stab)) { |
| 1021 | afree(sub->tosave); |
| 1022 | cmd_free(sub->cmd); |
| 1023 | } |
| 1024 | Safefree(stab->str_ptr); |
| 1025 | stab->str_ptr = Null(STBP*); |
| 1026 | stab->str_len = 0; |
| 1027 | stab->str_cur = 0; |
| 1028 | } |
| 1029 | |
| 1030 | #if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286)) |
| 1031 | #define MICROPORT |
| 1032 | #endif |
| 1033 | |
| 1034 | #ifdef MICROPORT /* Microport 2.4 hack */ |
| 1035 | ARRAY *stab_array(stab) |
| 1036 | register STAB *stab; |
| 1037 | { |
| 1038 | if (((STBP*)(stab->str_ptr))->stbp_array) |
| 1039 | return ((STBP*)(stab->str_ptr))->stbp_array; |
| 1040 | else |
| 1041 | return ((STBP*)(aadd(stab)->str_ptr))->stbp_array; |
| 1042 | } |
| 1043 | |
| 1044 | HASH *stab_hash(stab) |
| 1045 | register STAB *stab; |
| 1046 | { |
| 1047 | if (((STBP*)(stab->str_ptr))->stbp_hash) |
| 1048 | return ((STBP*)(stab->str_ptr))->stbp_hash; |
| 1049 | else |
| 1050 | return ((STBP*)(hadd(stab)->str_ptr))->stbp_hash; |
| 1051 | } |
| 1052 | #endif /* Microport 2.4 hack */ |