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