From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from kate-mail.whsl206.com ([49.50.249.113]) by ewsd; Sat Mar 21 03:57:22 EDT 2020 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=qs.co.nz; s=default; h=Content-Transfer-Encoding:Content-Type:MIME-Version:Date: Message-ID:Subject:From:To:Sender:Reply-To:Cc:Content-ID:Content-Description: Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc:Resent-Message-ID: In-Reply-To:References:List-Id:List-Help:List-Unsubscribe:List-Subscribe: List-Post:List-Owner:List-Archive; bh=qMK8wNpneEsjsneOyLIWSgDcL5/U7qCsINO8F9mipaw=; b=o+1mXyTa98pH3T6t9/5h8G6gxW AFlJ1eX4V4DVbKA5JQaEE8GHMa4a5TIPgYtTPSjm2nKj8TR3VoIXS8KhIZUAUZuWJjxGVXm9Ex8+j jyE/cxKEcU78Mpx9w88rWLrbyp8Vux/IoiPLBLfJApUMGjH4P0NF6wUG5L4PbaNDkntMVODLIRht9 hNM3up4PoKxjzZQpnqteCSRXbg9E6w85MionYNFpX8cbUBORGkBpWioiupJx4i/DUfzxo8LnI3lC9 BITKNCbhEaLyfbVXy3X4c7LO4fRVHK7a7EcnkLglJwZWtiWjLG/YRL585XtVZRMR9bdbwLZ6jYLCe LYYzgvCw==; Received: from 115-189-99-223.mobile.spark.co.nz ([115.189.99.223]:22041 helo=[192.168.43.110]) by kate.whsl206.com with esmtpsa (TLS1.2) tls TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256 (Exim 4.93) (envelope-from ) id 1jFYzc-001AKq-Mk for 9front@9front.org; Sat, 21 Mar 2020 20:56:29 +1300 To: 9front@9front.org From: Trevor Higgins Subject: Unsolicited patch for tclsh amd64 Message-ID: Date: Sat, 21 Mar 2020 20:56:27 +1300 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:52.0) Gecko/20100101 Thunderbird/52.2.1 MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 7bit Content-Language: en-US X-AntiAbuse: This header was added to track abuse, please include it with any abuse report X-AntiAbuse: Primary Hostname - kate.whsl206.com X-AntiAbuse: Original Domain - 9front.org X-AntiAbuse: Originator/Caller UID/GID - [47 12] / [47 12] X-AntiAbuse: Sender Address Domain - qs.co.nz X-Get-Message-Sender-Via: kate.whsl206.com: authenticated_id: phil@qs.co.nz X-Authenticated-Sender: kate.whsl206.com: phil@qs.co.nz X-Source: X-Source-Args: X-Source-Dir: List-ID: <9front.9front.org> List-Help: X-Glyph: ➈ X-Bullshit: cloud ACPI over AJAX content-driven-scale descriptor firewall I have issues with tclsh on amd64, this kludge got it running for me. This may be helpful for others wanting to do a proper fix. Test results show that there are differences (problems) with handling stderr on exec and pipelines and other stuff. It works enough for what I am doing. NOTE: The addition of compile debug flag is necessary to stop tclsh from bombing with invalid memory reference, remove and debug at you own leisure. This fix is definitely not production ready. Diff with cleanup performed under gnu diff. diff -cr -x '*.acid' -x '*.tcl' -x '*.rc' -x '*.sh' old/generic/tclExecute.c new/generic/tclExecute.c *** old/generic/tclExecute.c 2011-01-16 22:04:09.000000000 +1300 --- new/generic/tclExecute.c 2020-03-09 23:06:36.000000000 +1300 *************** *** 23,28 **** --- 23,30 ---- #include #include + typedef long long ptrdiffL_t; + /* * Hack to determine whether we may expect IEEE floating point. The hack is * formally incorrect in that non-IEEE platforms might have the same precision *************** *** 683,688 **** --- 685,693 ---- #endif /* TCL_COMPILE_STATS */ } + + void snarf(Tcl_Interp *i,ExecStack *e) { return;} + /* *---------------------------------------------------------------------- * *************** *** 705,711 **** *---------------------------------------------------------------------- */ ! #define TCL_STACK_INITIAL_SIZE 2000 ExecEnv * TclCreateExecEnv( --- 710,770 ---- *---------------------------------------------------------------------- */ ! #define TCL_STACK_INITIAL_SIZE 8000 ! void fnoop(void *) {} ! ! typedef union { ! char *c; ! long long *w; ! } fudger; ! ! void * fudge(void *ptr) { ! void *v = ptr; ! fudger *p = (fudger *)(&v); ! ! int offset = 0; ! switch((int)p->c & 0x0F ) { ! case 0: ! offset = 8; ! p->c += 8; ! break; ! case 4: ! offset = 4; ! p->c += 4; ! break; ! case 8: ! offset = 0; ! break; ! case 12: ! offset = 12; ! p->c += 12; ! break; ! default: ! Tcl_Panic("FUDGER: Memory allocator returned bad allocation pointer\n"); ! } ! *p->w++ = offset; ! /* fprintf(stderr,"FUDGE: in %p +%d out %p\n",ptr,offset,p->w); ! */ ! return(p->w); ! } ! ! void *unfudge(void *ptr) { ! void *v = ptr; ! int offset; ! fudger *p = (fudger *)(&v); ! if( (int)p->c & 0x03 ) ! Tcl_Panic("FUDGER: Memory deallocator called with bad allocation pointer\n"); ! p->w--; ! offset=*p->w; ! if(*p->w > 32) ! Tcl_Panic("FUDGER: Memory deallocator called with unfudged pointer\n"); ! p->c -= offset; /* subtract offset */ ! /* fprintf(stderr," UNFUDGE: in %p -%d out %p\n",ptr,offset,p->w); ! */ ! fnoop(p->w); ! return(p->w); ! } ! ExecEnv * TclCreateExecEnv( *************** *** 713,721 **** * environment is being created. */ { ExecEnv *eePtr = (ExecEnv *) ckalloc(sizeof(ExecEnv)); ! ExecStack *esPtr = (ExecStack *) ckalloc(sizeof(ExecStack) ! + (size_t) (TCL_STACK_INITIAL_SIZE-1) * sizeof(Tcl_Obj *)); ! eePtr->execStackPtr = esPtr; TclNewBooleanObj(eePtr->constants[0], 0); Tcl_IncrRefCount(eePtr->constants[0]); --- 772,781 ---- * environment is being created. */ { ExecEnv *eePtr = (ExecEnv *) ckalloc(sizeof(ExecEnv)); ! ExecStack *esPtr = (ExecStack *) fudge(ckalloc(sizeof(ExecStack) ! + (size_t) (TCL_STACK_INITIAL_SIZE-1) * sizeof(Tcl_Obj *)+32)); ! setbuf(stderr,NULL); ! snarf(interp,esPtr); eePtr->execStackPtr = esPtr; TclNewBooleanObj(eePtr->constants[0], 0); Tcl_IncrRefCount(eePtr->constants[0]); *************** *** 771,777 **** if (esPtr->nextPtr) { esPtr->nextPtr->prevPtr = esPtr->prevPtr; } ! ckfree((char *) esPtr); } void --- 831,837 ---- if (esPtr->nextPtr) { esPtr->nextPtr->prevPtr = esPtr->prevPtr; } ! ckfree((char *) unfudge(esPtr)); } void *************** *** 857,863 **** */ #define MEMSTART(markerPtr) \ ! ((markerPtr) + OFFSET(markerPtr)) /* --- 917,928 ---- */ #define MEMSTART(markerPtr) \ ! ((markerPtr) + OFFSET(markerPtr) ) ! ! void eedump(char *n, ExecEnv *eePtr , ExecStack *esPtr ) { return; ! fprintf(stderr,"%s: stack pes(%p) mark %p --> %p end %p tos %p\n",n,esPtr,esPtr->markerPtr,esPtr->markerPtr ? *esPtr->markerPtr : 0,esPtr->endPtr,esPtr->tosPtr); ! fflush(stderr); ! } /* *************** *** 888,893 **** --- 953,959 ---- int move) /* 1 if move words since last marker. */ { ExecStack *esPtr = eePtr->execStackPtr, *oldPtr = NULL; + eedump("GROW ent",eePtr,esPtr); int newBytes, newElems, currElems; int needed = growth - (esPtr->endPtr - esPtr->tosPtr); Tcl_Obj **markerPtr = esPtr->markerPtr, **memStart; *************** *** 903,909 **** } else { Tcl_Obj **tmpMarkerPtr = esPtr->tosPtr + 1; int offset = OFFSET(tmpMarkerPtr); ! if (needed + offset < 0) { /* * Put a marker pointing to the previous marker in this stack, and --- 969,976 ---- } else { Tcl_Obj **tmpMarkerPtr = esPtr->tosPtr + 1; int offset = OFFSET(tmpMarkerPtr); ! if(offset == 0) ! fprintf(stderr,"GROW: WARNING offset is zero for tos ptr == %p \n",esPtr->tosPtr + 1); if (needed + offset < 0) { /* * Put a marker pointing to the previous marker in this stack, and *************** *** 912,920 **** */ esPtr->markerPtr = tmpMarkerPtr; ! memStart = tmpMarkerPtr + offset; esPtr->tosPtr = memStart - 1; *esPtr->markerPtr = (Tcl_Obj *) markerPtr; return memStart; } } --- 979,988 ---- */ esPtr->markerPtr = tmpMarkerPtr; ! memStart = MEMSTART(tmpMarkerPtr); esPtr->tosPtr = memStart - 1; *esPtr->markerPtr = (Tcl_Obj *) markerPtr; + eedump("GROW leave ",eePtr,esPtr); return memStart; } } *************** *** 966,973 **** newBytes = sizeof (ExecStack) + (newElems-1) * sizeof(Tcl_Obj *); oldPtr = esPtr; ! esPtr = (ExecStack *) ckalloc(newBytes); ! oldPtr->nextPtr = esPtr; esPtr->prevPtr = oldPtr; esPtr->nextPtr = NULL; --- 1034,1040 ---- newBytes = sizeof (ExecStack) + (newElems-1) * sizeof(Tcl_Obj *); oldPtr = esPtr; ! esPtr = (ExecStack *) fudge(ckalloc(newBytes+32)); oldPtr->nextPtr = esPtr; esPtr->prevPtr = oldPtr; esPtr->nextPtr = NULL; *************** *** 985,990 **** --- 1052,1061 ---- esPtr->stackWords[0] = NULL; esPtr->markerPtr = &esPtr->stackWords[0]; memStart = MEMSTART(esPtr->markerPtr); + /* + if( memStart == esPtr->markerPtr) + fprintf(stderr,"GROW: MOVE WARNING memstart == &markerPtr \n"); + */ esPtr->tosPtr = memStart - 1; if (move) { *************** *** 1001,1007 **** if (!oldPtr->markerPtr) { DeleteExecStack(oldPtr); } ! return memStart; } --- 1072,1078 ---- if (!oldPtr->markerPtr) { DeleteExecStack(oldPtr); } ! eedump("GROW leav new",eePtr,esPtr); return memStart; } *************** *** 1022,1027 **** --- 1093,1099 ---- * *-------------------------------------------------------------- */ + void anoop(ExecStack *es) {return;} static Tcl_Obj ** StackAllocWords( *************** *** 1032,1043 **** * Note that GrowEvaluationStack sets a marker in the stack. This marker * is read when rewinding, e.g., by TclStackFree. */ - Interp *iPtr = (Interp *) interp; ExecEnv *eePtr = iPtr->execEnvPtr; Tcl_Obj **resPtr = GrowEvaluationStack(eePtr, numWords, 0); - eePtr->execStackPtr->tosPtr += numWords; return resPtr; } --- 1104,1117 ---- * Note that GrowEvaluationStack sets a marker in the stack. This marker * is read when rewinding, e.g., by TclStackFree. */ Interp *iPtr = (Interp *) interp; ExecEnv *eePtr = iPtr->execEnvPtr; Tcl_Obj **resPtr = GrowEvaluationStack(eePtr, numWords, 0); eePtr->execStackPtr->tosPtr += numWords; + /* fprintf(stderr," ALLOC mem: tos 0x%p mem @%p x %d bytes marker %p -> %p \n",eePtr->execStackPtr->tosPtr, + resPtr,numWords*sizeof(Tcl_Obj *),eePtr->execStackPtr->markerPtr,*eePtr->execStackPtr->markerPtr); + */ + anoop(eePtr->execStackPtr); return resPtr; } *************** *** 1051,1058 **** --- 1125,1136 ---- Tcl_Obj **resPtr = GrowEvaluationStack(eePtr, numWords, 1); eePtr->execStackPtr->tosPtr += numWords; + /* fprintf(stderr," REALLOC mem: tos 0x%p mem @%p x %d bytes marker %p -> %p \n",eePtr->execStackPtr->tosPtr, + resPtr,numWords*sizeof(Tcl_Obj *),eePtr->execStackPtr->markerPtr,*eePtr->execStackPtr->markerPtr); + */ return resPtr; } + Tcl_Interp * noop(Tcl_Interp * i) { return i;} void TclStackFree( *************** *** 1062,1068 **** Interp *iPtr = (Interp *) interp; ExecEnv *eePtr; ExecStack *esPtr; ! Tcl_Obj **markerPtr; if (iPtr == NULL || iPtr->execEnvPtr == NULL) { Tcl_Free((char *) freePtr); --- 1140,1146 ---- Interp *iPtr = (Interp *) interp; ExecEnv *eePtr; ExecStack *esPtr; ! Tcl_Obj **markerPtr,**m2; if (iPtr == NULL || iPtr->execEnvPtr == NULL) { Tcl_Free((char *) freePtr); *************** *** 1078,1098 **** eePtr = iPtr->execEnvPtr; esPtr = eePtr->execStackPtr; markerPtr = esPtr->markerPtr; ! if (MEMSTART(markerPtr) != (Tcl_Obj **)freePtr) { ! Tcl_Panic("TclStackFree: incorrect freePtr. Call out of sequence?"); } esPtr->tosPtr = markerPtr-1; esPtr->markerPtr = (Tcl_Obj **) *markerPtr; if (*markerPtr) { return; } /* * Return to previous stack. */ - esPtr->tosPtr = &esPtr->stackWords[-1]; if (esPtr->prevPtr) { eePtr->execStackPtr = esPtr->prevPtr; --- 1156,1179 ---- eePtr = iPtr->execEnvPtr; esPtr = eePtr->execStackPtr; markerPtr = esPtr->markerPtr; ! m2 = MEMSTART(markerPtr); ! eedump("STACKFREE ent ",eePtr,esPtr); if (MEMSTART(markerPtr) != (Tcl_Obj **)freePtr) { ! noop(interp); ! Tcl_Panic("TclStackFree: incorrect freePtr (%p != %p. Call out of sequence?",freePtr,MEMSTART(markerPtr)); } esPtr->tosPtr = markerPtr-1; esPtr->markerPtr = (Tcl_Obj **) *markerPtr; if (*markerPtr) { + + eedump(" LEAVE STKFREE quick:",eePtr,esPtr); return; } /* * Return to previous stack. */ esPtr->tosPtr = &esPtr->stackWords[-1]; if (esPtr->prevPtr) { eePtr->execStackPtr = esPtr->prevPtr; *************** *** 1102,1108 **** eePtr->execStackPtr = esPtr->nextPtr; } DeleteExecStack(esPtr); ! } } void * --- 1183,1192 ---- eePtr->execStackPtr = esPtr->nextPtr; } DeleteExecStack(esPtr); ! } ! /* debug lines follow */ ! esPtr=eePtr->execStackPtr; ! eedump(" LEAVE STKFREE prev",eePtr,esPtr); } void * *************** *** 1441,1447 **** } /* ! * #280. * Literal sharing fix. This part of the fix is not required by 8.4 * because it eval-directs any literals, so just saving the argument * locations per command in bytecode is enough, embedded 'eval' --- 1525,1531 ---- } /* ! * #0. * Literal sharing fix. This part of the fix is not required by 8.4 * because it eval-directs any literals, so just saving the argument * locations per command in bytecode is enough, embedded 'eval' *************** *** 1739,1745 **** ExecStack *esPtr; Tcl_Obj **initTosPtr; /* Stack top at start of execution. */ ! ptrdiff_t *initCatchTop; /* Catch stack top at start of execution. */ Var *compiledLocals; Namespace *namespacePtr; CmdFrame *bcFramePtr; /* TIP #280: Structure for tracking lines. */ --- 1823,1829 ---- ExecStack *esPtr; Tcl_Obj **initTosPtr; /* Stack top at start of execution. */ ! ptrdiffL_t *initCatchTop; /* Catch stack top at start of execution. */ Var *compiledLocals; Namespace *namespacePtr; CmdFrame *bcFramePtr; /* TIP #280: Structure for tracking lines. */ *************** *** 1749,1755 **** * Globals: variables that store state, must remain valid at all times. */ ! ptrdiff_t *catchTop; register Tcl_Obj **tosPtr; /* Cached pointer to top of evaluation * stack. */ register unsigned char *pc = codePtr->codeStart; --- 1833,1839 ---- * Globals: variables that store state, must remain valid at all times. */ ! ptrdiffL_t *catchTop; register Tcl_Obj **tosPtr; /* Cached pointer to top of evaluation * stack. */ register unsigned char *pc = codePtr->codeStart; *************** *** 1797,1810 **** * execution stack is large enough to execute this ByteCode. */ ! catchTop = initCatchTop = (ptrdiff_t *) ( GrowEvaluationStack(iPtr->execEnvPtr, codePtr->maxExceptDepth + sizeof(CmdFrame) + ! codePtr->maxStackDepth, 0) - 1); bcFramePtr = (CmdFrame *) (initCatchTop + codePtr->maxExceptDepth + 1); tosPtr = initTosPtr = ((Tcl_Obj **) (bcFramePtr + 1)) - 1; esPtr = iPtr->execEnvPtr->execStackPtr; - /* * TIP #280: Initialize the frame. Do not push it yet. */ --- 1881,1893 ---- * execution stack is large enough to execute this ByteCode. */ ! catchTop = initCatchTop = (ptrdiffL_t *) ( GrowEvaluationStack(iPtr->execEnvPtr, codePtr->maxExceptDepth + sizeof(CmdFrame) + ! codePtr->maxStackDepth+64, 0) - 1); bcFramePtr = (CmdFrame *) (initCatchTop + codePtr->maxExceptDepth + 1); tosPtr = initTosPtr = ((Tcl_Obj **) (bcFramePtr + 1)) - 1; esPtr = iPtr->execEnvPtr->execStackPtr; /* * TIP #280: Initialize the frame. Do not push it yet. */ *************** *** 1825,1832 **** #ifdef TCL_COMPILE_DEBUG if (tclTraceExec >= 2) { PrintByteCodeInfo(codePtr); ! fprintf(stdout, " Starting stack top=%d\n", CURR_DEPTH); ! fflush(stdout); } #endif --- 1908,1915 ---- #ifdef TCL_COMPILE_DEBUG if (tclTraceExec >= 2) { PrintByteCodeInfo(codePtr); ! fprintf(stderr, " Starting stack top=%d\n", CURR_DEPTH); ! fflush(stderr); } #endif *************** *** 2280,2286 **** case INST_EXPAND_STKTOP: { int objc, length, i; Tcl_Obj **objv, *valuePtr; ! ptrdiff_t moved; /* * Make sure that the element at stackTop is a list; if not, just --- 2363,2369 ---- case INST_EXPAND_STKTOP: { int objc, length, i; Tcl_Obj **objv, *valuePtr; ! ptrdiffL_t moved; /* * Make sure that the element at stackTop is a list; if not, just *************** *** 2306,2314 **** length = objc + (codePtr->maxStackDepth - TclGetInt4AtPtr(pc+1)); DECACHE_STACK_INFO(); ! moved = (GrowEvaluationStack(iPtr->execEnvPtr, length, 1) - 1) - (Tcl_Obj **) initCatchTop; - if (moved) { /* * Change the global data to point to the new stack. --- 2389,2396 ---- length = objc + (codePtr->maxStackDepth - TclGetInt4AtPtr(pc+1)); DECACHE_STACK_INFO(); ! moved = (GrowEvaluationStack(iPtr->execEnvPtr, length+64, 1) - 1) - (Tcl_Obj **) initCatchTop; if (moved) { /* * Change the global data to point to the new stack. *************** *** 2319,2324 **** --- 2401,2407 ---- initTosPtr += moved; tosPtr += moved; esPtr = iPtr->execEnvPtr->execStackPtr; + /* fprintf(stderr,"EXEC CRAP MOVED STACK by %d now %p\n",moved,initCatchTop); */ } /* *************** *** 2347,2353 **** expandNestList = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr2; objc = CURR_DEPTH ! - (ptrdiff_t) objPtr->internalRep.twoPtrValue.ptr1; TclDecrRefCount(objPtr); } --- 2430,2436 ---- expandNestList = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr2; objc = CURR_DEPTH ! - (ptrdiffL_t) objPtr->internalRep.twoPtrValue.ptr1; TclDecrRefCount(objPtr); } *************** *** 7398,7404 **** while ((expandNestList != NULL) && ((catchTop == initCatchTop) || (*catchTop <= ! (ptrdiff_t) expandNestList->internalRep.twoPtrValue.ptr1))) { Tcl_Obj *objPtr = expandNestList->internalRep.twoPtrValue.ptr2; TclDecrRefCount(expandNestList); --- 7481,7487 ---- while ((expandNestList != NULL) && ((catchTop == initCatchTop) || (*catchTop <= ! (ptrdiffL_t) expandNestList->internalRep.twoPtrValue.ptr1))) { Tcl_Obj *objPtr = expandNestList->internalRep.twoPtrValue.ptr2; TclDecrRefCount(expandNestList); *************** *** 7511,7517 **** /* * Restore the stack to the state it had previous to this bytecode. */ ! TclStackFree(interp, initCatchTop+1); return result; #undef iPtr --- 7594,7600 ---- /* * Restore the stack to the state it had previous to this bytecode. */ ! /*fprintf(stderr,"BUG WTF? remove crap from stack but why not save memptr??? %p !!!!!!\n",initCatchTop);*/ TclStackFree(interp, initCatchTop+1); return result; #undef iPtr *************** *** 8533,8535 **** --- 8616,8619 ---- * fill-column: 78 * End: */ + diff -cr -x '*.acid' -x '*.tcl' -x '*.rc' -x '*.sh' old/generic/tclInt.h new/generic/tclInt.h *** old/generic/tclInt.h 2011-01-16 21:40:08.000000000 +1300 --- new/generic/tclInt.h 2020-03-09 21:47:27.000000000 +1300 *************** *** 53,59 **** #ifdef STDC_HEADERS #include #else ! typedef int ptrdiff_t; #endif /* --- 53,59 ---- #ifdef STDC_HEADERS #include #else ! typedef long long ptrdiff_t; #endif /* diff -cr -x '*.acid' -x '*.tcl' -x '*.rc' -x '*.sh' old/mkfile new/mkfile *** old/mkfile 2011-01-16 21:57:08.000000000 +1300 --- new/mkfile 2020-03-08 04:47:23.000000000 +1300 *************** *** 3,15 **** BIN=/$objtype/bin TARG=tclsh - OFILES=tclAppInit.$O LIB=libtcl.a$O HFILES=plan9/tclConfig.h CLEANFILES=$LIB