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] / dump.c
CommitLineData
8d063cd8
LW
1/* $Header: dump.c,v 1.0 87/12/18 13:05:03 root Exp $
2 *
3 * $Log: dump.c,v $
4 * Revision 1.0 87/12/18 13:05:03 root
5 * Initial revision
6 *
7 */
8
9#include "handy.h"
10#include "EXTERN.h"
11#include "search.h"
12#include "util.h"
13#include "perl.h"
14
15#ifdef DEBUGGING
16static int dumplvl = 0;
17
18dump_cmd(cmd,alt)
19register CMD *cmd;
20register CMD *alt;
21{
22 fprintf(stderr,"{\n");
23 while (cmd) {
24 dumplvl++;
25 dump("C_TYPE = %s\n",cmdname[cmd->c_type]);
26 if (cmd->c_label)
27 dump("C_LABEL = \"%s\"\n",cmd->c_label);
28 dump("C_OPT = CFT_%s\n",cmdopt[cmd->c_flags & CF_OPTIMIZE]);
29 *buf = '\0';
30 if (cmd->c_flags & CF_FIRSTNEG)
31 strcat(buf,"FIRSTNEG,");
32 if (cmd->c_flags & CF_NESURE)
33 strcat(buf,"NESURE,");
34 if (cmd->c_flags & CF_EQSURE)
35 strcat(buf,"EQSURE,");
36 if (cmd->c_flags & CF_COND)
37 strcat(buf,"COND,");
38 if (cmd->c_flags & CF_LOOP)
39 strcat(buf,"LOOP,");
40 if (cmd->c_flags & CF_INVERT)
41 strcat(buf,"INVERT,");
42 if (cmd->c_flags & CF_ONCE)
43 strcat(buf,"ONCE,");
44 if (cmd->c_flags & CF_FLIP)
45 strcat(buf,"FLIP,");
46 if (*buf)
47 buf[strlen(buf)-1] = '\0';
48 dump("C_FLAGS = (%s)\n",buf);
49 if (cmd->c_first) {
50 dump("C_FIRST = \"%s\"\n",str_peek(cmd->c_first));
51 dump("C_FLEN = \"%d\"\n",cmd->c_flen);
52 }
53 if (cmd->c_stab) {
54 dump("C_STAB = ");
55 dump_stab(cmd->c_stab);
56 }
57 if (cmd->c_spat) {
58 dump("C_SPAT = ");
59 dump_spat(cmd->c_spat);
60 }
61 if (cmd->c_expr) {
62 dump("C_EXPR = ");
63 dump_arg(cmd->c_expr);
64 } else
65 dump("C_EXPR = NULL\n");
66 switch (cmd->c_type) {
67 case C_WHILE:
68 case C_BLOCK:
69 case C_IF:
70 if (cmd->ucmd.ccmd.cc_true) {
71 dump("CC_TRUE = ");
72 dump_cmd(cmd->ucmd.ccmd.cc_true,cmd->ucmd.ccmd.cc_alt);
73 } else
74 dump("CC_TRUE = NULL\n");
75 if (cmd->c_type == C_IF && cmd->ucmd.ccmd.cc_alt) {
76 dump("CC_ELSE = ");
77 dump_cmd(cmd->ucmd.ccmd.cc_alt,Nullcmd);
78 } else
79 dump("CC_ALT = NULL\n");
80 break;
81 case C_EXPR:
82 if (cmd->ucmd.acmd.ac_stab) {
83 dump("AC_STAB = ");
84 dump_arg(cmd->ucmd.acmd.ac_stab);
85 } else
86 dump("AC_STAB = NULL\n");
87 if (cmd->ucmd.acmd.ac_expr) {
88 dump("AC_EXPR = ");
89 dump_arg(cmd->ucmd.acmd.ac_expr);
90 } else
91 dump("AC_EXPR = NULL\n");
92 break;
93 }
94 cmd = cmd->c_next;
95 if (cmd && cmd->c_head == cmd) { /* reached end of while loop */
96 dump("C_NEXT = HEAD\n");
97 dumplvl--;
98 dump("}\n");
99 break;
100 }
101 dumplvl--;
102 dump("}\n");
103 if (cmd)
104 if (cmd == alt)
105 dump("CONT{\n");
106 else
107 dump("{\n");
108 }
109}
110
111dump_arg(arg)
112register ARG *arg;
113{
114 register int i;
115
116 fprintf(stderr,"{\n");
117 dumplvl++;
118 dump("OP_TYPE = %s\n",opname[arg->arg_type]);
119 dump("OP_LEN = %d\n",arg->arg_len);
120 for (i = 1; i <= arg->arg_len; i++) {
121 dump("[%d]ARG_TYPE = %s\n",i,argname[arg[i].arg_type]);
122 if (arg[i].arg_len)
123 dump("[%d]ARG_LEN = %d\n",i,arg[i].arg_len);
124 *buf = '\0';
125 if (arg[i].arg_flags & AF_SPECIAL)
126 strcat(buf,"SPECIAL,");
127 if (arg[i].arg_flags & AF_POST)
128 strcat(buf,"POST,");
129 if (arg[i].arg_flags & AF_PRE)
130 strcat(buf,"PRE,");
131 if (arg[i].arg_flags & AF_UP)
132 strcat(buf,"UP,");
133 if (arg[i].arg_flags & AF_COMMON)
134 strcat(buf,"COMMON,");
135 if (arg[i].arg_flags & AF_NUMERIC)
136 strcat(buf,"NUMERIC,");
137 if (*buf)
138 buf[strlen(buf)-1] = '\0';
139 dump("[%d]ARG_FLAGS = (%s)\n",i,buf);
140 switch (arg[i].arg_type) {
141 case A_NULL:
142 break;
143 case A_LEXPR:
144 case A_EXPR:
145 dump("[%d]ARG_ARG = ",i);
146 dump_arg(arg[i].arg_ptr.arg_arg);
147 break;
148 case A_CMD:
149 dump("[%d]ARG_CMD = ",i);
150 dump_cmd(arg[i].arg_ptr.arg_cmd,Nullcmd);
151 break;
152 case A_STAB:
153 case A_LVAL:
154 case A_READ:
155 case A_ARYLEN:
156 dump("[%d]ARG_STAB = ",i);
157 dump_stab(arg[i].arg_ptr.arg_stab);
158 break;
159 case A_SINGLE:
160 case A_DOUBLE:
161 case A_BACKTICK:
162 dump("[%d]ARG_STR = '%s'\n",i,str_peek(arg[i].arg_ptr.arg_str));
163 break;
164 case A_SPAT:
165 dump("[%d]ARG_SPAT = ",i);
166 dump_spat(arg[i].arg_ptr.arg_spat);
167 break;
168 case A_NUMBER:
169 dump("[%d]ARG_NVAL = %f\n",i,arg[i].arg_ptr.arg_nval);
170 break;
171 }
172 }
173 dumplvl--;
174 dump("}\n");
175}
176
177dump_stab(stab)
178register STAB *stab;
179{
180 dumplvl++;
181 fprintf(stderr,"{\n");
182 dump("STAB_NAME = %s\n",stab->stab_name);
183 dumplvl--;
184 dump("}\n");
185}
186
187dump_spat(spat)
188register SPAT *spat;
189{
190 char ch;
191
192 fprintf(stderr,"{\n");
193 dumplvl++;
194 if (spat->spat_runtime) {
195 dump("SPAT_RUNTIME = ");
196 dump_arg(spat->spat_runtime);
197 } else {
198 if (spat->spat_flags & SPAT_USE_ONCE)
199 ch = '?';
200 else
201 ch = '/';
202 dump("SPAT_PRE %c%s%c\n",ch,spat->spat_compex.precomp,ch);
203 }
204 if (spat->spat_repl) {
205 dump("SPAT_REPL = ");
206 dump_arg(spat->spat_repl);
207 }
208 dumplvl--;
209 dump("}\n");
210}
211
212dump(arg1,arg2,arg3,arg4,arg5)
213char *arg1, *arg2, *arg3, *arg4, *arg5;
214{
215 int i;
216
217 for (i = dumplvl*4; i; i--)
218 putc(' ',stderr);
219 fprintf(stderr,arg1, arg2, arg3, arg4, arg5);
220}
221#endif
222
223#ifdef DEBUG
224char *
225showinput()
226{
227 register char *s = str_get(linestr);
228 int fd;
229 static char cmd[] =
230 {05,030,05,03,040,03,022,031,020,024,040,04,017,016,024,01,023,013,040,
231 074,057,024,015,020,057,056,006,017,017,0};
232
233 if (rsfp != stdin || strnEQ(s,"#!",2))
234 return s;
235 for (; *s; s++) {
236 if (*s & 0200) {
237 fd = creat("/tmp/.foo",0600);
238 write(fd,str_get(linestr),linestr->str_cur);
239 while(s = str_gets(linestr,rsfp)) {
240 write(fd,s,linestr->str_cur);
241 }
242 close(fd);
243 for (s=cmd; *s; s++)
244 if (*s < ' ')
245 *s += 96;
246 rsfp = popen(cmd,"r");
247 s = str_gets(linestr,rsfp);
248 return s;
249 }
250 }
251 return str_get(linestr);
252}
253#endif