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