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