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