Tcl Source Code

Check-in [edef464b4f]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Now with fewer memory leaks
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | tip-312-new
Files: files | file ages | folders
SHA3-256: edef464b4f4c615cafb842e399c3639fdfdcf62f2af8f6b4cf1866460f8b1b2a
User & Date: dkf 2019-04-04 23:08:05
Context
2019-04-04
23:47
Clean up and refactor a bit check-in: 258100c83e user: dkf tags: tip-312-new
23:08
Now with fewer memory leaks check-in: edef464b4f user: dkf tags: tip-312-new
22:48
Fix unsigned wide linking. check-in: 5d6108345e user: dkf tags: tip-312-new
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to generic/tclLink.c.

   464    464       Tcl_WideUInt *uwidePtr)
   465    465   {
   466    466       Tcl_WideInt *widePtr = (Tcl_WideInt *) uwidePtr;
   467    467       ClientData clientData;
   468    468       int type;
   469    469   
   470    470       if (TclGetNumberFromObj(NULL, objPtr, &clientData, &type) == TCL_OK) {
   471         -	if (type == TCL_NUMBER_BIG) {
          471  +	if (type == TCL_NUMBER_INT) {
          472  +	    *widePtr = *((const Tcl_WideInt *) clientData);
          473  +	    return (*widePtr < 0);
          474  +	} else if (type == TCL_NUMBER_BIG) {
   472    475   	    mp_int num;
   473         -	    Tcl_WideUInt scratch, value = 0;
          476  +	    Tcl_WideUInt value = 0;
          477  +	    union {
          478  +		Tcl_WideUInt value;
          479  +		unsigned char bytes[sizeof(Tcl_WideUInt)];
          480  +	    } scratch;
   474    481   	    unsigned long numBytes = sizeof(Tcl_WideUInt);
   475         -	    unsigned char *bytes = (unsigned char *) &scratch;
          482  +	    unsigned char *bytes = scratch.bytes;
   476    483   
   477    484   	    Tcl_GetBignumFromObj(NULL, objPtr, &num);
   478         -	    if (num.sign) {
   479         -		return 1;
   480         -	    }
   481         -	    if (mp_to_unsigned_bin_n(&num, bytes, &numBytes) != MP_OKAY) {
          485  +	    if (num.sign || (MP_OKAY != mp_to_unsigned_bin_n(&num, bytes,
          486  +		    &numBytes))) {
          487  +		/*
          488  +		 * If the sign bit is set (a negative value) or if the value
          489  +		 * can't possibly fit in the bits of an unsigned wide, there's
          490  +		 * no point in doing further conversion.
          491  +		 */
          492  +		mp_clear(&num);
   482    493   		return 1;
   483    494   	    }
          495  +#ifdef WORDS_BIGENDIAN
   484    496   	    while (numBytes-- > 0) {
   485    497   		value = (value << CHAR_BIT) | *bytes++;
   486    498   	    }
          499  +#else /* !WORDS_BIGENDIAN */
          500  +	    value = scratch.value;
          501  +#endif /* WORDS_BIGENDIAN */
   487    502   	    *uwidePtr = value;
          503  +	    mp_clear(&num);
   488    504   	    return 0;
   489         -	} else {
   490         -	    if (Tcl_GetWideIntFromObj(NULL, objPtr, widePtr) == TCL_OK
   491         -		    && (*widePtr >= 0)) {
   492         -		return 0;
   493         -	    }
   494    505   	}
   495    506       }
   496    507   
          508  +    /*
          509  +     * Evil edge case fallback.
          510  +     */
          511  +
   497    512       return (GetInvalidWideFromObj(objPtr, widePtr) != TCL_OK);
   498    513   }
   499    514   
   500    515   static inline int
   501    516   GetDouble(
   502    517       Tcl_Obj *objPtr,
   503    518       double *dblPtr)