This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 4.0 patch 36: (combined patch)
[perl5.git] / dump.c
CommitLineData
8adcabd8 1/* $RCSfile: dump.c,v $$Revision: 4.0.1.2 $$Date: 92/06/08 13:14:22 $
a687059c 2 *
6e21c824 3 * Copyright (c) 1991, Larry Wall
a687059c 4 *
6e21c824
LW
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
LW
7 *
8 * $Log: dump.c,v $
8adcabd8
LW
9 * Revision 4.0.1.2 92/06/08 13:14:22 lwall
10 * patch20: removed implicit int declarations on funcions
11 * patch20: fixed confusion between a *var's real name and its effective name
12 *
6e21c824
LW
13 * Revision 4.0.1.1 91/06/07 10:58:44 lwall
14 * patch4: new copyright notice
15 *
fe14fcc3
LW
16 * Revision 4.0 91/03/20 01:08:25 lwall
17 * 4.0 baseline.
8d063cd8
LW
18 *
19 */
20
8d063cd8 21#include "EXTERN.h"
8d063cd8
LW
22#include "perl.h"
23
24#ifdef DEBUGGING
25static int dumplvl = 0;
26
8adcabd8
LW
27static void dump();
28
29void
a687059c
LW
30dump_all()
31{
32 register int i;
33 register STAB *stab;
34 register HENT *entry;
fe14fcc3 35 STR *str = str_mortal(&str_undef);
a687059c
LW
36
37 dump_cmd(main_root,Nullcmd);
38 for (i = 0; i <= 127; i++) {
39 for (entry = defstash->tbl_array[i]; entry; entry = entry->hent_next) {
40 stab = (STAB*)entry->hent_val;
41 if (stab_sub(stab)) {
c2ab57d4
LW
42 stab_fullname(str,stab);
43 dump("\nSUB %s = ", str->str_ptr);
a687059c
LW
44 dump_cmd(stab_sub(stab)->cmd,Nullcmd);
45 }
46 }
47 }
48}
49
8adcabd8 50void
8d063cd8
LW
51dump_cmd(cmd,alt)
52register CMD *cmd;
53register CMD *alt;
54{
55 fprintf(stderr,"{\n");
56 while (cmd) {
57 dumplvl++;
58 dump("C_TYPE = %s\n",cmdname[cmd->c_type]);
a687059c
LW
59 dump("C_ADDR = 0x%lx\n",cmd);
60 dump("C_NEXT = 0x%lx\n",cmd->c_next);
378cc40b 61 if (cmd->c_line)
a687059c 62 dump("C_LINE = %d (0x%lx)\n",cmd->c_line,cmd);
8d063cd8
LW
63 if (cmd->c_label)
64 dump("C_LABEL = \"%s\"\n",cmd->c_label);
65 dump("C_OPT = CFT_%s\n",cmdopt[cmd->c_flags & CF_OPTIMIZE]);
66 *buf = '\0';
67 if (cmd->c_flags & CF_FIRSTNEG)
a687059c 68 (void)strcat(buf,"FIRSTNEG,");
8d063cd8 69 if (cmd->c_flags & CF_NESURE)
a687059c 70 (void)strcat(buf,"NESURE,");
8d063cd8 71 if (cmd->c_flags & CF_EQSURE)
a687059c 72 (void)strcat(buf,"EQSURE,");
8d063cd8 73 if (cmd->c_flags & CF_COND)
a687059c 74 (void)strcat(buf,"COND,");
8d063cd8 75 if (cmd->c_flags & CF_LOOP)
a687059c 76 (void)strcat(buf,"LOOP,");
8d063cd8 77 if (cmd->c_flags & CF_INVERT)
a687059c 78 (void)strcat(buf,"INVERT,");
8d063cd8 79 if (cmd->c_flags & CF_ONCE)
a687059c 80 (void)strcat(buf,"ONCE,");
8d063cd8 81 if (cmd->c_flags & CF_FLIP)
a687059c
LW
82 (void)strcat(buf,"FLIP,");
83 if (cmd->c_flags & CF_TERM)
84 (void)strcat(buf,"TERM,");
8d063cd8
LW
85 if (*buf)
86 buf[strlen(buf)-1] = '\0';
87 dump("C_FLAGS = (%s)\n",buf);
378cc40b
LW
88 if (cmd->c_short) {
89 dump("C_SHORT = \"%s\"\n",str_peek(cmd->c_short));
90 dump("C_SLEN = \"%d\"\n",cmd->c_slen);
8d063cd8
LW
91 }
92 if (cmd->c_stab) {
93 dump("C_STAB = ");
94 dump_stab(cmd->c_stab);
95 }
96 if (cmd->c_spat) {
97 dump("C_SPAT = ");
98 dump_spat(cmd->c_spat);
99 }
100 if (cmd->c_expr) {
101 dump("C_EXPR = ");
102 dump_arg(cmd->c_expr);
103 } else
104 dump("C_EXPR = NULL\n");
105 switch (cmd->c_type) {
a687059c 106 case C_NEXT:
8d063cd8
LW
107 case C_WHILE:
108 case C_BLOCK:
a687059c 109 case C_ELSE:
8d063cd8
LW
110 case C_IF:
111 if (cmd->ucmd.ccmd.cc_true) {
112 dump("CC_TRUE = ");
113 dump_cmd(cmd->ucmd.ccmd.cc_true,cmd->ucmd.ccmd.cc_alt);
a687059c
LW
114 }
115 else
8d063cd8
LW
116 dump("CC_TRUE = NULL\n");
117 if (cmd->c_type == C_IF && cmd->ucmd.ccmd.cc_alt) {
a687059c
LW
118 dump("CC_ENDELSE = 0x%lx\n",cmd->ucmd.ccmd.cc_alt);
119 }
120 else if (cmd->c_type == C_NEXT && cmd->ucmd.ccmd.cc_alt) {
121 dump("CC_NEXT = 0x%lx\n",cmd->ucmd.ccmd.cc_alt);
122 }
123 else
8d063cd8
LW
124 dump("CC_ALT = NULL\n");
125 break;
126 case C_EXPR:
127 if (cmd->ucmd.acmd.ac_stab) {
128 dump("AC_STAB = ");
378cc40b 129 dump_stab(cmd->ucmd.acmd.ac_stab);
8d063cd8
LW
130 } else
131 dump("AC_STAB = NULL\n");
132 if (cmd->ucmd.acmd.ac_expr) {
133 dump("AC_EXPR = ");
134 dump_arg(cmd->ucmd.acmd.ac_expr);
135 } else
136 dump("AC_EXPR = NULL\n");
137 break;
a687059c
LW
138 case C_CSWITCH:
139 case C_NSWITCH:
140 {
141 int max, i;
142
143 max = cmd->ucmd.scmd.sc_max;
144 dump("SC_MIN = (%d)\n",cmd->ucmd.scmd.sc_offset + 1);
145 dump("SC_MAX = (%d)\n", max + cmd->ucmd.scmd.sc_offset - 1);
146 dump("SC_NEXT[LT] = 0x%lx\n", cmd->ucmd.scmd.sc_next[0]);
147 for (i = 1; i < max; i++)
148 dump("SC_NEXT[%d] = 0x%lx\n", i + cmd->ucmd.scmd.sc_offset,
149 cmd->ucmd.scmd.sc_next[i]);
150 dump("SC_NEXT[GT] = 0x%lx\n", cmd->ucmd.scmd.sc_next[max]);
151 }
152 break;
8d063cd8
LW
153 }
154 cmd = cmd->c_next;
155 if (cmd && cmd->c_head == cmd) { /* reached end of while loop */
156 dump("C_NEXT = HEAD\n");
157 dumplvl--;
158 dump("}\n");
159 break;
160 }
161 dumplvl--;
162 dump("}\n");
163 if (cmd)
164 if (cmd == alt)
a687059c 165 dump("CONT 0x%lx {\n",cmd);
8d063cd8
LW
166 else
167 dump("{\n");
168 }
169}
170
8adcabd8 171void
8d063cd8
LW
172dump_arg(arg)
173register ARG *arg;
174{
175 register int i;
176
177 fprintf(stderr,"{\n");
178 dumplvl++;
179 dump("OP_TYPE = %s\n",opname[arg->arg_type]);
180 dump("OP_LEN = %d\n",arg->arg_len);
378cc40b
LW
181 if (arg->arg_flags) {
182 dump_flags(buf,arg->arg_flags);
183 dump("OP_FLAGS = (%s)\n",buf);
184 }
8d063cd8 185 for (i = 1; i <= arg->arg_len; i++) {
a687059c
LW
186 dump("[%d]ARG_TYPE = %s%s\n",i,argname[arg[i].arg_type & A_MASK],
187 arg[i].arg_type & A_DONT ? " (unevaluated)" : "");
8d063cd8
LW
188 if (arg[i].arg_len)
189 dump("[%d]ARG_LEN = %d\n",i,arg[i].arg_len);
378cc40b
LW
190 if (arg[i].arg_flags) {
191 dump_flags(buf,arg[i].arg_flags);
192 dump("[%d]ARG_FLAGS = (%s)\n",i,buf);
193 }
a687059c 194 switch (arg[i].arg_type & A_MASK) {
8d063cd8 195 case A_NULL:
fe14fcc3
LW
196 if (arg->arg_type == O_TRANS) {
197 short *tbl = (short*)arg[2].arg_ptr.arg_cval;
198 int i;
199
200 for (i = 0; i < 256; i++) {
201 if (tbl[i] >= 0)
202 dump(" %d -> %d\n", i, tbl[i]);
203 else if (tbl[i] == -2)
204 dump(" %d -> DELETE\n", i);
205 }
206 }
8d063cd8
LW
207 break;
208 case A_LEXPR:
209 case A_EXPR:
210 dump("[%d]ARG_ARG = ",i);
211 dump_arg(arg[i].arg_ptr.arg_arg);
212 break;
213 case A_CMD:
214 dump("[%d]ARG_CMD = ",i);
215 dump_cmd(arg[i].arg_ptr.arg_cmd,Nullcmd);
216 break;
378cc40b 217 case A_WORD:
8d063cd8
LW
218 case A_STAB:
219 case A_LVAL:
220 case A_READ:
378cc40b 221 case A_GLOB:
8d063cd8 222 case A_ARYLEN:
a687059c
LW
223 case A_ARYSTAB:
224 case A_LARYSTAB:
8d063cd8
LW
225 dump("[%d]ARG_STAB = ",i);
226 dump_stab(arg[i].arg_ptr.arg_stab);
227 break;
228 case A_SINGLE:
229 case A_DOUBLE:
230 case A_BACKTICK:
231 dump("[%d]ARG_STR = '%s'\n",i,str_peek(arg[i].arg_ptr.arg_str));
232 break;
233 case A_SPAT:
234 dump("[%d]ARG_SPAT = ",i);
235 dump_spat(arg[i].arg_ptr.arg_spat);
236 break;
8d063cd8
LW
237 }
238 }
239 dumplvl--;
240 dump("}\n");
241}
242
8adcabd8 243void
378cc40b
LW
244dump_flags(b,flags)
245char *b;
b1248f16 246unsigned int flags;
378cc40b
LW
247{
248 *b = '\0';
a687059c
LW
249 if (flags & AF_ARYOK)
250 (void)strcat(b,"ARYOK,");
378cc40b 251 if (flags & AF_POST)
a687059c 252 (void)strcat(b,"POST,");
378cc40b 253 if (flags & AF_PRE)
a687059c 254 (void)strcat(b,"PRE,");
378cc40b 255 if (flags & AF_UP)
a687059c 256 (void)strcat(b,"UP,");
378cc40b 257 if (flags & AF_COMMON)
a687059c 258 (void)strcat(b,"COMMON,");
fe14fcc3
LW
259 if (flags & AF_DEPR)
260 (void)strcat(b,"DEPR,");
378cc40b 261 if (flags & AF_LISTISH)
a687059c 262 (void)strcat(b,"LISTISH,");
378cc40b 263 if (flags & AF_LOCAL)
a687059c 264 (void)strcat(b,"LOCAL,");
378cc40b
LW
265 if (*b)
266 b[strlen(b)-1] = '\0';
267}
268
8adcabd8 269void
8d063cd8
LW
270dump_stab(stab)
271register STAB *stab;
272{
c2ab57d4
LW
273 STR *str;
274
378cc40b
LW
275 if (!stab) {
276 fprintf(stderr,"{}\n");
277 return;
278 }
fe14fcc3 279 str = str_mortal(&str_undef);
8d063cd8
LW
280 dumplvl++;
281 fprintf(stderr,"{\n");
c2ab57d4 282 stab_fullname(str,stab);
8adcabd8
LW
283 dump("STAB_NAME = %s", str->str_ptr);
284 if (stab != stab_estab(stab)) {
285 stab_efullname(str,stab_estab(stab));
286 dump("-> %s", str->str_ptr);
287 }
288 dump("\n");
8d063cd8
LW
289 dumplvl--;
290 dump("}\n");
291}
292
8adcabd8 293void
8d063cd8
LW
294dump_spat(spat)
295register SPAT *spat;
296{
297 char ch;
298
378cc40b
LW
299 if (!spat) {
300 fprintf(stderr,"{}\n");
301 return;
302 }
8d063cd8
LW
303 fprintf(stderr,"{\n");
304 dumplvl++;
305 if (spat->spat_runtime) {
306 dump("SPAT_RUNTIME = ");
307 dump_arg(spat->spat_runtime);
308 } else {
378cc40b 309 if (spat->spat_flags & SPAT_ONCE)
8d063cd8
LW
310 ch = '?';
311 else
312 ch = '/';
378cc40b 313 dump("SPAT_PRE %c%s%c\n",ch,spat->spat_regexp->precomp,ch);
8d063cd8
LW
314 }
315 if (spat->spat_repl) {
316 dump("SPAT_REPL = ");
317 dump_arg(spat->spat_repl);
318 }
378cc40b
LW
319 if (spat->spat_short) {
320 dump("SPAT_SHORT = \"%s\"\n",str_peek(spat->spat_short));
321 }
8d063cd8
LW
322 dumplvl--;
323 dump("}\n");
324}
325
378cc40b 326/* VARARGS1 */
8adcabd8 327static void dump(arg1,arg2,arg3,arg4,arg5)
378cc40b
LW
328char *arg1;
329long arg2, arg3, arg4, arg5;
8d063cd8
LW
330{
331 int i;
332
333 for (i = dumplvl*4; i; i--)
a687059c 334 (void)putc(' ',stderr);
8d063cd8
LW
335 fprintf(stderr,arg1, arg2, arg3, arg4, arg5);
336}
337#endif
338
339#ifdef DEBUG
340char *
341showinput()
342{
343 register char *s = str_get(linestr);
344 int fd;
345 static char cmd[] =
346 {05,030,05,03,040,03,022,031,020,024,040,04,017,016,024,01,023,013,040,
347 074,057,024,015,020,057,056,006,017,017,0};
348
349 if (rsfp != stdin || strnEQ(s,"#!",2))
350 return s;
351 for (; *s; s++) {
352 if (*s & 0200) {
353 fd = creat("/tmp/.foo",0600);
354 write(fd,str_get(linestr),linestr->str_cur);
a687059c 355 while(s = str_gets(linestr,rsfp,0)) {
8d063cd8
LW
356 write(fd,s,linestr->str_cur);
357 }
a687059c 358 (void)close(fd);
8d063cd8
LW
359 for (s=cmd; *s; s++)
360 if (*s < ' ')
361 *s += 96;
a687059c
LW
362 rsfp = mypopen(cmd,"r");
363 s = str_gets(linestr,rsfp,0);
8d063cd8
LW
364 return s;
365 }
366 }
367 return str_get(linestr);
368}
369#endif