1#include "xotclInt.h" 2 3#ifdef XOTCL_BYTECODE 4#include <tclCompile.h> 5 6static CompileProc 7 initProcNsCompile, nextCompile, 8 selfCompile, selfDispatchCompile; 9 10static InstructionDesc instructionTable[] = { 11 {"initProc", 1, 0, {OPERAND_NONE}}, 12 {"next", 1, 0, {OPERAND_NONE}}, 13 {"self", 1, 0, {OPERAND_NONE}}, 14 {"dispatch", 2, 1, {OPERAND_UINT1}}, 15}; 16 17static XOTclCompEnv instructions[] = { 18 {0, 0, initProcNsCompile, XOTclInitProcNSCmd}, 19 {0, 0, nextCompile, XOTclNextObjCmd}, 20 {0, 0, selfCompile, XOTclGetSelfObjCmd}, 21 {0, 0, selfDispatchCompile, /*XOTclSelfDispatchCmd*/XOTclDirectSelfDispatch}, 22 0 23}; 24 25XOTclCompEnv * 26XOTclGetCompEnv() { 27 return &instructions[0]; 28} 29 30 31static int 32initProcNsCompile(Tcl_Interp *interp, Tcl_Parse *parsePtr, 33 CompileEnv *envPtr) { 34 35 if (parsePtr->numWords != 1) { 36 Tcl_ResetResult(interp); 37 Tcl_AppendToObj(Tcl_GetObjResult(interp), 38 "wrong # args: should be '::xotcl::initProcNS'", -1); 39 envPtr->maxStackDepth = 0; 40 return TCL_ERROR; 41 } 42 43 TclEmitOpcode(instructions[INST_INITPROC].bytecode, envPtr); 44 envPtr->maxStackDepth = 0; 45 46 return TCL_OK; 47} 48 49static int 50nextCompile(Tcl_Interp *interp, Tcl_Parse *parsePtr, 51 CompileEnv *envPtr) { 52 53 if (parsePtr->numWords != 1) 54 return TCL_OUT_LINE_COMPILE; 55 56 TclEmitOpcode(instructions[INST_NEXT].bytecode, envPtr); 57 envPtr->maxStackDepth = 0; 58 59 return TCL_OK; 60} 61static int 62selfCompile(Tcl_Interp *interp, Tcl_Parse *parsePtr, 63 CompileEnv *envPtr) { 64 65 if (parsePtr->numWords != 1) 66 return TCL_OUT_LINE_COMPILE; 67 68 TclEmitOpcode(instructions[INST_SELF].bytecode, envPtr); 69 envPtr->maxStackDepth = 0; 70 71 return TCL_OK; 72} 73static int 74selfDispatchCompile(Tcl_Interp *interp, Tcl_Parse *parsePtr, 75 CompileEnv *envPtr) { 76 77 Tcl_Token *tokenPtr; 78 int code, wordIdx; 79 /* 80 fprintf(stderr, "****** selfDispatchCompile words=%d tokens=%d, avail=%d\n", 81 parsePtr->numWords,parsePtr->numTokens,parsePtr->tokensAvailable); 82 */ 83 84 if (parsePtr->numWords > 255) 85 return TCL_OUT_LINE_COMPILE; 86 87 /*TclEmitOpcode(instructions[INST_SELF].bytecode, envPtr);*/ 88 89 for (wordIdx=0, tokenPtr = parsePtr->tokenPtr + 0; 90 wordIdx < parsePtr->numWords; 91 wordIdx++, tokenPtr += (tokenPtr->numComponents + 1)) { 92 93 /* 94 fprintf(stderr," %d: %p token type=%d size=%d\n", 95 wordIdx,tokenPtr,tokenPtr->type,tokenPtr->size ); 96 */ 97 if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { 98 TclEmitPush(TclRegisterLiteral(envPtr, tokenPtr->start, 99 tokenPtr->size, 0), envPtr); 100 envPtr->maxStackDepth = 1; 101 /* 102 fprintf(stderr," %d: simple '%s' components=%d\n", 103 wordIdx,tokenPtr->start, tokenPtr->numComponents); 104 */ 105 } else { 106 /* 107 fprintf(stderr," %d NOT simple '%s' components=%d\n", 108 wordIdx,tokenPtr->start, tokenPtr->numComponents); 109 */ 110 code = TclCompileTokens(interp, tokenPtr+1, 111 tokenPtr->numComponents, envPtr); 112 if (code != TCL_OK) { 113 return code; 114 } 115 } 116 } 117 118 /*fprintf(stderr, "maxdepth=%d, onStack=%d\n",envPtr->maxStackDepth,wordIdx); 119 */ 120 TclEmitInstInt1(instructions[INST_SELF_DISPATCH].bytecode, wordIdx, envPtr); 121 envPtr->maxStackDepth = 0; 122 123 return TCL_OK; 124} 125 126 127 128void 129XOTclBytecodeInit() { 130 int i; 131 for(i=0; i<LAST_INSTRUCTION; i++) { 132 if ((instructions[i].bytecode = 133 TclRegisterUserOpcode(&instructionTable[i], 134 instructions[i].callProc, 135 instructions[i].cmdPtr->objClientData))) { 136 instructions[i].cmdPtr->compileProc = instructions[i].compileProc; 137 } 138 139 } 140 /*tclTraceCompile = 2;*/ 141 142} 143 144#endif 145