This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
a "replacement" for awk and sed
[perl5.git] / stab.c
CommitLineData
8d063cd8
LW
1/* $Header: stab.c,v 1.0 87/12/18 13:06:14 root Exp $
2 *
3 * $Log: stab.c,v $
4 * Revision 1.0 87/12/18 13:06:14 root
5 * Initial revision
6 *
7 */
8
9#include <signal.h>
10#include "handy.h"
11#include "EXTERN.h"
12#include "search.h"
13#include "util.h"
14#include "perl.h"
15
16static char *sig_name[] = {
17 "",
18 "HUP",
19 "INT",
20 "QUIT",
21 "ILL",
22 "TRAP",
23 "IOT",
24 "EMT",
25 "FPE",
26 "KILL",
27 "BUS",
28 "SEGV",
29 "SYS",
30 "PIPE",
31 "ALRM",
32 "TERM",
33 "???"
34#ifdef SIGTSTP
35 ,"STOP",
36 "TSTP",
37 "CONT",
38 "CHLD",
39 "TTIN",
40 "TTOU",
41 "TINT",
42 "XCPU",
43 "XFSZ"
44#ifdef SIGPROF
45 ,"VTALARM",
46 "PROF"
47#ifdef SIGWINCH
48 ,"WINCH"
49#ifdef SIGLOST
50 ,"LOST"
51#ifdef SIGUSR1
52 ,"USR1"
53#endif
54#ifdef SIGUSR2
55 ,"USR2"
56#endif /* SIGUSR2 */
57#endif /* SIGLOST */
58#endif /* SIGWINCH */
59#endif /* SIGPROF */
60#endif /* SIGTSTP */
61 ,0
62 };
63
64STR *
65stab_str(stab)
66STAB *stab;
67{
68 register int paren;
69 register char *s;
70 extern int errno;
71
72 switch (*stab->stab_name) {
73 case '0': case '1': case '2': case '3': case '4':
74 case '5': case '6': case '7': case '8': case '9': case '&':
75 if (curspat) {
76 paren = atoi(stab->stab_name);
77 if (curspat->spat_compex.subend[paren] &&
78 (s = getparen(&curspat->spat_compex,paren))) {
79 curspat->spat_compex.subend[paren] = Nullch;
80 str_set(stab->stab_val,s);
81 }
82 }
83 break;
84 case '+':
85 if (curspat) {
86 paren = curspat->spat_compex.lastparen;
87 if (curspat->spat_compex.subend[paren] &&
88 (s = getparen(&curspat->spat_compex,paren))) {
89 curspat->spat_compex.subend[paren] = Nullch;
90 str_set(stab->stab_val,s);
91 }
92 }
93 break;
94 case '.':
95 if (last_in_stab) {
96 str_numset(stab->stab_val,(double)last_in_stab->stab_io->lines);
97 }
98 break;
99 case '?':
100 str_numset(stab->stab_val,(double)statusvalue);
101 break;
102 case '^':
103 s = curoutstab->stab_io->top_name;
104 str_set(stab->stab_val,s);
105 break;
106 case '~':
107 s = curoutstab->stab_io->fmt_name;
108 str_set(stab->stab_val,s);
109 break;
110 case '=':
111 str_numset(stab->stab_val,(double)curoutstab->stab_io->lines);
112 break;
113 case '-':
114 str_numset(stab->stab_val,(double)curoutstab->stab_io->lines_left);
115 break;
116 case '%':
117 str_numset(stab->stab_val,(double)curoutstab->stab_io->page);
118 break;
119 case '(':
120 if (curspat) {
121 str_numset(stab->stab_val,(double)(curspat->spat_compex.subbeg[0] -
122 curspat->spat_compex.subbase));
123 }
124 break;
125 case ')':
126 if (curspat) {
127 str_numset(stab->stab_val,(double)(curspat->spat_compex.subend[0] -
128 curspat->spat_compex.subbeg[0]));
129 }
130 break;
131 case '/':
132 *tokenbuf = record_separator;
133 tokenbuf[1] = '\0';
134 str_set(stab->stab_val,tokenbuf);
135 break;
136 case '[':
137 str_numset(stab->stab_val,(double)arybase);
138 break;
139 case '|':
140 str_numset(stab->stab_val,
141 (double)((curoutstab->stab_io->flags & IOF_FLUSH) != 0) );
142 break;
143 case ',':
144 str_set(stab->stab_val,ofs);
145 break;
146 case '\\':
147 str_set(stab->stab_val,ors);
148 break;
149 case '#':
150 str_set(stab->stab_val,ofmt);
151 break;
152 case '!':
153 str_numset(stab->stab_val,(double)errno);
154 break;
155 }
156 return stab->stab_val;
157}
158
159stabset(stab,str)
160register STAB *stab;
161STR *str;
162{
163 char *s;
164 int i;
165 int sighandler();
166
167 if (stab->stab_flags & SF_VMAGIC) {
168 switch (stab->stab_name[0]) {
169 case '^':
170 safefree(curoutstab->stab_io->top_name);
171 curoutstab->stab_io->top_name = str_get(str);
172 curoutstab->stab_io->top_stab = stabent(str_get(str),FALSE);
173 break;
174 case '~':
175 safefree(curoutstab->stab_io->fmt_name);
176 curoutstab->stab_io->fmt_name = str_get(str);
177 curoutstab->stab_io->fmt_stab = stabent(str_get(str),FALSE);
178 break;
179 case '=':
180 curoutstab->stab_io->page_len = (long)str_gnum(str);
181 break;
182 case '-':
183 curoutstab->stab_io->lines_left = (long)str_gnum(str);
184 break;
185 case '%':
186 curoutstab->stab_io->page = (long)str_gnum(str);
187 break;
188 case '|':
189 curoutstab->stab_io->flags &= ~IOF_FLUSH;
190 if (str_gnum(str) != 0.0) {
191 curoutstab->stab_io->flags |= IOF_FLUSH;
192 }
193 break;
194 case '*':
195 multiline = (int)str_gnum(str) != 0;
196 break;
197 case '/':
198 record_separator = *str_get(str);
199 break;
200 case '\\':
201 if (ors)
202 safefree(ors);
203 ors = savestr(str_get(str));
204 break;
205 case ',':
206 if (ofs)
207 safefree(ofs);
208 ofs = savestr(str_get(str));
209 break;
210 case '#':
211 if (ofmt)
212 safefree(ofmt);
213 ofmt = savestr(str_get(str));
214 break;
215 case '[':
216 arybase = (int)str_gnum(str);
217 break;
218 case '!':
219 errno = (int)str_gnum(str); /* will anyone ever use this? */
220 break;
221 case '.':
222 case '+':
223 case '&':
224 case '0':
225 case '1':
226 case '2':
227 case '3':
228 case '4':
229 case '5':
230 case '6':
231 case '7':
232 case '8':
233 case '9':
234 case '(':
235 case ')':
236 break; /* "read-only" registers */
237 }
238 }
239 else if (stab == envstab && envname) {
240 setenv(envname,str_get(str));
241 /* And you'll never guess what the dog had */
242 safefree(envname); /* in its mouth... */
243 envname = Nullch;
244 }
245 else if (stab == sigstab && signame) {
246 s = str_get(str);
247 i = whichsig(signame); /* ...no, a brick */
248 if (strEQ(s,"IGNORE"))
249 signal(i,SIG_IGN);
250 else if (strEQ(s,"DEFAULT") || !*s)
251 signal(i,SIG_DFL);
252 else
253 signal(i,sighandler);
254 safefree(signame);
255 signame = Nullch;
256 }
257}
258
259whichsig(signame)
260char *signame;
261{
262 register char **sigv;
263
264 for (sigv = sig_name+1; *sigv; sigv++)
265 if (strEQ(signame,*sigv))
266 return sigv - sig_name;
267 return 0;
268}
269
270sighandler(sig)
271int sig;
272{
273 STAB *stab;
274 ARRAY *savearray;
275 STR *str;
276
277 stab = stabent(str_get(hfetch(sigstab->stab_hash,sig_name[sig])),FALSE);
278 savearray = defstab->stab_array;
279 defstab->stab_array = anew();
280 str = str_new(0);
281 str_set(str,sig_name[sig]);
282 apush(defstab->stab_array,str);
283 str = cmd_exec(stab->stab_sub);
284 afree(defstab->stab_array); /* put back old $_[] */
285 defstab->stab_array = savearray;
286}
287
288char *
289reg_get(name)
290char *name;
291{
292 return STAB_GET(stabent(name,TRUE));
293}
294
295#ifdef NOTUSED
296reg_set(name,value)
297char *name;
298char *value;
299{
300 str_set(STAB_STR(stabent(name,TRUE)),value);
301}
302#endif
303
304STAB *
305aadd(stab)
306register STAB *stab;
307{
308 if (!stab->stab_array)
309 stab->stab_array = anew();
310 return stab;
311}
312
313STAB *
314hadd(stab)
315register STAB *stab;
316{
317 if (!stab->stab_hash)
318 stab->stab_hash = hnew();
319 return stab;
320}