tclBinary.c Go to the documentation of this file. /* * tclBinary.c -- * * This file contains the implementation of the "binary" Tcl built-in * command and the Tcl binary data object. * * Copyright (c) 1997 by Sun Microsystems, Inc. * Copyright (c) 1998-1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclBinary.c,v 1.39 2007/12/13 15:23:15 dgp Exp $ */ #include "tclInt.h" #include "tommath.h" #include <math.h> /* * The following constants are used by GetFormatSpec to indicate various * special conditions in the parsing of a format specifier. */ #define BINARY_ALL -1 /* Use all elements in the argument. */ #define BINARY_NOCOUNT -2 /* No count was specified in format. */ /* * The following flags may be ORed together and returned by GetFormatSpec */ #define BINARY_SIGNED 0 /* Field to be read as signed data */ #define BINARY_UNSIGNED 1 /* Field to be read as unsigned data */ /* * The following defines the maximum number of different (integer) numbers * placed in the object cache by 'binary scan' before it bails out and * switches back to Plan A (creating a new object for each value.) * Theoretically, it would be possible to keep the cache about for the values * that are already in it, but that makes the code slower in practise when * overflow happens, and makes little odds the rest of the time (as measured * on my machine.) It is also slower (on the sample I tried at least) to grow * the cache to hold all items we might want to put in it; presumably the * extra cost of managing the memory for the enlarged table outweighs the * benefit from allocating fewer objects. This is probably because as the * number of objects increases, the likelihood of reuse of any particular one * drops, and there is very little gain from larger maximum cache sizes (the * value below is chosen to allow caching to work in full with conversion of * bytes.) - DKF */ #define BINARY_SCAN_MAX_CACHE 260 /* * Prototypes for local procedures defined in this file: */ static void DupByteArrayInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static int FormatNumber(Tcl_Interp *interp, int type, Tcl_Obj *src, unsigned char **cursorPtr); static void FreeByteArrayInternalRep(Tcl_Obj *objPtr); static int GetFormatSpec(char **formatPtr, char *cmdPtr, int *countPtr, int *flagsPtr); static Tcl_Obj * ScanNumber(unsigned char *buffer, int type, int flags, Tcl_HashTable **numberCachePtr); static int SetByteArrayFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfByteArray(Tcl_Obj *listPtr); static void DeleteScanNumberCache(Tcl_HashTable *numberCachePtr); static int NeedReversing(int format); static void CopyNumber(const void *from, void *to, unsigned int length, int type); /* * The following object type represents an array of bytes. An array of bytes * is not equivalent to an internationalized string. Conceptually, a string is * an array of 16-bit quantities organized as a sequence of properly formed * UTF-8 characters, while a ByteArray is an array of 8-bit quantities. * Accessor functions are provided to convert a ByteArray to a String or a * String to a ByteArray. Two or more consecutive bytes in an array of bytes * may look like a single UTF-8 character if the array is casually treated as * a string. But obtaining the String from a ByteArray is guaranteed to * produced properly formed UTF-8 sequences so that there is a one-to-one map * between bytes and characters. * * Converting a ByteArray to a String proceeds by casting each byte in the * array to a 16-bit quantity, treating that number as a Unicode character, * and storing the UTF-8 version of that Unicode character in the String. For * ByteArrays consisting entirely of values 1..127, the corresponding String * representation is the same as the ByteArray representation. * * Converting a String to a ByteArray proceeds by getting the Unicode * representation of each character in the String, casting it to a byte by * truncating the upper 8 bits, and then storing the byte in the ByteArray. * Converting from ByteArray to String and back to ByteArray is not lossy, but * converting an arbitrary String to a ByteArray may be. */ Tcl_ObjType tclByteArrayType = { "bytearray", FreeByteArrayInternalRep, DupByteArrayInternalRep, UpdateStringOfByteArray, SetByteArrayFromAny }; /* * The following structure is the internal rep for a ByteArray object. Keeps * track of how much memory has been used and how much has been allocated for * the byte array to enable growing and shrinking of the ByteArray object with * fewer mallocs. */ typedef struct ByteArray { int used; /* The number of bytes used in the byte * array. */ int allocated; /* The amount of space actually allocated * minus 1 byte. */ unsigned char bytes[4]; /* The array of bytes. The actual size of this * field depends on the 'allocated' field * above. */ } ByteArray; #define BYTEARRAY_SIZE(len) \ ((unsigned) (sizeof(ByteArray) - 4 + (len))) #define GET_BYTEARRAY(objPtr) \ ((ByteArray *) (objPtr)->internalRep.otherValuePtr) #define SET_BYTEARRAY(objPtr, baPtr) \ (objPtr)->internalRep.otherValuePtr = (VOID *) (baPtr)  /* *---------------------------------------------------------------------- * * Tcl_NewByteArrayObj -- * * This procedure is creates a new ByteArray object and initializes it * from the given array of bytes. * * Results: * The newly create object is returned. This object will have no initial * string representation. The returned object has a ref count of 0. * * Side effects: * Memory allocated for new object and copy of byte array argument. * *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG #undef Tcl_NewByteArrayObj Tcl_Obj * Tcl_NewByteArrayObj( const unsigned char *bytes, /* The array of bytes used to initialize the * new object. */ int length) /* Length of the array of bytes, which must be * >= 0. */ { return Tcl_DbNewByteArrayObj(bytes, length, "unknown", 0); } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewByteArrayObj( const unsigned char *bytes, /* The array of bytes used to initialize the * new object. */ int length) /* Length of the array of bytes, which must be * >= 0. */ { Tcl_Obj *objPtr; TclNewObj(objPtr); Tcl_SetByteArrayObj(objPtr, bytes, length); return objPtr; } #endif /* TCL_MEM_DEBUG */  /* *---------------------------------------------------------------------- * * Tcl_DbNewByteArrayObj -- * * This procedure is normally called when debugging: i.e., when * TCL_MEM_DEBUG is defined. It is the same as the Tcl_NewByteArrayObj * above except that it calls Tcl_DbCkalloc directly with the file name * and line number from its caller. This simplifies debugging since then * the [memory active] command will report the correct file name and line * number when reporting objects that haven't been freed. * * When TCL_MEM_DEBUG is not defined, this procedure just returns the * result of calling Tcl_NewByteArrayObj. * * Results: * The newly create object is returned. This object will have no initial * string representation. The returned object has a ref count of 0. * * Side effects: * Memory allocated for new object and copy of byte array argument. * *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewByteArrayObj( const unsigned char *bytes, /* The array of bytes used to initialize the * new object. */ int length, /* Length of the array of bytes, which must be * >= 0. */ const char *file, /* The name of the source file calling this * procedure; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); Tcl_SetByteArrayObj(objPtr, bytes, length); return objPtr; } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_DbNewByteArrayObj( const unsigned char *bytes, /* The array of bytes used to initialize the * new object. */ int length, /* Length of the array of bytes, which must be * >= 0. */ const char *file, /* The name of the source file calling this * procedure; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { return Tcl_NewByteArrayObj(bytes, length); } #endif /* TCL_MEM_DEBUG */ /* *--------------------------------------------------------------------------- * * Tcl_SetByteArrayObj -- * * Modify an object to be a ByteArray object and to have the specified * array of bytes as its value. * * Results: * None. * * Side effects: * The object's old string rep and internal rep is freed. Memory * allocated for copy of byte array argument. * *---------------------------------------------------------------------- */ void Tcl_SetByteArrayObj( Tcl_Obj *objPtr, /* Object to initialize as a ByteArray. */ const unsigned char *bytes, /* The array of bytes to use as the new * value. */ int length) /* Length of the array of bytes, which must be * >= 0. */ { ByteArray *byteArrayPtr; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj"); } TclFreeIntRep(objPtr); Tcl_InvalidateStringRep(objPtr); byteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length)); byteArrayPtr->used = length; byteArrayPtr->allocated = length; memcpy(byteArrayPtr->bytes, bytes, (size_t) length); objPtr->typePtr = &tclByteArrayType; SET_BYTEARRAY(objPtr, byteArrayPtr); }  /* *---------------------------------------------------------------------- * * Tcl_GetByteArrayFromObj -- * * Attempt to get the array of bytes from the Tcl object. If the object * is not already a ByteArray object, an attempt will be made to convert * it to one. * * Results: * Pointer to array of bytes representing the ByteArray object. * * Side effects: * Frees old internal rep. Allocates memory for new internal rep. * *---------------------------------------------------------------------- */ unsigned char * Tcl_GetByteArrayFromObj( Tcl_Obj *objPtr, /* The ByteArray object. */ int *lengthPtr) /* If non-NULL, filled with length of the * array of bytes in the ByteArray object. */ { ByteArray *baPtr; if (objPtr->typePtr != &tclByteArrayType) { SetByteArrayFromAny(NULL, objPtr); } baPtr = GET_BYTEARRAY(objPtr); if (lengthPtr != NULL) { *lengthPtr = baPtr->used; } return (unsigned char *) baPtr->bytes; }  /* *---------------------------------------------------------------------- * * Tcl_SetByteArrayLength -- * * This procedure changes the length of the byte array for this object. * Once the caller has set the length of the array, it is acceptable to * directly modify the bytes in the array up until Tcl_GetStringFromObj() * has been called on this object. * * Results: * The new byte array of the specified length. * * Side effects: * Allocates enough memory for an array of bytes of the requested size. * When growing the array, the old array is copied to the new array; new * bytes are undefined. When shrinking, the old array is truncated to the * specified length. * *---------------------------------------------------------------------- */ unsigned char * Tcl_SetByteArrayLength( Tcl_Obj *objPtr, /* The ByteArray object. */ int length) /* New length for internal byte array. */ { ByteArray *byteArrayPtr; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength"); } if (objPtr->typePtr != &tclByteArrayType) { SetByteArrayFromAny(NULL, objPtr); } byteArrayPtr = GET_BYTEARRAY(objPtr); if (length > byteArrayPtr->allocated) { byteArrayPtr = (ByteArray *) ckrealloc( (char *) byteArrayPtr, BYTEARRAY_SIZE(length)); byteArrayPtr->allocated = length; SET_BYTEARRAY(objPtr, byteArrayPtr); } Tcl_InvalidateStringRep(objPtr); byteArrayPtr->used = length; return byteArrayPtr->bytes; }  /* *---------------------------------------------------------------------- * * SetByteArrayFromAny -- * * Generate the ByteArray internal rep from the string rep. * * Results: * The return value is always TCL_OK. * * Side effects: * A ByteArray object is stored as the internal rep of objPtr. * *---------------------------------------------------------------------- */ static int SetByteArrayFromAny( Tcl_Interp *interp, /* Not used. */ Tcl_Obj *objPtr) /* The object to convert to type ByteArray. */ { int length; char *src, *srcEnd; unsigned char *dst; ByteArray *byteArrayPtr; Tcl_UniChar ch; if (objPtr->typePtr != &tclByteArrayType) { src = TclGetStringFromObj(objPtr, &length); srcEnd = src + length; byteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length)); for (dst = byteArrayPtr->bytes; src < srcEnd; ) { src += Tcl_UtfToUniChar(src, &ch); *dst++ = (unsigned char) ch; } byteArrayPtr->used = dst - byteArrayPtr->bytes; byteArrayPtr->allocated = length; TclFreeIntRep(objPtr); objPtr->typePtr = &tclByteArrayType; SET_BYTEARRAY(objPtr, byteArrayPtr); } return TCL_OK; }  /* *---------------------------------------------------------------------- * * FreeByteArrayInternalRep -- * * Deallocate the storage associated with a ByteArray data object's * internal representation. * * Results: * None. * * Side effects: * Frees memory. * *---------------------------------------------------------------------- */ static void FreeByteArrayInternalRep( Tcl_Obj *objPtr) /* Object with internal rep to free. */ { ckfree((char *) GET_BYTEARRAY(objPtr)); }  /* *---------------------------------------------------------------------- * * DupByteArrayInternalRep -- * * Initialize the internal representation of a ByteArray Tcl_Obj to a * copy of the internal representation of an existing ByteArray object. * * Results: * None. * * Side effects: * Allocates memory. * *---------------------------------------------------------------------- */ static void DupByteArrayInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { int length; ByteArray *srcArrayPtr, *copyArrayPtr; srcArrayPtr = GET_BYTEARRAY(srcPtr); length = srcArrayPtr->used; copyArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length)); copyArrayPtr->used = length; copyArrayPtr->allocated = length; memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, (size_t) length); SET_BYTEARRAY(copyPtr, copyArrayPtr); copyPtr->typePtr = &tclByteArrayType; }  /* *---------------------------------------------------------------------- * * UpdateStringOfByteArray -- * * Update the string representation for a ByteArray data object. Note: * This procedure does not invalidate an existing old string rep so * storage will be lost if this has not already been done. * * Results: * None. * * Side effects: * The object's string is set to a valid string that results from the * ByteArray-to-string conversion. * * The object becomes a string object -- the internal rep is discarded * and the typePtr becomes NULL. * *---------------------------------------------------------------------- */ static void UpdateStringOfByteArray( Tcl_Obj *objPtr) /* ByteArray object whose string rep to * update. */ { int i, length, size; unsigned char *src; char *dst; ByteArray *byteArrayPtr; byteArrayPtr = GET_BYTEARRAY(objPtr); src = byteArrayPtr->bytes; length = byteArrayPtr->used; /* * How much space will string rep need? */ size = length; for (i = 0; i < length; i++) { if ((src[i] == 0) || (src[i] > 127)) { size++; } } dst = (char *) ckalloc((unsigned) (size + 1)); objPtr->bytes = dst; objPtr->length = size; if (size == length) { memcpy(dst, src, (size_t) size); dst[size] = '\0'; } else { for (i = 0; i < length; i++) { dst += Tcl_UniCharToUtf(src[i], dst); } *dst = '\0'; } }  /* *---------------------------------------------------------------------- * * Tcl_BinaryObjCmd -- * * This procedure implements the "binary" Tcl command. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_BinaryObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int arg; /* Index of next argument to consume. */ int value = 0; /* Current integer value to be packed. * Initialized to avoid compiler warning. */ char cmd; /* Current format character. */ int count; /* Count associated with current format * character. */ int flags; /* Format field flags */ char *format; /* Pointer to current position in format * string. */ Tcl_Obj *resultPtr = NULL; /* Object holding result buffer. */ unsigned char *buffer; /* Start of result buffer. */ unsigned char *cursor; /* Current position within result buffer. */ unsigned char *maxPos; /* Greatest position within result buffer that * cursor has visited.*/ const char *errorString; char *errorValue, *str; int offset, size, length, index; static const char *options[] = { "format", "scan", NULL }; enum options { BINARY_FORMAT, BINARY_SCAN }; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum options) index) { case BINARY_FORMAT: if (objc < 3) { Tcl_WrongNumArgs(interp, 2, objv, "formatString ?arg arg ...?"); return TCL_ERROR; } /* * To avoid copying the data, we format the string in two passes. The * first pass computes the size of the output buffer. The second pass * places the formatted data into the buffer. */ format = TclGetString(objv[2]); arg = 3; offset = 0; length = 0; while (*format != '\0') { str = format; flags = 0; if (!GetFormatSpec(&format, &cmd, &count, &flags)) { break; } switch (cmd) { case 'a': case 'A': case 'b': case 'B': case 'h': case 'H': /* * For string-type specifiers, the count corresponds to the * number of bytes in a single argument. */ if (arg >= objc) { goto badIndex; } if (count == BINARY_ALL) { Tcl_GetByteArrayFromObj(objv[arg], &count); } else if (count == BINARY_NOCOUNT) { count = 1; } arg++; if (cmd == 'a' || cmd == 'A') { offset += count; } else if (cmd == 'b' || cmd == 'B') { offset += (count + 7) / 8; } else { offset += (count + 1) / 2; } break; case 'c': size = 1; goto doNumbers; case 't': case 's': case 'S': size = 2; goto doNumbers; case 'n': case 'i': case 'I': size = 4; goto doNumbers; case 'm': case 'w': case 'W': size = 8; goto doNumbers; case 'r': case 'R': case 'f': size = sizeof(float); goto doNumbers; case 'q': case 'Q': case 'd': size = sizeof(double); doNumbers: if (arg >= objc) { goto badIndex; } /* * For number-type specifiers, the count corresponds to the * number of elements in the list stored in a single argument. * If no count is specified, then the argument is taken as a * single non-list value. */ if (count == BINARY_NOCOUNT) { arg++; count = 1; } else { int listc; Tcl_Obj **listv; /* The macro evals its args more than once: avoid arg++ */ if (TclListObjGetElements(interp, objv[arg], &listc, &listv) != TCL_OK) { return TCL_ERROR; } arg++; if (count == BINARY_ALL) { count = listc; } else if (count > listc) { Tcl_AppendResult(interp, "number of elements in list does not match count", NULL); return TCL_ERROR; } } offset += count*size; break; case 'x': if (count == BINARY_ALL) { Tcl_AppendResult(interp, "cannot use \"*\" in format string with \"x\"", NULL); return TCL_ERROR; } else if (count == BINARY_NOCOUNT) { count = 1; } offset += count; break; case 'X': if (count == BINARY_NOCOUNT) { count = 1; } if ((count > offset) || (count == BINARY_ALL)) { count = offset; } if (offset > length) { length = offset; } offset -= count; break; case '@': if (offset > length) { length = offset; } if (count == BINARY_ALL) { offset = length; } else if (count == BINARY_NOCOUNT) { goto badCount; } else { offset = count; } break; default: errorString = str; goto badField; } } if (offset > length) { length = offset; } if (length == 0) { return TCL_OK; } /* * Prepare the result object by preallocating the caclulated number of * bytes and filling with nulls. */ resultPtr = Tcl_NewObj(); buffer = Tcl_SetByteArrayLength(resultPtr, length); memset(buffer, 0, (size_t) length); /* * Pack the data into the result object. Note that we can skip the * error checking during this pass, since we have already parsed the * string once. */ arg = 3; format = TclGetString(objv[2]); cursor = buffer; maxPos = cursor; while (*format != 0) { flags = 0; if (!GetFormatSpec(&format, &cmd, &count, &flags)) { break; } if ((count == 0) && (cmd != '@')) { arg++; continue; } switch (cmd) { case 'a': case 'A': { char pad = (char) (cmd == 'a' ? '\0' : ' '); unsigned char *bytes; bytes = Tcl_GetByteArrayFromObj(objv[arg++], &length); if (count == BINARY_ALL) { count = length; } else if (count == BINARY_NOCOUNT) { count = 1; } if (length >= count) { memcpy(cursor, bytes, (size_t) count); } else { memcpy(cursor, bytes, (size_t) length); memset(cursor + length, pad, (size_t) (count - length)); } cursor += count; break; } case 'b': case 'B': { unsigned char *last; str = TclGetStringFromObj(objv[arg], &length); arg++; if (count == BINARY_ALL) { count = length; } else if (count == BINARY_NOCOUNT) { count = 1; } last = cursor + ((count + 7) / 8); if (count > length) { count = length; } value = 0; errorString = "binary"; if (cmd == 'B') { for (offset = 0; offset < count; offset++) { value <<= 1; if (str[offset] == '1') { value |= 1; } else if (str[offset] != '0') { errorValue = str; Tcl_DecrRefCount(resultPtr); goto badValue; } if (((offset + 1) % 8) == 0) { *cursor++ = (unsigned char) value; value = 0; } } } else { for (offset = 0; offset < count; offset++) { value >>= 1; if (str[offset] == '1') { value |= 128; } else if (str[offset] != '0') { errorValue = str; Tcl_DecrRefCount(resultPtr); goto badValue; } if (!((offset + 1) % 8)) { *cursor++ = (unsigned char) value; value = 0; } } } if ((offset % 8) != 0) { if (cmd == 'B') { value <<= 8 - (offset % 8); } else { value >>= 8 - (offset % 8); } *cursor++ = (unsigned char) value; } while (cursor < last) { *cursor++ = '\0'; } break; } case 'h': case 'H': { unsigned char *last; int c; str = TclGetStringFromObj(objv[arg], &length); arg++; if (count == BINARY_ALL) { count = length; } else if (count == BINARY_NOCOUNT) { count = 1; } last = cursor + ((count + 1) / 2); if (count > length) { count = length; } value = 0; errorString = "hexadecimal"; if (cmd == 'H') { for (offset = 0; offset < count; offset++) { value <<= 4; if (!isxdigit(UCHAR(str[offset]))) { /* INTL: digit */ errorValue = str; Tcl_DecrRefCount(resultPtr); goto badValue; } c = str[offset] - '0'; if (c > 9) { c += ('0' - 'A') + 10; } if (c > 16) { c += ('A' - 'a'); } value |= (c & 0xf); if (offset % 2) { *cursor++ = (char) value; value = 0; } } } else { for (offset = 0; offset < count; offset++) { value >>= 4; if (!isxdigit(UCHAR(str[offset]))) { /* INTL: digit */ errorValue = str; Tcl_DecrRefCount(resultPtr); goto badValue; } c = str[offset] - '0'; if (c > 9) { c += ('0' - 'A') + 10; } if (c > 16) { c += ('A' - 'a'); } value |= ((c << 4) & 0xf0); if (offset % 2) { *cursor++ = (unsigned char)(value & 0xff); value = 0; } } } if (offset % 2) { if (cmd == 'H') { value <<= 4; } else { value >>= 4; } *cursor++ = (unsigned char) value; } while (cursor < last) { *cursor++ = '\0'; } break; } case 'c': case 't': case 's': case 'S': case 'n': case 'i': case 'I': case 'm': case 'w': case 'W': case 'r': case 'R': case 'd': case 'q': case 'Q': case 'f': { int listc, i; Tcl_Obj **listv; if (count == BINARY_NOCOUNT) { /* * Note that we are casting away the const-ness of objv, * but this is safe since we aren't going to modify the * array. */ listv = (Tcl_Obj**)(objv + arg); listc = 1; count = 1; } else { TclListObjGetElements(interp, objv[arg], &listc, &listv); if (count == BINARY_ALL) { count = listc; } } arg++; for (i = 0; i < count; i++) { if (FormatNumber(interp, cmd, listv[i], &cursor)!=TCL_OK) { Tcl_DecrRefCount(resultPtr); return TCL_ERROR; } } break; } case 'x': if (count == BINARY_NOCOUNT) { count = 1; } memset(cursor, 0, (size_t) count); cursor += count; break; case 'X': if (cursor > maxPos) { maxPos = cursor; } if (count == BINARY_NOCOUNT) { count = 1; } if ((count == BINARY_ALL) || (count > (cursor - buffer))) { cursor = buffer; } else { cursor -= count; } break; case '@': if (cursor > maxPos) { maxPos = cursor; } if (count == BINARY_ALL) { cursor = maxPos; } else { cursor = buffer + count; } break; } } Tcl_SetObjResult(interp, resultPtr); break; case BINARY_SCAN: { int i; Tcl_Obj *valuePtr, *elementPtr; Tcl_HashTable numberCacheHash; Tcl_HashTable *numberCachePtr; if (objc < 4) { Tcl_WrongNumArgs(interp, 2, objv, "value formatString ?varName varName ...?"); return TCL_ERROR; } numberCachePtr = &numberCacheHash; Tcl_InitHashTable(numberCachePtr, TCL_ONE_WORD_KEYS); buffer = Tcl_GetByteArrayFromObj(objv[2], &length); format = TclGetString(objv[3]); cursor = buffer; arg = 4; offset = 0; while (*format != '\0') { str = format; flags = 0; if (!GetFormatSpec(&format, &cmd, &count, &flags)) { goto done; } switch (cmd) { case 'a': case 'A': { unsigned char *src; if (arg >= objc) { DeleteScanNumberCache(numberCachePtr); goto badIndex; } if (count == BINARY_ALL) { count = length - offset; } else { if (count == BINARY_NOCOUNT) { count = 1; } if (count > (length - offset)) { goto done; } } src = buffer + offset; size = count; /* * Trim trailing nulls and spaces, if necessary. */ if (cmd == 'A') { while (size > 0) { if (src[size-1] != '\0' && src[size-1] != ' ') { break; } size--; } } /* * Have to do this #ifdef-fery because (as part of defining * Tcl_NewByteArrayObj) we removed the #def that hides this * stuff normally. If this code ever gets copied to another * file, it should be changed back to the simpler version. */ #ifdef TCL_MEM_DEBUG valuePtr = Tcl_DbNewByteArrayObj(src, size, __FILE__,__LINE__); #else valuePtr = Tcl_NewByteArrayObj(src, size); #endif /* TCL_MEM_DEBUG */ resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr, TCL_LEAVE_ERR_MSG); arg++; if (resultPtr == NULL) { DeleteScanNumberCache(numberCachePtr); return TCL_ERROR; } offset += count; break; } case 'b': case 'B': { unsigned char *src; char *dest; if (arg >= objc) { DeleteScanNumberCache(numberCachePtr); goto badIndex; } if (count == BINARY_ALL) { count = (length - offset) * 8; } else { if (count == BINARY_NOCOUNT) { count = 1; } if (count > (length - offset) * 8) { goto done; } } src = buffer + offset; valuePtr = Tcl_NewObj(); Tcl_SetObjLength(valuePtr, count); dest = TclGetString(valuePtr); if (cmd == 'b') { for (i = 0; i < count; i++) { if (i % 8) { value >>= 1; } else { value = *src++; } *dest++ = (char) ((value & 1) ? '1' : '0'); } } else { for (i = 0; i < count; i++) { if (i % 8) { value <<= 1; } else { value = *src++; } *dest++ = (char) ((value & 0x80) ? '1' : '0'); } } resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr, TCL_LEAVE_ERR_MSG); arg++; if (resultPtr == NULL) { DeleteScanNumberCache(numberCachePtr); return TCL_ERROR; } offset += (count + 7) / 8; break; } case 'h': case 'H': { char *dest; unsigned char *src; int i; static const char hexdigit[] = "0123456789abcdef"; if (arg >= objc) { DeleteScanNumberCache(numberCachePtr); goto badIndex; } if (count == BINARY_ALL) { count = (length - offset)*2; } else { if (count == BINARY_NOCOUNT) { count = 1; } if (count > (length - offset)*2) { goto done; } } src = buffer + offset; valuePtr = Tcl_NewObj(); Tcl_SetObjLength(valuePtr, count); dest = TclGetString(valuePtr); if (cmd == 'h') { for (i = 0; i < count; i++) { if (i % 2) { value >>= 4; } else { value = *src++; } *dest++ = hexdigit[value & 0xf]; } } else { for (i = 0; i < count; i++) { if (i % 2) { value <<= 4; } else { value = *src++; } *dest++ = hexdigit[(value >> 4) & 0xf]; } } resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr, TCL_LEAVE_ERR_MSG); arg++; if (resultPtr == NULL) { DeleteScanNumberCache(numberCachePtr); return TCL_ERROR; } offset += (count + 1) / 2; break; } case 'c': size = 1; goto scanNumber; case 't': case 's': case 'S': size = 2; goto scanNumber; case 'n': case 'i': case 'I': size = 4; goto scanNumber; case 'm': case 'w': case 'W': size = 8; goto scanNumber; case 'r': case 'R': case 'f': size = sizeof(float); goto scanNumber; case 'q': case 'Q': case 'd': { unsigned char *src; size = sizeof(double); /* fall through */ scanNumber: if (arg >= objc) { DeleteScanNumberCache(numberCachePtr); goto badIndex; } if (count == BINARY_NOCOUNT) { if ((length - offset) < size) { goto done; } valuePtr = ScanNumber(buffer+offset, cmd, flags, &numberCachePtr); offset += size; } else { if (count == BINARY_ALL) { count = (length - offset) / size; } if ((length - offset) < (count * size)) { goto done; } valuePtr = Tcl_NewObj(); src = buffer+offset; for (i = 0; i < count; i++) { elementPtr = ScanNumber(src, cmd, flags, &numberCachePtr); src += size; Tcl_ListObjAppendElement(NULL, valuePtr, elementPtr); } offset += count*size; } resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr, TCL_LEAVE_ERR_MSG); arg++; if (resultPtr == NULL) { DeleteScanNumberCache(numberCachePtr); return TCL_ERROR; } break; } case 'x': if (count == BINARY_NOCOUNT) { count = 1; } if ((count == BINARY_ALL) || (count > (length - offset))) { offset = length; } else { offset += count; } break; case 'X': if (count == BINARY_NOCOUNT) { count = 1; } if ((count == BINARY_ALL) || (count > offset)) { offset = 0; } else { offset -= count; } break; case '@': if (count == BINARY_NOCOUNT) { DeleteScanNumberCache(numberCachePtr); goto badCount; } if ((count == BINARY_ALL) || (count > length)) { offset = length; } else { offset = count; } break; default: DeleteScanNumberCache(numberCachePtr); errorString = str; goto badField; } } /* * Set the result to the last position of the cursor. */ done: Tcl_SetObjResult(interp, Tcl_NewLongObj(arg - 4)); DeleteScanNumberCache(numberCachePtr); break; } } return TCL_OK; badValue: Tcl_ResetResult(interp); Tcl_AppendResult(interp, "expected ", errorString, " string but got \"", errorValue, "\" instead", NULL); return TCL_ERROR; badCount: errorString = "missing count for \"@\" field specifier"; goto error; badIndex: errorString = "not enough arguments for all format specifiers"; goto error; badField: { Tcl_UniChar ch; char buf[TCL_UTF_MAX + 1]; Tcl_UtfToUniChar(errorString, &ch); buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; Tcl_AppendResult(interp, "bad field specifier \"", buf, "\"", NULL); return TCL_ERROR; } error: Tcl_AppendResult(interp, errorString, NULL); return TCL_ERROR; }  /* *---------------------------------------------------------------------- * * GetFormatSpec -- * * This function parses the format strings used in the binary format and * scan commands. * * Results: * Moves the formatPtr to the start of the next command. Returns the * current command character and count in cmdPtr and countPtr. The count * is set to BINARY_ALL if the count character was '*' or BINARY_NOCOUNT * if no count was specified. Returns 1 on success, or 0 if the string * did not have a format specifier. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int GetFormatSpec( char **formatPtr, /* Pointer to format string. */ char *cmdPtr, /* Pointer to location of command char. */ int *countPtr, /* Pointer to repeat count value. */ int *flagsPtr) /* Pointer to field flags */ { /* * Skip any leading blanks. */ while (**formatPtr == ' ') { (*formatPtr)++; } /* * The string was empty, except for whitespace, so fail. */ if (!(**formatPtr)) { return 0; } /* * Extract the command character and any trailing digits or '*'. */ *cmdPtr = **formatPtr; (*formatPtr)++; if (**formatPtr == 'u') { (*formatPtr)++; (*flagsPtr) |= BINARY_UNSIGNED; } if (**formatPtr == '*') { (*formatPtr)++; (*countPtr) = BINARY_ALL; } else if (isdigit(UCHAR(**formatPtr))) { /* INTL: digit */ (*countPtr) = strtoul(*formatPtr, formatPtr, 10); } else { (*countPtr) = BINARY_NOCOUNT; } return 1; }  /* *---------------------------------------------------------------------- * * NeedReversing -- * * This routine determines, if bytes of a number need to be re-ordered, * and returns a numeric code indicating the re-ordering to be done. * This depends on the endiannes of the machine and the desired format. * It is in effect a table (whose contents depend on the endianness of * the system) describing whether a value needs reversing or not. Anyone * porting the code to a big-endian platform should take care to make * sure that they define WORDS_BIGENDIAN though this is already done by * configure for the Unix build; little-endian platforms (including * Windows) don't need to do anything. * * Results: * 0 No re-ordering needed. * 1 Reverse the bytes: 01234567 <-> 76543210 (little to big) * 2 Apply this re-ordering: 01234567 <-> 45670123 (Nokia to little) * 3 Apply this re-ordering: 01234567 <-> 32107654 (Nokia to big) * * Side effects: * None * *---------------------------------------------------------------------- */ static int NeedReversing( int format) { switch (format) { /* native floats and doubles: never reverse */ case 'd': case 'f': /* big endian ints: never reverse */ case 'I': case 'S': case 'W': #ifdef WORDS_BIGENDIAN /* native ints: reverse if we're little-endian */ case 'n': case 't': case 'm': /* f: reverse if we're little-endian */ case 'Q': case 'R': #else /* !WORDS_BIGENDIAN */ /* small endian floats: reverse if we're big-endian */ case 'r': #endif /* WORDS_BIGENDIAN */ return 0; #ifdef WORDS_BIGENDIAN /* small endian floats: reverse if we're big-endian */ case 'q': case 'r': #else /* !WORDS_BIGENDIAN */ /* native ints: reverse if we're little-endian */ case 'n': case 't': case 'm': /* f: reverse if we're little-endian */ case 'R': #endif /* WORDS_BIGENDIAN */ /* small endian ints: always reverse */ case 'i': case 's': case 'w': return 1; #ifndef WORDS_BIGENDIAN /* * The Q and q formats need special handling to account for the unusual * byte ordering of 8-byte floats on Nokia 770 systems, which claim to be * little-endian, but also reverse word order. */ case 'Q': if (TclNokia770Doubles()) { return 3; } return 1; case 'q': if (TclNokia770Doubles()) { return 2; } return 0; #endif } Tcl_Panic("unexpected fallthrough"); return 0; }  /* *---------------------------------------------------------------------- * * CopyNumber -- * * This routine is called by FormatNumber and ScanNumber to copy a * floating-point number. If required, bytes are reversed while copying. * The behaviour is only fully defined when used with IEEE float and * double values (guaranteed to be 4 and 8 bytes long, respectively.) * * Results: * None * * Side effects: * Copies length bytes * *---------------------------------------------------------------------- */ static void CopyNumber( const void *from, /* source */ void *to, /* destination */ unsigned int length, /* Number of bytes to copy */ int type) /* What type of thing are we copying? */ { switch (NeedReversing(type)) { case 0: memcpy(to, from, length); break; case 1: { const unsigned char *fromPtr = from; unsigned char *toPtr = to; switch (length) { case 4: toPtr[0] = fromPtr[3]; toPtr[1] = fromPtr[2]; toPtr[2] = fromPtr[1]; toPtr[3] = fromPtr[0]; break; case 8: toPtr[0] = fromPtr[7]; toPtr[1] = fromPtr[6]; toPtr[2] = fromPtr[5]; toPtr[3] = fromPtr[4]; toPtr[4] = fromPtr[3]; toPtr[5] = fromPtr[2]; toPtr[6] = fromPtr[1]; toPtr[7] = fromPtr[0]; break; } break; } case 2: { const unsigned char *fromPtr = from; unsigned char *toPtr = to; toPtr[0] = fromPtr[4]; toPtr[1] = fromPtr[5]; toPtr[2] = fromPtr[6]; toPtr[3] = fromPtr[7]; toPtr[4] = fromPtr[0]; toPtr[5] = fromPtr[1]; toPtr[6] = fromPtr[2]; toPtr[7] = fromPtr[3]; break; } case 3: { const unsigned char *fromPtr = from; unsigned char *toPtr = to; toPtr[0] = fromPtr[3]; toPtr[1] = fromPtr[2]; toPtr[2] = fromPtr[1]; toPtr[3] = fromPtr[0]; toPtr[4] = fromPtr[7]; toPtr[5] = fromPtr[6]; toPtr[6] = fromPtr[5]; toPtr[7] = fromPtr[4]; break; } } }  /* *---------------------------------------------------------------------- * * FormatNumber -- * * This routine is called by Tcl_BinaryObjCmd to format a number into a * location pointed at by cursor. * * Results: * A standard Tcl result. * * Side effects: * Moves the cursor to the next location to be written into. * *---------------------------------------------------------------------- */ static int FormatNumber( Tcl_Interp *interp, /* Current interpreter, used to report * errors. */ int type, /* Type of number to format. */ Tcl_Obj *src, /* Number to format. */ unsigned char **cursorPtr) /* Pointer to index into destination buffer. */ { long value; double dvalue; Tcl_WideInt wvalue; float fvalue; switch (type) { case 'd': case 'q': case 'Q': /* * Double-precision floating point values. Tcl_GetDoubleFromObj * returns TCL_ERROR for NaN, but we can check by comparing the * object's type pointer. */ if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) { if (src->typePtr != &tclDoubleType) { return TCL_ERROR; } dvalue = src->internalRep.doubleValue; } CopyNumber(&dvalue, *cursorPtr, sizeof(double), type); *cursorPtr += sizeof(double); return TCL_OK; case 'f': case 'r': case 'R': /* * Single-precision floating point values. Tcl_GetDoubleFromObj * returns TCL_ERROR for NaN, but we can check by comparing the * object's type pointer. */ if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) { if (src->typePtr != &tclDoubleType) { return TCL_ERROR; } dvalue = src->internalRep.doubleValue; } /* * Because some compilers will generate floating point exceptions on * an overflow cast (e.g. Borland), we restrict the values to the * valid range for float. */ if (fabs(dvalue) > (double)FLT_MAX) { fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX; } else { fvalue = (float) dvalue; } CopyNumber(&fvalue, *cursorPtr, sizeof(float), type); *cursorPtr += sizeof(float); return TCL_OK; /* * 64-bit integer values. */ case 'w': case 'W': case 'm': if (Tcl_GetWideIntFromObj(interp, src, &wvalue) != TCL_OK) { return TCL_ERROR; } if (NeedReversing(type)) { *(*cursorPtr)++ = (unsigned char) wvalue; *(*cursorPtr)++ = (unsigned char) (wvalue >> 8); *(*cursorPtr)++ = (unsigned char) (wvalue >> 16); *(*cursorPtr)++ = (unsigned char) (wvalue >> 24); *(*cursorPtr)++ = (unsigned char) (wvalue >> 32); *(*cursorPtr)++ = (unsigned char) (wvalue >> 40); *(*cursorPtr)++ = (unsigned char) (wvalue >> 48); *(*cursorPtr)++ = (unsigned char) (wvalue >> 56); } else { *(*cursorPtr)++ = (unsigned char) (wvalue >> 56); *(*cursorPtr)++ = (unsigned char) (wvalue >> 48); *(*cursorPtr)++ = (unsigned char) (wvalue >> 40); *(*cursorPtr)++ = (unsigned char) (wvalue >> 32); *(*cursorPtr)++ = (unsigned char) (wvalue >> 24); *(*cursorPtr)++ = (unsigned char) (wvalue >> 16); *(*cursorPtr)++ = (unsigned char) (wvalue >> 8); *(*cursorPtr)++ = (unsigned char) wvalue; } return TCL_OK; /* * 32-bit integer values. */ case 'i': case 'I': case 'n': if (TclGetLongFromObj(interp, src, &value) != TCL_OK) { return TCL_ERROR; } if (NeedReversing(type)) { *(*cursorPtr)++ = (unsigned char) value; *(*cursorPtr)++ = (unsigned char) (value >> 8); *(*cursorPtr)++ = (unsigned char) (value >> 16); *(*cursorPtr)++ = (unsigned char) (value >> 24); } else { *(*cursorPtr)++ = (unsigned char) (value >> 24); *(*cursorPtr)++ = (unsigned char) (value >> 16); *(*cursorPtr)++ = (unsigned char) (value >> 8); *(*cursorPtr)++ = (unsigned char) value; } return TCL_OK; /* * 16-bit integer values. */ case 's': case 'S': case 't': if (TclGetLongFromObj(interp, src, &value) != TCL_OK) { return TCL_ERROR; } if (NeedReversing(type)) { *(*cursorPtr)++ = (unsigned char) value; *(*cursorPtr)++ = (unsigned char) (value >> 8); } else { *(*cursorPtr)++ = (unsigned char) (value >> 8); *(*cursorPtr)++ = (unsigned char) value; } return TCL_OK; /* * 8-bit integer values. */ case 'c': if (TclGetLongFromObj(interp, src, &value) != TCL_OK) { return TCL_ERROR; } *(*cursorPtr)++ = (unsigned char) value; return TCL_OK; default: Tcl_Panic("unexpected fallthrough"); return TCL_ERROR; } }  /* *---------------------------------------------------------------------- * * ScanNumber -- * * This routine is called by Tcl_BinaryObjCmd to scan a number out of a * buffer. * * Results: * Returns a newly created object containing the scanned number. This * object has a ref count of zero. * * Side effects: * Might reuse an object in the number cache, place a new object in the * cache, or delete the cache and set the reference to it (itself passed * in by reference) to NULL. * *---------------------------------------------------------------------- */ static Tcl_Obj * ScanNumber( unsigned char *buffer, /* Buffer to scan number from. */ int type, /* Format character from "binary scan" */ int flags, /* Format field flags */ Tcl_HashTable **numberCachePtrPtr) /* Place to look for cache of scanned * value objects, or NULL if too many * different numbers have been scanned. */ { long value; float fvalue; double dvalue; Tcl_WideUInt uwvalue; /* * We cannot rely on the compiler to properly sign extend integer values * when we cast from smaller values to larger values because we don't know * the exact size of the integer types. So, we have to handle sign * extension explicitly by checking the high bit and padding with 1's as * needed. This practice is disabled if the BINARY_UNSIGNED flag is set. */ switch (type) { case 'c': /* * Characters need special handling. We want to produce a signed * result, but on some platforms (such as AIX) chars are unsigned. To * deal with this, check for a value that should be negative but * isn't. */ value = buffer[0]; if (!(flags & BINARY_UNSIGNED)) { if (value & 0x80) { value |= -0x100; } } goto returnNumericObject; /* * 16-bit numeric values. We need the sign extension trick (see above) * here as well. */ case 's': case 'S': case 't': if (NeedReversing(type)) { value = (long) (buffer[0] + (buffer[1] << 8)); } else { value = (long) (buffer[1] + (buffer[0] << 8)); } if (!(flags & BINARY_UNSIGNED)) { if (value & 0x8000) { value |= -0x10000; } } goto returnNumericObject; /* * 32-bit numeric values. */ case 'i': case 'I': case 'n': if (NeedReversing(type)) { value = (long) (buffer[0] + (buffer[1] << 8) + (buffer[2] << 16) + (((long)buffer[3]) << 24)); } else { value = (long) (buffer[3] + (buffer[2] << 8) + (buffer[1] << 16) + (((long)buffer[0]) << 24)); } /* * Check to see if the value was sign extended properly on systems * where an int is more than 32-bits. * We avoid caching unsigned integers as we cannot distinguish between * 32bit signed and unsigned in the hash (short and char are ok). */ if (flags & BINARY_UNSIGNED) { return Tcl_NewWideIntObj((Tcl_WideInt)(unsigned long)value); } if ((value & (((unsigned int)1)<<31)) && (value > 0)) { value -= (((unsigned int)1)<<31); value -= (((unsigned int)1)<<31); } returnNumericObject: if (*numberCachePtrPtr == NULL) { return Tcl_NewLongObj(value); } else { register Tcl_HashTable *tablePtr = *numberCachePtrPtr; register Tcl_HashEntry *hPtr; int isNew; hPtr = Tcl_CreateHashEntry(tablePtr, (char *)value, &isNew); if (!isNew) { return (Tcl_Obj *) Tcl_GetHashValue(hPtr); } if (tablePtr->numEntries <= BINARY_SCAN_MAX_CACHE) { register Tcl_Obj *objPtr = Tcl_NewLongObj(value); Tcl_IncrRefCount(objPtr); Tcl_SetHashValue(hPtr, (ClientData) objPtr); return objPtr; } /* * We've overflowed the cache! Someone's parsing a LOT of varied * binary data in a single call! Bail out by switching back to the * old behaviour for the rest of the scan. * * Note that anyone just using the 'c' conversion (for bytes) * cannot trigger this. */ DeleteScanNumberCache(tablePtr); *numberCachePtrPtr = NULL; return Tcl_NewLongObj(value); } /* * Do not cache wide (64-bit) values; they are already too large to * use as keys. */ case 'w': case 'W': case 'm': if (NeedReversing(type)) { uwvalue = ((Tcl_WideUInt) buffer[0]) | (((Tcl_WideUInt) buffer[1]) << 8) | (((Tcl_WideUInt) buffer[2]) << 16) | (((Tcl_WideUInt) buffer[3]) << 24) | (((Tcl_WideUInt) buffer[4]) << 32) | (((Tcl_WideUInt) buffer[5]) << 40) | (((Tcl_WideUInt) buffer[6]) << 48) | (((Tcl_WideUInt) buffer[7]) << 56); } else { uwvalue = ((Tcl_WideUInt) buffer[7]) | (((Tcl_WideUInt) buffer[6]) << 8) | (((Tcl_WideUInt) buffer[5]) << 16) | (((Tcl_WideUInt) buffer[4]) << 24) | (((Tcl_WideUInt) buffer[3]) << 32) | (((Tcl_WideUInt) buffer[2]) << 40) | (((Tcl_WideUInt) buffer[1]) << 48) | (((Tcl_WideUInt) buffer[0]) << 56); } if (flags & BINARY_UNSIGNED) { Tcl_Obj *bigObj = NULL; mp_int big; TclBNInitBignumFromWideUInt(&big, uwvalue); bigObj = Tcl_NewBignumObj(&big); return bigObj; } return Tcl_NewWideIntObj((Tcl_WideInt) uwvalue); /* * Do not cache double values; they are already too large to use as * keys and the values stored are utterly incompatible with the * integer part of the cache. */ /* * 32-bit IEEE single-precision floating point. */ case 'f': case 'R': case 'r': CopyNumber(buffer, &fvalue, sizeof(float), type); return Tcl_NewDoubleObj(fvalue); /* * 64-bit IEEE double-precision floating point. */ case 'd': case 'Q': case 'q': CopyNumber(buffer, &dvalue, sizeof(double), type); return Tcl_NewDoubleObj(dvalue); } return NULL; }  /* *---------------------------------------------------------------------- * * DeleteScanNumberCache -- * * Deletes the hash table acting as a scan number cache. * * Results: * None * * Side effects: * Decrements the reference counts of the objects in the cache. * *---------------------------------------------------------------------- */ static void DeleteScanNumberCache( Tcl_HashTable *numberCachePtr) /* Pointer to the hash table, or NULL (when * the cache has already been deleted due to * overflow.) */ { Tcl_HashEntry *hEntry; Tcl_HashSearch search; if (numberCachePtr == NULL) { return; } hEntry = Tcl_FirstHashEntry(numberCachePtr, &search); while (hEntry != NULL) { register Tcl_Obj *value = Tcl_GetHashValue(hEntry); if (value != NULL) { Tcl_DecrRefCount(value); } hEntry = Tcl_NextHashEntry(&search); } Tcl_DeleteHashTable(numberCachePtr); }  /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */

• ソフトウェア開発
• ホームページ制作
• Doxygen版
• STLport版