From f521b724666bd391377bcc556d0f9103750931b7 Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 20 Sep 2014 11:40:35 +0000 Subject: Tidy things up a bit more. --- generic/tclDisassemble.c | 17 +++++++++++++---- generic/tclProc.c | 2 +- 2 files changed, 14 insertions(+), 5 deletions(-) diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c index 9556d46..b3753c31 100644 --- a/generic/tclDisassemble.c +++ b/generic/tclDisassemble.c @@ -21,6 +21,7 @@ * Prototypes for procedures defined later in this file: */ +static Tcl_Obj * DisassembleByteCodeAsDicts(Tcl_Obj *objPtr); static int FormatInstruction(ByteCode *codePtr, const unsigned char *pc, Tcl_Obj *bufferObj); static void PrintSourceToObj(Tcl_Obj *appendObj, @@ -39,6 +40,13 @@ static const Tcl_ObjType tclInstNameType = { UpdateStringOfInstName, /* updateStringProc */ NULL, /* setFromAnyProc */ }; + +/* + * How to get the bytecode out of a Tcl_Obj. + */ + +#define BYTECODE(objPtr) \ + ((ByteCode *) (objPtr)->internalRep.twoPtrValue.ptr1) #ifdef TCL_COMPILE_DEBUG /* @@ -181,7 +189,7 @@ Tcl_Obj * TclDisassembleByteCodeObj( Tcl_Obj *objPtr) /* The bytecode object to disassemble. */ { - ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1; + ByteCode *codePtr = BYTECODE(objPtr); unsigned char *codeStart, *codeLimit, *pc; unsigned char *codeDeltaNext, *codeLengthNext; unsigned char *srcDeltaNext, *srcLengthNext; @@ -858,7 +866,7 @@ static Tcl_Obj * DisassembleByteCodeAsDicts( Tcl_Obj *objPtr) /* The bytecode-holding value to take apart */ { - ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1; + ByteCode *codePtr = BYTECODE(objPtr); Tcl_Obj *description, *literals, *variables, *instructions, *inst; Tcl_Obj *aux, *exn, *commands; unsigned char *pc, *opnd, *codeOffPtr, *codeLenPtr, *srcOffPtr, *srcLenPtr; @@ -1201,6 +1209,8 @@ Tcl_DisassembleObjCmd( /* * Compile (if uncompiled) and disassemble a lambda term. + * + * WARNING! Pokes inside the lambda objtype. */ if (objc != 3) { @@ -1368,8 +1378,7 @@ Tcl_DisassembleObjCmd( * Do the actual disassembly. */ - if (((ByteCode *) codeObjPtr->internalRep.twoPtrValue.ptr1)->flags - & TCL_BYTECODE_PRECOMPILED) { + if (BYTECODE(codeObjPtr)->flags & TCL_BYTECODE_PRECOMPILED) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "may not disassemble prebuilt bytecode", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE", diff --git a/generic/tclProc.c b/generic/tclProc.c index 42c9a72..e0d6ec7 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -88,7 +88,7 @@ static const Tcl_ObjType levelReferenceType = { * * Internally, ptr1 is a pointer to a Proc instance that is not bound to a * command name, and ptr2 is a pointer to the namespace that the Proc instance - * will execute within. + * will execute within. IF YOU CHANGE THIS, CHECK IN tclDisassemble.c TOO. */ const Tcl_ObjType tclLambdaType = { -- cgit v0.12