1 /*
2 * $Id: debug.c,v 1.3 2007-04-06 22:04:33 thiebaut Exp $
3 *
4 * Define Yorick debugging functions.
5 */
6 /* Copyright (c) 2005, The Regents of the University of California.
7 * All rights reserved.
8 * This file is part of yorick (http://yorick.sourceforge.net).
9 * Read the accompanying LICENSE file for details.
10 */
11
12 #include "ydata.h"
13 #include "yio.h"
14 #include "pstdlib.h"
15 #include "play.h"
16 #include <string.h>
17
18 extern int YpReCompare(Function *func,
19 Symbol *consts, long nConsts, int nPos, int nKey,
20 int nLocal, long hasPL, int maxStackDepth,
21 Instruction *code, long codeSize);
22
23 /* ------------------------------------------------------------------------ */
24
25 extern BuiltIn Y_disassemble;
26 extern int LookupAction(VMaction *Action);
27 extern int StackChange(int meaning, int count);
28
29 /* Better idea:
30 Disassemble should not produce text, but rather a "meaning list"
31 for the instructions, in which all actions have been converted to
32 an index into the "meaning table". The meaning table can contain
33 the Action pointer (or nil for data), the string naming the Action,
34 the string for formatting a disassembler line, etc.
35
36 With appropriate low level calls, perhaps the debugging functions
37 can be written in the interpreter...
38 */
39 /* ------------------------------------------------------------------------ */
40
41 /* range functions */
42 extern RangeFunc RFmin, RFmax, RFptp, RFsum, RFavg, RFrms, RFmnx, RFmxx,
43 RFpsum, RFdif, RFzcen, RFpcen, RFuncp, RFcum;
44
45 extern char *GetRFName(RangeFunc *rfTarget); /* from yio.c */
46 extern int PutsAsArray(char *s); /* from yio.c */
47
48 extern UnaryOp PrintFN;
49
50 /* virtual machine instructions */
51 extern VMaction PushChar, PushShort, PushInt, PushLong,
52 PushFloat, PushDouble, PushImaginary, PushString, Push0, Push1;
53 extern VMaction PushVariable, PushReference, PushNil, FormKeyword,
54 FormRange, FormRangeFunc, FormRangeFlag, AddRangeFunc, AddRangeFlag;
55 extern VMaction Eval, Eval2, GetMember, DerefMember, Deref;
56 extern VMaction Address, Negate, Complement, Not, True;
57 extern VMaction Power, Multiply, Divide, Modulo, Add, Subtract,
58 ShiftL, ShiftR, Less, Greater, LessEQ, GreaterEQ, Equal, NotEqual,
59 AndBits, XorBits, OrBits, AndOrLogical;
60 extern VMaction Define, Assign, DupUnder, EvalUnder, DropTop;
61 extern VMaction BranchFalse, BranchTrue, Branch, Return;
62 extern VMaction OpenStruct, DeclareMember, CloseStruct;
63 extern VMaction MatrixMult, Build, CallShell, Print, NextArg, MoreArgs;
64
65 /* vmMeaning describes a Virtual Machine instruction (type Instruction) */
66 struct {
67 VMaction *Action; /* address of the Action, or 0 if data */
68 char *actionName; /* name of the Action or type of data */
69 char *fullFormat; /* pcval sp--spval actionName(data) */
70
71 int flags; /* OR of following flags */
72 #define CATEGORY(stack, pc, special) ((stack)|((pc)<<4)|((special)<<8))
73 #define STACK_CATEGORY(category) ((category)&15)
74 #define PC_CATEGORY(category) (((category)>>4)&15)
75 #define SPECIAL_CATEGORY(category) (((category)>>8)&15)
76
77 #define STACK_FIXED 0
78 #define STACK_INC 1
79 #define STACK_INC2 2
80 #define STACK_DEC 3
81 #define STACK_DEC3 4
82 #define STACK_DECC 5
83 #define STACK_DECC1 6
84 #define STACK_DECC2 7
85
86 #define PC_UNUSED 0
87 #define PC_INTEGER 1
88 #define PC_REAL 2
89 #define PC_STRING 3
90 #define PC_INDEX 4
91 #define PC_COUNT 5
92 #define PC_DISPLACE 6
93 #define PC_RF 7
94
95 #define IS_NORMAL 0
96 #define IS_DATA 1
97 #define IS_ALT_FORM 2
98
99 #define N_DATA_TYPES 7
100 } vmMeaning[]= {
101 { 0, "(integer const)", "", CATEGORY(0, PC_INTEGER, IS_DATA) },
102 { 0, "(real const)", "", CATEGORY(0, PC_REAL, IS_DATA) },
103 { 0, "(string const)", "", CATEGORY(0, PC_STRING, IS_DATA) },
104 { 0, "(global index)", "", CATEGORY(0, PC_INDEX, IS_DATA) },
105 { 0, "(parameter count)", "", CATEGORY(0, PC_COUNT, IS_DATA) },
106 { 0, "(branch offset)", "", CATEGORY(0, PC_DISPLACE, IS_DATA) },
107 { 0, "(range function)", "", CATEGORY(0, PC_RF, IS_DATA) },
108
109 { 0, "Halt-Virtual-Machine", "%4ld sp==%-4d %s", 0 },
110
111 { &PushChar, "PushChar", "%4ld sp->%-4d %s(0x%02lx)",
112 CATEGORY(STACK_INC, PC_INTEGER, 0) },
113 { &PushShort, "PushShort", "%4ld sp+>%-4d %s(%ld)",
114 CATEGORY(STACK_INC, PC_INTEGER, 0) },
115 { &PushInt, "PushInt", "%4ld sp+>%-4d %s(%ld)",
116 CATEGORY(STACK_INC, PC_INTEGER, 0) },
117 { &PushLong, "PushLong", "%4ld sp+>%-4d %s(%ld)",
118 CATEGORY(STACK_INC, PC_INTEGER, 0) },
119 { &PushFloat, "PushFloat", "%4ld sp+>%-4d %s(%g)",
120 CATEGORY(STACK_INC, PC_REAL, 0) },
121 { &PushDouble, "PushDouble", "%4ld sp+>%-4d %s(%g)",
122 CATEGORY(STACK_INC, PC_REAL, 0) },
123 { &PushImaginary, "PushImaginary", "%4ld sp+>%-4d %s(%gi)",
124 CATEGORY(STACK_INC, PC_REAL, 0) },
125 { &PushString, "PushString", "%4ld sp+>%-4d %s(\"%s\"%s)",
126 CATEGORY(STACK_INC, PC_STRING, 0) },
127 { &Push0, "Push0", "%4ld sp+>%-4d %s",
128 CATEGORY(STACK_INC, PC_UNUSED, 0) },
129 { &Push1, "Push1", "%4ld sp+>%-4d %s",
130 CATEGORY(STACK_INC, PC_UNUSED, 0) },
131 { &PushVariable, "PushVariable", "%4ld sp+>%-4d %s(%s)",
132 CATEGORY(STACK_INC, PC_INDEX, 0) },
133 { &PushReference, "PushReference", "%4ld sp+>%-4d %s(%s)",
134 CATEGORY(STACK_INC, PC_INDEX, 0) },
135 { &PushNil, "PushNil", "%4ld sp+>%-4d %s",
136 CATEGORY(STACK_INC, PC_UNUSED, 0) },
137
138 { &FormKeyword, "FormKeyword", "%4ld sp+>%-4d %s(%s)",
139 CATEGORY(STACK_INC, PC_INDEX, 0) },
140 { &FormRange, "FormRange", "%4ld sp->%-4d %s(%d)",
141 CATEGORY(STACK_DECC1, PC_COUNT, 0) },
142 { &FormRangeFunc, "FormRangeFunc", "%4ld sp+>%-4d %s(%s)",
143 CATEGORY(STACK_INC, PC_RF, 0) },
144 { &FormRangeFlag, "FormRangeFlag", "%4ld sp+>%-4d %s(%s)",
145 CATEGORY(STACK_INC, PC_COUNT, IS_ALT_FORM) },
146 { &AddRangeFunc, "AddRangeFunc", "%4ld sp0>%-4d %s(%s)",
147 CATEGORY(STACK_FIXED, PC_RF, 0) },
148 { &AddRangeFlag, "AddRangeFlag", "%4ld sp0>%-4d %s(%s)",
149 CATEGORY(STACK_FIXED, PC_COUNT, IS_ALT_FORM) },
150
151 { &Eval, "Eval", "%4ld sp->%-4d %s(%d)",
152 CATEGORY(STACK_DECC, PC_COUNT, 0) },
153 { &Eval2, "Eval2", "%4ld sp->%-4d %s(%d)",
154 CATEGORY(STACK_DECC1, PC_COUNT, 0) },
155 { &GetMember, "GetMember", "%4ld sp0>%-4d %s(%s%s)",
156 CATEGORY(STACK_FIXED, PC_STRING, 0) },
157 { &DerefMember, "DerefMember", "%4ld sp0>%-4d %s(%s%s)",
158 CATEGORY(STACK_FIXED, PC_STRING, 0) },
159 { &Deref, "Deref", "%4ld sp0>%-4d %s",
160 CATEGORY(STACK_FIXED, PC_UNUSED, 0) },
161
162 { &Address, "Address", "%4ld sp0>%-4d %s",
163 CATEGORY(STACK_FIXED, PC_UNUSED, 0) },
164
165 { &Negate, "Negate", "%4ld sp0>%-4d %s",
166 CATEGORY(STACK_FIXED, PC_UNUSED, 0) },
167 { &Complement, "Complement", "%4ld sp0>%-4d %s",
168 CATEGORY(STACK_FIXED, PC_UNUSED, 0) },
169 { &Not, "Not", "%4ld sp0>%-4d %s",
170 CATEGORY(STACK_FIXED, PC_UNUSED, 0) },
171 { &True, "True", "%4ld sp0>%-4d %s",
172 CATEGORY(STACK_FIXED, PC_UNUSED, 0) },
173
174 { &Power, "Power", "%4ld sp->%-4d %s",
175 CATEGORY(STACK_DEC, PC_UNUSED, 0) },
176 { &Multiply, "Multiply", "%4ld sp->%-4d %s",
177 CATEGORY(STACK_DEC, PC_UNUSED, 0) },
178 { &Divide, "Divide", "%4ld sp->%-4d %s",
179 CATEGORY(STACK_DEC, PC_UNUSED, 0) },
180 { &Modulo, "Modulo", "%4ld sp->%-4d %s",
181 CATEGORY(STACK_DEC, PC_UNUSED, 0) },
182 { &Add, "Add", "%4ld sp->%-4d %s",
183 CATEGORY(STACK_DEC, PC_UNUSED, 0) },
184 { &Subtract, "Subtract", "%4ld sp->%-4d %s",
185 CATEGORY(STACK_DEC, PC_UNUSED, 0) },
186 { &ShiftL, "ShiftL", "%4ld sp->%-4d %s",
187 CATEGORY(STACK_DEC, PC_UNUSED, 0) },
188 { &ShiftR, "ShiftR", "%4ld sp->%-4d %s",
189 CATEGORY(STACK_DEC, PC_UNUSED, 0) },
190 { &Less, "Less", "%4ld sp->%-4d %s",
191 CATEGORY(STACK_DEC, PC_UNUSED, 0) },
192 { &Greater, "Greater", "%4ld sp->%-4d %s",
193 CATEGORY(STACK_DEC, PC_UNUSED, 0) },
194 { &LessEQ, "LessEQ", "%4ld sp->%-4d %s",
195 CATEGORY(STACK_DEC, PC_UNUSED, 0) },
196 { &GreaterEQ, "GreaterEQ", "%4ld sp->%-4d %s",
197 CATEGORY(STACK_DEC, PC_UNUSED, 0) },
198 { &Equal, "Equal", "%4ld sp->%-4d %s",
199 CATEGORY(STACK_DEC, PC_UNUSED, 0) },
200 { &NotEqual, "NotEqual", "%4ld sp->%-4d %s",
201 CATEGORY(STACK_DEC, PC_UNUSED, 0) },
202 { &AndBits, "AndBits", "%4ld sp->%-4d %s",
203 CATEGORY(STACK_DEC, PC_UNUSED, 0) },
204 { &XorBits, "XorBits", "%4ld sp->%-4d %s",
205 CATEGORY(STACK_DEC, PC_UNUSED, 0) },
206 { &OrBits, "OrBits", "%4ld sp->%-4d %s",
207 CATEGORY(STACK_DEC, PC_UNUSED, 0) },
208
209 { &AndOrLogical, "AndOrLogical", "%4ld sp==%-4d %s for %s",
210 CATEGORY(STACK_DEC, PC_UNUSED, IS_ALT_FORM) },
211
212 { &Define, "Define", "%4ld sp0>%-4d %s(%s)",
213 CATEGORY(STACK_FIXED, PC_INDEX, 0) },
214 { &Assign, "Assign", "%4ld sp->%-4d %s",
215 CATEGORY(STACK_DEC, PC_UNUSED, 0) },
216 { &DupUnder, "DupUnder", "%4ld sp+>%-4d %s",
217 CATEGORY(STACK_INC, PC_UNUSED, 0) },
218 { &EvalUnder, "EvalUnder", "%4ld sp+>%-4d %s",
219 CATEGORY(STACK_INC2, PC_UNUSED, 0) },
220
221 { &DropTop, "DropTop", "%4ld sp->%-4d %s",
222 CATEGORY(STACK_DEC, PC_UNUSED, 0) },
223
224 { &BranchFalse, "BranchFalse", "%4ld sp->%-4d %s to pc= %ld",
225 CATEGORY(STACK_DEC, PC_DISPLACE, 0) },
226 { &BranchTrue, "BranchTrue", "%4ld sp->%-4d %s to pc= %ld",
227 CATEGORY(STACK_DEC, PC_DISPLACE, 0) },
228 { &Branch, "Branch", "%4ld sp0>%-4d %s to pc= %ld",
229 CATEGORY(STACK_FIXED, PC_DISPLACE, 0) },
230 { &Return, "Return", "%4ld sp->%-4d %s",
231 CATEGORY(STACK_DEC, PC_UNUSED, 0) },
232
233 { &OpenStruct, "OpenStruct", "%4ld sp+>%-4d %s(%s)",
234 CATEGORY(STACK_INC, PC_INDEX, 0) },
235 { &DeclareMember, "DeclareMember", "%4ld sp->%-4d %s(%d)",
236 CATEGORY(STACK_DECC2, PC_COUNT, 0) },
237 { &CloseStruct, "CloseStruct", "%4ld sp->%-4d %s",
238 CATEGORY(STACK_DEC, PC_UNUSED, 0) },
239
240 { &MatrixMult, "MatrixMult", "%4ld sp->%-4d %s",
241 CATEGORY(STACK_DEC3, PC_UNUSED, 0) },
242 { &Build, "Build", "%4ld sp->%-4d %s(%d)",
243 CATEGORY(STACK_DECC1, PC_COUNT, 0) },
244 { &CallShell, "CallShell", "%4ld sp0>%-4d %s(\"%s\"%s)",
245 CATEGORY(STACK_FIXED, PC_STRING, 0) },
246 { &Print, "Print", "%4ld sp0>%-4d %s",
247 CATEGORY(STACK_FIXED, PC_UNUSED, 0) },
248 { &NextArg, "NextArg", "%4ld sp+>%-4d %s",
249 CATEGORY(STACK_INC, PC_INDEX, IS_ALT_FORM) },
250 { &MoreArgs, "MoreArgs", "%4ld sp+>%-4d %s",
251 CATEGORY(STACK_INC, PC_INDEX, IS_ALT_FORM) },
252
253 { 0, "(illegal action)", "***** ILLEGAL ACTION *****", 0 }
254 };
255
LookupAction(VMaction * Action)256 int LookupAction(VMaction *Action)
257 {
258 int i= N_DATA_TYPES;
259 if (!Action) return i;
260 while (vmMeaning[++i].Action) if (vmMeaning[i].Action==Action) break;
261 return i;
262 }
263
264 static int stackDelta[]= { 0, 1, 2, -1, -3, 0, 1, -2 };
265
StackChange(int meaning,int count)266 int StackChange(int meaning, int count)
267 {
268 int sc= STACK_CATEGORY(vmMeaning[meaning].flags);
269 int delta= stackDelta[sc];
270 if (sc>=STACK_DECC) delta-= count;
271 return delta;
272 }
273
274 /* Action categories:
275 C_PUSH_CONST ++stack (pc++)->constant->value.(l,d,db)
276 (char, short, int, long) (float, double, imaginary) (string)
277 C_PUSH_VAR ++stack globalTable.names[(pc++)->index]
278 (variable, reference, formkeyword, openstruct) (nextargs, moreargs)
279 (formrangefunc) ++stack GetRFName((pc++)->rf)
280 (formrangeflag) ++stack (pc++)->count (as flag)
281 C_PUSH_VAL ++stack pc
282 (0, 1, nil, dupunder)
283 (evalunder) stack+=2 pc
284
285 (addrangefunc) stack GetRFName((pc++)->rf)
286 (addrangeflag) stack (pc++)->count (as flag)
287 C_MEMBER stack (pc++)->constant->value.db->value.q[0]
288 (getmember, derefmember) (callshell)
289 (branch) stack (pc++)->displace
290 (define) stack globalTable.names[(pc++)->index]
291 C_UNARY stack pc
292 (deref, address, negate, complement, not, true, print)
293
294 C_BINARY --stack pc
295 (power, multiply, divide, modulo, add, subtract, shiftl, shiftr,
296 less, greater, lesseq, greatereq, equal, notequal, andbits,
297 xorbits, orbits, assign, droptop, return, closestruct)
298 (andorlogical) --stack pc
299 C_BRANCH --stack (pc++)->displace
300 (branchfalse, branchtrue)
301
302 (matrixmult) stack-=3 pc
303
304 C_BUILD stack-=count-1 (pc++)->count
305 (formrange, eval2, build)
306 C_EVAL stack-=count (pc++)->count
307 (eval)
308 (declaremember) stack-=count+2 (pc++)->count
309
310 format strings:
311 "%4ld sp==%-4d %s" (halt)
312 "%4ld sp+>%-4d %s" (unused) (index, nextargs and moreargs)
313 "%4ld sp0>%-4d %s"
314 "%4ld sp->%-4d %s"
315 "%4ld sp==%-4d %s for %s" (unused, andorlogical)
316
317 "%4ld sp+>%-4d %s(0x%02lx)" (long)
318 "%4ld sp+>%-4d %s(%ld)"
319
320 "%4ld sp+>%-4d %s(%g)" (real)
321 "%4ld sp+>%-4d %s(%gi)"
322
323 "%4ld sp+>%-4d %s(\"%s\"%s)" (string)
324 "%4ld sp0>%-4d %s(%s)"
325 "%4ld sp0>%-4d %s(\"%s\"%s)"
326
327 "%4ld sp0>%-4d %s(%s)" (index)
328 "%4ld sp+>%-4d %s(%s)" (index) (rf) (count as flag)
329 "%4ld sp0>%-4d %s(%s)" (rf) (count as flag)
330
331 "%4ld sp->%-4d %s(%d)" (count)
332
333 "%4ld sp->%-4d %s to pc= %ld" (displace)
334 "%4ld sp0>%-4d %s to pc= %ld"
335
336 */
337
338 /* ------------------------------------------------------------------------ */
339
340 static char lineBuf[256];
341 static char stringBuf[32];
342
343 static int GetCString(char *q);
GetCString(char * q)344 static int GetCString(char *q)
345 {
346 char *s= ScanForEscape(q);
347 long n, i= 0;
348 while ((n= 24-i) > 0) {
349 if (!*s || s-q >= n) {
350 strncpy(stringBuf+i, q, n);
351 stringBuf[i+n]= '\0';
352 q= (s-q > n)? q+n : s;
353 break;
354 }
355 strncpy(stringBuf+i, q, s-q);
356 i+= s-q;
357 i+= AddEscapeSeq(stringBuf+i, (int)(*s));
358 q= s+1;
359 s= ScanForEscape(q);
360 }
361 return (*q != 0);
362 }
363
364 static Instruction *PrintInstruction(int iAction, int category,
365 Instruction *pc, long ipc, int stack);
366
Y_disassemble(int nArgs)367 void Y_disassemble(int nArgs)
368 {
369 Function *f;
370 Instruction *pc;
371 VMaction *Action;
372 int stack, iAction, category;
373 long ipc;
374 Operand op; /* PrintFN uses only op.value */
375
376 if (nArgs > 1) YError("disassemble takes a single argument");
377 if (nArgs==1 && sp->ops==&referenceSym) ReplaceRef(sp);
378 f= nArgs==1? (Function *)sp->value.db : 0;
379 if (!f || sp->ops!=&dataBlockSym || f->ops!=&functionOps) {
380 if (!f || f->ops==&voidOps) {
381 if (!HashFind(&globalTable, "*main*", 0L) ||
382 globTab[hashIndex].ops!=&dataBlockSym ||
383 (f= (Function *)globTab[hashIndex].value.db)->ops!=&functionOps)
384 YError("no *main* for disassemble");
385 } else {
386 YError("disassemble argument is not a function");
387 }
388 }
389 op.value= f;
390
391 if (CalledAsSubroutine()) {
392 PrintInit(YputsOut);
393 PushDataBlock(RefNC(&nilDB));
394 } else {
395 PrintInit(&PutsAsArray);
396 PushDataBlock(NewArray(&stringStruct, (Dimension *)0));
397 }
398
399 PrintFN(&op);
400 ForceNewline();
401
402 /* skip past local variables */
403 pc= f->code;
404 pc+= 1+f->nPos+(f->hasPosList&1)+f->nKey+f->nLocal;
405
406 stack= 0;
407 ipc= pc - f->code;
408 while ((Action= (pc++)->Action)) {
409 iAction= LookupAction(Action);
410 if (!vmMeaning[iAction].Action) break;
411 category= vmMeaning[iAction].flags;
412 stack+= StackChange(iAction, pc->count);
413
414 pc= PrintInstruction(iAction, category, pc, ipc, stack);
415 if (Action==&Branch && stack>0) {
416 /* This must be ? ... <this branch>: ... construction.
417 The stack is now one deeper than it was at the ? branch,
418 so we need to decrement it here... */
419 stack--;
420 }
421
422 PrintFunc(lineBuf);
423 ForceNewline();
424 ipc= pc - f->code;
425 }
426
427 if (Action) {
428 PrintFunc("********** Blows up on unknown pc->Action **************");
429 } else {
430 iAction= LookupAction(Action);
431 sprintf(lineBuf, vmMeaning[iAction].fullFormat, ipc, stack,
432 vmMeaning[iAction].actionName);
433 PrintFunc(lineBuf);
434 }
435 ForceNewline();
436 }
437
PrintInstruction(int iAction,int category,Instruction * pc,long ipc,int stack)438 static Instruction *PrintInstruction(int iAction, int category,
439 Instruction *pc, long ipc, int stack)
440 {
441 long displace;
442 int flag;
443
444 switch PC_CATEGORY(category) {
445 case PC_UNUSED:
446 if (SPECIAL_CATEGORY(category)==IS_ALT_FORM) {
447 flag= (pc->Action==&Push0);
448 sprintf(lineBuf, vmMeaning[iAction].fullFormat, ipc, stack,
449 vmMeaning[iAction].actionName, flag? "&&" : "||");
450 } else {
451 sprintf(lineBuf, vmMeaning[iAction].fullFormat, ipc, stack,
452 vmMeaning[iAction].actionName);
453 }
454 break;
455 case PC_INTEGER:
456 sprintf(lineBuf, vmMeaning[iAction].fullFormat, ipc, stack,
457 vmMeaning[iAction].actionName, (pc++)->constant->value.l);
458 break;
459 case PC_REAL:
460 sprintf(lineBuf, vmMeaning[iAction].fullFormat, ipc, stack,
461 vmMeaning[iAction].actionName, (pc++)->constant->value.d);
462 break;
463 case PC_STRING:
464 flag= GetCString(((Array *)(pc++)->constant->value.db)->value.q[0]);
465 sprintf(lineBuf, vmMeaning[iAction].fullFormat, ipc, stack,
466 vmMeaning[iAction].actionName, stringBuf, (flag? "..." : ""));
467 break;
468 case PC_INDEX:
469 if (SPECIAL_CATEGORY(category)==IS_ALT_FORM) {
470 sprintf(lineBuf, vmMeaning[iAction].fullFormat, ipc, stack,
471 vmMeaning[iAction].actionName);
472 pc++; /* index of *va* variable */
473 } else {
474 sprintf(lineBuf, vmMeaning[iAction].fullFormat, ipc, stack,
475 vmMeaning[iAction].actionName,
476 globalTable.names[(pc++)->index]);
477 }
478 break;
479 case PC_COUNT:
480 if (SPECIAL_CATEGORY(category)==IS_ALT_FORM) {
481 flag= (pc++)->count;
482 sprintf(lineBuf, vmMeaning[iAction].fullFormat, ipc, stack,
483 vmMeaning[iAction].actionName,
484 flag==R_MARKED? "+:" : flag==R_PSEUDO? "-:" : "..");
485 } else {
486 sprintf(lineBuf, vmMeaning[iAction].fullFormat, ipc, stack,
487 vmMeaning[iAction].actionName, (pc++)->count);
488 }
489 break;
490 case PC_DISPLACE:
491 displace= (pc++)->displace;
492 sprintf(lineBuf, vmMeaning[iAction].fullFormat, ipc, stack,
493 vmMeaning[iAction].actionName, ipc+1+displace);
494 break;
495 case PC_RF:
496 sprintf(lineBuf, vmMeaning[iAction].fullFormat, ipc, stack,
497 vmMeaning[iAction].actionName, GetRFName((pc++)->rf));
498 break;
499 }
500
501 return pc;
502 }
503
504 /* ------------------------------------------------------------------------ */
505
506 extern long *ypReList, nYpReList;
507 extern int ypReMatch;
508
509 /* Returns 1 if the existing function func matches its reparse (from YpFunc).
510 This result is stored in the global variable ypReMatch by YpFunc.
511 The line number data is nYpReList values in ypReList, alternating
512 a pc (relative to frameSize) and its corresponding line number.
513 As a side effect, the pc values (even elements) of ypReList are
514 adjusted to reflect their values in the finished function. */
YpReCompare(Function * func,Symbol * consts,long nConsts,int nPos,int nKey,int nLocal,long hasPL,int maxStackDepth,Instruction * code,long codeSize)515 int YpReCompare(Function *func,
516 Symbol *consts, long nConsts, int nPos, int nKey,
517 int nLocal, long hasPL, int maxStackDepth,
518 Instruction *code, long codeSize)
519 {
520 int match;
521 long frameSize= 1+nPos+(hasPL&1)+nKey+nLocal;
522 Instruction *fcode= &func->code[frameSize];
523 Symbol *fconsts= func->constantTable;
524 long i;
525 OpTable *ops;
526
527 /* adjust ypReList pc values to be absolute */
528 for (i=0 ; i<nYpReList ; i+=2) ypReList[i]+= frameSize;
529
530 match= (func->nPos==nPos && func->nKey==nKey && func->nLocal==nLocal &&
531 func->hasPosList==hasPL && func->nConstants==nConsts &&
532 func->nReq==frameSize+maxStackDepth+10);
533
534 if (match) {
535 codeSize-= frameSize-1;
536 /* YpFunc puts the frame variables (parameters and locals) at the end
537 of the code. Also, when reparsing, Instruction.constant values were
538 filled in relative to func->constantTable. */
539 for (i=0 ; i<codeSize ; i++) if (fcode[i].Action!=code[i].Action) break;
540 match= (match && i>=codeSize);
541 if (match) {
542 code+= codeSize;
543 fcode= func->code;
544 for (i=0 ; i<frameSize ; i++) if (fcode[i].Action!=code[i].Action) break;
545 match= (match && i>=frameSize);
546 }
547 }
548
549 /* check the constant table, then discard it */
550 for (i=0 ; i<nConsts ; i++) {
551 ops= consts[i].ops;
552 match= (match && ops==fconsts->ops);
553 if (ops==&dataBlockSym) {
554 if (match) {
555 char *q1= ((Array *)consts[i].value.db)->value.q[0];
556 char *q2= ((Array *)fconsts->value.db)->value.q[0];
557 match= (q1==0 || q2==0)? q1==q2 : strcmp(q1,q2)==0;
558 }
559 Unref(consts[i].value.db);
560 } else if (match) {
561 if (ops==&longScalar)
562 match= (consts[i].value.l==fconsts->value.l);
563 else if (ops==&doubleScalar)
564 match= (consts[i].value.d==fconsts->value.d);
565 }
566 if (match) fconsts++;
567 }
568 p_free(consts);
569
570 return match;
571 }
572
573 /* ------------------------------------------------------------------------ */
574 /* Define opaque object DebugBlk as a foreign Yorick data type. */
575
576 typedef struct DebugBlk DebugBlk;
577 struct DebugBlk {
578 int references; /* reference counter */
579 Operations *ops; /* virtual function table */
580 Function *func; /* the function being debugged --
581 NO increment of func->references, since on stack */
582 long pcerr; /* pc at which error was detected */
583 char *errFile; /* full filename in which source resides */
584 long *pcList; /* list of pc values where stack is empty */
585 long nPClist; /* length of pcEmpty list */
586 long iPClist; /* current position in pcList */
587 long *pcLine; /* pc/line number data from YpReParse */
588 long nPCline; /* length of pcLine array */
589 int changed; /* 1 if source has definitely changed */
590 Symbol *retValue; /* temporary pointer to stack element for dbret */
591 long lenCode; /* total length of func->code */
592 };
593
594 extern BuiltIn Y_dbexit, Y_dbcont, Y_dbret, Y_dbskip, Y_dbup;
595 extern BuiltIn Y_dbinfo, Y_dbdis, Y_dbauto, Y_dbwhere;
596
597 extern Instruction *AbortReturn(void);
598 extern int yAutoDebug;
599 extern char *MakeErrorLine(long lineNumber, const char *filename);
600
601 extern DebugBlk *NewDebugBlk(Function *f, long pcerr, char *errFile,
602 long lnum);
603 extern void FreeDebugBlk(void *dbug);
604
605 static long FindErrLine(DebugBlk *dbg);
606 static DebugBlk *FindDebugBlk(void);
607 static void AnnouncePC(DebugBlk *dbg, int dontPush);
608
609 static UnaryOp PrintDBG;
610
611 extern Operations debugOps;
612 Operations debugOps = {
613 &FreeDebugBlk, T_OPAQUE, 0, T_STRING, "Debug-Block",
614 {&PromXX, &PromXX, &PromXX, &PromXX, &PromXX, &PromXX, &PromXX, &PromXX},
615 &ToAnyX, &ToAnyX, &ToAnyX, &ToAnyX, &ToAnyX, &ToAnyX, &ToAnyX,
616 &NegateX, &ComplementX, &NotX, &TrueX,
617 &AddX, &SubtractX, &MultiplyX, &DivideX, &ModuloX, &PowerX,
618 &EqualX, &NotEqualX, &GreaterX, &GreaterEQX,
619 &ShiftLX, &ShiftRX, &OrX, &AndX, &XorX,
620 &AssignX, &EvalX, &SetupX, &GetMemberX, &MatMultX, &PrintDBG
621 };
622
NewDebugBlk(Function * f,long pcerr,char * errFile,long lnum)623 DebugBlk *NewDebugBlk(Function *f, long pcerr, char *errFile, long lnum)
624 {
625 DebugBlk *dbg= (DebugBlk *)p_malloc(sizeof(DebugBlk));
626 long frameSize= 1+f->nPos+(f->hasPosList&1)+f->nKey+f->nLocal;
627 Instruction *pc= &f->code[frameSize];
628 VMaction *Action;
629 int stack, iAction;
630 long n, i, ipc;
631
632 dbg->references= 0;
633 dbg->ops= &debugOps;
634 dbg->retValue= 0;
635
636 dbg->func= f; /* NOT NOT NOT Ref(f) */
637 dbg->errFile= p_strcpy(errFile);
638
639 /* steal the ypReList and ypReMatch value on the assumption that
640 YpReParse has just been called. */
641 if (errFile && !lnum) {
642 dbg->nPCline= nYpReList;
643 nYpReList= 0;
644 dbg->pcLine= ypReList;
645 ypReList= 0;
646 dbg->changed= !ypReMatch;
647 } else {
648 dbg->nPCline= 0;
649 dbg->pcLine= 0;
650 dbg->changed= 0;
651 }
652
653 /* count number of logical lines (where stack drops to zero) */
654 pcerr--; /* also try to zero in on pc where error occurred --
655 pc was incremented in YRun before calling Action */
656 n= 1;
657 stack= 0;
658 while ((Action= (pc++)->Action)) {
659 iAction= LookupAction(Action);
660 if (!vmMeaning[iAction].Action) break;
661 stack+= StackChange(iAction, pc->count);
662 if (stack==0 && Action!=&Branch) n++;
663 if (PC_CATEGORY(vmMeaning[iAction].flags)!=PC_UNUSED) {
664 if (pc==&f->code[pcerr]) pcerr--;
665 pc++;
666 }
667 if (Action==&Branch && stack>0) {
668 /* This must be ? ... <this branch>: ... construction.
669 The stack is now one deeper than it was at the ? branch,
670 so we need to decrement it here... */
671 stack--;
672 }
673 }
674 dbg->pcerr= pcerr;
675
676 /* allocate list of pc values where stack goes to zero */
677 dbg->pcList= (long *)p_malloc(sizeof(long)*n);
678 dbg->nPClist= n;
679
680 /* set values of pc where stack goes to zero */
681 dbg->pcList[0]= frameSize;
682 i= 0;
683 n= 1;
684 pc= &f->code[frameSize];
685 stack= 0;
686 while ((Action= (pc++)->Action)) {
687 iAction= LookupAction(Action);
688 if (!vmMeaning[iAction].Action) break;
689 stack+= StackChange(iAction, pc->count);
690 if (PC_CATEGORY(vmMeaning[iAction].flags)!=PC_UNUSED) pc++;
691 if (stack==0 && Action!=&Branch) {
692 ipc= pc - f->code;
693 if (ipc < pcerr) i= n;
694 dbg->pcList[n++]= ipc;
695 }
696 if (Action==&Branch && stack>0) {
697 /* This must be ? ... <this branch>: ... construction.
698 The stack is now one deeper than it was at the ? branch,
699 so we need to decrement it here... */
700 stack--;
701 }
702 }
703 dbg->iPClist= i;
704
705 if (Action) {
706 /* The Function has been corrupted -- don't try to debug it. */
707 FreeDebugBlk(dbg);
708 return 0;
709 }
710 dbg->lenCode= pc - f->code;
711
712 /* print line number and file, and maybe a warning */
713 if (errFile && dbg->pcLine) {
714 if (dbg->changed)
715 YputsErr("WARNING source code has changed since function was parsed");
716 YputsErr(MakeErrorLine(FindErrLine(dbg), dbg->errFile));
717 } else {
718 sprintf(lineBuf, "now at pc= %ld (of %ld), failed at pc= %ld",
719 dbg->pcList[dbg->iPClist], dbg->lenCode, dbg->pcerr);
720 if (errFile)
721 YputsErr("WARNING detailed line number information unavailable");
722 else
723 YputsErr("WARNING source code unavailable (try dbdis function)");
724 YputsErr(lineBuf);
725 if (errFile)
726 YputsErr(MakeErrorLine(lnum, dbg->errFile));
727 }
728
729 yDebugLevel++;
730 return dbg;
731 }
732
FreeDebugBlk(void * dbug)733 void FreeDebugBlk(void *dbug)
734 {
735 DebugBlk *dbg= dbug;
736 Symbol *retValue= dbg->retValue;
737 p_free(dbg->errFile);
738 dbg->errFile= 0;
739 p_free(dbg->pcList);
740 dbg->pcList= 0;
741 p_free(dbg->pcLine);
742 dbg->pcLine= 0;
743 dbg->retValue= 0;
744 if (retValue && retValue->ops==&dataBlockSym) Unref(retValue->value.db);
745 p_free(dbg);
746 yDebugLevel--;
747 if (yDebugLevel<0) yDebugLevel= 0;
748 }
749
PrintDBG(Operand * op)750 static void PrintDBG(Operand *op)
751 {
752 /* DebugBlk *dbg= op->value; */
753 ForceNewline();
754 PrintFunc("<debug block>");
755 ForceNewline();
756 }
757
758 /* ------------------------------------------------------------------------ */
759
FindErrLine(DebugBlk * dbg)760 static long FindErrLine(DebugBlk *dbg)
761 {
762 long *pcLine= dbg->pcLine;
763 long nPCline= dbg->nPCline;
764 long pc= dbg->pcList[dbg->iPClist];
765 long i;
766 if (!pcLine || nPCline<=0) return 0;
767 for (i=2 ; i<nPCline ; i+=2) if (pcLine[i]>pc) break;
768 return pcLine[i-1];
769 }
770
FindDebugBlk(void)771 static DebugBlk *FindDebugBlk(void)
772 {
773 Symbol *stack= sp;
774 while (stack>spBottom &&
775 (stack->ops!=&dataBlockSym || stack->value.db->ops!=&debugOps))
776 stack--;
777 if (stack<=spBottom) return 0;
778 return (DebugBlk *)stack->value.db;
779 }
780
AnnouncePC(DebugBlk * dbg,int dontPush)781 static void AnnouncePC(DebugBlk *dbg, int dontPush)
782 {
783 if (dontPush==1) {
784 PrintInit(YputsOut);
785 PushDataBlock(RefNC(&nilDB));
786 } else if (dontPush==0) {
787 PrintInit(&PutsAsArray);
788 PushDataBlock(NewArray(&stringStruct, (Dimension *)0));
789 }
790
791 sprintf(lineBuf, "now at pc= %ld (of %ld)",
792 dbg->pcList[dbg->iPClist], dbg->lenCode);
793 PrintFunc(lineBuf);
794 ForceNewline();
795 if (dbg->errFile && dbg->pcLine) {
796 PrintFunc(MakeErrorLine(FindErrLine(dbg), dbg->errFile));
797 ForceNewline();
798 }
799 }
800
801 /* ------------------------------------------------------------------------ */
802
Y_dbexit(int nArgs)803 void Y_dbexit(int nArgs)
804 {
805 extern void YHalt(void);
806 extern void yg_got_expose(void);
807 extern void yr_reset(void);
808 extern char *y_read_prompt;
809 long n= 1; /* default is to back out of 1 level */
810 if (nArgs>1) YError("dbexit takes 0 or 1 argument (number of levels)");
811 if (nArgs==1) n= YGetInteger(sp);
812 if (n<=0 || y_read_prompt!=0) {
813 /* Clear stack completely -- wipes out all levels of debug blocks. */
814 ResetStack(1);
815 } else {
816 /* First, clear stack back to current debug block. */
817 ResetStack(0);
818 while (n--) {
819 /* Next, eliminate everything back to previous debug block. */
820 ResetStack(0);
821 if (sp==spBottom) break; /* gone about as fer as we can go, yes sir */
822 }
823 }
824 yr_reset();
825 yg_got_expose(); /* in case window,wait=1 or pause */
826 p_clr_alarm(0, 0);
827 YHalt(); /* the *main* that called this is gone -- halt VM */
828 }
829
Y_dbcont(int nArgs)830 void Y_dbcont(int nArgs)
831 {
832 Instruction *pcResume;
833 DebugBlk *dbg;
834 if (nArgs>0) YError("dbcont takes no argument");
835 /* First, clear stack back to current debug block. */
836 ResetStack(0);
837 /* Check for debug block. */
838 if (sp->ops!=&dataBlockSym || sp->value.db->ops!=&debugOps)
839 YError("stack corrupted -- dbcont cannot find debug block");
840 dbg= (DebugBlk *)sp->value.db;
841 pcResume= dbg->func->code + dbg->pcList[dbg->iPClist];
842 Drop(1); /* drop current debug block... */
843 pc= pcResume; /* ...and continue */
844 }
845
Y_dbret(int nArgs)846 void Y_dbret(int nArgs)
847 {
848 Symbol *stack;
849 Instruction *pcResume;
850 DebugBlk *dbg= FindDebugBlk();
851 if (!dbg) YError("dbret cannot find debug block");
852 if (nArgs>1) YError("dbret takes 0 or 1 argument");
853 if (nArgs<1) PushDataBlock(RefNC(&nilDB));
854
855 /* temporarily remove return value from top of stack --
856 save pointer back to it as a failsafe */
857 stack= sp--;
858 dbg->retValue= stack;
859 /* then clear stack back to current debug block --
860 this always clears at least the main program off the stack */
861 ResetStack(0);
862 /* check for debug block */
863 if (sp->ops!=&dataBlockSym || sp->value.db!=(DataBlock *)dbg)
864 YError("stack corrupted -- dbret cannot find debug block");
865 pcResume= dbg->func->code + dbg->pcList[dbg->iPClist];
866
867 /* move debug block up on stack, and copy return value under it */
868 sp[1].ops= &dataBlockSym;
869 sp[1].value.db= (DataBlock *)dbg;
870 sp[0].ops= &intScalar;
871 sp++;
872 sp[-1].value= stack->value;
873 dbg->retValue= 0;
874 sp[-1].ops= stack->ops;
875
876 Drop(1); /* drop current debug block... */
877
878 /* set pc to value it would have on dbcont --
879 this way, if there is an error during the return, it will have
880 a sensible value */
881 pc= pcResume;
882 /* since the return value is at the top of the stack, and the
883 return Symbol is directly under it, the virtual machine can be
884 fooled into doing an ordinary return operation */
885 Return();
886 }
887
888 extern Instruction *yErrorPC;
889
Y_dbup(int nArgs)890 void Y_dbup(int nArgs)
891 {
892 if (nArgs>0) YError("dbup takes no arguments");
893
894 /* clear stack back to current debug block --
895 this always clears at least the main program off the stack */
896 ResetStack(0);
897 /* check for debug block */
898 if (sp->ops!=&dataBlockSym || sp->value.db->ops!=&debugOps)
899 YError("stack corrupted -- dbup cannot find debug block");
900
901 Drop(1); /* drop current debug block... */
902
903 yErrorPC= AbortReturn();
904 YError("<not an error -- ignored>");
905 }
906
Y_dbskip(int nArgs)907 void Y_dbskip(int nArgs)
908 {
909 long n= 1; /* default number of lines to skip */
910 long i;
911 DebugBlk *dbg= FindDebugBlk();
912 if (!dbg) YError("dbskip cannot find debug block");
913 if (nArgs>1) YError("dbskip takes at most one argument");
914 if (nArgs==1) n= YGetInteger(sp);
915 i= dbg->iPClist + n;
916 if (i<0) i= 0;
917 else if (i>=dbg->nPClist) i= dbg->nPClist-1;
918 dbg->iPClist= i;
919 AnnouncePC(dbg, CalledAsSubroutine()? 1 : 0);
920 }
921
922 /* ------------------------------------------------------------------------ */
923
Y_dbinfo(int nArgs)924 void Y_dbinfo(int nArgs)
925 {
926 DebugBlk *dbg= FindDebugBlk();
927 Operand op;
928 if (!dbg) YError("dbinfo cannot find debug block");
929
930 if (CalledAsSubroutine()) {
931 PrintInit(YputsOut);
932 PushDataBlock(RefNC(&nilDB));
933 } else {
934 PrintInit(&PutsAsArray);
935 PushDataBlock(NewArray(&stringStruct, (Dimension *)0));
936 }
937
938 op.value= dbg->func; /* PrintFN only uses this member of op */
939 PrintFN(&op);
940 ForceNewline();
941 sprintf(lineBuf, "Current debug level is: %d", yDebugLevel);
942 PrintFunc(lineBuf);
943 ForceNewline();
944
945 AnnouncePC(dbg, 2);
946 }
947
Y_dbdis(int nArgs)948 void Y_dbdis(int nArgs)
949 {
950 Function *f;
951 Instruction *pc;
952 VMaction *Action;
953 int stack, iAction, category, lastPass;
954 long ipc, ipc0;
955 DebugBlk *dbg= FindDebugBlk();
956 if (!dbg) YError("dbdis cannot find debug block");
957
958 f= dbg->func;
959 pc= f->code + dbg->pcList[dbg->iPClist];
960
961 if (CalledAsSubroutine()) {
962 PrintInit(YputsOut);
963 PushDataBlock(RefNC(&nilDB));
964 } else {
965 PrintInit(&PutsAsArray);
966 PushDataBlock(NewArray(&stringStruct, (Dimension *)0));
967 }
968
969 lastPass= 0;
970 stack= 0;
971 ipc= ipc0= pc - f->code;
972 while ((Action= (pc++)->Action)) {
973 iAction= LookupAction(Action);
974 if (!vmMeaning[iAction].Action) break;
975 category= vmMeaning[iAction].flags;
976 stack+= StackChange(iAction, pc->count);
977
978 pc= PrintInstruction(iAction, category, pc, ipc, stack);
979 if (lastPass) break;
980 if (stack<=0) lastPass= 1;
981 if (Action==&Branch && stack>0) {
982 /* This must be ? ... <this branch>: ... construction.
983 The stack is now one deeper than it was at the ? branch,
984 so we need to decrement it here... */
985 stack--;
986 }
987
988 PrintFunc(lineBuf);
989 ForceNewline();
990 ipc= pc - f->code;
991 }
992
993 if (dbg->pcerr>ipc0 && dbg->pcerr<=ipc) {
994 sprintf(lineBuf, "***the error occurred near pc= %ld", dbg->pcerr);
995 PrintFunc(lineBuf);
996 ForceNewline();
997 }
998 }
999
Y_dbauto(int nArgs)1000 void Y_dbauto(int nArgs)
1001 {
1002 long n= 2;
1003 if (nArgs>1) YError("dbauto takes at most one argument");
1004 if (nArgs==1) n= YGetInteger(sp);
1005 if (n==1) yAutoDebug= 1;
1006 else if (n==2) yAutoDebug= !yAutoDebug;
1007 else yAutoDebug= 0;
1008 }
1009
1010 /* ------------------------------------------------------------------------ */
1011
1012 static Function *ydb_funcof(Instruction *pc); /* see task.c:FuncContaining */
1013
1014 void
Y_dbwhere(int nArgs)1015 Y_dbwhere(int nArgs)
1016 {
1017 extern void YHalt(void);
1018 Symbol *stack = sp;
1019 Function *f = ydb_funcof(pc);
1020
1021 if (CalledAsSubroutine()) {
1022 PrintInit(YputsOut);
1023 PushDataBlock(RefNC(&nilDB));
1024 } else {
1025 PrintInit(&PutsAsArray);
1026 PushDataBlock(NewArray(&stringStruct, (Dimension *)0));
1027 }
1028
1029 if (f) {
1030 if (f->code->index < 0) PrintFunc("*anon*");
1031 else PrintFunc(globalTable.names[f->code->index]);
1032 } else {
1033 PrintFunc("*lost*");
1034 }
1035 /* pc[-2] must equal &Eval that created this returnSym */
1036 sprintf(lineBuf, "[%ld]", f? (long)(pc-f->code)-2L : 0L);
1037 PrintFunc(lineBuf);
1038 ForceNewline();
1039
1040 for (; stack>spBottom ; stack--) {
1041 if (stack->ops == &returnSym) {
1042 if (stack->value.pc->Action == &YHalt)
1043 continue; /* crucial to detect and avoid task.c:taskCode */
1044 f = ydb_funcof(stack->value.pc);
1045 if (f) {
1046 if (f->code->index < 0) PrintFunc("*anon*");
1047 else PrintFunc(globalTable.names[f->code->index]);
1048 } else {
1049 PrintFunc("*lost*");
1050 }
1051 /* pc[-2] must equal &Eval that created this returnSym */
1052 sprintf(lineBuf, "[%ld]", f? (long)(stack->value.pc-f->code)-2L : 0L);
1053 PrintFunc(lineBuf);
1054 ForceNewline();
1055 } else if (stack->ops==&dataBlockSym && stack->value.db->ops==&debugOps) {
1056 PrintFunc("*dbug*[0]");
1057 ForceNewline();
1058 }
1059 }
1060 }
1061
1062 #include <stddef.h>
1063 static Function *
ydb_funcof(Instruction * pc)1064 ydb_funcof(Instruction *pc)
1065 {
1066 Function *f = 0;
1067 if (pc) {
1068 long i = -1;
1069 for (;; i++) {
1070 while (pc[i].Action) i++;
1071 if (pc[i-1].Action==&Return) break;
1072 }
1073 i++;
1074 /* Now pc[i] is the Instruction generated by following line
1075 in parse.c (YpFunc):
1076 vmCode[nextPC].index= codeSize= nPos+nKey+nLocal+ nextPC;
1077 (nextPC does NOT include the parameters or locals)
1078 */
1079 i -= pc[i].index;
1080 if (i<0) f = (Function *)((char *)(pc+i) - offsetof(Function, code));
1081 }
1082 return f;
1083 }
1084