| ︙ | | |
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
|
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
|
-
-
+
+
|
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "procName");
return TCL_ERROR;
}
procPtr = TclFindProc((Interp *) interp, TclGetString(objv[2]));
if (procPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" isn't a procedure", TclGetString(objv[2])));
TclPrintfResult(interp,
"\"%s\" isn't a procedure", TclGetString(objv[2]));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROC",
TclGetString(objv[2]), (char *)NULL);
return TCL_ERROR;
}
/*
* Compile (if uncompiled) and disassemble a procedure.
|
| ︙ | | |
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
|
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
|
-
-
+
+
-
-
-
+
+
|
classPtr = TclOOGetClassFromObj(interp, ooWhat);
if (classPtr == NULL) {
return TCL_ERROR;
}
methodPtr = classPtr->constructorPtr;
if (methodPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" has no defined constructor",
TclPrintfResult(interp,
"\"%s\" has no defined constructor", TclGetString(ooWhat));
TclGetString(ooWhat)));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
"CONSRUCTOR", (char *)NULL);
return TCL_ERROR;
}
procPtr = TclOOGetProcFromMethod(methodPtr);
if (procPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"body not available for this kind of constructor", -1));
TclPrintfResult(interp,
"body not available for this kind of constructor");
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
"METHODTYPE", (char *)NULL);
return TCL_ERROR;
}
oPtr = classPtr->thisPtr;
bodyType = "body of constructor";
|
| ︙ | | |
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
|
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
|
-
-
+
+
-
-
-
+
+
|
classPtr = TclOOGetClassFromObj(interp, ooWhat);
if (classPtr == NULL) {
return TCL_ERROR;
}
methodPtr = classPtr->destructorPtr;
if (methodPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" has no defined destructor",
TclPrintfResult(interp,
"\"%s\" has no defined destructor", TclGetString(ooWhat));
TclGetString(ooWhat)));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
"DESRUCTOR", (char *)NULL);
return TCL_ERROR;
}
procPtr = TclOOGetProcFromMethod(methodPtr);
if (procPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"body not available for this kind of destructor", -1));
TclPrintfResult(interp,
"body not available for this kind of destructor");
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
"METHODTYPE", (char *)NULL);
return TCL_ERROR;
}
oPtr = classPtr->thisPtr;
bodyType = "body of destructor";
|
| ︙ | | |
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
|
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
|
-
-
+
+
-
-
+
+
|
/*
* Compile (if necessary) and disassemble a method body.
*/
methodBody:
if (hPtr == NULL) {
unknownMethod:
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"unknown method \"%s\"", TclGetString(ooWhat)));
TclPrintfResult(interp,
"unknown method \"%s\"", TclGetString(ooWhat));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(ooWhat), (char *)NULL);
return TCL_ERROR;
}
procPtr = TclOOGetProcFromMethod((Method *)Tcl_GetHashValue(hPtr));
if (procPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"body not available for this kind of method", -1));
TclPrintfResult(interp,
"body not available for this kind of method");
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
"METHODTYPE", (char *)NULL);
return TCL_ERROR;
}
bodyType = "body of method";
compileMethodIfNeeded:
|
| ︙ | | |
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
|
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
|
-
-
+
|
/*
* Do the actual disassembly.
*/
ByteCodeGetInternalRep(codeObjPtr, &tclByteCodeType, codePtr);
if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"may not disassemble prebuilt bytecode", -1));
TclPrintfResult(interp, "may not disassemble prebuilt bytecode");
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
"BYTECODE", (char *)NULL);
return TCL_ERROR;
}
if (clientData) {
Tcl_SetObjResult(interp,
DisassembleByteCodeAsDicts(codeObjPtr));
|
| ︙ | | |