diff options
| author | dkf <donal.k.fellows@manchester.ac.uk> | 2014-09-20 12:37:19 (GMT) |
|---|---|---|
| committer | dkf <donal.k.fellows@manchester.ac.uk> | 2014-09-20 12:37:19 (GMT) |
| commit | c220fbe2ff72c2408a2e9c303975f80d04fd44e7 (patch) | |
| tree | 924c0628c3e395cad796069cd9705d3d20155c45 /generic/tclCompCmdsSZ.c | |
| parent | fc7d1ca9fea4659cab0c374e75bfb7bb9f68c37e (diff) | |
| parent | f521b724666bd391377bcc556d0f9103750931b7 (diff) | |
| download | tcl-c220fbe2ff72c2408a2e9c303975f80d04fd44e7.zip tcl-c220fbe2ff72c2408a2e9c303975f80d04fd44e7.tar.gz tcl-c220fbe2ff72c2408a2e9c303975f80d04fd44e7.tar.bz2 | |
Added a script-readable bytecode disassembler in tcl::unsupported.
Diffstat (limited to 'generic/tclCompCmdsSZ.c')
| -rw-r--r-- | generic/tclCompCmdsSZ.c | 32 |
1 files changed, 31 insertions, 1 deletions
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index ed9c088..2b83fd2 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -28,6 +28,9 @@ static void FreeJumptableInfo(ClientData clientData); static void PrintJumptableInfo(ClientData clientData, Tcl_Obj *appendObj, ByteCode *codePtr, unsigned int pcOffset); +static void DisassembleJumptableInfo(ClientData clientData, + Tcl_Obj *dictObj, ByteCode *codePtr, + unsigned int pcOffset); static int CompileAssociativeBinaryOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, const char *identity, int instruction, CompileEnv *envPtr); @@ -72,7 +75,8 @@ const AuxDataType tclJumptableInfoType = { "JumptableInfo", /* name */ DupJumptableInfo, /* dupProc */ FreeJumptableInfo, /* freeProc */ - PrintJumptableInfo /* printProc */ + PrintJumptableInfo, /* printProc */ + DisassembleJumptableInfo /* disassembleProc */ }; /* @@ -2441,11 +2445,13 @@ IssueSwitchJumpTable( * DupJumptableInfo: a copy of the jump-table * FreeJumptableInfo: none * PrintJumptableInfo: none + * DisassembleJumptableInfo: none * * Side effects: * DupJumptableInfo: allocates memory * FreeJumptableInfo: releases memory * PrintJumptableInfo: none + * DisassembleJumptableInfo: none * *---------------------------------------------------------------------- */ @@ -2508,6 +2514,30 @@ PrintJumptableInfo( keyPtr, pcOffset + offset); } } + +static void +DisassembleJumptableInfo( + ClientData clientData, + Tcl_Obj *dictObj, + ByteCode *codePtr, + unsigned int pcOffset) +{ + register JumptableInfo *jtPtr = clientData; + Tcl_Obj *mapping = Tcl_NewObj(); + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + const char *keyPtr; + int offset; + + hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search); + for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) { + keyPtr = Tcl_GetHashKey(&jtPtr->hashTable, hPtr); + offset = PTR2INT(Tcl_GetHashValue(hPtr)); + Tcl_DictObjPut(NULL, mapping, Tcl_NewStringObj(keyPtr, -1), + Tcl_NewIntObj(offset)); + } + Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("mapping", -1), mapping); +} /* *---------------------------------------------------------------------- |