From 00c0664fd2487670b9bf12e3c2ba32fa4a5ea944 Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 25 Nov 2006 17:18:09 +0000 Subject: Finished coding part of TIP#174. Still have tests and docs to do. --- ChangeLog | 8 + generic/tclCompCmds.c | 1544 ++------------------------ generic/tclMathOp.c | 2870 +++++++++++++++++++++++++++++++++++++++++++++++++ unix/Makefile.in | 347 +++--- win/Makefile.in | 120 +-- win/makefile.bc | 1 + win/makefile.vc | 3 +- 7 files changed, 3191 insertions(+), 1702 deletions(-) create mode 100644 generic/tclMathOp.c diff --git a/ChangeLog b/ChangeLog index 77ce434..a5cfee4 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2006-11-25 Donal K. Fellows + + TIP#269 IMPLEMENTATION + + * generic/tclMathOp.c (new file): Completed the implementation of the + interpreted versions of all the tcl::mathop commands. Moved to a new + file to make tclCompCmds.c more focussed in purpose. + 2006-11-23 Donal K. Fellows * generic/tclCompCmds.c (Tcl*OpCmd, TclCompile*OpCmd): diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 152597b..aa522c0 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -1,27 +1,23 @@ /* * tclCompCmds.c -- * - * This file contains compilation procedures that compile various - * Tcl commands into a sequence of instructions ("bytecodes"). + * This file contains compilation procedures that compile various Tcl + * commands into a sequence of instructions ("bytecodes"). * * Copyright (c) 1997-1998 Sun Microsystems, Inc. * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. * Copyright (c) 2002 ActiveState Corporation. - * Copyright (c) 2004-2005 by Donal K. Fellows. + * Copyright (c) 2004-2006 by Donal K. Fellows. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompCmds.c,v 1.91 2006/11/24 15:34:23 dkf Exp $ + * RCS: @(#) $Id: tclCompCmds.c,v 1.92 2006/11/25 17:18:09 dkf Exp $ */ #include "tclInt.h" #include "tclCompile.h" -#include "tommath.h" -#include -#include - /* * Macro that encapsulates an efficiency trick that avoids a function call for * the simplest of compiles. The ANSI C "prototype" for this macro is: @@ -126,8 +122,6 @@ static int PushVarName(Tcl_Interp *interp, Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags, int *localIndexPtr, int *simpleVarNamePtr, int *isScalarPtr); -static int CompareNumbers(Tcl_Interp *interp, Tcl_Obj *numObj1, - Tcl_Obj *numObj2, int *resultPtr); /* * Flags bits used by PushVarName. @@ -4449,59 +4443,23 @@ PushVarName( return TCL_OK; } -int -TclInvertOpCmd( - ClientData clientData, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - ClientData val; - int type; - - if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "number"); - return TCL_ERROR; - } - if (TclGetNumberFromObj(interp, objv[1], &val, &type) != TCL_OK) { - return TCL_ERROR; - } - switch (type) { - case TCL_NUMBER_LONG: { - long l = *((const long *) val); - - Tcl_SetLongObj(Tcl_GetObjResult(interp), ~l); - return TCL_OK; - } -#ifndef NO_WIDE_TYPE - case TCL_NUMBER_WIDE: { - Tcl_WideInt w = *((const Tcl_WideInt *) val); - - Tcl_SetWideIntObj(Tcl_GetObjResult(interp), ~w); - return TCL_OK; - } -#endif - default: { - mp_int big; - - if (Tcl_IsShared(objv[1])) { - Tcl_GetBignumFromObj(NULL, objv[1], &big); - } else { - Tcl_GetBignumAndClearObj(NULL, objv[1], &big); - } - /* ~a = - a - 1 */ - mp_neg(&big, &big); - mp_sub_d(&big, 1, &big); - if (Tcl_IsShared(objv[1])) { - Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big)); - } else { - Tcl_SetBignumObj(objv[1], &big); - Tcl_SetObjResult(interp, objv[1]); - } - return TCL_OK; - } - } -} +/* + *---------------------------------------------------------------------- + * + * TclCompileInvertOpCmd -- + * + * Procedure called to compile the "::tcl::mathop::~" command. + * + * Results: + * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer + * evaluation to runtime. + * + * Side effects: + * Instructions are added to envPtr to execute the "::tcl::mathop::~" + * command at runtime. + * + *---------------------------------------------------------------------- + */ int TclCompileInvertOpCmd( @@ -4521,26 +4479,6 @@ TclCompileInvertOpCmd( } int -TclNotOpCmd( - ClientData clientData, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - int b; - - if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "boolean"); - return TCL_ERROR; - } - if (Tcl_GetBooleanFromObj(interp, objv[1], &b) != TCL_OK) { - return TCL_ERROR; - } - Tcl_SetBooleanObj(Tcl_GetObjResult(interp), !b); - return TCL_OK; -} - -int TclCompileNotOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, @@ -4558,17 +4496,6 @@ TclCompileNotOpCmd( } int -TclAddOpCmd( - ClientData clientData, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - Tcl_AppendResult(interp, "not yet implemented", NULL); - return TCL_ERROR; -} - -int TclCompileAddOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, @@ -4592,17 +4519,6 @@ TclCompileAddOpCmd( } int -TclMulOpCmd( - ClientData clientData, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - Tcl_AppendResult(interp, "not yet implemented", NULL); - return TCL_ERROR; -} - -int TclCompileMulOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, @@ -4626,17 +4542,6 @@ TclCompileMulOpCmd( } int -TclAndOpCmd( - ClientData clientData, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - Tcl_AppendResult(interp, "not yet implemented", NULL); - return TCL_ERROR; -} - -int TclCompileAndOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, @@ -4660,17 +4565,6 @@ TclCompileAndOpCmd( } int -TclOrOpCmd( - ClientData clientData, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - Tcl_AppendResult(interp, "not yet implemented", NULL); - return TCL_ERROR; -} - -int TclCompileOrOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, @@ -4694,17 +4588,6 @@ TclCompileOrOpCmd( } int -TclXorOpCmd( - ClientData clientData, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - Tcl_AppendResult(interp, "not yet implemented", NULL); - return TCL_ERROR; -} - -int TclCompileXorOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, @@ -4728,17 +4611,6 @@ TclCompileXorOpCmd( } int -TclPowOpCmd( - ClientData clientData, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - Tcl_AppendResult(interp, "not yet implemented", NULL); - return TCL_ERROR; -} - -int TclCompilePowOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, @@ -4764,22 +4636,6 @@ TclCompilePowOpCmd( } int -TclMinusOpCmd( - ClientData clientData, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "value ?value ...?"); - return TCL_ERROR; - } - - Tcl_AppendResult(interp, "not yet implemented", NULL); - return TCL_ERROR; -} - -int TclCompileMinusOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, @@ -4806,22 +4662,6 @@ TclCompileMinusOpCmd( } int -TclDivOpCmd( - ClientData clientData, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "value ?value ...?"); - return TCL_ERROR; - } - - Tcl_AppendResult(interp, "not yet implemented", NULL); - return TCL_ERROR; -} - -int TclCompileDivOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, @@ -4833,7 +4673,7 @@ TclCompileDivOpCmd( if (parsePtr->numWords == 1) { return TCL_ERROR; } else if (parsePtr->numWords == 2) { - PushLiteral(envPtr, "1", 1); + PushLiteral(envPtr, "1.0", 3); tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp); TclEmitOpcode(INST_DIV, envPtr); @@ -4850,143 +4690,45 @@ TclCompileDivOpCmd( } int -TclLshiftOpCmd( - ClientData clientData, +TclCompileLshiftOpCmd( Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) + Tcl_Parse *parsePtr, + CompileEnv *envPtr) { - ClientData ptr1, ptr2; - int invalid, shift, type1, type2, idx; - const char *description; - long l1; - - if (objc != 3) { - Tcl_WrongNumArgs(interp, 1, objv, "value value"); - return TCL_ERROR; - } + Tcl_Token *tokenPtr; - if ((TclGetNumberFromObj(NULL, objv[1], &ptr1, &type1) != TCL_OK) - || (type1 == TCL_NUMBER_DOUBLE) || (type1 == TCL_NUMBER_NAN)) { - idx = 1; - goto illegalOperand; - } - if ((TclGetNumberFromObj(NULL, objv[2], &ptr2, &type2) != TCL_OK) - || (type2 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_NAN)) { - idx = 2; - goto illegalOperand; - } - - /* reject negative shift argument */ - switch (type2) { - case TCL_NUMBER_LONG: - invalid = (*((const long *)ptr2) < (long)0); - break; -#ifndef NO_WIDE_TYPE - case TCL_NUMBER_WIDE: - invalid = (*((const Tcl_WideInt *)ptr2) < (Tcl_WideInt)0); - break; -#endif - case TCL_NUMBER_BIG: - /* TODO: const correctness ? */ - invalid = (mp_cmp_d((mp_int *)ptr2, 0) == MP_LT); - break; - default: - /* Unused, here to silence compiler warning */ - invalid = 0; - } - if (invalid) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("negative shift argument", -1)); + if (parsePtr->numWords != 3) { return TCL_ERROR; } + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitOpcode(INST_LSHIFT, envPtr); + return TCL_OK; +} + +int +TclCompileRshiftOpCmd( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + CompileEnv *envPtr) +{ + Tcl_Token *tokenPtr; - /* Zero shifted any number of bits is still zero */ - if ((type1 == TCL_NUMBER_LONG) && (*((const long *)ptr1) == (long)0)) { - Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); - return TCL_OK; - } - - /* Large left shifts create integer overflow */ - if (Tcl_GetIntFromObj(NULL, objv[2], &shift) != TCL_OK) { - /* - * Technically, we could hold the value (1 << (INT_MAX+1)) in an - * mp_int, but since we're using mp_mul_2d() to do the work, and it - * takes only an int argument, that's a good place to draw the line. - */ - - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "integer value too large to represent", -1)); + if (parsePtr->numWords != 3) { return TCL_ERROR; } - - /* Handle shifts within the native long range */ - if ((type1 == TCL_NUMBER_LONG) && ((size_t)shift < CHAR_BIT*sizeof(long)) - && (l1 = *((CONST long *)ptr1)) && - !(((l1>0) ? l1 : ~l1) & -(1L<<(CHAR_BIT*sizeof(long)-1-shift)))) { - Tcl_SetObjResult(interp, Tcl_NewLongObj(l1<0) ? w : ~w) & -(((Tcl_WideInt)1) - << (CHAR_BIT*sizeof(Tcl_WideInt)-1-shift)))) { - Tcl_SetObjResult(interp, Tcl_NewWideIntObj(w<tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitOpcode(INST_RSHIFT, envPtr); return TCL_OK; - - illegalOperand: - if (TclGetNumberFromObj(NULL, objv[idx], &ptr1, &type1) != TCL_OK) { - int numBytes; - const char *bytes = Tcl_GetStringFromObj(objv[idx], &numBytes); - if (numBytes == 0) { - description = "empty string"; - } else if (TclCheckBadOctal(NULL, bytes)) { - description = "invalid octal number"; - } else { - description = "non-numeric string"; - } - } else if (type1 == TCL_NUMBER_NAN) { - description = "non-numeric floating-point value"; - } else { - description = "floating-point value"; - } - - Tcl_SetObjResult(interp, - Tcl_ObjPrintf("can't use %s as operand of \"<<\"", description)); - return TCL_ERROR; } - + int -TclCompileLshiftOpCmd( +TclCompileModOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr) @@ -5000,179 +4742,50 @@ TclCompileLshiftOpCmd( CompileWord(envPtr, tokenPtr, interp); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp); - TclEmitOpcode(INST_LSHIFT, envPtr); + TclEmitOpcode(INST_MOD, envPtr); return TCL_OK; } int -TclRshiftOpCmd( - ClientData clientData, +TclCompileNeqOpCmd( Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) + Tcl_Parse *parsePtr, + CompileEnv *envPtr) { - ClientData ptr1, ptr2; - int invalid, shift, type1, type2, idx; - const char *description; - long l1; + Tcl_Token *tokenPtr; - if (objc != 3) { - Tcl_WrongNumArgs(interp, 1, objv, "value value"); + if (parsePtr->numWords != 3) { return TCL_ERROR; } + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitOpcode(INST_NEQ, envPtr); + return TCL_OK; +} + +int +TclCompileStrneqOpCmd( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + CompileEnv *envPtr) +{ + Tcl_Token *tokenPtr; - if ((TclGetNumberFromObj(NULL, objv[1], &ptr1, &type1) != TCL_OK) - || (type1 == TCL_NUMBER_DOUBLE) || (type1 == TCL_NUMBER_NAN)) { - idx = 1; - goto illegalOperand; - } - if ((TclGetNumberFromObj(NULL, objv[2], &ptr2, &type2) != TCL_OK) - || (type2 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_NAN)) { - idx = 2; - goto illegalOperand; - } - - /* reject negative shift argument */ - switch (type2) { - case TCL_NUMBER_LONG: - invalid = (*((const long *)ptr2) < (long)0); - break; -#ifndef NO_WIDE_TYPE - case TCL_NUMBER_WIDE: - invalid = (*((const Tcl_WideInt *)ptr2) < (Tcl_WideInt)0); - break; -#endif - case TCL_NUMBER_BIG: - /* TODO: const correctness ? */ - invalid = (mp_cmp_d((mp_int *)ptr2, 0) == MP_LT); - break; - default: - /* Unused, here to silence compiler warning */ - invalid = 0; - } - if (invalid) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("negative shift argument", -1)); + if (parsePtr->numWords != 3) { return TCL_ERROR; } - - /* Zero shifted any number of bits is still zero */ - if ((type1 == TCL_NUMBER_LONG) && (*((const long *)ptr1) == (long)0)) { - Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); - return TCL_OK; - } - - /* Quickly force large right shifts to 0 or -1 */ - if ((type2 != TCL_NUMBER_LONG) - || (*((const long *)ptr2) > INT_MAX)) { - /* - * Again, technically, the value to be shifted could be an mp_int so - * huge that a right shift by (INT_MAX+1) bits could not take us to - * the result of 0 or -1, but since we're using mp_div_2d to do the - * work, and it takes only an int argument, we draw the line there. - */ - - int zero; - - switch (type1) { - case TCL_NUMBER_LONG: - zero = (*((const long *)ptr1) > (long)0); - break; -#ifndef NO_WIDE_TYPE - case TCL_NUMBER_WIDE: - zero = (*((const Tcl_WideInt *)ptr1) > (Tcl_WideInt)0); - break; -#endif - case TCL_NUMBER_BIG: - /* TODO: const correctness ? */ - zero = (mp_cmp_d((mp_int *)ptr1, 0) == MP_GT); - break; - default: - /* Unused, here to silence compiler warning. */ - zero = 0; - } - Tcl_SetObjResult(interp, Tcl_NewIntObj(zero ? 0 : -1)); - return TCL_OK; - } - - shift = (int)(*((const long *)ptr2)); - /* Handle shifts within the native long range */ - if (type1 == TCL_NUMBER_LONG) { - l1 = *((const long *)ptr1); - if ((size_t)shift >= CHAR_BIT*sizeof(long)) { - Tcl_SetObjResult(interp, Tcl_NewIntObj(l1 >= (long)0 ? 0 : -1)); - } else { - Tcl_SetObjResult(interp, Tcl_NewIntObj(l1 >> shift)); - } - return TCL_OK; - } - -#ifndef NO_WIDE_TYPE - /* Handle shifts within the native wide range */ - if (type1 == TCL_NUMBER_WIDE) { - Tcl_WideInt w = *((const Tcl_WideInt *)ptr1); - if ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideInt)) { - Tcl_SetObjResult(interp, - Tcl_NewIntObj(w >= (Tcl_WideInt)0 ? 0 : -1)); - } else { - Tcl_SetObjResult(interp, Tcl_NewWideIntObj(w >> shift)); - } - return TCL_OK; - } -#endif - - { - mp_int big, bigResult, bigRemainder; - - if (Tcl_IsShared(objv[1])) { - Tcl_GetBignumFromObj(NULL, objv[1], &big); - } else { - Tcl_GetBignumAndClearObj(NULL, objv[1], &big); - } - - mp_init(&bigResult); - mp_init(&bigRemainder); - mp_div_2d(&big, shift, &bigResult, &bigRemainder); - if (mp_cmp_d(&bigRemainder, 0) == MP_LT) { - /* Convert to Tcl's integer division rules */ - mp_sub_d(&bigResult, 1, &bigResult); - } - mp_clear(&bigRemainder); - mp_clear(&big); - - if (!Tcl_IsShared(objv[1])) { - Tcl_SetBignumObj(objv[1], &bigResult); - Tcl_SetObjResult(interp, objv[1]); - } else { - Tcl_SetObjResult(interp, Tcl_NewBignumObj(&bigResult)); - } - } + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + TclEmitOpcode(INST_STR_NEQ, envPtr); return TCL_OK; - - illegalOperand: - if (TclGetNumberFromObj(NULL, objv[idx], &ptr1, &type1) != TCL_OK) { - int numBytes; - const char *bytes = Tcl_GetStringFromObj(objv[idx], &numBytes); - if (numBytes == 0) { - description = "empty string"; - } else if (TclCheckBadOctal(NULL, bytes)) { - description = "invalid octal number"; - } else { - description = "non-numeric string"; - } - } else if (type1 == TCL_NUMBER_NAN) { - description = "non-numeric floating-point value"; - } else { - description = "floating-point value"; - } - - Tcl_SetObjResult(interp, - Tcl_ObjPrintf("can't use %s as operand of \">>\"", description)); - return TCL_ERROR; } - + int -TclCompileRshiftOpCmd( +TclCompileInOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr) @@ -5186,419 +4799,20 @@ TclCompileRshiftOpCmd( CompileWord(envPtr, tokenPtr, interp); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp); - TclEmitOpcode(INST_RSHIFT, envPtr); + TclEmitOpcode(INST_LIST_IN, envPtr); return TCL_OK; } int -TclModOpCmd( - ClientData clientData, +TclCompileNiOpCmd( Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) + Tcl_Parse *parsePtr, + CompileEnv *envPtr) { - Tcl_Obj *argObj; - ClientData ptr1, ptr2; - int type1, type2; - long l1, l2 = 0; - const char *description; - - if (objc != 3) { - Tcl_WrongNumArgs(interp, 1, objv, "value value"); - return TCL_ERROR; - } + Tcl_Token *tokenPtr; - if ((TclGetNumberFromObj(NULL, objv[1], &ptr1, &type1) != TCL_OK) - || (type1 == TCL_NUMBER_DOUBLE) || (type1 == TCL_NUMBER_NAN)) { - argObj = objv[1]; - goto badArg; - } - if ((TclGetNumberFromObj(NULL, objv[2], &ptr2, &type2) != TCL_OK) - || (type2 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_NAN)) { - argObj = objv[2]; - goto badArg; - } - - if (type2 == TCL_NUMBER_LONG) { - l2 = *((CONST long *)ptr2); - if (l2 == 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", -1)); - Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", - NULL); - return TCL_ERROR; - } - if ((l2 == 1) || (l2 == -1)) { - Tcl_SetIntObj(Tcl_GetObjResult(interp), 0); - return TCL_OK; - } - } - if (type1 == TCL_NUMBER_LONG) { - l1 = *((CONST long *)ptr1); - if (l1 == 0) { - Tcl_SetIntObj(Tcl_GetObjResult(interp), 0); - return TCL_OK; - } - if (type2 == TCL_NUMBER_LONG) { - /* Both operands are long; do native calculation */ - long lRemainder, lQuotient = l1 / l2; - - /* Force Tcl's integer division rules */ - /* TODO: examine for logic simplification */ - if (((lQuotient < 0) || ((lQuotient == 0) && - ((l1 < 0 && l2 > 0) || (l1 > 0 && l2 < 0)))) && - ((lQuotient * l2) != l1)) { - lQuotient -= 1; - } - lRemainder = l1 - l2*lQuotient; - Tcl_SetLongObj(Tcl_GetObjResult(interp), lRemainder); - return TCL_OK; - } - /* - * First operand fits in long; second does not, so the second has - * greater magnitude than first. No need to divide to determine the - * remainder. - */ -#ifndef NO_WIDE_TYPE - if (type2 == TCL_NUMBER_WIDE) { - Tcl_WideInt w2 = *((CONST Tcl_WideInt *)ptr2); - - if ((l1 > 0) ^ (w2 > (Tcl_WideInt)0)) { - /* Arguments are opposite sign; remainder is sum */ - Tcl_SetObjResult(interp, - Tcl_NewWideIntObj(w2+(Tcl_WideInt)l1)); - return TCL_OK; - } - /* Arguments are same sign; remainder is first operand */ - Tcl_SetObjResult(interp, objv[1]); - return TCL_OK; - } -#endif - { - mp_int big2; - if (Tcl_IsShared(objv[2])) { - Tcl_GetBignumFromObj(NULL, objv[2], &big2); - } else { - Tcl_GetBignumAndClearObj(NULL, objv[2], &big2); - } - - /* TODO: internals intrusion */ - if ((l1 > 0) ^ (big2.sign == MP_ZPOS)) { - /* Arguments are opposite sign; remainder is sum */ - mp_int big1; - TclBNInitBignumFromLong(&big1, l1); - mp_add(&big2, &big1, &big2); - Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big2)); - } else { - /* Arguments are same sign; remainder is first operand */ - Tcl_SetObjResult(interp, objv[1]); - /* TODO: free big2? */ - } - } - return TCL_OK; - } -#ifndef NO_WIDE_TYPE - if (type1 == TCL_NUMBER_WIDE) { - Tcl_WideInt w1 = *((CONST Tcl_WideInt *)ptr1); - if (type2 != TCL_NUMBER_BIG) { - Tcl_WideInt w2, wQuotient, wRemainder; - - Tcl_GetWideIntFromObj(NULL, objv[2], &w2); - wQuotient = w1 / w2; - - /* Force Tcl's integer division rules */ - /* TODO: examine for logic simplification */ - if (((wQuotient < ((Tcl_WideInt) 0)) - || ((wQuotient == ((Tcl_WideInt) 0)) && ( - (w1 < ((Tcl_WideInt) 0) && w2 > ((Tcl_WideInt) 0)) - || (w1 > ((Tcl_WideInt) 0) && w2 < ((Tcl_WideInt) 0))) - )) && ((wQuotient * w2) != w1)) { - wQuotient -= (Tcl_WideInt) 1; - } - wRemainder = w1 - w2*wQuotient; - Tcl_SetObjResult(interp, Tcl_NewWideIntObj(wRemainder)); - } else { - mp_int big2; - if (Tcl_IsShared(objv[2])) { - Tcl_GetBignumFromObj(NULL, objv[2], &big2); - } else { - Tcl_GetBignumAndClearObj(NULL, objv[2], &big2); - } - - /* TODO: internals intrusion */ - if ((w1 > ((Tcl_WideInt) 0)) ^ (big2.sign == MP_ZPOS)) { - /* Arguments are opposite sign; remainder is sum */ - mp_int big1; - TclBNInitBignumFromWideInt(&big1, w1); - mp_add(&big2, &big1, &big2); - Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big2)); - } else { - /* Arguments are same sign; remainder is first operand */ - Tcl_SetObjResult(interp, objv[1]); - } - } - return TCL_OK; - } -#endif - { - mp_int big1, big2, bigResult, bigRemainder; - - Tcl_GetBignumFromObj(NULL, objv[1], &big1); - Tcl_GetBignumFromObj(NULL, objv[2], &big2); - mp_init(&bigResult); - mp_init(&bigRemainder); - mp_div(&big1, &big2, &bigResult, &bigRemainder); - if (!mp_iszero(&bigRemainder) && (bigRemainder.sign != big2.sign)) { - /* Convert to Tcl's integer division rules */ - mp_sub_d(&bigResult, 1, &bigResult); - mp_add(&bigRemainder, &big2, &bigRemainder); - } - mp_copy(&bigRemainder, &bigResult); - mp_clear(&bigRemainder); - mp_clear(&big1); - mp_clear(&big2); - if (Tcl_IsShared(objv[1])) { - Tcl_SetObjResult(interp, Tcl_NewBignumObj(&bigResult)); - } else { - Tcl_SetBignumObj(objv[1], &bigResult); - Tcl_SetObjResult(interp, objv[1]); - } - return TCL_OK; - } - - badArg: - if (TclGetNumberFromObj(NULL, argObj, &ptr1, &type1) != TCL_OK) { - int numBytes; - CONST char *bytes = Tcl_GetStringFromObj(argObj, &numBytes); - if (numBytes == 0) { - description = "empty string"; - } else if (TclCheckBadOctal(NULL, bytes)) { - description = "invalid octal number"; - } else { - description = "non-numeric string"; - } - } else if (type1 == TCL_NUMBER_NAN) { - description = "non-numeric floating-point value"; - } else { - description = "floating-point value"; - } - - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't use %s as operand of \"%%\"", description)); - return TCL_ERROR; -} - -int -TclCompileModOpCmd( - Tcl_Interp *interp, - Tcl_Parse *parsePtr, - CompileEnv *envPtr) -{ - Tcl_Token *tokenPtr; - - if (parsePtr->numWords != 3) { - return TCL_ERROR; - } - tokenPtr = TokenAfter(parsePtr->tokenPtr); - CompileWord(envPtr, tokenPtr, interp); - tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp); - TclEmitOpcode(INST_MOD, envPtr); - return TCL_OK; -} - -int -TclNeqOpCmd( - ClientData clientData, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - int result = 1, cmp, len1, len2; - const char *str1, *str2; - - if (objc != 3) { - Tcl_WrongNumArgs(interp, 1, objv, "value value"); - return TCL_ERROR; - } - - switch (CompareNumbers(NULL, objv[1], objv[2], &cmp)) { - case TCL_ERROR: - /* - * Got a string - */ - str1 = Tcl_GetStringFromObj(objv[1], &len1); - str2 = Tcl_GetStringFromObj(objv[2], &len2); - if (len1 == len2 && !strcmp(str1, str2)) { - result = 0; - } - case TCL_BREAK: /* Deliberate fallthrough */ - break; - case TCL_OK: - /* - * Got proper numbers - */ - if (cmp != MP_EQ) { - result = 0; - } - } - Tcl_SetBooleanObj(Tcl_GetObjResult(interp), result); - return TCL_OK; -} - -int -TclCompileNeqOpCmd( - Tcl_Interp *interp, - Tcl_Parse *parsePtr, - CompileEnv *envPtr) -{ - Tcl_Token *tokenPtr; - - if (parsePtr->numWords != 3) { - return TCL_ERROR; - } - tokenPtr = TokenAfter(parsePtr->tokenPtr); - CompileWord(envPtr, tokenPtr, interp); - tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp); - TclEmitOpcode(INST_NEQ, envPtr); - return TCL_OK; -} - -int -TclStrneqOpCmd( - ClientData clientData, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - const char *s1, *s2; - int s1len, s2len; - - if (objc != 3) { - Tcl_WrongNumArgs(interp, 1, objv, "value value"); - return TCL_ERROR; - } - - s1 = Tcl_GetStringFromObj(objv[1], &s1len); - s2 = Tcl_GetStringFromObj(objv[2], &s2len); - if (s1len == s2len && !strcmp(s1, s2)) { - Tcl_SetBooleanObj(Tcl_GetObjResult(interp), 0); - } else { - Tcl_SetBooleanObj(Tcl_GetObjResult(interp), 1); - } - return TCL_OK; -} - -int -TclCompileStrneqOpCmd( - Tcl_Interp *interp, - Tcl_Parse *parsePtr, - CompileEnv *envPtr) -{ - Tcl_Token *tokenPtr; - - if (parsePtr->numWords != 3) { - return TCL_ERROR; - } - tokenPtr = TokenAfter(parsePtr->tokenPtr); - CompileWord(envPtr, tokenPtr, interp); - tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp); - TclEmitOpcode(INST_STR_NEQ, envPtr); - return TCL_OK; -} - -int -TclInOpCmd( - ClientData clientData, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - const char *s1, *s2; - int s1len, s2len, i, len; - Tcl_Obj **listObj; - - if (objc != 3) { - Tcl_WrongNumArgs(interp, 1, objv, "value list"); - return TCL_ERROR; - } - - if (Tcl_ListObjGetElements(interp, objv[2], &len, &listObj) != TCL_OK) { - return TCL_ERROR; - } - s1 = Tcl_GetStringFromObj(objv[1], &s1len); - for (i=0 ; inumWords != 3) { - return TCL_ERROR; - } - tokenPtr = TokenAfter(parsePtr->tokenPtr); - CompileWord(envPtr, tokenPtr, interp); - tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp); - TclEmitOpcode(INST_LIST_IN, envPtr); - return TCL_OK; -} - -int -TclNiOpCmd( - ClientData clientData, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - const char *s1, *s2; - int s1len, s2len, i, len; - Tcl_Obj **listObj; - - if (objc != 3) { - Tcl_WrongNumArgs(interp, 1, objv, "value list"); - return TCL_ERROR; - } - - if (Tcl_ListObjGetElements(interp, objv[2], &len, &listObj) != TCL_OK) { - return TCL_ERROR; - } - s1 = Tcl_GetStringFromObj(objv[1], &s1len); - for (i=0 ; inumWords != 3) { - return TCL_ERROR; + if (parsePtr->numWords != 3) { + return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp); @@ -5609,57 +4823,6 @@ TclCompileNiOpCmd( } int -TclLessOpCmd( - ClientData clientData, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - int result = 1; - - if (objc > 2) { - int i, cmp, len1, len2; - const char *str1, *str2; - - for (i=1 ; i= 0) { - result = 0; - i = objc; - } - continue; - case TCL_OK: - /* - * Got proper numbers - */ - if (cmp != MP_LT) { - result = 0; - i = objc; - } - continue; - case TCL_BREAK: - /* - * Got a NaN (which is different from everything, including - * itself) - */ - result = 0; - i = objc; - continue; - } - } - } - Tcl_SetBooleanObj(Tcl_GetObjResult(interp), result); - return TCL_OK; -} - -int TclCompileLessOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, @@ -5709,57 +4872,6 @@ TclCompileLessOpCmd( } int -TclLeqOpCmd( - ClientData clientData, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - int result = 1; - - if (objc > 2) { - int i, cmp, len1, len2; - const char *str1, *str2; - - for (i=1 ; i 0) { - result = 0; - i = objc; - } - continue; - case TCL_OK: - /* - * Got proper numbers - */ - if (cmp == MP_GT) { - result = 0; - i = objc; - } - continue; - case TCL_BREAK: - /* - * Got a NaN (which is different from everything, including - * itself) - */ - result = 0; - i = objc; - continue; - } - } - } - Tcl_SetBooleanObj(Tcl_GetObjResult(interp), result); - return TCL_OK; -} - -int TclCompileLeqOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, @@ -5809,57 +4921,6 @@ TclCompileLeqOpCmd( } int -TclGreaterOpCmd( - ClientData clientData, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - int result = 1; - - if (objc > 2) { - int i, cmp, len1, len2; - const char *str1, *str2; - - for (i=1 ; i 2) { - int i, cmp, len1, len2; - const char *str1, *str2; - - for (i=1 ; i 2) { - int i, cmp, len1, len2; - const char *str1, *str2; - - for (i=1 ; i 2) { - int i, len1, len2; - const char *str1, *str2; - - for (i=1 ; i CHAR_BIT*sizeof(long)) - || (l1 == (long) d1) || (modf(d2, &tmp) != 0.0)) { - goto doubleCompare; - } - - /* - * Otherwise, to make comparision based on full precision, need to - * convert the double to a suitably sized integer. - * - * Need this to get comparsions like - * expr 20000000000000003 < 20000000000000004.0 - * right. Converting the first argument to double will yield two - * double values that are equivalent within double precision. - * Converting the double to an integer gets done exactly, then - * integer comparison can tell the difference. - */ - - if (d2 < (double)LONG_MIN) { - *resultPtr = MP_GT; - return TCL_OK; - } - if (d2 > (double)LONG_MAX) { - *resultPtr = MP_LT; - return TCL_OK; - } - l2 = (long) d2; - goto longCompare; - case TCL_NUMBER_BIG: - if (Tcl_IsShared(numObj2)) { - Tcl_GetBignumFromObj(NULL, numObj2, &big2); - } else { - Tcl_GetBignumAndClearObj(NULL, numObj2, &big2); - } - if (mp_cmp_d(&big2, 0) == MP_LT) { - *resultPtr = MP_GT; - } else { - *resultPtr = MP_LT; - } - mp_clear(&big2); - } - return TCL_OK; - -#ifndef NO_WIDE_TYPE - case TCL_NUMBER_WIDE: - w1 = *((CONST Tcl_WideInt *)ptr1); - switch (type2) { - case TCL_NUMBER_WIDE: - w2 = *((CONST Tcl_WideInt *)ptr2); - goto wideCompare; - case TCL_NUMBER_LONG: - l2 = *((CONST long *)ptr2); - w2 = (Tcl_WideInt)l2; - goto wideCompare; - case TCL_NUMBER_DOUBLE: - d2 = *((CONST double *)ptr2); - d1 = (double) w1; - if ((DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt)) - || (w1 == (Tcl_WideInt) d1) || (modf(d2, &tmp) != 0.0)) { - goto doubleCompare; - } - if (d2 < (double)LLONG_MIN) { - *resultPtr = MP_GT; - return TCL_OK; - } - if (d2 > (double)LLONG_MAX) { - *resultPtr = MP_LT; - return TCL_OK; - } - w2 = (Tcl_WideInt) d2; - goto wideCompare; - case TCL_NUMBER_BIG: - if (Tcl_IsShared(numObj2)) { - Tcl_GetBignumFromObj(NULL, numObj2, &big2); - } else { - Tcl_GetBignumAndClearObj(NULL, numObj2, &big2); - } - if (mp_cmp_d(&big2, 0) == MP_LT) { - *resultPtr = MP_GT; - } else { - *resultPtr = MP_LT; - } - mp_clear(&big2); - } - return TCL_OK; -#endif - - case TCL_NUMBER_DOUBLE: - d1 = *((CONST double *)ptr1); - switch (type2) { - case TCL_NUMBER_DOUBLE: - d2 = *((CONST double *)ptr2); - goto doubleCompare; - case TCL_NUMBER_LONG: - l2 = *((CONST long *)ptr2); - d2 = (double) l2; - - if ((DBL_MANT_DIG > CHAR_BIT*sizeof(long)) - || (l2 == (long) d2) || (modf(d1, &tmp) != 0.0)) { - goto doubleCompare; - } - if (d1 < (double)LONG_MIN) { - *resultPtr = MP_LT; - return TCL_OK; - } - if (d1 > (double)LONG_MAX) { - *resultPtr = MP_GT; - return TCL_OK; - } - l1 = (long) d1; - goto longCompare; -#ifndef NO_WIDE_TYPE - case TCL_NUMBER_WIDE: - w2 = *((CONST Tcl_WideInt *)ptr2); - d2 = (double) w2; - if ((DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt)) - || (w2 == (Tcl_WideInt) d2) || (modf(d1, &tmp) != 0.0)) { - goto doubleCompare; - } - if (d1 < (double)LLONG_MIN) { - *resultPtr = MP_LT; - return TCL_OK; - } - if (d1 > (double)LLONG_MAX) { - *resultPtr = MP_GT; - return TCL_OK; - } - w1 = (Tcl_WideInt) d1; - goto wideCompare; -#endif - case TCL_NUMBER_BIG: - if (TclIsInfinite(d1)) { - *resultPtr = (d1 > 0.0) ? MP_GT : MP_LT; - return TCL_OK; - } - if (Tcl_IsShared(numObj2)) { - Tcl_GetBignumFromObj(NULL, numObj2, &big2); - } else { - Tcl_GetBignumAndClearObj(NULL, numObj2, &big2); - } - if ((d1 < (double)LONG_MAX) && (d1 > (double)LONG_MIN)) { - if (mp_cmp_d(&big2, 0) == MP_LT) { - *resultPtr = MP_GT; - } else { - *resultPtr = MP_LT; - } - mp_clear(&big2); - return TCL_OK; - } - if ((DBL_MANT_DIG > CHAR_BIT*sizeof(long)) - && (modf(d1, &tmp) != 0.0)) { - d2 = TclBignumToDouble(&big2); - mp_clear(&big2); - goto doubleCompare; - } - Tcl_InitBignumFromDouble(NULL, d1, &big1); - goto bigCompare; - } - return TCL_OK; - - case TCL_NUMBER_BIG: - if (Tcl_IsShared(numObj1)) { - Tcl_GetBignumFromObj(NULL, numObj1, &big1); - } else { - Tcl_GetBignumAndClearObj(NULL, numObj1, &big1); - } - switch (type2) { -#ifndef NO_WIDE_TYPE - case TCL_NUMBER_WIDE: -#endif - case TCL_NUMBER_LONG: - *resultPtr = mp_cmp_d(&big1, 0); - mp_clear(&big1); - return TCL_OK; - case TCL_NUMBER_DOUBLE: - d2 = *((CONST double *)ptr2); - if (TclIsInfinite(d2)) { - *resultPtr = (d2 > 0.0) ? MP_LT : MP_GT; - mp_clear(&big1); - return TCL_OK; - } - if ((d2 < (double)LONG_MAX) && (d2 > (double)LONG_MIN)) { - *resultPtr = mp_cmp_d(&big1, 0); - mp_clear(&big1); - return TCL_OK; - } - if ((DBL_MANT_DIG > CHAR_BIT*sizeof(long)) - && (modf(d2, &tmp) != 0.0)) { - d1 = TclBignumToDouble(&big1); - mp_clear(&big1); - goto doubleCompare; - } - Tcl_InitBignumFromDouble(NULL, d2, &big2); - goto bigCompare; - case TCL_NUMBER_BIG: - if (Tcl_IsShared(numObj2)) { - Tcl_GetBignumFromObj(NULL, numObj2, &big2); - } else { - Tcl_GetBignumAndClearObj(NULL, numObj2, &big2); - } - goto bigCompare; - } - } - - /* - * Should really be impossible to get here - */ - - return TCL_OK; - - /* - * The real core comparison rules. - */ - - longCompare: - *resultPtr = (l1 < l2) ? MP_LT : ((l1 > l2) ? MP_GT : MP_EQ); - return TCL_OK; -#ifndef NO_WIDE_TYPE - wideCompare: - *resultPtr = (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ); - return TCL_OK; -#endif - doubleCompare: - *resultPtr = (d1 < d2) ? MP_LT : ((d1 > d2) ? MP_GT : MP_EQ); - return TCL_OK; - bigCompare: - *resultPtr = mp_cmp(&big1, &big2); - mp_clear(&big1); - mp_clear(&big2); - return TCL_OK; -} - /* * Local Variables: * mode: c diff --git a/generic/tclMathOp.c b/generic/tclMathOp.c new file mode 100644 index 0000000..8836da5 --- /dev/null +++ b/generic/tclMathOp.c @@ -0,0 +1,2870 @@ +/* + * tclMathOp.c -- + * + * This file contains normal command versions of the contents of the + * tcl::mathop namespace. + * + * Copyright (c) 2006 by Donal K. Fellows. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tclMathOp.c,v 1.1 2006/11/25 17:18:10 dkf Exp $ + */ + +#include "tclInt.h" +#include "tclCompile.h" +#include "tommath.h" +#include +#include + +/* + * 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 + * and range, but VAX, IBM, and Cray do not; are there any other floating + * point units that we might care about? + */ + +#if (FLT_RADIX == 2) && (DBL_MANT_DIG == 53) && (DBL_MAX_EXP == 1024) +#define IEEE_FLOATING_POINT +#endif + +/* + * The stuff below is a bit of a hack so that this file can be used in + * environments that include no UNIX. + * TODO: Does this serve any purpose anymore? + */ + +#ifdef TCL_GENERIC_ONLY +# ifndef NO_FLOAT_H +# include +# else /* NO_FLOAT_H */ +# ifndef NO_VALUES_H +# include +# endif /* !NO_VALUES_H */ +# endif /* !NO_FLOAT_H */ +#endif /* !TCL_GENERIC_ONLY */ + +/* + * Prototypes for helper functions defined in this file: + */ + +static Tcl_Obj * CombineIntFloat(Tcl_Interp *interp, Tcl_Obj *valuePtr, + int opcode, Tcl_Obj *value2Ptr); +static Tcl_Obj * CombineIntOnly(Tcl_Interp *interp, Tcl_Obj *valuePtr, + int opcode, Tcl_Obj *value2Ptr); +static int CompareNumbers(Tcl_Interp *interp, Tcl_Obj *numObj1, + Tcl_Obj *numObj2, int *resultPtr); + +/* + *---------------------------------------------------------------------- + * + * CombineIntFloat -- + * + * Parses and combines two numbers (either entier() or double()) + * according to the specified operation. + * + * Results: + * Returns the resulting number object (or NULL on failure). + * + * Side effects: + * None. + * + * Notes: + * This code originally extracted from tclExecute.c. + * + *---------------------------------------------------------------------- + */ + +static Tcl_Obj * +CombineIntFloat( + Tcl_Interp *interp, /* Place to write error messages. */ + Tcl_Obj *valuePtr, /* First value to combine. */ + int opcode, /* Operation to use to combine the + * values. Must be one of INST_ADD, INST_SUB, + * INST_MULT, INST_DIV or INST_EXPON. */ + Tcl_Obj *value2Ptr) /* Second value to combine. */ +{ + ClientData ptr1, ptr2; + int type1, type2; + Tcl_Obj *errPtr; + + if ((TclGetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) +#ifndef ACCEPT_NAN + || (type1 == TCL_NUMBER_NAN) +#endif + ) { + errPtr = valuePtr; + goto illegalOperand; + } + +#ifdef ACCEPT_NAN + if (type1 == TCL_NUMBER_NAN) { + /* NaN first argument -> result is also NaN */ + NEXT_INST_F(1, 1, 0); + } +#endif + + if ((TclGetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK) +#ifndef ACCEPT_NAN + || (type2 == TCL_NUMBER_NAN) +#endif + ) { + errPtr = value2Ptr; + goto illegalOperand; + } + +#ifdef ACCEPT_NAN + if (type2 == TCL_NUMBER_NAN) { + /* NaN second argument -> result is also NaN */ + return value2Ptr; + NEXT_INST_F(1, 2, 1); + } +#endif + + if ((type1 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_DOUBLE)) { + /* + * At least one of the values is floating-point, so perform floating + * point calculations. + */ + + double d1, d2, dResult; + Tcl_GetDoubleFromObj(NULL, valuePtr, &d1); + Tcl_GetDoubleFromObj(NULL, value2Ptr, &d2); + + switch (opcode) { + case INST_ADD: + dResult = d1 + d2; + break; + case INST_SUB: + dResult = d1 - d2; + break; + case INST_MULT: + dResult = d1 * d2; + break; + case INST_DIV: +#ifndef IEEE_FLOATING_POINT + if (d2 == 0.0) { + goto divideByZero; + } +#endif + /* + * We presume that we are running with zero-divide unmasked if + * we're on an IEEE box. Otherwise, this statement might cause + * demons to fly out our noses. + */ + + dResult = d1 / d2; + break; + case INST_EXPON: + if (d1==0.0 && d2<0.0) { + goto exponOfZero; + } + dResult = pow(d1, d2); + break; + default: + /* Unused, here to silence compiler warning. */ + dResult = 0; + } + +#ifndef ACCEPT_NAN + /* + * Check now for IEEE floating-point error. + */ + + if (TclIsNaN(dResult)) { + TclExprFloatError(interp, dResult); + return NULL; + } +#endif + if (Tcl_IsShared(valuePtr)) { + return Tcl_NewDoubleObj(dResult); + } + Tcl_SetDoubleObj(valuePtr, dResult); + return valuePtr; + } + + if ((sizeof(long) >= 2*sizeof(int)) && (opcode == INST_MULT) + && (type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) { + long l1 = *((CONST long *)ptr1); + long l2 = *((CONST long *)ptr2); + if ((l1 <= INT_MAX) && (l1 >= INT_MIN) + && (l2 <= INT_MAX) && (l2 >= INT_MIN)) { + long lResult = l1 * l2; + + if (Tcl_IsShared(valuePtr)) { + return Tcl_NewLongObj(lResult); + } + Tcl_SetLongObj(valuePtr, lResult); + return valuePtr; + } + } + + if ((sizeof(Tcl_WideInt) >= 2*sizeof(long)) && (opcode == INST_MULT) + && (type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) { + Tcl_WideInt w1, w2, wResult; + Tcl_GetWideIntFromObj(NULL, valuePtr, &w1); + Tcl_GetWideIntFromObj(NULL, value2Ptr, &w2); + + wResult = w1 * w2; + + if (Tcl_IsShared(valuePtr)) { + return Tcl_NewWideIntObj(wResult); + } + Tcl_SetWideIntObj(valuePtr, wResult); + return valuePtr; + } + + /* TODO: Attempts to re-use unshared operands on stack */ + if (opcode == INST_EXPON) { + long l1, l2 = 0; + int oddExponent = 0, negativeExponent = 0; + if (type2 == TCL_NUMBER_LONG) { + l2 = *((CONST long *)ptr2); + if (l2 == 0) { + /* Anything to the zero power is 1 */ + return Tcl_NewIntObj(1); + } + } + switch (type2) { + case TCL_NUMBER_LONG: { + negativeExponent = (l2 < 0); + oddExponent = (int) (l2 & 1); + break; + } +#ifndef NO_WIDE_TYPE + case TCL_NUMBER_WIDE: { + Tcl_WideInt w2 = *((CONST Tcl_WideInt *)ptr2); + negativeExponent = (w2 < 0); + oddExponent = (int) (w2 & (Tcl_WideInt)1); + break; + } +#endif + case TCL_NUMBER_BIG: { + mp_int big2; + if (Tcl_IsShared(value2Ptr)) { + Tcl_GetBignumFromObj(NULL, value2Ptr, &big2); + } else { + Tcl_GetBignumAndClearObj(NULL, value2Ptr, &big2); + } + negativeExponent = (mp_cmp_d(&big2, 0) == MP_LT); + mp_mod_2d(&big2, 1, &big2); + oddExponent = !mp_iszero(&big2); + mp_clear(&big2); + break; + } + } + + if (negativeExponent) { + if (type1 == TCL_NUMBER_LONG) { + l1 = *((CONST long *)ptr1); + switch (l1) { + case 0: + /* zero to a negative power is div by zero error */ + goto exponOfZero; + case -1: + if (oddExponent) { + return Tcl_NewIntObj(-1); + } else { + return Tcl_NewIntObj(1); + } + case 1: + /* 1 to any power is 1 */ + return Tcl_NewIntObj(1); + } + } + /* + * Integers with magnitude greater than 1 raise to a negative + * power yield the answer zero (see TIP 123) + */ + return Tcl_NewIntObj(0); + } + + if (type1 == TCL_NUMBER_LONG) { + l1 = *((CONST long *)ptr1); + switch (l1) { + case 0: + /* zero to a positive power is zero */ + return Tcl_NewIntObj(0); + case 1: + /* 1 to any power is 1 */ + return Tcl_NewIntObj(1); + case -1: + if (oddExponent) { + return Tcl_NewIntObj(-1); + } else { + return Tcl_NewIntObj(1); + } + } + } + if (type2 == TCL_NUMBER_BIG) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("exponent too large", -1)); + return NULL; + } + /* TODO: Perform those computations that fit in native types */ + goto overflow; + } + + if ((opcode != INST_MULT) + && (type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) { + Tcl_WideInt w1, w2, wResult; + Tcl_GetWideIntFromObj(NULL, valuePtr, &w1); + Tcl_GetWideIntFromObj(NULL, value2Ptr, &w2); + + switch (opcode) { + case INST_ADD: + wResult = w1 + w2; +#ifndef NO_WIDE_TYPE + if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) +#endif + { + /* Check for overflow */ + if (((w1 < 0) && (w2 < 0) && (wResult > 0)) + || ((w1 > 0) && (w2 > 0) && (wResult < 0))) { + goto overflow; + } + } + break; + + case INST_SUB: + wResult = w1 - w2; +#ifndef NO_WIDE_TYPE + if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) +#endif + { + /* Must check for overflow */ + if (((w1 < 0) && (w2 > 0) && (wResult > 0)) + || ((w1 > 0) && (w2 < 0) && (wResult < 0))) { + goto overflow; + } + } + break; + + case INST_DIV: + if (w2 == 0) { + goto divideByZero; + } + + /* Need a bignum to represent (LLONG_MIN / -1) */ + if ((w1 == LLONG_MIN) && (w2 == -1)) { + goto overflow; + } + wResult = w1 / w2; + + /* Force Tcl's integer division rules */ + /* TODO: examine for logic simplification */ + if (((wResult < 0) || ((wResult == 0) && + ((w1 < 0 && w2 > 0) || (w1 > 0 && w2 < 0)))) && + ((wResult * w2) != w1)) { + wResult -= 1; + } + break; + default: + /* Unused, here to silence compiler warning. */ + wResult = 0; + } + + if (Tcl_IsShared(valuePtr)) { + return Tcl_NewWideIntObj(wResult); + } + Tcl_SetWideIntObj(valuePtr, wResult); + return valuePtr; + } + + overflow: + { + mp_int big1, big2, bigResult, bigRemainder; + if (Tcl_IsShared(valuePtr)) { + Tcl_GetBignumFromObj(NULL, valuePtr, &big1); + } else { + Tcl_GetBignumAndClearObj(NULL, valuePtr, &big1); + } + if (Tcl_IsShared(value2Ptr)) { + Tcl_GetBignumFromObj(NULL, value2Ptr, &big2); + } else { + Tcl_GetBignumAndClearObj(NULL, value2Ptr, &big2); + } + mp_init(&bigResult); + switch (opcode) { + case INST_ADD: + mp_add(&big1, &big2, &bigResult); + break; + case INST_SUB: + mp_sub(&big1, &big2, &bigResult); + break; + case INST_MULT: + mp_mul(&big1, &big2, &bigResult); + break; + case INST_DIV: + if (mp_iszero(&big2)) { + mp_clear(&big1); + mp_clear(&big2); + goto divideByZero; + } + mp_init(&bigRemainder); + mp_div(&big1, &big2, &bigResult, &bigRemainder); + /* TODO: internals intrusion */ + if (!mp_iszero(&bigRemainder) + && (bigRemainder.sign != big2.sign)) { + /* Convert to Tcl's integer division rules */ + mp_sub_d(&bigResult, 1, &bigResult); + mp_add(&bigRemainder, &big2, &bigRemainder); + } + mp_clear(&bigRemainder); + break; + case INST_EXPON: + if (big2.used > 1) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("exponent too large", -1)); + mp_clear(&big1); + mp_clear(&big2); + return NULL; + } + mp_expt_d(&big1, big2.dp[0], &bigResult); + break; + } + mp_clear(&big1); + mp_clear(&big2); + if (Tcl_IsShared(valuePtr)) { + return Tcl_NewBignumObj(&bigResult); + } + Tcl_SetBignumObj(valuePtr, &bigResult); + return valuePtr; + } + + { + const char *description, *operator; + + illegalOperand: + switch (opcode) { + case INST_ADD: operator = "+"; break; + case INST_SUB: operator = "-"; break; + case INST_MULT: operator = "*"; break; + case INST_DIV: operator = "/"; break; + case INST_EXPON: operator = "**"; break; + default: + operator = "???"; + } + + if (TclGetNumberFromObj(NULL, errPtr, &ptr1, &type1) != TCL_OK) { + int numBytes; + CONST char *bytes = Tcl_GetStringFromObj(errPtr, &numBytes); + if (numBytes == 0) { + description = "empty string"; + } else if (TclCheckBadOctal(NULL, bytes)) { + description = "invalid octal number"; + } else { + description = "non-numeric string"; + } + } else if (type1 == TCL_NUMBER_NAN) { + description = "non-numeric floating-point value"; + } else if (type1 == TCL_NUMBER_DOUBLE) { + description = "floating-point value"; + } else { + /* TODO: No caller needs this. Eliminate? */ + description = "(big) integer"; + } + + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use %s as operand of \"%s\"", description, operator)); + return NULL; + } + + divideByZero: + Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", -1)); + Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL); + return NULL; + + exponOfZero: + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "exponentiation of zero by negative power", -1)); + Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", + "exponentiation of zero by negative power", NULL); + return NULL; +} + +/* + *---------------------------------------------------------------------- + * + * CombineIntOnly -- + * + * Parses and combines two numbers (must be entier()) according to the + * specified operation. + * + * Results: + * Returns the resulting number object (or NULL on failure). + * + * Side effects: + * None. + * + * Notes: + * This code originally extracted from tclExecute.c. + * + *---------------------------------------------------------------------- + */ + +static Tcl_Obj * +CombineIntOnly( + Tcl_Interp *interp, /* Place to write error messages. */ + Tcl_Obj *valuePtr, /* First value to combine. */ + int opcode, /* Operation to use to combine the + * values. Must be one of INST_BITAND, + * INST_BITOR or INST_BITXOR. */ + Tcl_Obj *value2Ptr) /* Second value to combine. */ +{ + ClientData ptr1, ptr2; + int type1, type2; + Tcl_Obj *errPtr; + + if ((TclGetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) + || (type1 == TCL_NUMBER_NAN) || (type1 == TCL_NUMBER_DOUBLE)) { + errPtr = valuePtr; + goto illegalOperand; + } + if ((TclGetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK) + || (type2 == TCL_NUMBER_NAN) || (type2 == TCL_NUMBER_DOUBLE)) { + errPtr = value2Ptr; + goto illegalOperand; + } + + if ((type1 == TCL_NUMBER_BIG) || (type2 == TCL_NUMBER_BIG)) { + mp_int big1, big2, bigResult; + mp_int *First, *Second; + int numPos; + + if (Tcl_IsShared(valuePtr)) { + Tcl_GetBignumFromObj(NULL, valuePtr, &big1); + } else { + Tcl_GetBignumAndClearObj(NULL, valuePtr, &big1); + } + if (Tcl_IsShared(value2Ptr)) { + Tcl_GetBignumFromObj(NULL, value2Ptr, &big2); + } else { + Tcl_GetBignumAndClearObj(NULL, value2Ptr, &big2); + } + + /* + * Count how many positive arguments we have. If only one of the + * arguments is negative, store it in 'Second'. + */ + + if (mp_cmp_d(&big1, 0) != MP_LT) { + numPos = 1 + (mp_cmp_d(&big2, 0) != MP_LT); + First = &big1; + Second = &big2; + } else { + First = &big2; + Second = &big1; + numPos = (mp_cmp_d(First, 0) != MP_LT); + } + mp_init(&bigResult); + + switch (opcode) { + case INST_BITAND: + switch (numPos) { + case 2: + /* Both arguments positive, base case */ + mp_and(First, Second, &bigResult); + break; + case 1: + /* First is positive; Second negative + * P & N = P & ~~N = P&~(-N-1) = P & (P ^ (-N-1)) */ + mp_neg(Second, Second); + mp_sub_d(Second, 1, Second); + mp_xor(First, Second, &bigResult); + mp_and(First, &bigResult, &bigResult); + break; + case 0: + /* Both arguments negative + * a & b = ~ (~a | ~b) = -(-a-1|-b-1)-1 */ + mp_neg(First, First); + mp_sub_d(First, 1, First); + mp_neg(Second, Second); + mp_sub_d(Second, 1, Second); + mp_or(First, Second, &bigResult); + mp_neg(&bigResult, &bigResult); + mp_sub_d(&bigResult, 1, &bigResult); + break; + } + break; + + case INST_BITOR: + switch (numPos) { + case 2: + /* Both arguments positive, base case */ + mp_or(First, Second, &bigResult); + break; + case 1: + /* First is positive; Second negative + * N|P = ~(~N&~P) = ~((-N-1)&~P) = -((-N-1)&((-N-1)^P))-1 */ + mp_neg(Second, Second); + mp_sub_d(Second, 1, Second); + mp_xor(First, Second, &bigResult); + mp_and(Second, &bigResult, &bigResult); + mp_neg(&bigResult, &bigResult); + mp_sub_d(&bigResult, 1, &bigResult); + break; + case 0: + /* Both arguments negative + * a | b = ~ (~a & ~b) = -(-a-1&-b-1)-1 */ + mp_neg(First, First); + mp_sub_d(First, 1, First); + mp_neg(Second, Second); + mp_sub_d(Second, 1, Second); + mp_and(First, Second, &bigResult); + mp_neg(&bigResult, &bigResult); + mp_sub_d(&bigResult, 1, &bigResult); + break; + } + break; + + case INST_BITXOR: + switch (numPos) { + case 2: + /* Both arguments positive, base case */ + mp_xor(First, Second, &bigResult); + break; + case 1: + /* First is positive; Second negative + * P^N = ~(P^~N) = -(P^(-N-1))-1 */ + mp_neg(Second, Second); + mp_sub_d(Second, 1, Second); + mp_xor(First, Second, &bigResult); + mp_neg(&bigResult, &bigResult); + mp_sub_d(&bigResult, 1, &bigResult); + break; + case 0: + /* Both arguments negative + * a ^ b = (~a ^ ~b) = (-a-1^-b-1) */ + mp_neg(First, First); + mp_sub_d(First, 1, First); + mp_neg(Second, Second); + mp_sub_d(Second, 1, Second); + mp_xor(First, Second, &bigResult); + break; + } + break; + } + + mp_clear(&big1); + mp_clear(&big2); + if (Tcl_IsShared(valuePtr)) { + return Tcl_NewBignumObj(&bigResult); + } + Tcl_SetBignumObj(valuePtr, &bigResult); + return valuePtr; + } +#ifndef NO_WIDE_TYPE + else if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) { + Tcl_WideInt wResult, w1, w2; + Tcl_GetWideIntFromObj(NULL, valuePtr, &w1); + Tcl_GetWideIntFromObj(NULL, value2Ptr, &w2); + + switch (opcode) { + case INST_BITAND: + wResult = w1 & w2; + break; + case INST_BITOR: + wResult = w1 | w2; + break; + case INST_BITXOR: + wResult = w1 ^ w2; + break; + default: + /* Unused, here to silence compiler warning. */ + wResult = 0; + } + + if (Tcl_IsShared(valuePtr)) { + return Tcl_NewWideIntObj(wResult); + } + Tcl_SetWideIntObj(valuePtr, wResult); + return valuePtr; + } +#endif + else { + long lResult, l1 = *((const long *)ptr1); + long l2 = *((const long *)ptr2); + + switch (opcode) { + case INST_BITAND: + lResult = l1 & l2; + break; + case INST_BITOR: + lResult = l1 | l2; + break; + case INST_BITXOR: + lResult = l1 ^ l2; + break; + default: + /* Unused, here to silence compiler warning. */ + lResult = 0; + } + + if (Tcl_IsShared(valuePtr)) { + return Tcl_NewLongObj(lResult); + } + TclSetLongObj(valuePtr, lResult); + return valuePtr; + } + + { + const char *description, *operator; + + illegalOperand: + switch (opcode) { + case INST_BITAND: operator = "&"; break; + case INST_BITOR: operator = "|"; break; + case INST_BITXOR: operator = "^"; break; + default: + operator = "???"; + } + + if (TclGetNumberFromObj(NULL, errPtr, &ptr1, &type1) != TCL_OK) { + int numBytes; + CONST char *bytes = Tcl_GetStringFromObj(errPtr, &numBytes); + if (numBytes == 0) { + description = "empty string"; + } else if (TclCheckBadOctal(NULL, bytes)) { + description = "invalid octal number"; + } else { + description = "non-numeric string"; + } + } else if (type1 == TCL_NUMBER_NAN) { + description = "non-numeric floating-point value"; + } else if (type1 == TCL_NUMBER_DOUBLE) { + description = "floating-point value"; + } else { + /* TODO: No caller needs this. Eliminate? */ + description = "(big) integer"; + } + + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use %s as operand of \"%s\"", description, operator)); + return NULL; + } +} + +/* + *---------------------------------------------------------------------- + * + * CompareNumbers -- + * + * Parses and compares two numbers (may be either entier() or double()). + * + * Results: + * TCL_OK if the numbers parse correctly, TCL_ERROR if one is not numeric + * at all, and TCL_BREAK if one or the other is "NaN". The resultPtr + * argument is used to update a variable with how the numbers relate to + * each other in the TCL_OK case. + * + * Side effects: + * None. + * + * Notes: + * This code originally extracted from tclExecute.c. + * + *---------------------------------------------------------------------- + */ + +static int +CompareNumbers( + Tcl_Interp *interp, /* Where to write error messages if any. */ + Tcl_Obj *numObj1, /* First number to compare. */ + Tcl_Obj *numObj2, /* Second number to compare. */ + int *resultPtr) /* Pointer to a variable to write the outcome + * of the comparison into. Must not be + * NULL. */ +{ + ClientData ptr1, ptr2; + int type1, type2; + double d1, d2, tmp; + long l1, l2; + mp_int big1, big2; +#ifndef NO_WIDE_TYPE + Tcl_WideInt w1, w2; +#endif + + if (TclGetNumberFromObj(interp, numObj1, &ptr1, &type1) != TCL_OK) { + return TCL_ERROR; + } + if (TclGetNumberFromObj(interp, numObj2, &ptr2, &type2) != TCL_OK) { + return TCL_ERROR; + } + + /* + * Selected special cases. NaNs are not equal to *everything*, otherwise + * objects are equal to themselves. + */ + + if (type1 == TCL_NUMBER_NAN) { + /* NaN first arg: NaN != to everything, other compares are false */ + return TCL_BREAK; + } + if (numObj1 == numObj2) { + *resultPtr = MP_EQ; + return TCL_OK; + } + if (type2 == TCL_NUMBER_NAN) { + /* NaN 2nd arg: NaN != to everything, other compares are false */ + return TCL_BREAK; + } + + /* + * Big switch to pick apart the type rules and choose how to compare the + * two numbers. Also handles a few special cases along the way. + */ + + switch (type1) { + case TCL_NUMBER_LONG: + l1 = *((CONST long *)ptr1); + switch (type2) { + case TCL_NUMBER_LONG: + l2 = *((CONST long *)ptr2); + goto longCompare; +#ifndef NO_WIDE_TYPE + case TCL_NUMBER_WIDE: + w2 = *((CONST Tcl_WideInt *)ptr2); + w1 = (Tcl_WideInt)l1; + goto wideCompare; +#endif + case TCL_NUMBER_DOUBLE: + d2 = *((CONST double *)ptr2); + d1 = (double) l1; + + /* + * If the double has a fractional part, or if the long can be + * converted to double without loss of precision, then compare as + * doubles. + */ + + if ((DBL_MANT_DIG > CHAR_BIT*sizeof(long)) + || (l1 == (long) d1) || (modf(d2, &tmp) != 0.0)) { + goto doubleCompare; + } + + /* + * Otherwise, to make comparision based on full precision, need to + * convert the double to a suitably sized integer. + * + * Need this to get comparsions like + * expr 20000000000000003 < 20000000000000004.0 + * right. Converting the first argument to double will yield two + * double values that are equivalent within double precision. + * Converting the double to an integer gets done exactly, then + * integer comparison can tell the difference. + */ + + if (d2 < (double)LONG_MIN) { + *resultPtr = MP_GT; + return TCL_OK; + } + if (d2 > (double)LONG_MAX) { + *resultPtr = MP_LT; + return TCL_OK; + } + l2 = (long) d2; + goto longCompare; + case TCL_NUMBER_BIG: + if (Tcl_IsShared(numObj2)) { + Tcl_GetBignumFromObj(NULL, numObj2, &big2); + } else { + Tcl_GetBignumAndClearObj(NULL, numObj2, &big2); + } + if (mp_cmp_d(&big2, 0) == MP_LT) { + *resultPtr = MP_GT; + } else { + *resultPtr = MP_LT; + } + mp_clear(&big2); + } + return TCL_OK; + +#ifndef NO_WIDE_TYPE + case TCL_NUMBER_WIDE: + w1 = *((CONST Tcl_WideInt *)ptr1); + switch (type2) { + case TCL_NUMBER_WIDE: + w2 = *((CONST Tcl_WideInt *)ptr2); + goto wideCompare; + case TCL_NUMBER_LONG: + l2 = *((CONST long *)ptr2); + w2 = (Tcl_WideInt)l2; + goto wideCompare; + case TCL_NUMBER_DOUBLE: + d2 = *((CONST double *)ptr2); + d1 = (double) w1; + if ((DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt)) + || (w1 == (Tcl_WideInt) d1) || (modf(d2, &tmp) != 0.0)) { + goto doubleCompare; + } + if (d2 < (double)LLONG_MIN) { + *resultPtr = MP_GT; + return TCL_OK; + } + if (d2 > (double)LLONG_MAX) { + *resultPtr = MP_LT; + return TCL_OK; + } + w2 = (Tcl_WideInt) d2; + goto wideCompare; + case TCL_NUMBER_BIG: + if (Tcl_IsShared(numObj2)) { + Tcl_GetBignumFromObj(NULL, numObj2, &big2); + } else { + Tcl_GetBignumAndClearObj(NULL, numObj2, &big2); + } + if (mp_cmp_d(&big2, 0) == MP_LT) { + *resultPtr = MP_GT; + } else { + *resultPtr = MP_LT; + } + mp_clear(&big2); + } + return TCL_OK; +#endif + + case TCL_NUMBER_DOUBLE: + d1 = *((CONST double *)ptr1); + switch (type2) { + case TCL_NUMBER_DOUBLE: + d2 = *((CONST double *)ptr2); + goto doubleCompare; + case TCL_NUMBER_LONG: + l2 = *((CONST long *)ptr2); + d2 = (double) l2; + + if ((DBL_MANT_DIG > CHAR_BIT*sizeof(long)) + || (l2 == (long) d2) || (modf(d1, &tmp) != 0.0)) { + goto doubleCompare; + } + if (d1 < (double)LONG_MIN) { + *resultPtr = MP_LT; + return TCL_OK; + } + if (d1 > (double)LONG_MAX) { + *resultPtr = MP_GT; + return TCL_OK; + } + l1 = (long) d1; + goto longCompare; +#ifndef NO_WIDE_TYPE + case TCL_NUMBER_WIDE: + w2 = *((CONST Tcl_WideInt *)ptr2); + d2 = (double) w2; + if ((DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt)) + || (w2 == (Tcl_WideInt) d2) || (modf(d1, &tmp) != 0.0)) { + goto doubleCompare; + } + if (d1 < (double)LLONG_MIN) { + *resultPtr = MP_LT; + return TCL_OK; + } + if (d1 > (double)LLONG_MAX) { + *resultPtr = MP_GT; + return TCL_OK; + } + w1 = (Tcl_WideInt) d1; + goto wideCompare; +#endif + case TCL_NUMBER_BIG: + if (TclIsInfinite(d1)) { + *resultPtr = (d1 > 0.0) ? MP_GT : MP_LT; + return TCL_OK; + } + if (Tcl_IsShared(numObj2)) { + Tcl_GetBignumFromObj(NULL, numObj2, &big2); + } else { + Tcl_GetBignumAndClearObj(NULL, numObj2, &big2); + } + if ((d1 < (double)LONG_MAX) && (d1 > (double)LONG_MIN)) { + if (mp_cmp_d(&big2, 0) == MP_LT) { + *resultPtr = MP_GT; + } else { + *resultPtr = MP_LT; + } + mp_clear(&big2); + return TCL_OK; + } + if ((DBL_MANT_DIG > CHAR_BIT*sizeof(long)) + && (modf(d1, &tmp) != 0.0)) { + d2 = TclBignumToDouble(&big2); + mp_clear(&big2); + goto doubleCompare; + } + Tcl_InitBignumFromDouble(NULL, d1, &big1); + goto bigCompare; + } + return TCL_OK; + + case TCL_NUMBER_BIG: + if (Tcl_IsShared(numObj1)) { + Tcl_GetBignumFromObj(NULL, numObj1, &big1); + } else { + Tcl_GetBignumAndClearObj(NULL, numObj1, &big1); + } + switch (type2) { +#ifndef NO_WIDE_TYPE + case TCL_NUMBER_WIDE: +#endif + case TCL_NUMBER_LONG: + *resultPtr = mp_cmp_d(&big1, 0); + mp_clear(&big1); + return TCL_OK; + case TCL_NUMBER_DOUBLE: + d2 = *((CONST double *)ptr2); + if (TclIsInfinite(d2)) { + *resultPtr = (d2 > 0.0) ? MP_LT : MP_GT; + mp_clear(&big1); + return TCL_OK; + } + if ((d2 < (double)LONG_MAX) && (d2 > (double)LONG_MIN)) { + *resultPtr = mp_cmp_d(&big1, 0); + mp_clear(&big1); + return TCL_OK; + } + if ((DBL_MANT_DIG > CHAR_BIT*sizeof(long)) + && (modf(d2, &tmp) != 0.0)) { + d1 = TclBignumToDouble(&big1); + mp_clear(&big1); + goto doubleCompare; + } + Tcl_InitBignumFromDouble(NULL, d2, &big2); + goto bigCompare; + case TCL_NUMBER_BIG: + if (Tcl_IsShared(numObj2)) { + Tcl_GetBignumFromObj(NULL, numObj2, &big2); + } else { + Tcl_GetBignumAndClearObj(NULL, numObj2, &big2); + } + goto bigCompare; + } + } + + /* + * Should really be impossible to get here + */ + + return TCL_OK; + + /* + * The real core comparison rules. + */ + + longCompare: + *resultPtr = (l1 < l2) ? MP_LT : ((l1 > l2) ? MP_GT : MP_EQ); + return TCL_OK; +#ifndef NO_WIDE_TYPE + wideCompare: + *resultPtr = (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ); + return TCL_OK; +#endif + doubleCompare: + *resultPtr = (d1 < d2) ? MP_LT : ((d1 > d2) ? MP_GT : MP_EQ); + return TCL_OK; + bigCompare: + *resultPtr = mp_cmp(&big1, &big2); + mp_clear(&big1); + mp_clear(&big2); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclInvertOpCmd -- + * + * This procedure is invoked to process the "::tcl::mathop::~" Tcl + * command. See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +int +TclInvertOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + ClientData val; + int type; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "number"); + return TCL_ERROR; + } + if (TclGetNumberFromObj(interp, objv[1], &val, &type) != TCL_OK) { + return TCL_ERROR; + } + switch (type) { + case TCL_NUMBER_LONG: { + long l = *((const long *) val); + + Tcl_SetLongObj(Tcl_GetObjResult(interp), ~l); + return TCL_OK; + } +#ifndef NO_WIDE_TYPE + case TCL_NUMBER_WIDE: { + Tcl_WideInt w = *((const Tcl_WideInt *) val); + + Tcl_SetWideIntObj(Tcl_GetObjResult(interp), ~w); + return TCL_OK; + } +#endif + default: { + mp_int big; + + if (Tcl_IsShared(objv[1])) { + Tcl_GetBignumFromObj(NULL, objv[1], &big); + } else { + Tcl_GetBignumAndClearObj(NULL, objv[1], &big); + } + /* ~a = - a - 1 */ + mp_neg(&big, &big); + mp_sub_d(&big, 1, &big); + if (Tcl_IsShared(objv[1])) { + Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big)); + } else { + Tcl_SetBignumObj(objv[1], &big); + Tcl_SetObjResult(interp, objv[1]); + } + return TCL_OK; + } + } +} + +/* + *---------------------------------------------------------------------- + * + * TclNotOpCmd -- + * + * This procedure is invoked to process the "::tcl::mathop::!" Tcl + * command. See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +int +TclNotOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + int b; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "boolean"); + return TCL_ERROR; + } + if (Tcl_GetBooleanFromObj(interp, objv[1], &b) != TCL_OK) { + return TCL_ERROR; + } + Tcl_SetBooleanObj(Tcl_GetObjResult(interp), !b); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclAddOpCmd -- + * + * This procedure is invoked to process the "::tcl::mathop::+" Tcl + * command. See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +int +TclAddOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + if (objc < 2) { + Tcl_SetIntObj(Tcl_GetObjResult(interp), 0); + return TCL_OK; + } else if (objc == 2) { + Tcl_SetObjResult(interp, objv[1]); + return TCL_OK; + } else if (objc == 3) { + /* + * This is a special case of the version with the loop that allows for + * better memory management of objects in some cases. + */ + + Tcl_Obj *resPtr = CombineIntFloat(interp, objv[1], INST_ADD, objv[2]); + if (resPtr == NULL) { + return TCL_ERROR; + } + Tcl_SetObjResult(interp, resPtr); + return TCL_OK; + } else { + Tcl_Obj *sumPtr = objv[1]; + int i; + + Tcl_IncrRefCount(sumPtr); + for (i=2 ; i=1 ; i--) { + Tcl_Obj *resPtr = CombineIntFloat(interp, objv[i], INST_EXPON, + powPtr); + + if (resPtr == NULL) { + TclDecrRefCount(powPtr); + return TCL_ERROR; + } + Tcl_IncrRefCount(resPtr); + TclDecrRefCount(powPtr); + powPtr = resPtr; + } + Tcl_SetObjResult(interp, powPtr); + Tcl_DecrRefCount(powPtr); /* Public form since we know we won't + * be freeing this object now. */ + return TCL_OK; + } +} + +/* + *---------------------------------------------------------------------- + * + * TclMinusOpCmd -- + * + * This procedure is invoked to process the "::tcl::mathop::-" Tcl + * command. See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +int +TclMinusOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "value ?value ...?"); + return TCL_ERROR; + } else if (objc == 2) { + /* + * Only a single argument, so we compute the negation. + */ + + Tcl_Obj *zeroPtr = Tcl_NewIntObj(0); + Tcl_Obj *resPtr; + + Tcl_IncrRefCount(zeroPtr); + resPtr = CombineIntFloat(interp, zeroPtr, INST_SUB, objv[1]); + if (resPtr == NULL) { + TclDecrRefCount(zeroPtr); + return TCL_ERROR; + } + Tcl_SetObjResult(interp, resPtr); + TclDecrRefCount(zeroPtr); + return TCL_OK; + } else if (objc == 3) { + /* + * This is a special case of the version with the loop that allows for + * better memory management of objects in some cases. + */ + + Tcl_Obj *resPtr = CombineIntFloat(interp, objv[1], INST_SUB, objv[2]); + if (resPtr == NULL) { + return TCL_ERROR; + } + Tcl_SetObjResult(interp, resPtr); + return TCL_OK; + } else { + Tcl_Obj *diffPtr = objv[1]; + int i; + + Tcl_IncrRefCount(diffPtr); + for (i=2 ; i0) ? l1 : ~l1) & -(1L<<(CHAR_BIT*sizeof(long)-1-shift)))) { + Tcl_SetObjResult(interp, Tcl_NewLongObj(l1<0) ? w : ~w) & -(((Tcl_WideInt)1) + << (CHAR_BIT*sizeof(Tcl_WideInt)-1-shift)))) { + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(w<>" Tcl + * command. See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +int +TclRshiftOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + ClientData ptr1, ptr2; + int invalid, shift, type1, type2, idx; + const char *description; + long l1; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "value value"); + return TCL_ERROR; + } + + if ((TclGetNumberFromObj(NULL, objv[1], &ptr1, &type1) != TCL_OK) + || (type1 == TCL_NUMBER_DOUBLE) || (type1 == TCL_NUMBER_NAN)) { + idx = 1; + goto illegalOperand; + } + if ((TclGetNumberFromObj(NULL, objv[2], &ptr2, &type2) != TCL_OK) + || (type2 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_NAN)) { + idx = 2; + goto illegalOperand; + } + + /* reject negative shift argument */ + switch (type2) { + case TCL_NUMBER_LONG: + invalid = (*((const long *)ptr2) < (long)0); + break; +#ifndef NO_WIDE_TYPE + case TCL_NUMBER_WIDE: + invalid = (*((const Tcl_WideInt *)ptr2) < (Tcl_WideInt)0); + break; +#endif + case TCL_NUMBER_BIG: + /* TODO: const correctness ? */ + invalid = (mp_cmp_d((mp_int *)ptr2, 0) == MP_LT); + break; + default: + /* Unused, here to silence compiler warning */ + invalid = 0; + } + if (invalid) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("negative shift argument", -1)); + return TCL_ERROR; + } + + /* Zero shifted any number of bits is still zero */ + if ((type1 == TCL_NUMBER_LONG) && (*((const long *)ptr1) == (long)0)) { + Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); + return TCL_OK; + } + + /* Quickly force large right shifts to 0 or -1 */ + if ((type2 != TCL_NUMBER_LONG) + || (*((const long *)ptr2) > INT_MAX)) { + /* + * Again, technically, the value to be shifted could be an mp_int so + * huge that a right shift by (INT_MAX+1) bits could not take us to + * the result of 0 or -1, but since we're using mp_div_2d to do the + * work, and it takes only an int argument, we draw the line there. + */ + + int zero; + + switch (type1) { + case TCL_NUMBER_LONG: + zero = (*((const long *)ptr1) > (long)0); + break; +#ifndef NO_WIDE_TYPE + case TCL_NUMBER_WIDE: + zero = (*((const Tcl_WideInt *)ptr1) > (Tcl_WideInt)0); + break; +#endif + case TCL_NUMBER_BIG: + /* TODO: const correctness ? */ + zero = (mp_cmp_d((mp_int *)ptr1, 0) == MP_GT); + break; + default: + /* Unused, here to silence compiler warning. */ + zero = 0; + } + Tcl_SetObjResult(interp, Tcl_NewIntObj(zero ? 0 : -1)); + return TCL_OK; + } + + shift = (int)(*((const long *)ptr2)); + /* Handle shifts within the native long range */ + if (type1 == TCL_NUMBER_LONG) { + l1 = *((const long *)ptr1); + if ((size_t)shift >= CHAR_BIT*sizeof(long)) { + Tcl_SetObjResult(interp, Tcl_NewIntObj(l1 >= (long)0 ? 0 : -1)); + } else { + Tcl_SetObjResult(interp, Tcl_NewIntObj(l1 >> shift)); + } + return TCL_OK; + } + +#ifndef NO_WIDE_TYPE + /* Handle shifts within the native wide range */ + if (type1 == TCL_NUMBER_WIDE) { + Tcl_WideInt w = *((const Tcl_WideInt *)ptr1); + if ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideInt)) { + Tcl_SetObjResult(interp, + Tcl_NewIntObj(w >= (Tcl_WideInt)0 ? 0 : -1)); + } else { + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(w >> shift)); + } + return TCL_OK; + } +#endif + + { + mp_int big, bigResult, bigRemainder; + + if (Tcl_IsShared(objv[1])) { + Tcl_GetBignumFromObj(NULL, objv[1], &big); + } else { + Tcl_GetBignumAndClearObj(NULL, objv[1], &big); + } + + mp_init(&bigResult); + mp_init(&bigRemainder); + mp_div_2d(&big, shift, &bigResult, &bigRemainder); + if (mp_cmp_d(&bigRemainder, 0) == MP_LT) { + /* Convert to Tcl's integer division rules */ + mp_sub_d(&bigResult, 1, &bigResult); + } + mp_clear(&bigRemainder); + mp_clear(&big); + + if (!Tcl_IsShared(objv[1])) { + Tcl_SetBignumObj(objv[1], &bigResult); + Tcl_SetObjResult(interp, objv[1]); + } else { + Tcl_SetObjResult(interp, Tcl_NewBignumObj(&bigResult)); + } + } + return TCL_OK; + + illegalOperand: + if (TclGetNumberFromObj(NULL, objv[idx], &ptr1, &type1) != TCL_OK) { + int numBytes; + const char *bytes = Tcl_GetStringFromObj(objv[idx], &numBytes); + if (numBytes == 0) { + description = "empty string"; + } else if (TclCheckBadOctal(NULL, bytes)) { + description = "invalid octal number"; + } else { + description = "non-numeric string"; + } + } else if (type1 == TCL_NUMBER_NAN) { + description = "non-numeric floating-point value"; + } else { + description = "floating-point value"; + } + + Tcl_SetObjResult(interp, + Tcl_ObjPrintf("can't use %s as operand of \">>\"", description)); + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * TclModOpCmd -- + * + * This procedure is invoked to process the "::tcl::mathop::%" Tcl + * command. See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +int +TclModOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + Tcl_Obj *argObj; + ClientData ptr1, ptr2; + int type1, type2; + long l1, l2 = 0; + const char *description; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "value value"); + return TCL_ERROR; + } + + if ((TclGetNumberFromObj(NULL, objv[1], &ptr1, &type1) != TCL_OK) + || (type1 == TCL_NUMBER_DOUBLE) || (type1 == TCL_NUMBER_NAN)) { + argObj = objv[1]; + goto badArg; + } + if ((TclGetNumberFromObj(NULL, objv[2], &ptr2, &type2) != TCL_OK) + || (type2 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_NAN)) { + argObj = objv[2]; + goto badArg; + } + + if (type2 == TCL_NUMBER_LONG) { + l2 = *((CONST long *)ptr2); + if (l2 == 0) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", -1)); + Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", + NULL); + return TCL_ERROR; + } + if ((l2 == 1) || (l2 == -1)) { + Tcl_SetIntObj(Tcl_GetObjResult(interp), 0); + return TCL_OK; + } + } + if (type1 == TCL_NUMBER_LONG) { + l1 = *((CONST long *)ptr1); + if (l1 == 0) { + Tcl_SetIntObj(Tcl_GetObjResult(interp), 0); + return TCL_OK; + } + if (type2 == TCL_NUMBER_LONG) { + /* Both operands are long; do native calculation */ + long lRemainder, lQuotient = l1 / l2; + + /* Force Tcl's integer division rules */ + /* TODO: examine for logic simplification */ + if (((lQuotient < 0) || ((lQuotient == 0) && + ((l1 < 0 && l2 > 0) || (l1 > 0 && l2 < 0)))) && + ((lQuotient * l2) != l1)) { + lQuotient -= 1; + } + lRemainder = l1 - l2*lQuotient; + Tcl_SetLongObj(Tcl_GetObjResult(interp), lRemainder); + return TCL_OK; + } + /* + * First operand fits in long; second does not, so the second has + * greater magnitude than first. No need to divide to determine the + * remainder. + */ +#ifndef NO_WIDE_TYPE + if (type2 == TCL_NUMBER_WIDE) { + Tcl_WideInt w2 = *((CONST Tcl_WideInt *)ptr2); + + if ((l1 > 0) ^ (w2 > (Tcl_WideInt)0)) { + /* Arguments are opposite sign; remainder is sum */ + Tcl_SetObjResult(interp, + Tcl_NewWideIntObj(w2+(Tcl_WideInt)l1)); + return TCL_OK; + } + /* Arguments are same sign; remainder is first operand */ + Tcl_SetObjResult(interp, objv[1]); + return TCL_OK; + } +#endif + { + mp_int big2; + if (Tcl_IsShared(objv[2])) { + Tcl_GetBignumFromObj(NULL, objv[2], &big2); + } else { + Tcl_GetBignumAndClearObj(NULL, objv[2], &big2); + } + + /* TODO: internals intrusion */ + if ((l1 > 0) ^ (big2.sign == MP_ZPOS)) { + /* Arguments are opposite sign; remainder is sum */ + mp_int big1; + TclBNInitBignumFromLong(&big1, l1); + mp_add(&big2, &big1, &big2); + Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big2)); + } else { + /* Arguments are same sign; remainder is first operand */ + Tcl_SetObjResult(interp, objv[1]); + /* TODO: free big2? */ + } + } + return TCL_OK; + } +#ifndef NO_WIDE_TYPE + if (type1 == TCL_NUMBER_WIDE) { + Tcl_WideInt w1 = *((CONST Tcl_WideInt *)ptr1); + if (type2 != TCL_NUMBER_BIG) { + Tcl_WideInt w2, wQuotient, wRemainder; + + Tcl_GetWideIntFromObj(NULL, objv[2], &w2); + wQuotient = w1 / w2; + + /* Force Tcl's integer division rules */ + /* TODO: examine for logic simplification */ + if (((wQuotient < ((Tcl_WideInt) 0)) + || ((wQuotient == ((Tcl_WideInt) 0)) && ( + (w1 < ((Tcl_WideInt) 0) && w2 > ((Tcl_WideInt) 0)) + || (w1 > ((Tcl_WideInt) 0) && w2 < ((Tcl_WideInt) 0))) + )) && ((wQuotient * w2) != w1)) { + wQuotient -= (Tcl_WideInt) 1; + } + wRemainder = w1 - w2*wQuotient; + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(wRemainder)); + } else { + mp_int big2; + if (Tcl_IsShared(objv[2])) { + Tcl_GetBignumFromObj(NULL, objv[2], &big2); + } else { + Tcl_GetBignumAndClearObj(NULL, objv[2], &big2); + } + + /* TODO: internals intrusion */ + if ((w1 > ((Tcl_WideInt) 0)) ^ (big2.sign == MP_ZPOS)) { + /* Arguments are opposite sign; remainder is sum */ + mp_int big1; + TclBNInitBignumFromWideInt(&big1, w1); + mp_add(&big2, &big1, &big2); + Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big2)); + } else { + /* Arguments are same sign; remainder is first operand */ + Tcl_SetObjResult(interp, objv[1]); + } + } + return TCL_OK; + } +#endif + { + mp_int big1, big2, bigResult, bigRemainder; + + Tcl_GetBignumFromObj(NULL, objv[1], &big1); + Tcl_GetBignumFromObj(NULL, objv[2], &big2); + mp_init(&bigResult); + mp_init(&bigRemainder); + mp_div(&big1, &big2, &bigResult, &bigRemainder); + if (!mp_iszero(&bigRemainder) && (bigRemainder.sign != big2.sign)) { + /* Convert to Tcl's integer division rules */ + mp_sub_d(&bigResult, 1, &bigResult); + mp_add(&bigRemainder, &big2, &bigRemainder); + } + mp_copy(&bigRemainder, &bigResult); + mp_clear(&bigRemainder); + mp_clear(&big1); + mp_clear(&big2); + if (Tcl_IsShared(objv[1])) { + Tcl_SetObjResult(interp, Tcl_NewBignumObj(&bigResult)); + } else { + Tcl_SetBignumObj(objv[1], &bigResult); + Tcl_SetObjResult(interp, objv[1]); + } + return TCL_OK; + } + + badArg: + if (TclGetNumberFromObj(NULL, argObj, &ptr1, &type1) != TCL_OK) { + int numBytes; + CONST char *bytes = Tcl_GetStringFromObj(argObj, &numBytes); + if (numBytes == 0) { + description = "empty string"; + } else if (TclCheckBadOctal(NULL, bytes)) { + description = "invalid octal number"; + } else { + description = "non-numeric string"; + } + } else if (type1 == TCL_NUMBER_NAN) { + description = "non-numeric floating-point value"; + } else { + description = "floating-point value"; + } + + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use %s as operand of \"%%\"", description)); + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * TclNeqOpCmd -- + * + * This procedure is invoked to process the "::tcl::mathop::!=" Tcl + * command. See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +int +TclNeqOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + int result = 1, cmp, len1, len2; + const char *str1, *str2; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "value value"); + return TCL_ERROR; + } + + switch (CompareNumbers(NULL, objv[1], objv[2], &cmp)) { + case TCL_ERROR: + /* + * Got a string + */ + str1 = Tcl_GetStringFromObj(objv[1], &len1); + str2 = Tcl_GetStringFromObj(objv[2], &len2); + if (len1 == len2 && !strcmp(str1, str2)) { + result = 0; + } + case TCL_BREAK: /* Deliberate fallthrough */ + break; + case TCL_OK: + /* + * Got proper numbers + */ + if (cmp != MP_EQ) { + result = 0; + } + } + Tcl_SetBooleanObj(Tcl_GetObjResult(interp), result); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclStrneqOpCmd -- + * + * This procedure is invoked to process the "::tcl::mathop::ne" Tcl + * command. See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +int +TclStrneqOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + const char *s1, *s2; + int s1len, s2len; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "value value"); + return TCL_ERROR; + } + + s1 = Tcl_GetStringFromObj(objv[1], &s1len); + s2 = Tcl_GetStringFromObj(objv[2], &s2len); + if (s1len == s2len && !strcmp(s1, s2)) { + Tcl_SetBooleanObj(Tcl_GetObjResult(interp), 0); + } else { + Tcl_SetBooleanObj(Tcl_GetObjResult(interp), 1); + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclInOpCmd -- + * + * This procedure is invoked to process the "::tcl::mathop::in" Tcl + * command. See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +int +TclInOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + const char *s1, *s2; + int s1len, s2len, i, len; + Tcl_Obj **listObj; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "value list"); + return TCL_ERROR; + } + + if (Tcl_ListObjGetElements(interp, objv[2], &len, &listObj) != TCL_OK) { + return TCL_ERROR; + } + s1 = Tcl_GetStringFromObj(objv[1], &s1len); + for (i=0 ; i 2) { + int i, cmp, len1, len2; + const char *str1, *str2; + + for (i=1 ; i= 0) { + result = 0; + i = objc; + } + continue; + case TCL_OK: + /* + * Got proper numbers + */ + if (cmp != MP_LT) { + result = 0; + i = objc; + } + continue; + case TCL_BREAK: + /* + * Got a NaN (which is different from everything, including + * itself) + */ + result = 0; + i = objc; + continue; + } + } + } + Tcl_SetBooleanObj(Tcl_GetObjResult(interp), result); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclLeqOpCmd -- + * + * This procedure is invoked to process the "::tcl::mathop::<=" Tcl + * command. See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +int +TclLeqOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + int result = 1; + + if (objc > 2) { + int i, cmp, len1, len2; + const char *str1, *str2; + + for (i=1 ; i 0) { + result = 0; + i = objc; + } + continue; + case TCL_OK: + /* + * Got proper numbers + */ + if (cmp == MP_GT) { + result = 0; + i = objc; + } + continue; + case TCL_BREAK: + /* + * Got a NaN (which is different from everything, including + * itself) + */ + result = 0; + i = objc; + continue; + } + } + } + Tcl_SetBooleanObj(Tcl_GetObjResult(interp), result); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclGreaterOpCmd -- + * + * This procedure is invoked to process the "::tcl::mathop::>" Tcl + * command. See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +int +TclGreaterOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + int result = 1; + + if (objc > 2) { + int i, cmp, len1, len2; + const char *str1, *str2; + + for (i=1 ; i=" Tcl + * command. See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +int +TclGeqOpCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + int result = 1; + + if (objc > 2) { + int i, cmp, len1, len2; + const char *str1, *str2; + + for (i=1 ; i 2) { + int i, cmp, len1, len2; + const char *str1, *str2; + + for (i=1 ; i 2) { + int i, len1, len2; + const char *str1, *str2; + + for (i=1 ; i$(GENERIC_DIR)/tclDate.c # rm y.tab.c -# The following target generates the file generic/tclTomMath.h. -# It needs to be run (and the results checked) after updating -# to a new release of libtommath. +# The following target generates the file generic/tclTomMath.h. It needs to be +# run (and the results checked) after updating to a new release of libtommath. gentommath_h: $(TCL_EXE) "$(TOP_DIR)/tools/fix_tommath_h.tcl" \ "$(TOMMATH_DIR)/tommath.h" \ > "$(GENERIC_DIR)/tclTomMath.h" -# The following target generates the shared libraries in dltest/ that -# are used for testing; they are included as part of the "tcltest" -# target (via the BUILD_DLTEST variable) if dynamic loading is supported -# on this platform. The Makefile in the dltest subdirectory creates -# the dltest.marker file in this directory after a successful build. +# The following target generates the shared libraries in dltest/ that are used +# for testing; they are included as part of the "tcltest" target (via the +# BUILD_DLTEST variable) if dynamic loading is supported on this platform. The +# Makefile in the dltest subdirectory creates the dltest.marker file in this +# directory after a successful build. dltest.marker: cd dltest ; $(MAKE) @@ -718,9 +708,9 @@ install-strip: INSTALL_PROGRAM="$(INSTALL_PROGRAM) ${INSTALL_STRIP_PROGRAM}" \ INSTALL_LIBRARY="$(INSTALL_LIBRARY) ${INSTALL_STRIP_LIBRARY}" -# Note: before running ranlib below, must cd to target directory because -# some ranlibs write to current directory, and this might not always be -# possible (e.g. if installing as root). +# Note: before running ranlib below, must cd to target directory because some +# ranlibs write to current directory, and this might not always be possible +# (e.g. if installing as root). install-binaries: binaries @for i in $(LIB_INSTALL_DIR) $(BIN_INSTALL_DIR) ; \ @@ -899,10 +889,10 @@ distclean: clean depend: makedepend -- $(DEPEND_SWITCHES) -- $(SRCS) -# Test binaries. The rules for tclTestInit.o and xtTestInit.o are -# complicated because they are compiled from tclAppInit.c. Can't use -# the "-o" option because this doesn't work on some strange compilers -# (e.g. UnixWare). +# Test binaries. The rules for tclTestInit.o and xtTestInit.o are complicated +# because they are compiled from tclAppInit.c. Can't use the "-o" option +# because this doesn't work on some strange compilers (e.g. UnixWare). +# # To enable concurrent parallel make of tclsh and tcltest resp xttest, these # targets have to depend on tclsh, this ensures that linking of tclsh with # tclAppInit.o does not execute concurrently with the renaming and recompiling @@ -963,7 +953,7 @@ regerror.o: $(REGHDRS) $(GENERIC_DIR)/regerrs.h $(GENERIC_DIR)/regerror.c tclAppInit.o: $(UNIX_DIR)/tclAppInit.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclAppInit.c -# On unix we want to use the normal malloc/free implementation, so we +# On Unix we want to use the normal malloc/free implementation, so we # specifically set the USE_TCLALLOC flag. tclAlloc.o: $(GENERIC_DIR)/tclAlloc.c @@ -1104,6 +1094,9 @@ tclLoadShl.o: $(UNIX_DIR)/tclLoadShl.c tclMain.o: $(GENERIC_DIR)/tclMain.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclMain.c +tclMathOp.o: $(GENERIC_DIR)/tclMathOp.c $(MATHHDRS) + $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclMathOp.c + tclNamesp.o: $(GENERIC_DIR)/tclNamesp.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclNamesp.c @@ -1127,12 +1120,11 @@ tclPkg.o: $(GENERIC_DIR)/tclPkg.c # TIP #59, embedding of configuration information into the binary library. # -# Part of Tcl's configuration information are the paths where it was -# installed and where it will look for its libraries (which can be -# different). We derive this information from the variables which can -# be overridden by the user. As every path can be configured -# separately we do not remember one general prefix/exec_prefix but all -# the different paths individually. +# Part of Tcl's configuration information are the paths where it was installed +# and where it will look for its libraries (which can be different). We derive +# this information from the variables which can be overridden by the user. As +# every path can be configured separately we do not remember one general +# prefix/exec_prefix but all the different paths individually. tclPkgConfig.o: $(GENERIC_DIR)/tclPkgConfig.c $(CC) -c $(CC_SWITCHES) \ @@ -1453,9 +1445,9 @@ tclMacOSXFCmd.o: $(MAC_OSX_DIR)/tclMacOSXFCmd.c tclMacOSXNotify.o: $(MAC_OSX_DIR)/tclMacOSXNotify.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tclMacOSXNotify.c -# The following targets are not completely general. They are provide -# purely for documentation purposes so people who are interested in -# the Xt based notifier can modify them to suit their own installation. +# The following targets are not completely general. They are provide purely +# for documentation purposes so people who are interested in the Xt based +# notifier can modify them to suit their own installation. xttest: ${XTTEST_OBJS} ${GENERIC_OBJS} ${UNIX_OBJS} ${COMPAT_OBJS} \ @DL_OBJS@ ${BUILD_DLTEST} @@ -1471,10 +1463,10 @@ tclXtTest.o: $(UNIX_DIR)/tclXtTest.c $(CC) -c $(CC_SWITCHES) -I/usr/openwin/include \ $(UNIX_DIR)/tclXtTest.c -# compat binaries, these must be compiled for use in a shared library -# even though they may be placed in a static executable or library. Since -# they are included in both the tcl library and the stub library, they -# need to be relocatable. +# Compat binaries, these must be compiled for use in a shared library even +# though they may be placed in a static executable or library. Since they are +# included in both the tcl library and the stub library, they need to be +# relocatable. fixstrtod.o: $(COMPAT_DIR)/fixstrtod.c $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/fixstrtod.c @@ -1555,9 +1547,8 @@ checkstubs: $(TCL_LIB_FILE) done # -# Target to check that all public APIs which are not command -# implementations have an entry in section three of the distributed -# manpages. +# Target to check that all public APIs which are not command implementations +# have an entry in section three of the distributed manpages. # checkdoc: $(TCL_LIB_FILE) @@ -1580,8 +1571,7 @@ checkuchar: -egrep isalnum\|isalpha\|iscntrl\|isdigit\|islower\|isprint\|ispunct\|isspace\|isupper\|isxdigit\|toupper\|tolower $(SRCS) | grep -v UCHAR # -# Target to make sure that only symbols with "Tcl" prefixes are -# exported. +# Target to make sure that only symbols with "Tcl" prefixes are exported. # checkexports: $(TCL_LIB_FILE) @@ -1590,7 +1580,7 @@ checkexports: $(TCL_LIB_FILE) | sort -n | grep -E -v '^[Tt]cl' || true # -# Target to create a Tcl RPM for Linux. Requires that you be on a Linux +# Target to create a Tcl RPM for Linux. Requires that you be on a Linux # system. # @@ -1605,9 +1595,9 @@ rpm: all /bin/rpm rm -rf RPMS THIS.TCL.SPEC # -# Target to create a proper Tcl distribution from information in the -# master source directory. DISTDIR must be defined to indicate where -# to put the distribution. DISTDIR must be an absolute path name. +# Target to create a proper Tcl distribution from information in the master +# source directory. DISTDIR must be defined to indicate where to put the +# distribution. DISTDIR must be an absolute path name. # DISTROOT = /tmp/dist @@ -1721,8 +1711,8 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(DISTDIR)/libtommath # -# The following target can only be used for non-patch releases. Use -# the "allpatch" target below for patch releases. +# The following target can only be used for non-patch releases. Use the +# "allpatch" target below for patch releases. # alldist: dist @@ -1731,11 +1721,11 @@ alldist: dist gzip -9 $(DISTNAME)-src.tar; zip -qr8 $(ZIPNAME) $(DISTNAME) # -# The target below is similar to "alldist" except it works for patch -# releases. It is needed because patch releases are peculiar: the -# patch designation appears in the name of the compressed file -# (e.g. tcl8.0p1.tar.gz) but the extracted source directory doesn't -# include the patch designation (e.g. tcl8.0). +# The target below is similar to "alldist" except it works for patch releases. +# It is needed because patch releases are peculiar: the patch designation +# appears in the name of the compressed file (e.g. tcl8.0p1.tar.gz) but the +# extracted source directory doesn't include the patch designation (e.g., +# tcl8.0). # allpatch: dist @@ -1748,11 +1738,10 @@ allpatch: dist mv $(DISTROOT)/old $(DISTROOT)/tcl${VERSION} # -# This target creates the HTML folder for Tcl & Tk and places it -# in DISTDIR/html. It uses the tcltk-man2html.tcl tool from -# the Tcl group's tool workspace. It depends on the Tcl & Tk being -# in directories called tcl8.* & tk8.* up two directories from the -# TOOL_DIR. +# This target creates the HTML folder for Tcl & Tk and places it in +# DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool +# workspace. It depends on the Tcl & Tk being in directories called tcl8.* & +# tk8.* up two directories from the TOOL_DIR. # html: @@ -1773,23 +1762,21 @@ BUILD_HTML = \ # # Targets to build Solaris package of the distribution for the current -# architecture. To build stream packages for both sun4 and i86pc -# architectures: +# architecture. To build stream packages for both sun4 and i86pc +# architectures: # # On the sun4 machine, execute the following: # make distclean; ./configure # make DISTDIR= package # -# Once the build is complete, execute the following on the i86pc -# machine: +# Once the build is complete, execute the following on the i86pc machine: # make DISTDIR= package-quick # -# is the absolute path to a directory where the build should -# take place. These steps will generate the $(PACKAGE).sun4 and -# $(PACKAGE).i86pc stream packages. It is important that the packages be -# built in this fashion in order to ensure that the architecture -# independent files are exactly the same, including timestamps, in -# both packages. +# is the absolute path to a directory where the build should take +# place. These steps will generate the $(PACKAGE).sun4 and $(PACKAGE).i86pc +# stream packages. It is important that the packages be built in this fashion +# in order to ensure that the architecture independent files are exactly the +# same, including timestamps, in both packages. # PACKAGE=SCRPtcl @@ -1828,7 +1815,7 @@ package-common: # Build and install the architecture specific files in the dist directory. # -package-binaries: +package-binaries: cd $(DISTDIR)/unix/`arch`; \ $(MAKE); \ $(MAKE) install-binaries prefix=$(DISTDIR)/$(PACKAGE)/$(VERSION) \ diff --git a/win/Makefile.in b/win/Makefile.in index 861a395..b8bdbfd 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -1,26 +1,23 @@ # -# This file is a Makefile for Tcl. If it has the name "Makefile.in" -# then it is a template for a Makefile; to generate the actual Makefile, -# run "./configure", which is a configuration script generated by the -# "autoconf" program (constructs like "@foo@" will get replaced in the -# actual Makefile. +# This file is a Makefile for Tcl. If it has the name "Makefile.in" then it +# is a template for a Makefile; to generate the actual Makefile, run +# "./configure", which is a configuration script generated by the "autoconf" +# program (constructs like "@foo@" will get replaced in the actual Makefile. # -# RCS: @(#) $Id: Makefile.in,v 1.109 2006/11/09 16:52:31 dgp Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.110 2006/11/25 17:18:10 dkf Exp $ VERSION = @TCL_VERSION@ -#---------------------------------------------------------------- -# Things you can change to personalize the Makefile for your own -# site (you can make these changes in either Makefile.in or -# Makefile, but changes to Makefile will get lost if you re-run -# the configuration script). -#---------------------------------------------------------------- +#-------------------------------------------------------------------------- +# Things you can change to personalize the Makefile for your own site (you can +# make these changes in either Makefile.in or Makefile, but changes to +# Makefile will get lost if you re-run the configuration script). +#-------------------------------------------------------------------------- -# Default top-level directories in which to install architecture- -# specific files (exec_prefix) and machine-independent files such -# as scripts (prefix). The values specified here may be overridden -# at configure-time with the --exec-prefix and --prefix options -# to the "configure" script. +# Default top-level directories in which to install architecture-specific +# files (exec_prefix) and machine-independent files such as scripts (prefix). +# The values specified here may be overridden at configure-time with the +# --exec-prefix and --prefix options to the "configure" script. prefix = @prefix@ exec_prefix = @exec_prefix@ @@ -29,16 +26,15 @@ libdir = @libdir@ includedir = @includedir@ mandir = @mandir@ -# The following definition can be set to non-null for special systems -# like AFS with replication. It allows the pathnames used for installation -# to be different than those used for actually reference files at -# run-time. INSTALL_ROOT is prepended to $prefix and $exec_prefix -# when installing files. +# The following definition can be set to non-null for special systems like AFS +# with replication. It allows the pathnames used for installation to be +# different than those used for actually reference files at run-time. +# INSTALL_ROOT is prepended to $prefix and $exec_prefix when installing files. INSTALL_ROOT = -# Directory from which applications will reference the library of Tcl -# scripts (note: you can set the TCL_LIBRARY environment variable at -# run-time to override this value): +# Directory from which applications will reference the library of Tcl scripts +# (note: you can set the TCL_LIBRARY environment variable at run-time to +# override this value): TCL_LIBRARY = $(prefix)/lib/tcl$(VERSION) # Path to use at runtime to refer to LIB_INSTALL_DIR: @@ -65,12 +61,10 @@ MAN_INSTALL_DIR = $(INSTALL_ROOT)$(mandir) # Directory in which to install manual entry for tclsh: MAN1_INSTALL_DIR = $(MAN_INSTALL_DIR)/man1 -# Directory in which to install manual entries for Tcl's C library -# procedures: +# Directory in which to install manual entries for Tcl's C library procedures: MAN3_INSTALL_DIR = $(MAN_INSTALL_DIR)/man3 -# Directory in which to install manual entries for the built-in -# Tcl commands: +# Directory in which to install manual entries for the built-in Tcl commands: MANN_INSTALL_DIR = $(MAN_INSTALL_DIR)/mann # Libraries built with optimization switches have this additional extension @@ -90,8 +84,8 @@ CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@ #CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE) CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ -# To enable compilation debugging reverse the comment characters on -# one of the following lines. +# To enable compilation debugging reverse the comment characters on one of the +# following lines. COMPILE_DEBUG_FLAGS = #COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG #COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS @@ -140,11 +134,10 @@ SHARED_LIBRARIES = $(TCL_DLL_FILE) $(TCL_STUB_LIB_FILE) \ $(DDE_DLL_FILE) $(REG_DLL_FILE) $(PIPE_DLL_FILE) STATIC_LIBRARIES = $(TCL_LIB_FILE) $(REG_LIB_FILE) $(DDE_LIB_FILE) -# TCL_EXE is the name of a tclsh executable that is available *BEFORE* -# running make for the first time. Certain build targets (make genstubs) -# need it to be available on the PATH. This executable should *NOT* be -# required just to do a normal build although it can be required to run -# make dist. +# TCL_EXE is the name of a tclsh executable that is available *BEFORE* running +# make for the first time. Certain build targets (make genstubs) need it to be +# available on the PATH. This executable should *NOT* be required just to do a +# normal build although it can be required to run make dist. TCL_EXE = tclsh TCLSH = tclsh$(VER)${EXESUFFIX} @@ -154,9 +147,8 @@ MAN2TCL = man2tcl$(EXEEXT) @SET_MAKE@ -# Setting the VPATH variable to a list of paths will cause the -# makefile to look into these paths when resolving .c to .obj -# dependencies. +# Setting the VPATH variable to a list of paths will cause the Makefile to +# look into these paths when resolving .c to .obj dependencies. VPATH = $(GENERIC_DIR):$(TOMMATH_DIR):$(WIN_DIR):$(COMPAT_DIR) @@ -250,6 +242,7 @@ GENERIC_OBJS = \ tclListObj.$(OBJEXT) \ tclLoad.$(OBJEXT) \ tclMain.$(OBJEXT) \ + tclMathOp.$(OBJEXT) \ tclNamesp.$(OBJEXT) \ tclNotify.$(OBJEXT) \ tclObj.$(OBJEXT) \ @@ -359,7 +352,7 @@ WIN_OBJS = \ tclWinPipe.$(OBJEXT) \ tclWinSock.$(OBJEXT) \ tclWinThrd.$(OBJEXT) \ - tclWinTime.$(OBJEXT) + tclWinTime.$(OBJEXT) COMPAT_OBJS = \ strtoll.$(OBJEXT) strtoull.$(OBJEXT) @@ -410,8 +403,8 @@ cat32.$(OBJEXT): cat.c $(CAT32): cat32.$(OBJEXT) $(CC) $(CFLAGS) cat32.$(OBJEXT) $(CC_EXENAME) $(LIBS) $(LDFLAGS_CONSOLE) -# The following targets are configured by autoconf to generate either -# a shared library or static library +# The following targets are configured by autoconf to generate either a shared +# library or static library ${TCL_STUB_LIB_FILE}: ${STUB_OBJS} @$(RM) ${TCL_STUB_LIB_FILE} @@ -443,14 +436,13 @@ ${REG_LIB_FILE}: ${REG_OBJS} ${TCL_LIB_FILE} @$(RM) ${REG_LIB_FILE} @MAKE_LIB@ ${REG_OBJS} ${TCL_LIB_FILE} -# PIPE_DLL_FILE is actually an executable, don't build it -# like a DLL. +# PIPE_DLL_FILE is actually an executable, don't build it like a DLL. ${PIPE_DLL_FILE}: ${PIPE_OBJS} @$(RM) ${PIPE_DLL_FILE} @MAKE_EXE@ $(CFLAGS) ${PIPE_OBJS} $(LIBS) $(LDFLAGS_CONSOLE) -# Add the object extension to the implicit rules. By default .obj is not +# Add the object extension to the implicit rules. By default .obj is not # automatically added. .SUFFIXES: .${OBJEXT} @@ -491,12 +483,11 @@ tclWinDde.${OBJEXT} : tclWinDde.c # TIP #59, embedding of configuration information into the binary library. # -# Part of Tcl's configuration information are the paths where it was -# installed and where it will look for its libraries (which can be -# different). We derive this information from the variables which can -# be overridden by the user. As every path can be configured -# separately we do not remember one general prefix/exec_prefix but all -# the different paths individually. +# Part of Tcl's configuration information are the paths where it was installed +# and where it will look for its libraries (which can be different). We derive +# this information from the variables which can be overridden by the user. As +# every path can be configured separately we do not remember one general +# prefix/exec_prefix but all the different paths individually. tclPkgConfig.${OBJEXT}: tclPkgConfig.c $(CC) -c $(CC_SWITCHES) \ @@ -514,8 +505,8 @@ tclPkgConfig.${OBJEXT}: tclPkgConfig.c -DBUILD_tcl \ @DEPARG@ $(CC_OBJNAME) -# The following objects are part of the stub library and should not -# be built as DLL objects but none of the symbols should be exported +# The following objects are part of the stub library and should not be built +# as DLL objects but none of the symbols should be exported tclStubLib.${OBJEXT}: tclStubLib.c $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME) @@ -529,11 +520,11 @@ tclStubLib.${OBJEXT}: tclStubLib.c .rc.$(RES): $(RC) @RC_OUT@ $@ @RC_TYPE@ @RC_DEFINES@ @RC_INCLUDE@ "$(GENERIC_DIR_NATIVE)" @RC_INCLUDE@ "$(WIN_DIR_NATIVE)" @DEPARG@ -# The following target generates the file generic/tclDate.c -# from the yacc grammar found in generic/tclGetDate.y. This is -# only run by hand as yacc is not available in all environments. -# The name of the .c file is different than the name of the .y file -# so that make doesn't try to automatically regenerate the .c file. +# The following target generates the file generic/tclDate.c from the yacc +# grammar found in generic/tclGetDate.y. This is only run by hand as yacc is +# not available in all environments. The name of the .c file is different than +# the name of the .y file so that make doesn't try to automatically regenerate +# the .c file. gendate: bison --output-file=$(GENERIC_DIR)/tclDate.c \ @@ -541,9 +532,8 @@ gendate: --no-lines \ $(GENERIC_DIR)/tclGetDate.y -# The following target generates the file generic/tclTomMath.h. -# It needs to be run (and the results checked) after updating -# to a new release of libtommath. +# The following target generates the file generic/tclTomMath.h. It needs to be +# run (and the results checked) after updating to a new release of libtommath. gentommath_h: $(TCL_EXE) "$(ROOT_DIR_NATIVE)\tools\fix_tommath_h.tcl" \ @@ -691,8 +681,8 @@ install-private-headers: libraries $(COPY) "$$i" "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \ done; -# Specifying TESTFLAGS on the command line is the standard way to pass -# args to tcltest, ie: +# Specifying TESTFLAGS on the command line is the standard way to pass args to +# tcltest, i.e.: # % make test TESTFLAGS="-verbose bps -file fileName.test" test: binaries $(TCLTEST) @@ -707,8 +697,8 @@ runtest: binaries $(TCLTEST) ./$(TCLTEST) $(TESTFLAGS) -load "set ::ddelib [file normalize ${DDE_DLL_FILE}]; \ set ::reglib [file normalize ${REG_DLL_FILE}]" $(SCRIPT) -# This target can be used to run tclsh from the build directory -# via `make shell SCRIPT=foo.tcl` +# This target can be used to run tclsh from the build directory via +# `make shell SCRIPT=foo.tcl` shell: binaries @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ ./$(TCLSH) $(SCRIPT) diff --git a/win/makefile.bc b/win/makefile.bc index 75d7ca4..0a847a0 100644 --- a/win/makefile.bc +++ b/win/makefile.bc @@ -231,6 +231,7 @@ TCLOBJS = \ $(TMPDIR)\tclListObj.obj \ $(TMPDIR)\tclLoad.obj \ $(TMPDIR)\tclMain.obj \ + $(TMPDIR)\tclMathOp.obj \ $(TMPDIR)\tclNamesp.obj \ $(TMPDIR)\tclNotify.obj \ $(TMPDIR)\tclObj.obj \ diff --git a/win/makefile.vc b/win/makefile.vc index d30fb0b..1a5bb27 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -12,7 +12,7 @@ # Copyright (c) 2001-2004 David Gravereaux. # #------------------------------------------------------------------------------ -# RCS: @(#) $Id: makefile.vc,v 1.155 2006/11/09 16:52:31 dgp Exp $ +# RCS: @(#) $Id: makefile.vc,v 1.156 2006/11/25 17:18:10 dkf Exp $ #------------------------------------------------------------------------------ # Check to see we are configured to build with MSVC (MSDEVDIR or MSVCDIR) @@ -291,6 +291,7 @@ TCLOBJS = \ $(TMP_DIR)\tclLiteral.obj \ $(TMP_DIR)\tclLoad.obj \ $(TMP_DIR)\tclMain.obj \ + $(TMP_DIR)\tclMathOp.obj \ $(TMP_DIR)\tclNamesp.obj \ $(TMP_DIR)\tclNotify.obj \ $(TMP_DIR)\tclObj.obj \ -- cgit v0.12 'add'>+ /* XXX */;
+
+ value = GetKeepedObjects(src);
+ Py_INCREF(value);
+ return value;
+ }
+
+ if (PointerTypeObject_Check(type)
+ && ArrayObject_Check(value)) {
+ StgDictObject *p1, *p2;
+ PyObject *keep;
+ p1 = PyObject_stgdict(value);
+ p2 = PyType_stgdict(type);
+
+ if (p1->proto != p2->proto) {
+ PyErr_Format(PyExc_TypeError,
+ "incompatible types, %s instance instead of %s instance",
+ value->ob_type->tp_name,
+ ((PyTypeObject *)type)->tp_name);
+ return NULL;
+ }
+ *(void **)ptr = src->b_ptr;
+
+ keep = GetKeepedObjects(src);
+ /*
+ We are assigning an array object to a field which represents
+ a pointer. This has the same effect as converting an array
+ into a pointer. So, again, we have to keep the whole object
+ pointed to (which is the array in this case) alive, and not
+ only it's object list. So we create a tuple, containing
+ b_objects list PLUS the array itself, and return that!
+ */
+ return Py_BuildValue("(OO)", keep, value);
+ }
+ PyErr_Format(PyExc_TypeError,
+ "incompatible types, %s instance instead of %s instance",
+ value->ob_type->tp_name,
+ ((PyTypeObject *)type)->tp_name);
+ return NULL;
+}
+
+/*
+ * Set a slice in object 'dst', which has the type 'type',
+ * to the value 'value'.
+ */
+int
+CData_set(PyObject *dst, PyObject *type, SETFUNC setfunc, PyObject *value,
+ int index, int size, char *ptr)
+{
+ CDataObject *mem = (CDataObject *)dst;
+ PyObject *result;
+
+ if (!CDataObject_Check(dst)) {
+ PyErr_SetString(PyExc_TypeError,
+ "not a ctype instance");
+ return -1;
+ }
+
+ result = _CData_set(mem, type, setfunc, value,
+ size, ptr);
+ if (result == NULL)
+ return -1;
+
+ /* KeepRef steals a refcount from it's last argument */
+ /* If KeepRef fails, we are stumped. The dst memory block has already
+ been changed */
+ return KeepRef(mem, index, result);
+}
+
+
+/******************************************************************/
+static PyObject *
+GenericCData_new(PyTypeObject *type, PyObject *args, PyObject *kwds)
+{
+ CDataObject *obj;
+ StgDictObject *dict;
+
+ dict = PyType_stgdict((PyObject *)type);
+ if (!dict) {
+ PyErr_SetString(PyExc_TypeError,
+ "abstract class");
+ return NULL;
+ }
+ dict->flags |= DICTFLAG_FINAL;
+
+ obj = (CDataObject *)type->tp_alloc(type, 0);
+ if (!obj)
+ return NULL;
+
+ obj->b_base = NULL;
+ obj->b_index = 0;
+ obj->b_objects = NULL;
+ obj->b_length = dict->length;
+
+ CData_MallocBuffer(obj, dict);
+ return (PyObject *)obj;
+}
+/*****************************************************************/
+/*
+ CFuncPtr_Type
+*/
+
+static PyObject *
+CFuncPtr_as_parameter(CDataObject *self)
+{
+ PyCArgObject *parg;
+
+ parg = new_CArgObject();
+ if (parg == NULL)
+ return NULL;
+
+ parg->tag = 'P';
+ parg->pffi_type = &ffi_type_pointer;
+ Py_INCREF(self);
+ parg->obj = (PyObject *)self;
+ parg->value.p = *(void **)self->b_ptr;
+ return (PyObject *)parg;
+}
+
+static int
+CFuncPtr_set_errcheck(CFuncPtrObject *self, PyObject *ob)
+{
+ if (ob && !PyCallable_Check(ob)) {
+ PyErr_SetString(PyExc_TypeError,
+ "the errcheck attribute must be callable");
+ return -1;
+ }
+ Py_XDECREF(self->errcheck);
+ Py_XINCREF(ob);
+ self->errcheck = ob;
+ return 0;
+}
+
+static PyObject *
+CFuncPtr_get_errcheck(CFuncPtrObject *self)
+{
+ if (self->errcheck) {
+ Py_INCREF(self->errcheck);
+ return self->errcheck;
+ }
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+static int
+CFuncPtr_set_restype(CFuncPtrObject *self, PyObject *ob)
+{
+ if (ob == NULL) {
+ Py_XDECREF(self->restype);
+ self->restype = NULL;
+ Py_XDECREF(self->checker);
+ self->checker = NULL;
+ return 0;
+ }
+ if (ob != Py_None && !PyType_stgdict(ob) && !PyCallable_Check(ob)) {
+ PyErr_SetString(PyExc_TypeError,
+ "restype must be a type, a callable, or None");
+ return -1;
+ }
+ Py_XDECREF(self->checker);
+ Py_XDECREF(self->restype);
+ Py_INCREF(ob);
+ self->restype = ob;
+ self->checker = PyObject_GetAttrString(ob, "_check_retval_");
+ if (self->checker == NULL)
+ PyErr_Clear();
+ return 0;
+}
+
+static PyObject *
+CFuncPtr_get_restype(CFuncPtrObject *self)
+{
+ StgDictObject *dict;
+ if (self->restype) {
+ Py_INCREF(self->restype);
+ return self->restype;
+ }
+ dict = PyObject_stgdict((PyObject *)self);
+ assert(dict);
+ if (dict->restype) {
+ Py_INCREF(dict->restype);
+ return dict->restype;
+ } else {
+ Py_INCREF(Py_None);
+ return Py_None;
+ }
+}
+
+static int
+CFuncPtr_set_argtypes(CFuncPtrObject *self, PyObject *ob)
+{
+ PyObject *converters;
+
+ if (ob == NULL || ob == Py_None) {
+ Py_XDECREF(self->converters);
+ self->converters = NULL;
+ Py_XDECREF(self->argtypes);
+ self->argtypes = NULL;
+ } else {
+ converters = converters_from_argtypes(ob);
+ if (!converters)
+ return -1;
+ Py_XDECREF(self->converters);
+ self->converters = converters;
+ Py_XDECREF(self->argtypes);
+ Py_INCREF(ob);
+ self->argtypes = ob;
+ }
+ return 0;
+}
+
+static PyObject *
+CFuncPtr_get_argtypes(CFuncPtrObject *self)
+{
+ StgDictObject *dict;
+ if (self->argtypes) {
+ Py_INCREF(self->argtypes);
+ return self->argtypes;
+ }
+ dict = PyObject_stgdict((PyObject *)self);
+ assert(dict);
+ if (dict->argtypes) {
+ Py_INCREF(dict->argtypes);
+ return dict->argtypes;
+ } else {
+ Py_INCREF(Py_None);
+ return Py_None;
+ }
+}
+
+static PyGetSetDef CFuncPtr_getsets[] = {
+ { "errcheck", (getter)CFuncPtr_get_errcheck, (setter)CFuncPtr_set_errcheck,
+ "a function to check for errors", NULL },
+ { "restype", (getter)CFuncPtr_get_restype, (setter)CFuncPtr_set_restype,
+ "specify the result type", NULL },
+ { "argtypes", (getter)CFuncPtr_get_argtypes,
+ (setter)CFuncPtr_set_argtypes,
+ "specify the argument types", NULL },
+ { "_as_parameter_", (getter)CFuncPtr_as_parameter, NULL,
+ "return a magic value so that this can be converted to a C parameter (readonly)",
+ NULL },
+ { NULL, NULL }
+};
+
+#ifdef MS_WIN32
+static PPROC FindAddress(void *handle, char *name, PyObject *type)
+{
+ PPROC address;
+ char *mangled_name;
+ int i;
+ StgDictObject *dict = PyType_stgdict((PyObject *)type);
+
+ address = (PPROC)GetProcAddress(handle, name);
+ if (address)
+ return address;
+ /* It should not happen that dict is NULL, but better be safe */
+ if (dict==NULL || dict->flags & FUNCFLAG_CDECL)
+ return address;
+
+ /* for stdcall, try mangled names:
+ funcname -> _funcname@<n>
+ where n is 0, 4, 8, 12, ..., 128
+ */
+ mangled_name = _alloca(strlen(name) + 1 + 1 + 1 + 3); /* \0 _ @ %d */
+ for (i = 0; i < 32; ++i) {
+ sprintf(mangled_name, "_%s@%d", name, i*4);
+ address = (PPROC)GetProcAddress(handle, mangled_name);
+ if (address)
+ return address;
+ }
+ return NULL;
+}
+#endif
+
+/* Return 1 if usable, 0 else and exception set. */
+static int
+_check_outarg_type(PyObject *arg, int index)
+{
+ StgDictObject *dict;
+
+ if (PointerTypeObject_Check(arg))
+ return 1;
+
+ if (ArrayTypeObject_Check(arg))
+ return 1;
+
+ dict = PyType_stgdict(arg);
+ if (dict
+ /* simple pointer types, c_void_p, c_wchar_p, BSTR, ... */
+ && PyString_Check(dict->proto)
+/* We only allow c_void_p, c_char_p and c_wchar_p as a simple output parameter type */
+ && (strchr("PzZ", PyString_AS_STRING(dict->proto)[0]))) {
+ return 1;
+ }
+
+ PyErr_Format(PyExc_TypeError,
+ "'out' parameter %d must be a pointer type, not %s",
+ index,
+ PyType_Check(arg) ?
+ ((PyTypeObject *)arg)->tp_name :
+ arg->ob_type->tp_name);
+ return 0;
+}
+
+/* Returns 1 on success, 0 on error */
+static int
+_validate_paramflags(PyTypeObject *type, PyObject *paramflags)
+{
+ int i, len;
+ StgDictObject *dict = PyType_stgdict((PyObject *)type);
+ PyObject *argtypes = dict->argtypes;
+
+ if (paramflags == NULL || dict->argtypes == NULL)
+ return 1;
+
+ if (!PyTuple_Check(paramflags)) {
+ PyErr_SetString(PyExc_TypeError,
+ "paramflags must be a tuple or None");
+ return 0;
+ }
+
+ len = PyTuple_GET_SIZE(paramflags);
+ if (len != PyTuple_GET_SIZE(dict->argtypes)) {
+ PyErr_SetString(PyExc_ValueError,
+ "paramflags must have the same length as argtypes");
+ return 0;
+ }
+
+ for (i = 0; i < len; ++i) {
+ PyObject *item = PyTuple_GET_ITEM(paramflags, i);
+ int flag;
+ char *name;
+ PyObject *defval;
+ PyObject *typ;
+ if (!PyArg_ParseTuple(item, "i|zO", &flag, &name, &defval)) {
+ PyErr_SetString(PyExc_TypeError,
+ "paramflags must be a sequence of (int [,string [,value]]) tuples");
+ return 0;
+ }
+ typ = PyTuple_GET_ITEM(argtypes, i);
+ switch (flag & (PARAMFLAG_FIN | PARAMFLAG_FOUT | PARAMFLAG_FLCID)) {
+ case 0:
+ case PARAMFLAG_FIN:
+ case PARAMFLAG_FIN | PARAMFLAG_FLCID:
+ case PARAMFLAG_FIN | PARAMFLAG_FOUT:
+ break;
+ case PARAMFLAG_FOUT:
+ if (!_check_outarg_type(typ, i+1))
+ return 0;
+ break;
+ default:
+ PyErr_Format(PyExc_TypeError,
+ "paramflag value %d not supported",
+ flag);
+ return 0;
+ }
+ }
+ return 1;
+}
+
+static PyObject *
+CFuncPtr_FromDll(PyTypeObject *type, PyObject *args, PyObject *kwds)
+{
+ char *name;
+ int (* address)(void);
+ PyObject *dll;
+ PyObject *obj;
+ CFuncPtrObject *self;
+ void *handle;
+ PyObject *paramflags = NULL;
+
+ if (!PyArg_ParseTuple(args, "sO|O", &name, &dll, &paramflags))
+ return NULL;
+ if (paramflags == Py_None)
+ paramflags = NULL;
+
+ obj = PyObject_GetAttrString(dll, "_handle");
+ if (!obj)
+ return NULL;
+ if (!PyInt_Check(obj) && !PyLong_Check(obj)) {
+ PyErr_SetString(PyExc_TypeError,
+ "the _handle attribute of the second argument must be an integer");
+ Py_DECREF(obj);
+ return NULL;
+ }
+ handle = (void *)PyLong_AsVoidPtr(obj);
+ Py_DECREF(obj);
+ if (PyErr_Occurred()) {
+ PyErr_SetString(PyExc_ValueError,
+ "could not convert the _handle attribute to a pointer");
+ return NULL;
+ }
+
+#ifdef MS_WIN32
+ address = FindAddress(handle, name, (PyObject *)type);
+ if (!address) {
+ PyErr_Format(PyExc_AttributeError,
+ "function '%s' not found",
+ name);
+ return NULL;
+ }
+#else
+ address = (PPROC)ctypes_dlsym(handle, name);
+ if (!address) {
+ PyErr_Format(PyExc_AttributeError,
+#ifdef __CYGWIN__
+/* dlerror() isn't very helpful on cygwin */
+ "function '%s' not found (%s) ",
+ name,
+#endif
+ ctypes_dlerror());
+ return NULL;
+ }
+#endif
+ if (!_validate_paramflags(type, paramflags))
+ return NULL;
+
+ self = (CFuncPtrObject *)GenericCData_new(type, args, kwds);
+ if (!self)
+ return NULL;
+
+ Py_XINCREF(paramflags);
+ self->paramflags = paramflags;
+
+ *(void **)self->b_ptr = address;
+
+ if (-1 == KeepRef((CDataObject *)self, 0, dll)) {
+ Py_DECREF((PyObject *)self);
+ return NULL;
+ }
+ Py_INCREF((PyObject *)dll); /* for KeepRef above */
+
+ Py_INCREF(self);
+ self->callable = (PyObject *)self;
+ return (PyObject *)self;
+}
+
+#ifdef MS_WIN32
+static PyObject *
+CFuncPtr_FromVtblIndex(PyTypeObject *type, PyObject *args, PyObject *kwds)
+{
+ CFuncPtrObject *self;
+ int index;
+ char *name = NULL;
+ PyObject *paramflags = NULL;
+ GUID *iid = NULL;
+ int iid_len = 0;
+
+ if (!PyArg_ParseTuple(args, "is|Oz#", &index, &name, &paramflags, &iid, &iid_len))
+ return NULL;
+ if (paramflags == Py_None)
+ paramflags = NULL;
+
+ if (!_validate_paramflags(type, paramflags))
+ return NULL;
+
+ self = (CFuncPtrObject *)GenericCData_new(type, args, kwds);
+ self->index = index + 0x1000;
+ Py_XINCREF(paramflags);
+ self->paramflags = paramflags;
+ if (iid_len == sizeof(GUID))
+ self->iid = iid;
+ return (PyObject *)self;
+}
+#endif
+
+/*
+ CFuncPtr_new accepts different argument lists in addition to the standard
+ _basespec_ keyword arg:
+
+ one argument form
+ "i" - function address
+ "O" - must be a callable, creates a C callable function
+
+ two or more argument forms (the third argument is a paramflags tuple)
+ "sO|O" - function name, dll object (with an integer handle)
+ "is|O" - vtable index, method name, creates callable calling COM vtbl
+*/
+static PyObject *
+CFuncPtr_new(PyTypeObject *type, PyObject *args, PyObject *kwds)
+{
+ CFuncPtrObject *self;
+ PyObject *callable;
+ StgDictObject *dict;
+ THUNK thunk;
+
+ if (PyTuple_GET_SIZE(args) == 0)
+ return GenericCData_new(type, args, kwds);
+
+ /* Shouldn't the following better be done in __init__? */
+ if (2 <= PyTuple_GET_SIZE(args)) {
+#ifdef MS_WIN32
+ if (PyInt_Check(PyTuple_GET_ITEM(args, 0)))
+ return CFuncPtr_FromVtblIndex(type, args, kwds);
+#endif
+ return CFuncPtr_FromDll(type, args, kwds);
+ }
+
+ if (1 == PyTuple_GET_SIZE(args)
+ && (PyInt_Check(PyTuple_GET_ITEM(args, 0))
+ || PyLong_Check(PyTuple_GET_ITEM(args, 0)))) {
+ CDataObject *ob;
+ void *ptr = PyLong_AsVoidPtr(PyTuple_GET_ITEM(args, 0));
+ if (ptr == NULL)
+ return NULL;
+ ob = (CDataObject *)GenericCData_new(type, args, kwds);
+ *(void **)ob->b_ptr = ptr;
+ return (PyObject *)ob;
+ }
+
+ if (!PyArg_ParseTuple(args, "O", &callable))
+ return NULL;
+ if (!PyCallable_Check(callable)) {
+ PyErr_SetString(PyExc_TypeError,
+ "argument must be callable or integer function address");
+ return NULL;
+ }
+
+ /* XXX XXX This would allow to pass additional options. For COM
+ method *implementations*, we would probably want different
+ behaviour than in 'normal' callback functions: return a HRESULT if
+ an exception occurrs in the callback, and print the traceback not
+ only on the console, but also to OutputDebugString() or something
+ like that.
+ */
+/*
+ if (kwds && PyDict_GetItemString(kwds, "options")) {
+ ...
+ }
+*/
+
+ dict = PyType_stgdict((PyObject *)type);
+ /* XXXX Fails if we do: 'CFuncPtr(lambda x: x)' */
+ if (!dict || !dict->argtypes) {
+ PyErr_SetString(PyExc_TypeError,
+ "cannot construct instance of this class:"
+ " no argtypes");
+ return NULL;
+ }
+
+ /*****************************************************************/
+ /* The thunk keeps unowned references to callable and dict->argtypes
+ so we have to keep them alive somewhere else: callable is kept in self,
+ dict->argtypes is in the type's stgdict.
+ */
+ thunk = AllocFunctionCallback(callable,
+ dict->argtypes,
+ dict->restype,
+ dict->flags & FUNCFLAG_CDECL);
+ if (!thunk)
+ return NULL;
+
+ self = (CFuncPtrObject *)GenericCData_new(type, args, kwds);
+
+ Py_INCREF(callable);
+ self->callable = callable;
+
+ self->thunk = thunk;
+ *(void **)self->b_ptr = *(void **)thunk;
+
+ /* We store ourself in self->b_objects[0], because the whole instance
+ must be kept alive if stored in a structure field, for example.
+ Cycle GC to the rescue! And we have a unittest proving that this works
+ correctly...
+ */
+
+ if (-1 == KeepRef((CDataObject *)self, 0, (PyObject *)self)) {
+ Py_DECREF((PyObject *)self);
+ return NULL;
+ }
+ Py_INCREF((PyObject *)self); /* for KeepRef above */
+
+ return (PyObject *)self;
+}
+
+
+/*
+ _byref consumes a refcount to its argument
+*/
+static PyObject *
+_byref(PyObject *obj)
+{
+ PyCArgObject *parg;
+ if (!CDataObject_Check(obj)) {
+ PyErr_SetString(PyExc_TypeError,
+ "expected CData instance");
+ return NULL;
+ }
+
+ parg = new_CArgObject();
+ if (parg == NULL) {
+ Py_DECREF(obj);
+ return NULL;
+ }
+
+ parg->tag = 'P';
+ parg->pffi_type = &ffi_type_pointer;
+ parg->obj = obj;
+ parg->value.p = ((CDataObject *)obj)->b_ptr;
+ return (PyObject *)parg;
+}
+
+static PyObject *
+_get_arg(int *pindex, char *name, PyObject *defval, PyObject *inargs, PyObject *kwds)
+{
+ PyObject *v;
+
+ if (*pindex < PyTuple_GET_SIZE(inargs)) {
+ v = PyTuple_GET_ITEM(inargs, *pindex);
+ ++*pindex;
+ Py_INCREF(v);
+ return v;
+ }
+ if (kwds && (v = PyDict_GetItemString(kwds, name))) {
+ ++*pindex;
+ Py_INCREF(v);
+ return v;
+ }
+ if (defval) {
+ Py_INCREF(defval);
+ return defval;
+ }
+ /* we can't currently emit a better error message */
+ if (name)
+ PyErr_Format(PyExc_TypeError,
+ "required argument '%s' missing", name);
+ else
+ PyErr_Format(PyExc_TypeError,
+ "not enough arguments");
+ return NULL;
+}
+
+/*
+ This function implements higher level functionality plus the ability to call
+ functions with keyword arguments by looking at parameter flags. parameter
+ flags is a tuple of 1, 2 or 3-tuples. The first entry in each is an integer
+ specifying the direction of the data transfer for this parameter - 'in',
+ 'out' or 'inout' (zero means the same as 'in'). The second entry is the
+ parameter name, and the third is the default value if the parameter is
+ missing in the function call.
+
+ This function builds and returns a new tuple 'callargs' which contains the
+ parameters to use in the call. Items on this tuple are copied from the
+ 'inargs' tuple for 'in' and 'in, out' parameters, and constructed from the
+ 'argtypes' tuple for 'out' parameters. It also calculates numretvals which
+ is the number of return values for the function, outmask/inoutmask are
+ bitmasks containing indexes into the callargs tuple specifying which
+ parameters have to be returned. _build_result builds the return value of the
+ function.
+*/
+static PyObject *
+_build_callargs(CFuncPtrObject *self, PyObject *argtypes,
+ PyObject *inargs, PyObject *kwds,
+ int *poutmask, int *pinoutmask, int *pnumretvals)
+{
+ PyObject *paramflags = self->paramflags;
+ PyObject *callargs;
+ StgDictObject *dict;
+ int i, len;
+ int inargs_index = 0;
+ /* It's a little bit difficult to determine how many arguments the
+ function call requires/accepts. For simplicity, we count the consumed
+ args and compare this to the number of supplied args. */
+ int actual_args;
+
+ *poutmask = 0;
+ *pinoutmask = 0;
+ *pnumretvals = 0;
+
+ /* Trivial cases, where we either return inargs itself, or a slice of it. */
+ if (argtypes == NULL || paramflags == NULL || PyTuple_GET_SIZE(argtypes) == 0) {
+#ifdef MS_WIN32
+ if (self->index)
+ return PyTuple_GetSlice(inargs, 1, PyTuple_GET_SIZE(inargs));
+#endif
+ Py_INCREF(inargs);
+ return inargs;
+ }
+
+ len = PyTuple_GET_SIZE(argtypes);
+ callargs = PyTuple_New(len); /* the argument tuple we build */
+ if (callargs == NULL)
+ return NULL;
+
+#ifdef MS_WIN32
+ /* For a COM method, skip the first arg */
+ if (self->index) {
+ inargs_index = 1;
+ }
+#endif
+ for (i = 0; i < len; ++i) {
+ PyObject *item = PyTuple_GET_ITEM(paramflags, i);
+ PyObject *ob;
+ int flag;
+ char *name = NULL;
+ PyObject *defval = NULL;
+
+ /* This way seems to be ~2 us faster than the PyArg_ParseTuple
+ calls below. */
+ /* We HAVE already checked that the tuple can be parsed with "i|zO", so... */
+ int tsize = PyTuple_GET_SIZE(item);
+ flag = PyInt_AS_LONG(PyTuple_GET_ITEM(item, 0));
+ name = tsize > 1 ? PyString_AS_STRING(PyTuple_GET_ITEM(item, 1)) : NULL;
+ defval = tsize > 2 ? PyTuple_GET_ITEM(item, 2) : NULL;
+
+ switch (flag & (PARAMFLAG_FIN | PARAMFLAG_FOUT | PARAMFLAG_FLCID)) {
+ case PARAMFLAG_FIN | PARAMFLAG_FLCID:
+ /* ['in', 'lcid'] parameter. Always taken from defval */
+ Py_INCREF(defval);
+ PyTuple_SET_ITEM(callargs, i, defval);
+ break;
+ case (PARAMFLAG_FIN | PARAMFLAG_FOUT):
+ *pinoutmask |= (1 << i); /* mark as inout arg */
+ (*pnumretvals)++;
+ /* fall through to PARAMFLAG_FIN... */
+ case 0:
+ case PARAMFLAG_FIN:
+ /* 'in' parameter. Copy it from inargs. */
+ ob =_get_arg(&inargs_index, name, defval, inargs, kwds);
+ if (ob == NULL)
+ goto error;
+ PyTuple_SET_ITEM(callargs, i, ob);
+ break;
+ case PARAMFLAG_FOUT:
+ /* XXX Refactor this code into a separate function. */
+ /* 'out' parameter.
+ argtypes[i] must be a POINTER to a c type.
+
+ Cannot by supplied in inargs, but a defval will be used
+ if available. XXX Should we support getting it from kwds?
+ */
+ if (defval) {
+ /* XXX Using mutable objects as defval will
+ make the function non-threadsafe, unless we
+ copy the object in each invocation */
+ Py_INCREF(defval);
+ PyTuple_SET_ITEM(callargs, i, defval);
+ *poutmask |= (1 << i); /* mark as out arg */
+ (*pnumretvals)++;
+ break;
+ }
+ ob = PyTuple_GET_ITEM(argtypes, i);
+ dict = PyType_stgdict(ob);
+ if (PyString_Check(dict->proto)) {
+ PyErr_Format(
+ PyExc_TypeError,
+ "%s 'out' parameter must be passed as default value",
+ ((PyTypeObject *)ob)->tp_name);
+ goto error;
+ }
+ if (ArrayTypeObject_Check(ob))
+ ob = PyObject_CallObject(ob, NULL);
+ else
+ /* Create an instance of the pointed-to type */
+ ob = PyObject_CallObject(dict->proto, NULL);
+ /*
+ XXX Is the following correct any longer?
+ We must not pass a byref() to the array then but
+ the array instance itself. Then, we cannot retrive
+ the result from the PyCArgObject.
+ */
+ if (ob == NULL)
+ goto error;
+ /* The .from_param call that will ocurr later will pass this
+ as a byref parameter. */
+ PyTuple_SET_ITEM(callargs, i, ob);
+ *poutmask |= (1 << i); /* mark as out arg */
+ (*pnumretvals)++;
+ break;
+ default:
+ PyErr_Format(PyExc_ValueError,
+ "paramflag %d not yet implemented", flag);
+ goto error;
+ break;
+ }
+ }
+
+ /* We have counted the arguments we have consumed in 'inargs_index'. This
+ must be the same as len(inargs) + len(kwds), otherwise we have
+ either too much or not enough arguments. */
+
+ actual_args = PyTuple_GET_SIZE(inargs) + (kwds ? PyDict_Size(kwds) : 0);
+ if (actual_args != inargs_index) {
+ /* When we have default values or named parameters, this error
+ message is misleading. See unittests/test_paramflags.py
+ */
+ PyErr_Format(PyExc_TypeError,
+ "call takes exactly %d arguments (%d given)",
+ inargs_index, actual_args);
+ goto error;
+ }
+
+ /* outmask is a bitmask containing indexes into callargs. Items at
+ these indexes contain values to return.
+ */
+ return callargs;
+ error:
+ Py_DECREF(callargs);
+ return NULL;
+}
+
+/* See also:
+ http://msdn.microsoft.com/library/en-us/com/html/769127a1-1a14-4ed4-9d38-7cf3e571b661.asp
+*/
+/*
+ Build return value of a function.
+
+ Consumes the refcount on result and callargs.
+*/
+static PyObject *
+_build_result(PyObject *result, PyObject *callargs,
+ int outmask, int inoutmask, int numretvals)
+{
+ int i, index, bit;
+ PyObject *tup = NULL;
+
+ if (callargs == NULL)
+ return result;
+ if (result == NULL || numretvals == 0) {
+ Py_DECREF(callargs);
+ return result;
+ }
+ Py_DECREF(result);
+
+ /* allocate tuple to hold the result */
+ if (numretvals > 1) {
+ tup = PyTuple_New(numretvals);
+ if (tup == NULL) {
+ Py_DECREF(callargs);
+ return NULL;
+ }
+ }
+
+ index = 0;
+ for (bit = 1, i = 0; i < 32; ++i, bit <<= 1) {
+ PyObject *v;
+ if (bit & inoutmask) {
+ v = PyTuple_GET_ITEM(callargs, i);
+ Py_INCREF(v);
+ if (numretvals == 1) {
+ Py_DECREF(callargs);
+ return v;
+ }
+ PyTuple_SET_ITEM(tup, index, v);
+ index++;
+ } else if (bit & outmask) {
+ v = PyTuple_GET_ITEM(callargs, i);
+ v = PyObject_CallMethod(v, "__ctypes_from_outparam__", NULL);
+ if (v == NULL || numretvals == 1) {
+ Py_DECREF(callargs);
+ return v;
+ }
+ PyTuple_SET_ITEM(tup, index, v);
+ index++;
+ }
+ if (index == numretvals)
+ break;
+ }
+
+ Py_DECREF(callargs);
+ return tup;
+}
+
+static PyObject *
+CFuncPtr_call(CFuncPtrObject *self, PyObject *inargs, PyObject *kwds)
+{
+ PyObject *restype;
+ PyObject *converters;
+ PyObject *checker;
+ PyObject *argtypes;
+ StgDictObject *dict = PyObject_stgdict((PyObject *)self);
+ PyObject *result;
+ PyObject *callargs;
+ PyObject *errcheck;
+#ifdef MS_WIN32
+ IUnknown *piunk = NULL;
+#endif
+ void *pProc = NULL;
+
+ int inoutmask;
+ int outmask;
+ int numretvals;
+
+ assert(dict); /* if not, it's a bug */
+ restype = self->restype ? self->restype : dict->restype;
+ converters = self->converters ? self->converters : dict->converters;
+ checker = self->checker ? self->checker : dict->checker;
+ argtypes = self->argtypes ? self->argtypes : dict->argtypes;
+/* later, we probably want to have an errcheck field in stgdict */
+ errcheck = self->errcheck /* ? self->errcheck : dict->errcheck */;
+
+
+ pProc = *(void **)self->b_ptr;
+#ifdef MS_WIN32
+ if (self->index) {
+ /* It's a COM method */
+ CDataObject *this;
+ this = (CDataObject *)PyTuple_GetItem(inargs, 0); /* borrowed ref! */
+ if (!this) {
+ PyErr_SetString(PyExc_ValueError,
+ "native com method call without 'this' parameter");
+ return NULL;
+ }
+ if (!CDataObject_Check(this)) {
+ PyErr_SetString(PyExc_TypeError,
+ "Expected a COM this pointer as first argument");
+ return NULL;
+ }
+ /* there should be more checks? No, in Python */
+ /* First arg is an pointer to an interface instance */
+ if (!this->b_ptr || *(void **)this->b_ptr == NULL) {
+ PyErr_SetString(PyExc_ValueError,
+ "NULL COM pointer access");
+ return NULL;
+ }
+ piunk = *(IUnknown **)this->b_ptr;
+ if (NULL == piunk->lpVtbl) {
+ PyErr_SetString(PyExc_ValueError,
+ "COM method call without VTable");
+ return NULL;
+ }
+ pProc = ((void **)piunk->lpVtbl)[self->index - 0x1000];
+ }
+#endif
+ callargs = _build_callargs(self, argtypes,
+ inargs, kwds,
+ &outmask, &inoutmask, &numretvals);
+ if (callargs == NULL)
+ return NULL;
+
+ if (converters) {
+ int required = PyTuple_GET_SIZE(converters);
+ int actual = PyTuple_GET_SIZE(callargs);
+
+ if ((dict->flags & FUNCFLAG_CDECL) == FUNCFLAG_CDECL) {
+ /* For cdecl functions, we allow more actual arguments
+ than the length of the argtypes tuple.
+ */
+ if (required > actual) {
+ Py_DECREF(callargs);
+ PyErr_Format(PyExc_TypeError,
+ "this function takes at least %d argument%s (%d given)",
+ required,
+ required == 1 ? "" : "s",
+ actual);
+ return NULL;
+ }
+ } else if (required != actual) {
+ Py_DECREF(callargs);
+ PyErr_Format(PyExc_TypeError,
+ "this function takes %d argument%s (%d given)",
+ required,
+ required == 1 ? "" : "s",
+ actual);
+ return NULL;
+ }
+ }
+
+ result = _CallProc(pProc,
+ callargs,
+#ifdef MS_WIN32
+ piunk,
+ self->iid,
+#endif
+ dict->flags,
+ converters,
+ restype,
+ checker);
+/* The 'errcheck' protocol */
+ if (result != NULL && errcheck) {
+ PyObject *v = PyObject_CallFunctionObjArgs(errcheck,
+ result,
+ self,
+ callargs,
+ NULL);
+ /* If the errcheck funtion failed, return NULL.
+ If the errcheck function returned callargs unchanged,
+ continue normal processing.
+ If the errcheck function returned something else,
+ use that as result.
+ */
+ if (v == NULL || v != callargs) {
+ Py_DECREF(result);
+ Py_DECREF(callargs);
+ return v;
+ }
+ Py_DECREF(v);
+ }
+
+ return _build_result(result, callargs,
+ outmask, inoutmask, numretvals);
+}
+
+static int
+CFuncPtr_traverse(CFuncPtrObject *self, visitproc visit, void *arg)
+{
+ Py_VISIT(self->callable);
+ Py_VISIT(self->restype);
+ Py_VISIT(self->checker);
+ Py_VISIT(self->errcheck);
+ Py_VISIT(self->argtypes);
+ Py_VISIT(self->converters);
+ Py_VISIT(self->paramflags);
+ return CData_traverse((CDataObject *)self, visit, arg);
+}
+
+static int
+CFuncPtr_clear(CFuncPtrObject *self)
+{
+ Py_CLEAR(self->callable);
+ Py_CLEAR(self->restype);
+ Py_CLEAR(self->checker);
+ Py_CLEAR(self->errcheck);
+ Py_CLEAR(self->argtypes);
+ Py_CLEAR(self->converters);
+ Py_CLEAR(self->paramflags);
+
+ if (self->thunk)
+ FreeCallback(self->thunk);
+ self->thunk = NULL;
+
+ return CData_clear((CDataObject *)self);
+}
+
+static void
+CFuncPtr_dealloc(CFuncPtrObject *self)
+{
+ CFuncPtr_clear(self);
+ self->ob_type->tp_free((PyObject *)self);
+}
+
+static PyObject *
+CFuncPtr_repr(CFuncPtrObject *self)
+{
+#ifdef MS_WIN32
+ if (self->index)
+ return PyString_FromFormat("<COM method offset %d: %s at %p>",
+ self->index - 0x1000,
+ self->ob_type->tp_name,
+ self);
+#endif
+ return PyString_FromFormat("<%s object at %p>",
+ self->ob_type->tp_name,
+ self);
+}
+
+PyTypeObject CFuncPtr_Type = {
+ PyObject_HEAD_INIT(NULL)
+ 0,
+ "_ctypes.CFuncPtr",
+ sizeof(CFuncPtrObject), /* tp_basicsize */
+ 0, /* tp_itemsize */
+ (destructor)CFuncPtr_dealloc, /* tp_dealloc */
+ 0, /* tp_print */
+ 0, /* tp_getattr */
+ 0, /* tp_setattr */
+ 0, /* tp_compare */
+ (reprfunc)CFuncPtr_repr, /* tp_repr */
+ 0, /* tp_as_number */
+ 0, /* tp_as_sequence */
+ 0, /* tp_as_mapping */
+ 0, /* tp_hash */
+ (ternaryfunc)CFuncPtr_call, /* tp_call */
+ 0, /* tp_str */
+ 0, /* tp_getattro */
+ 0, /* tp_setattro */
+ &CData_as_buffer, /* tp_as_buffer */
+ Py_TPFLAGS_DEFAULT | Py_TPFLAGS_BASETYPE, /* tp_flags */
+ "Function Pointer", /* tp_doc */
+ (traverseproc)CFuncPtr_traverse, /* tp_traverse */
+ (inquiry)CFuncPtr_clear, /* tp_clear */
+ 0, /* tp_richcompare */
+ 0, /* tp_weaklistoffset */
+ 0, /* tp_iter */
+ 0, /* tp_iternext */
+ 0, /* tp_methods */
+ 0, /* tp_members */
+ CFuncPtr_getsets, /* tp_getset */
+ 0, /* tp_base */
+ 0, /* tp_dict */
+ 0, /* tp_descr_get */
+ 0, /* tp_descr_set */
+ 0, /* tp_dictoffset */
+ 0, /* tp_init */
+ 0, /* tp_alloc */
+ CFuncPtr_new, /* tp_new */
+ 0, /* tp_free */
+};
+
+/*****************************************************************/
+/*
+ Struct_Type
+*/
+static int
+IBUG(char *msg)
+{
+ PyErr_Format(PyExc_RuntimeError,
+ "inconsistent state in CDataObject (%s)", msg);
+ return -1;
+}
+
+static PyObject *
+Struct_as_parameter(CDataObject *self)
+{
+ PyCArgObject *parg;
+ StgDictObject *stgdict;
+
+ parg = new_CArgObject();
+ if (parg == NULL)
+ return NULL;
+
+ parg->tag = 'V';
+ stgdict = PyObject_stgdict((PyObject *)self);
+ parg->pffi_type = &stgdict->ffi_type;
+ /* For structure parameters (by value), parg->value doesn't contain the structure
+ data itself, instead parg->value.p *points* to the structure's data
+ See also _ctypes.c, function _call_function_pointer().
+ */
+ parg->value.p = self->b_ptr;
+ parg->size = self->b_size;
+ Py_INCREF(self);
+ parg->obj = (PyObject *)self;
+ return (PyObject *)parg;
+}
+
+static int
+Struct_init(PyObject *self, PyObject *args, PyObject *kwds)
+{
+ int i;
+ PyObject *fields;
+
+/* Optimization possible: Store the attribute names _fields_[x][0]
+ * in C accessible fields somewhere ?
+ */
+
+/* Check this code again for correctness! */
+
+ if (!PyTuple_Check(args)) {
+ PyErr_SetString(PyExc_TypeError,
+ "args not a tuple?");
+ return -1;
+ }
+ if (PyTuple_GET_SIZE(args)) {
+ fields = PyObject_GetAttrString(self, "_fields_");
+ if (!fields) {
+ PyErr_Clear();
+ fields = PyTuple_New(0);
+ }
+
+ if (PyTuple_GET_SIZE(args) > PySequence_Length(fields)) {
+ Py_DECREF(fields);
+ PyErr_SetString(PyExc_ValueError,
+ "too many initializers");
+ return -1;
+ }
+
+ for (i = 0; i < PyTuple_GET_SIZE(args); ++i) {
+ PyObject *pair = PySequence_GetItem(fields, i);
+ PyObject *name;
+ PyObject *val;
+ if (!pair) {
+ Py_DECREF(fields);
+ return IBUG("_fields_[i] failed");
+ }
+
+ name = PySequence_GetItem(pair, 0);
+ if (!name) {
+ Py_DECREF(pair);
+ Py_DECREF(fields);
+ return IBUG("_fields_[i][0] failed");
+ }
+
+ val = PyTuple_GET_ITEM(args, i);
+ if (-1 == PyObject_SetAttr(self, name, val)) {
+ Py_DECREF(pair);
+ Py_DECREF(name);
+ Py_DECREF(fields);
+ return -1;
+ }
+
+ Py_DECREF(name);
+ Py_DECREF(pair);
+ }
+ Py_DECREF(fields);
+ }
+
+ if (kwds) {
+ PyObject *key, *value;
+ int pos = 0;
+ while(PyDict_Next(kwds, &pos, &key, &value)) {
+ if (-1 == PyObject_SetAttr(self, key, value))
+ return -1;
+ }
+ }
+ return 0;
+}
+
+static PyGetSetDef Struct_getsets[] = {
+ { "_as_parameter_", (getter)Struct_as_parameter, NULL,
+ "return a magic value so that this can be converted to a C parameter (readonly)",
+ NULL },
+ { NULL, NULL }
+};
+
+static PyTypeObject Struct_Type = {
+ PyObject_HEAD_INIT(NULL)
+ 0,
+ "_ctypes.Structure",
+ sizeof(CDataObject), /* tp_basicsize */
+ 0, /* tp_itemsize */
+ 0, /* tp_dealloc */
+ 0, /* tp_print */
+ 0, /* tp_getattr */
+ 0, /* tp_setattr */
+ 0, /* tp_compare */
+ 0, /* tp_repr */
+ 0, /* tp_as_number */
+ 0, /* tp_as_sequence */
+ 0, /* tp_as_mapping */
+ 0, /* tp_hash */
+ 0, /* tp_call */
+ 0, /* tp_str */
+ 0, /* tp_getattro */
+ 0, /* tp_setattro */
+ &CData_as_buffer, /* tp_as_buffer */
+ Py_TPFLAGS_DEFAULT | Py_TPFLAGS_BASETYPE, /* tp_flags */
+ "Structure base class", /* tp_doc */
+ (traverseproc)CData_traverse, /* tp_traverse */
+ (inquiry)CData_clear, /* tp_clear */
+ 0, /* tp_richcompare */
+ 0, /* tp_weaklistoffset */
+ 0, /* tp_iter */
+ 0, /* tp_iternext */
+ 0, /* tp_methods */
+ 0, /* tp_members */
+ Struct_getsets, /* tp_getset */
+ 0, /* tp_base */
+ 0, /* tp_dict */
+ 0, /* tp_descr_get */
+ 0, /* tp_descr_set */
+ 0, /* tp_dictoffset */
+ Struct_init, /* tp_init */
+ 0, /* tp_alloc */
+ GenericCData_new, /* tp_new */
+ 0, /* tp_free */
+};
+
+static PyTypeObject Union_Type = {
+ PyObject_HEAD_INIT(NULL)
+ 0,
+ "_ctypes.Union",
+ sizeof(CDataObject), /* tp_basicsize */
+ 0, /* tp_itemsize */
+ 0, /* tp_dealloc */
+ 0, /* tp_print */
+ 0, /* tp_getattr */
+ 0, /* tp_setattr */
+ 0, /* tp_compare */
+ 0, /* tp_repr */
+ 0, /* tp_as_number */
+ 0, /* tp_as_sequence */
+ 0, /* tp_as_mapping */
+ 0, /* tp_hash */
+ 0, /* tp_call */
+ 0, /* tp_str */
+ 0, /* tp_getattro */
+ 0, /* tp_setattro */
+ &CData_as_buffer, /* tp_as_buffer */
+ Py_TPFLAGS_DEFAULT | Py_TPFLAGS_BASETYPE, /* tp_flags */
+ "Union base class", /* tp_doc */
+ (traverseproc)CData_traverse, /* tp_traverse */
+ (inquiry)CData_clear, /* tp_clear */
+ 0, /* tp_richcompare */
+ 0, /* tp_weaklistoffset */
+ 0, /* tp_iter */
+ 0, /* tp_iternext */
+ 0, /* tp_methods */
+ 0, /* tp_members */
+ Struct_getsets, /* tp_getset */
+ 0, /* tp_base */
+ 0, /* tp_dict */
+ 0, /* tp_descr_get */
+ 0, /* tp_descr_set */
+ 0, /* tp_dictoffset */
+ Struct_init, /* tp_init */
+ 0, /* tp_alloc */
+ GenericCData_new, /* tp_new */
+ 0, /* tp_free */
+};
+
+
+/******************************************************************/
+/*
+ Array_Type
+*/
+static int
+Array_init(CDataObject *self, PyObject *args, PyObject *kw)
+{
+ int i;
+ int n;
+
+ if (!PyTuple_Check(args)) {
+ PyErr_SetString(PyExc_TypeError,
+ "args not a tuple?");
+ return -1;
+ }
+ n = PyTuple_GET_SIZE(args);
+ for (i = 0; i < n; ++i) {
+ PyObject *v;
+ v = PyTuple_GET_ITEM(args, i);
+ if (-1 == PySequence_SetItem((PyObject *)self, i, v))
+ return -1;
+ }
+ return 0;
+}
+
+static PyObject *
+Array_item(CDataObject *self, int index)
+{
+ int offset, size;
+ StgDictObject *stgdict;
+
+ if (index < 0 || index >= self->b_length) {
+ PyErr_SetString(PyExc_IndexError,
+ "invalid index");
+ return NULL;
+ }
+
+ stgdict = PyObject_stgdict((PyObject *)self);
+ assert(stgdict);
+ /* Would it be clearer if we got the item size from
+ stgdict->proto's stgdict?
+ */
+ size = stgdict->size / stgdict->length;
+ offset = index * size;
+
+ return CData_get(stgdict->proto, stgdict->getfunc, (PyObject *)self,
+ index, size, self->b_ptr + offset);
+}
+
+static PyObject *
+Array_slice(CDataObject *self, int ilow, int ihigh)
+{
+ StgDictObject *stgdict, *itemdict;
+ PyObject *proto;
+ PyListObject *np;
+ int i, len;
+
+ if (ilow < 0)
+ ilow = 0;
+ else if (ilow > self->b_length)
+ ilow = self->b_length;
+ if (ihigh < ilow)
+ ihigh = ilow;
+ else if (ihigh > self->b_length)
+ ihigh = self->b_length;
+ len = ihigh - ilow;
+
+ stgdict = PyObject_stgdict((PyObject *)self);
+ proto = stgdict->proto;
+ itemdict = PyType_stgdict(proto);
+ if (itemdict->getfunc == getentry("c")->getfunc) {
+ char *ptr = (char *)self->b_ptr;
+ return PyString_FromStringAndSize(ptr + ilow, len);
+#ifdef CTYPES_UNICODE
+ } else if (itemdict->getfunc == getentry("u")->getfunc) {
+ wchar_t *ptr = (wchar_t *)self->b_ptr;
+ return PyUnicode_FromWideChar(ptr + ilow, len);
+#endif
+ }
+
+ np = (PyListObject *) PyList_New(len);
+ if (np == NULL)
+ return NULL;
+
+ for (i = 0; i < len; i++) {
+ PyObject *v = Array_item(self, i+ilow);
+ PyList_SET_ITEM(np, i, v);
+ }
+ return (PyObject *)np;
+}
+
+static int
+Array_ass_item(CDataObject *self, int index, PyObject *value)
+{
+ int size, offset;
+ StgDictObject *stgdict;
+ char *ptr;
+
+ if (value == NULL) {
+ PyErr_SetString(PyExc_TypeError,
+ "Array does not support item deletion");
+ return -1;
+ }
+
+ stgdict = PyObject_stgdict((PyObject *)self);
+ if (index < 0 || index >= stgdict->length) {
+ PyErr_SetString(PyExc_IndexError,
+ "invalid index");
+ return -1;
+ }
+ size = stgdict->size / stgdict->length;
+ offset = index * size;
+ ptr = self->b_ptr + offset;
+
+ return CData_set((PyObject *)self, stgdict->proto, stgdict->setfunc, value,
+ index, size, ptr);
+}
+
+static int
+Array_ass_slice(CDataObject *self, int ilow, int ihigh, PyObject *value)
+{
+ int i, len;
+
+ if (value == NULL) {
+ PyErr_SetString(PyExc_TypeError,
+ "Array does not support item deletion");
+ return -1;
+ }
+
+ if (ilow < 0)
+ ilow = 0;
+ else if (ilow > self->b_length)
+ ilow = self->b_length;
+ if (ihigh < 0)
+ ihigh = 0;
+ if (ihigh < ilow)
+ ihigh = ilow;
+ else if (ihigh > self->b_length)
+ ihigh = self->b_length;
+
+ len = PySequence_Length(value);
+ if (len != ihigh - ilow) {
+ PyErr_SetString(PyExc_ValueError,
+ "Can only assign sequence of same size");
+ return -1;
+ }
+ for (i = 0; i < len; i++) {
+ PyObject *item = PySequence_GetItem(value, i);
+ int result;
+ if (item == NULL)
+ return -1;
+ result = Array_ass_item(self, i+ilow, item);
+ Py_DECREF(item);
+ if (result == -1)
+ return -1;
+ }
+ return 0;
+}
+
+static int
+Array_length(CDataObject *self)
+{
+ return self->b_length;
+}
+
+static PySequenceMethods Array_as_sequence = {
+ (inquiry)Array_length, /* sq_length; */
+ 0, /* sq_concat; */
+ 0, /* sq_repeat; */
+ (intargfunc)Array_item, /* sq_item; */
+ (intintargfunc)Array_slice, /* sq_slice; */
+ (intobjargproc)Array_ass_item, /* sq_ass_item; */
+ (intintobjargproc)Array_ass_slice, /* sq_ass_slice; */
+ 0, /* sq_contains; */
+
+ 0, /* sq_inplace_concat; */
+ 0, /* sq_inplace_repeat; */
+};
+
+static PyObject *
+Array_as_parameter(CDataObject *self)
+{
+ PyCArgObject *p = new_CArgObject();
+ if (p == NULL)
+ return NULL;
+ p->tag = 'P';
+ p->pffi_type = &ffi_type_pointer;
+ p->value.p = (char *)self->b_ptr;
+ Py_INCREF(self);
+ p->obj = (PyObject *)self;
+ return (PyObject *)p;
+}
+
+static PyGetSetDef Array_getsets[] = {
+ { "_as_parameter_", (getter)Array_as_parameter,
+ (setter)NULL, "convert to a parameter", NULL },
+ { NULL },
+};
+
+PyTypeObject Array_Type = {
+ PyObject_HEAD_INIT(NULL)
+ 0,
+ "_ctypes.Array",
+ sizeof(CDataObject), /* tp_basicsize */
+ 0, /* tp_itemsize */
+ 0, /* tp_dealloc */
+ 0, /* tp_print */
+ 0, /* tp_getattr */
+ 0, /* tp_setattr */
+ 0, /* tp_compare */
+ 0, /* tp_repr */
+ 0, /* tp_as_number */
+ &Array_as_sequence, /* tp_as_sequence */
+ 0, /* tp_as_mapping */
+ 0, /* tp_hash */
+ 0, /* tp_call */
+ 0, /* tp_str */
+ 0, /* tp_getattro */
+ 0, /* tp_setattro */
+ &CData_as_buffer, /* tp_as_buffer */
+ Py_TPFLAGS_DEFAULT | Py_TPFLAGS_BASETYPE, /* tp_flags */
+ "XXX to be provided", /* tp_doc */
+ (traverseproc)CData_traverse, /* tp_traverse */
+ (inquiry)CData_clear, /* tp_clear */
+ 0, /* tp_richcompare */
+ 0, /* tp_weaklistoffset */
+ 0, /* tp_iter */
+ 0, /* tp_iternext */
+ 0, /* tp_methods */
+ 0, /* tp_members */
+ Array_getsets, /* tp_getset */
+ 0, /* tp_base */
+ 0, /* tp_dict */
+ 0, /* tp_descr_get */
+ 0, /* tp_descr_set */
+ 0, /* tp_dictoffset */
+ (initproc)Array_init, /* tp_init */
+ 0, /* tp_alloc */
+ GenericCData_new, /* tp_new */
+ 0, /* tp_free */
+};
+
+PyObject *
+CreateArrayType(PyObject *itemtype, int length)
+{
+ static PyObject *cache;
+ PyObject *key;
+ PyObject *result;
+ char name[256];
+
+ if (cache == NULL) {
+ cache = PyDict_New();
+ if (cache == NULL)
+ return NULL;
+ }
+ key = Py_BuildValue("(Oi)", itemtype, length);
+ if (!key)
+ return NULL;
+ result = PyDict_GetItem(cache, key);
+ if (result) {
+ Py_INCREF(result);
+ Py_DECREF(key);
+ return result;
+ }
+
+ if (!PyType_Check(itemtype)) {
+ PyErr_SetString(PyExc_TypeError,
+ "Expected a type object");
+ return NULL;
+ }
+ sprintf(name, "%.200s_Array_%d",
+ ((PyTypeObject *)itemtype)->tp_name, length);
+
+ result = PyObject_CallFunction((PyObject *)&ArrayType_Type,
+ "s(O){s:i,s:O}",
+ name,
+ &Array_Type,
+ "_length_",
+ length,
+ "_type_",
+ itemtype
+ );
+ if (!result)
+ return NULL;
+ PyDict_SetItem(cache, key, result);
+ Py_DECREF(key);
+ return result;
+}
+
+
+/******************************************************************/
+/*
+ Simple_Type
+*/
+
+static int
+Simple_set_value(CDataObject *self, PyObject *value)
+{
+ PyObject *result;
+ StgDictObject *dict = PyObject_stgdict((PyObject *)self);
+
+ assert(dict->setfunc);
+ result = dict->setfunc(self->b_ptr, value, dict->size);
+ if (!result)
+ return -1;
+
+ /* consumes the refcount the setfunc returns */
+ return KeepRef(self, 0, result);
+}
+
+static int
+Simple_init(CDataObject *self, PyObject *args, PyObject *kw)
+{
+ PyObject *value = NULL;
+ if (!PyArg_UnpackTuple(args, "__init__", 0, 1, &value))
+ return -1;
+ if (value)
+ return Simple_set_value(self, value);
+ return 0;
+}
+
+static PyObject *
+Simple_get_value(CDataObject *self)
+{
+ StgDictObject *dict;
+ dict = PyObject_stgdict((PyObject *)self);
+ assert(dict->getfunc);
+ dict = PyObject_stgdict((PyObject *)self);
+ return dict->getfunc(self->b_ptr, self->b_size);
+}
+
+static PyObject *
+Simple_as_parameter(CDataObject *self)
+{
+ StgDictObject *dict = PyObject_stgdict((PyObject *)self);
+ char *fmt = PyString_AsString(dict->proto);
+ PyCArgObject *parg;
+ struct fielddesc *fd;
+
+ fd = getentry(fmt);
+ assert(fd);
+
+ parg = new_CArgObject();
+ if (parg == NULL)
+ return NULL;
+
+ parg->tag = fmt[0];
+ parg->pffi_type = fd->pffi_type;
+ Py_INCREF(self);
+ parg->obj = (PyObject *)self;
+ memcpy(&parg->value, self->b_ptr, self->b_size);
+ return (PyObject *)parg;
+}
+
+static PyGetSetDef Simple_getsets[] = {
+ { "value", (getter)Simple_get_value, (setter)Simple_set_value,
+ "current value", NULL },
+ { "_as_parameter_", (getter)Simple_as_parameter, NULL,
+ "return a magic value so that this can be converted to a C parameter (readonly)",
+ NULL },
+ { NULL, NULL }
+};
+
+static PyObject *
+Simple_from_outparm(PyObject *self, PyObject *args)
+{
+ if (IsSimpleSubType((PyObject *)self->ob_type)) {
+ Py_INCREF(self);
+ return self;
+ }
+ /* call stgdict->getfunc */
+ return Simple_get_value((CDataObject *)self);
+}
+
+static PyMethodDef Simple_methods[] = {
+ { "__ctypes_from_outparam__", Simple_from_outparm, METH_NOARGS, },
+ { NULL, NULL },
+};
+
+static int Simple_nonzero(CDataObject *self)
+{
+ return memcmp(self->b_ptr, "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0", self->b_size);
+}
+
+static PyNumberMethods Simple_as_number = {
+ 0, /* nb_add */
+ 0, /* nb_subtract */
+ 0, /* nb_multiply */
+ 0, /* nb_divide */
+ 0, /* nb_remainder */
+ 0, /* nb_divmod */
+ 0, /* nb_power */
+ 0, /* nb_negative */
+ 0, /* nb_positive */
+ 0, /* nb_absolute */
+ (inquiry)Simple_nonzero, /* nb_nonzero */
+};
+
+#if (PY_VERSION_HEX < 0x02040000)
+/* Only in Python 2.4 and up */
+static PyObject *
+PyTuple_Pack(int n, ...)
+{
+ int i;
+ PyObject *o;
+ PyObject *result;
+ PyObject **items;
+ va_list vargs;
+
+ va_start(vargs, n);
+ result = PyTuple_New(n);
+ if (result == NULL)
+ return NULL;
+ items = ((PyTupleObject *)result)->ob_item;
+ for (i = 0; i < n; i++) {
+ o = va_arg(vargs, PyObject *);
+ Py_INCREF(o);
+ items[i] = o;
+ }
+ va_end(vargs);
+ return result;
+}
+#endif
+
+/* "%s(%s)" % (self.__class__.__name__, self.value) */
+static PyObject *
+Simple_repr(CDataObject *self)
+{
+ PyObject *val, *name, *args, *result;
+ static PyObject *format;
+
+ if (self->ob_type->tp_base != &Simple_Type) {
+ return PyString_FromFormat("<%s object at %p>",
+ self->ob_type->tp_name, self);
+ }
+
+ if (format == NULL) {
+ format = PyString_FromString("%s(%r)");
+ if (format == NULL)
+ return NULL;
+ }
+
+ val = Simple_get_value(self);
+ if (val == NULL)
+ return NULL;
+
+ name = PyString_FromString(self->ob_type->tp_name);
+ if (name == NULL) {
+ Py_DECREF(name);
+ return NULL;
+ }
+
+ args = PyTuple_Pack(2, name, val);
+ Py_DECREF(name);
+ Py_DECREF(val);
+ if (args == NULL)
+ return NULL;
+
+ result = PyString_Format(format, args);
+ Py_DECREF(args);
+ return result;
+}
+
+static PyTypeObject Simple_Type = {
+ PyObject_HEAD_INIT(NULL)
+ 0,
+ "_ctypes._SimpleCData",
+ sizeof(CDataObject), /* tp_basicsize */
+ 0, /* tp_itemsize */
+ 0, /* tp_dealloc */
+ 0, /* tp_print */
+ 0, /* tp_getattr */
+ 0, /* tp_setattr */
+ 0, /* tp_compare */
+ (reprfunc)&Simple_repr, /* tp_repr */
+ &Simple_as_number, /* tp_as_number */
+ 0, /* tp_as_sequence */
+ 0, /* tp_as_mapping */
+ 0, /* tp_hash */
+ 0, /* tp_call */
+ 0, /* tp_str */
+ 0, /* tp_getattro */
+ 0, /* tp_setattro */
+ &CData_as_buffer, /* tp_as_buffer */
+ Py_TPFLAGS_DEFAULT | Py_TPFLAGS_BASETYPE, /* tp_flags */
+ "XXX to be provided", /* tp_doc */
+ (traverseproc)CData_traverse, /* tp_traverse */
+ (inquiry)CData_clear, /* tp_clear */
+ 0, /* tp_richcompare */
+ 0, /* tp_weaklistoffset */
+ 0, /* tp_iter */
+ 0, /* tp_iternext */
+ Simple_methods, /* tp_methods */
+ 0, /* tp_members */
+ Simple_getsets, /* tp_getset */
+ 0, /* tp_base */
+ 0, /* tp_dict */
+ 0, /* tp_descr_get */
+ 0, /* tp_descr_set */
+ 0, /* tp_dictoffset */
+ (initproc)Simple_init, /* tp_init */
+ 0, /* tp_alloc */
+ GenericCData_new, /* tp_new */
+ 0, /* tp_free */
+};
+
+/******************************************************************/
+/*
+ Pointer_Type
+*/
+static PyObject *
+Pointer_item(CDataObject *self, int index)
+{
+ int size, offset;
+ StgDictObject *stgdict, *itemdict;
+ PyObject *proto;
+
+ if (*(void **)self->b_ptr == NULL) {
+ PyErr_SetString(PyExc_ValueError,
+ "NULL pointer access");
+ return NULL;
+ }
+
+
+ stgdict = PyObject_stgdict((PyObject *)self);
+ assert(stgdict);
+
+ proto = stgdict->proto;
+ /* XXXXXX MAKE SURE PROTO IS NOT NULL! */
+ itemdict = PyType_stgdict(proto);
+ size = itemdict->size;
+ offset = index * itemdict->size;
+
+ return CData_get(stgdict->proto, stgdict->getfunc, (PyObject *)self,
+ index, size, (*(char **)self->b_ptr) + offset);
+}
+
+static int
+Pointer_ass_item(CDataObject *self, int index, PyObject *value)
+{
+ int size;
+ StgDictObject *stgdict;
+
+ if (value == NULL) {
+ PyErr_SetString(PyExc_TypeError,
+ "Pointer does not support item deletion");
+ return -1;
+ }
+
+ if (*(void **)self->b_ptr == NULL) {
+ PyErr_SetString(PyExc_ValueError,
+ "NULL pointer access");
+ return -1;
+ }
+
+ stgdict = PyObject_stgdict((PyObject *)self);
+ if (index != 0) {
+ PyErr_SetString(PyExc_IndexError,
+ "invalid index");
+ return -1;
+ }
+ size = stgdict->size / stgdict->length;
+
+ /* XXXXX Make sure proto is NOT NULL! */
+ return CData_set((PyObject *)self, stgdict->proto, stgdict->setfunc, value,
+ index, size, *(void **)self->b_ptr);
+}
+
+static PyObject *
+Pointer_get_contents(CDataObject *self, void *closure)
+{
+ StgDictObject *stgdict;
+
+ if (*(void **)self->b_ptr == NULL) {
+ PyErr_SetString(PyExc_ValueError,
+ "NULL pointer access");
+ return NULL;
+ }
+
+ stgdict = PyObject_stgdict((PyObject *)self);
+ assert(stgdict);
+ return CData_FromBaseObj(stgdict->proto,
+ (PyObject *)self, 0,
+ *(void **)self->b_ptr);
+}
+
+static int
+Pointer_set_contents(CDataObject *self, PyObject *value, void *closure)
+{
+ StgDictObject *stgdict;
+ CDataObject *dst;
+ PyObject *keep;
+
+ if (value == NULL) {
+ PyErr_SetString(PyExc_TypeError,
+ "Pointer does not support item deletion");
+ return -1;
+ }
+ stgdict = PyObject_stgdict((PyObject *)self);
+ /* should have been catched in Pointer_new() */
+ assert(stgdict->proto);
+ if (!CDataObject_Check(value)
+ || 0 == PyObject_IsInstance(value, stgdict->proto)) {
+ /* XXX PyObject_IsInstance could return -1! */
+ PyErr_Format(PyExc_TypeError,
+ "expected %s instead of %s",
+ ((PyTypeObject *)(stgdict->proto))->tp_name,
+ value->ob_type->tp_name);
+ return -1;
+ }
+
+ dst = (CDataObject *)value;
+ *(void **)self->b_ptr = dst->b_ptr;
+
+ /*
+ A Pointer instance must keep a the value it points to alive. So, a
+ pointer instance has b_length set to 2 instead of 1, and we set
+ 'value' itself as the second item of the b_objects list, additionally.
+ */
+ Py_INCREF(value);
+ if (-1 == KeepRef(self, 1, value))
+ return -1;
+
+ keep = GetKeepedObjects(dst);
+ Py_INCREF(keep);
+ return KeepRef(self, 0, keep);
+}
+
+static PyObject *
+Pointer_as_parameter(CDataObject *self)
+{
+ PyCArgObject *parg;
+
+ parg = new_CArgObject();
+ if (parg == NULL)
+ return NULL;
+
+ parg->tag = 'P';
+ parg->pffi_type = &ffi_type_pointer;
+ Py_INCREF(self);
+ parg->obj = (PyObject *)self;
+ parg->value.p = *(void **)self->b_ptr;
+ return (PyObject *)parg;
+}
+
+static PyGetSetDef Pointer_getsets[] = {
+ { "contents", (getter)Pointer_get_contents,
+ (setter)Pointer_set_contents,
+ "the object this pointer points to (read-write)", NULL },
+ { "_as_parameter_", (getter)Pointer_as_parameter, NULL,
+ "return a magic value so that this can be converted to a C parameter (readonly)",
+ NULL },
+ { NULL, NULL }
+};
+
+static int
+Pointer_init(CDataObject *self, PyObject *args, PyObject *kw)
+{
+ PyObject *value = NULL;
+
+ if (!PyArg_ParseTuple(args, "|O:POINTER", &value))
+ return -1;
+ if (value == NULL)
+ return 0;
+ return Pointer_set_contents(self, value, NULL);
+}
+
+static PyObject *
+Pointer_new(PyTypeObject *type, PyObject *args, PyObject *kw)
+{
+ StgDictObject *dict = PyType_stgdict((PyObject *)type);
+ if (!dict || !dict->proto) {
+ PyErr_SetString(PyExc_TypeError,
+ "Cannot create instance: has no _type_");
+ return NULL;
+ }
+ return GenericCData_new(type, args, kw);
+}
+
+static PyObject *
+Pointer_slice(CDataObject *self, int ilow, int ihigh)
+{
+ PyListObject *np;
+ StgDictObject *stgdict, *itemdict;
+ PyObject *proto;
+ int i, len;
+
+ if (ilow < 0)
+ ilow = 0;
+ if (ihigh < ilow)
+ ihigh = ilow;
+ len = ihigh - ilow;
+
+ stgdict = PyObject_stgdict((PyObject *)self);
+ proto = stgdict->proto;
+ itemdict = PyType_stgdict(proto);
+ if (itemdict->getfunc == getentry("c")->getfunc) {
+ char *ptr = *(char **)self->b_ptr;
+ return PyString_FromStringAndSize(ptr + ilow, len);
+#ifdef CTYPES_UNICODE
+ } else if (itemdict->getfunc == getentry("u")->getfunc) {
+ wchar_t *ptr = *(wchar_t **)self->b_ptr;
+ return PyUnicode_FromWideChar(ptr + ilow, len);
+#endif
+ }
+
+ np = (PyListObject *) PyList_New(len);
+ if (np == NULL)
+ return NULL;
+
+ for (i = 0; i < len; i++) {
+ PyObject *v = Pointer_item(self, i+ilow);
+ PyList_SET_ITEM(np, i, v);
+ }
+ return (PyObject *)np;
+}
+
+static PySequenceMethods Pointer_as_sequence = {
+ 0, /* inquiry sq_length; */
+ 0, /* binaryfunc sq_concat; */
+ 0, /* intargfunc sq_repeat; */
+ (intargfunc)Pointer_item, /* intargfunc sq_item; */
+ (intintargfunc)Pointer_slice, /* intintargfunc sq_slice; */
+ (intobjargproc)Pointer_ass_item, /* intobjargproc sq_ass_item; */
+ 0, /* intintobjargproc sq_ass_slice; */
+ 0, /* objobjproc sq_contains; */
+ /* Added in release 2.0 */
+ 0, /* binaryfunc sq_inplace_concat; */
+ 0, /* intargfunc sq_inplace_repeat; */
+};
+
+static int
+Pointer_nonzero(CDataObject *self)
+{
+ return *(void **)self->b_ptr != NULL;
+}
+
+static PyNumberMethods Pointer_as_number = {
+ 0, /* nb_add */
+ 0, /* nb_subtract */
+ 0, /* nb_multiply */
+ 0, /* nb_divide */
+ 0, /* nb_remainder */
+ 0, /* nb_divmod */
+ 0, /* nb_power */
+ 0, /* nb_negative */
+ 0, /* nb_positive */
+ 0, /* nb_absolute */
+ (inquiry)Pointer_nonzero, /* nb_nonzero */
+};
+
+PyTypeObject Pointer_Type = {
+ PyObject_HEAD_INIT(NULL)
+ 0,
+ "_ctypes._Pointer",
+ sizeof(CDataObject), /* tp_basicsize */
+ 0, /* tp_itemsize */
+ 0, /* tp_dealloc */
+ 0, /* tp_print */
+ 0, /* tp_getattr */
+ 0, /* tp_setattr */
+ 0, /* tp_compare */
+ 0, /* tp_repr */
+ &Pointer_as_number, /* tp_as_number */
+ &Pointer_as_sequence, /* tp_as_sequence */
+ 0, /* tp_as_mapping */
+ 0, /* tp_hash */
+ 0, /* tp_call */
+ 0, /* tp_str */
+ 0, /* tp_getattro */
+ 0, /* tp_setattro */
+ &CData_as_buffer, /* tp_as_buffer */
+ Py_TPFLAGS_DEFAULT | Py_TPFLAGS_BASETYPE, /* tp_flags */
+ "XXX to be provided", /* tp_doc */
+ (traverseproc)CData_traverse, /* tp_traverse */
+ (inquiry)CData_clear, /* tp_clear */
+ 0, /* tp_richcompare */
+ 0, /* tp_weaklistoffset */
+ 0, /* tp_iter */
+ 0, /* tp_iternext */
+ 0, /* tp_methods */
+ 0, /* tp_members */
+ Pointer_getsets, /* tp_getset */
+ 0, /* tp_base */
+ 0, /* tp_dict */
+ 0, /* tp_descr_get */
+ 0, /* tp_descr_set */
+ 0, /* tp_dictoffset */
+ (initproc)Pointer_init, /* tp_init */
+ 0, /* tp_alloc */
+ Pointer_new, /* tp_new */
+ 0, /* tp_free */
+};
+
+
+/******************************************************************/
+/*
+ * Module initialization.
+ */
+
+static char *module_docs =
+"Create and manipulate C compatible data types in Python.";
+
+#ifdef MS_WIN32
+
+static char comerror_doc[] = "Raised when a COM method call failed.";
+
+static PyObject *
+comerror_str(PyObject *ignored, PyObject *self)
+{
+ PyObject *args = PyObject_GetAttrString(self, "args");
+ PyObject *result;
+ if (args == NULL)
+ return NULL;
+ result = PyObject_Str(args);
+ Py_DECREF(args);
+ return result;
+}
+
+static PyObject *
+comerror_init(PyObject *self, PyObject *args)
+{
+ PyObject *hresult, *text, *details;
+ PyObject *a;
+ int status;
+
+ if (!PyArg_ParseTuple(args, "OOOO:COMError", &self, &hresult, &text, &details))
+ return NULL;
+
+ a = PySequence_GetSlice(args, 1, PySequence_Size(args));
+ if (!a)
+ return NULL;
+ status = PyObject_SetAttrString(self, "args", a);
+ Py_DECREF(a);
+ if (status < 0)
+ return NULL;
+
+ if (PyObject_SetAttrString(self, "hresult", hresult) < 0)
+ return NULL;
+
+ if (PyObject_SetAttrString(self, "text", text) < 0)
+ return NULL;
+
+ if (PyObject_SetAttrString(self, "details", details) < 0)
+ return NULL;
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+static PyMethodDef comerror_methods[] = {
+ { "__str__", comerror_str, METH_O },
+ { "__init__", comerror_init, METH_VARARGS },
+ { NULL, NULL },
+};
+
+PyObject *COMError;
+
+static int
+create_comerror(void)
+{
+ PyObject *dict = PyDict_New();
+ PyMethodDef *methods = comerror_methods;
+ PyObject *s;
+ int status;
+
+ ComError = PyErr_NewException("_ctypes.COMError",
+ NULL,
+ dict);
+ if (ComError == NULL)
+ return -1;
+ while (methods->ml_name) {
+ /* get a wrapper for the built-in function */
+ PyObject *func = PyCFunction_New(methods, NULL);
+ PyObject *meth;
+ if (func == NULL)
+ return -1;
+ meth = PyMethod_New(func, NULL, ComError);
+ Py_DECREF(func);
+ if (meth == NULL)
+ return -1;
+ PyDict_SetItemString(dict, methods->ml_name, meth);
+ Py_DECREF(meth);
+ ++methods;
+ }
+ Py_INCREF(ComError);
+ s = PyString_FromString(comerror_doc);
+ if (s == NULL)
+ return -1;
+ status = PyDict_SetItemString(dict, "__doc__", s);
+ Py_DECREF(s);
+ return status;
+}
+
+#endif
+
+static PyObject *
+string_at(const char *ptr, int size)
+{
+ if (size == 0)
+ return PyString_FromString(ptr);
+ return PyString_FromStringAndSize(ptr, size);
+}
+
+
+#ifdef CTYPES_UNICODE
+static PyObject *
+wstring_at(const wchar_t *ptr, int size)
+{
+ if (size == 0)
+ size = wcslen(ptr);
+ return PyUnicode_FromWideChar(ptr, size);
+}
+#endif
+
+DL_EXPORT(void)
+init_ctypes(void)
+{
+ PyObject *m;
+
+/* Note:
+ ob_type is the metatype (the 'type'), defaults to PyType_Type,
+ tp_base is the base type, defaults to 'object' aka PyBaseObject_Type.
+*/
+ PyEval_InitThreads();
+ m = Py_InitModule3("_ctypes", module_methods, module_docs);
+ if (!m)
+ return;
+
+ if (PyType_Ready(&PyCArg_Type) < 0)
+ return;
+
+ /* StgDict is derived from PyDict_Type */
+ StgDict_Type.tp_base = &PyDict_Type;
+ if (PyType_Ready(&StgDict_Type) < 0)
+ return;
+
+ /*************************************************
+ *
+ * Metaclasses
+ */
+
+ StructType_Type.tp_base = &PyType_Type;
+ if (PyType_Ready(&StructType_Type) < 0)
+ return;
+
+ UnionType_Type.tp_base = &PyType_Type;
+ if (PyType_Ready(&UnionType_Type) < 0)
+ return;
+
+ PointerType_Type.tp_base = &PyType_Type;
+ if (PyType_Ready(&PointerType_Type) < 0)
+ return;
+
+ ArrayType_Type.tp_base = &PyType_Type;
+ if (PyType_Ready(&ArrayType_Type) < 0)
+ return;
+
+ SimpleType_Type.tp_base = &PyType_Type;
+ if (PyType_Ready(&SimpleType_Type) < 0)
+ return;
+
+ CFuncPtrType_Type.tp_base = &PyType_Type;
+ if (PyType_Ready(&CFuncPtrType_Type) < 0)
+ return;
+
+ /*************************************************
+ *
+ * Classes using a custom metaclass
+ */
+
+ if (PyType_Ready(&CData_Type) < 0)
+ return;
+
+ Struct_Type.ob_type = &StructType_Type;
+ Struct_Type.tp_base = &CData_Type;
+ if (PyType_Ready(&Struct_Type) < 0)
+ return;
+ PyModule_AddObject(m, "Structure", (PyObject *)&Struct_Type);
+
+ Union_Type.ob_type = &UnionType_Type;
+ Union_Type.tp_base = &CData_Type;
+ if (PyType_Ready(&Union_Type) < 0)
+ return;
+ PyModule_AddObject(m, "Union", (PyObject *)&Union_Type);
+
+ Pointer_Type.ob_type = &PointerType_Type;
+ Pointer_Type.tp_base = &CData_Type;
+ if (PyType_Ready(&Pointer_Type) < 0)
+ return;
+ PyModule_AddObject(m, "_Pointer", (PyObject *)&Pointer_Type);
+
+ Array_Type.ob_type = &ArrayType_Type;
+ Array_Type.tp_base = &CData_Type;
+ if (PyType_Ready(&Array_Type) < 0)
+ return;
+ PyModule_AddObject(m, "Array", (PyObject *)&Array_Type);
+
+ Simple_Type.ob_type = &SimpleType_Type;
+ Simple_Type.tp_base = &CData_Type;
+ if (PyType_Ready(&Simple_Type) < 0)
+ return;
+ PyModule_AddObject(m, "_SimpleCData", (PyObject *)&Simple_Type);
+
+ CFuncPtr_Type.ob_type = &CFuncPtrType_Type;
+ CFuncPtr_Type.tp_base = &CData_Type;
+ if (PyType_Ready(&CFuncPtr_Type) < 0)
+ return;
+ PyModule_AddObject(m, "CFuncPtr", (PyObject *)&CFuncPtr_Type);
+
+ /*************************************************
+ *
+ * Simple classes
+ */
+
+ /* CField_Type is derived from PyBaseObject_Type */
+ if (PyType_Ready(&CField_Type) < 0)
+ return;
+
+ /*************************************************
+ *
+ * Other stuff
+ */
+
+#ifdef MS_WIN32
+ if (create_comerror() < 0)
+ return;
+ PyModule_AddObject(m, "COMError", ComError);
+
+ PyModule_AddObject(m, "FUNCFLAG_HRESULT", PyInt_FromLong(FUNCFLAG_HRESULT));
+ PyModule_AddObject(m, "FUNCFLAG_STDCALL", PyInt_FromLong(FUNCFLAG_STDCALL));
+#endif
+ PyModule_AddObject(m, "FUNCFLAG_CDECL", PyInt_FromLong(FUNCFLAG_CDECL));
+ PyModule_AddObject(m, "FUNCFLAG_PYTHONAPI", PyInt_FromLong(FUNCFLAG_PYTHONAPI));
+ PyModule_AddStringConstant(m, "__version__", "0.9.9.4");
+
+ PyModule_AddObject(m, "_memmove_addr", PyLong_FromVoidPtr(memmove));
+ PyModule_AddObject(m, "_memset_addr", PyLong_FromVoidPtr(memset));
+ PyModule_AddObject(m, "_string_at_addr", PyLong_FromVoidPtr(string_at));
+#ifdef CTYPES_UNICODE
+ PyModule_AddObject(m, "_wstring_at_addr", PyLong_FromVoidPtr(wstring_at));
+#endif
+
+#ifdef RTLD_LOCAL
+ PyModule_AddObject(m, "RTLD_LOCAL", PyInt_FromLong(RTLD_LOCAL));
+ PyModule_AddObject(m, "RTLD_GLOBAL", PyInt_FromLong(RTLD_GLOBAL));
+#endif
+
+ PyExc_ArgError = PyErr_NewException("ctypes.ArgumentError", NULL, NULL);
+ if (PyExc_ArgError) {
+ Py_INCREF(PyExc_ArgError);
+ PyModule_AddObject(m, "ArgumentError", PyExc_ArgError);
+ }
+ /*************************************************
+ *
+ * Others...
+ */
+ init_callbacks_in_module(m);
+}
+
+/*****************************************************************
+ * replacements for broken Python api functions
+ */
+
+#ifdef HAVE_WCHAR_H
+
+PyObject *My_PyUnicode_FromWideChar(register const wchar_t *w,
+ int size)
+{
+ PyUnicodeObject *unicode;
+
+ if (w == NULL) {
+ PyErr_BadInternalCall();
+ return NULL;
+ }
+
+ unicode = (PyUnicodeObject *)PyUnicode_FromUnicode(NULL, size);
+ if (!unicode)
+ return NULL;
+
+ /* Copy the wchar_t data into the new object */
+#ifdef HAVE_USABLE_WCHAR_T
+ memcpy(unicode->str, w, size * sizeof(wchar_t));
+#else
+ {
+ register Py_UNICODE *u;
+ register int i;
+ u = PyUnicode_AS_UNICODE(unicode);
+ /* In Python, the following line has a one-off error */
+ for (i = size; i > 0; i--)
+ *u++ = *w++;
+ }
+#endif
+
+ return (PyObject *)unicode;
+}
+
+int My_PyUnicode_AsWideChar(PyUnicodeObject *unicode,
+ register wchar_t *w,
+ int size)
+{
+ if (unicode == NULL) {
+ PyErr_BadInternalCall();
+ return -1;
+ }
+ if (size > PyUnicode_GET_SIZE(unicode))
+ size = PyUnicode_GET_SIZE(unicode);
+#ifdef HAVE_USABLE_WCHAR_T
+ memcpy(w, unicode->str, size * sizeof(wchar_t));
+#else
+ {
+ register Py_UNICODE *u;
+ register int i;
+ u = PyUnicode_AS_UNICODE(unicode);
+ /* In Python, the following line has a one-off error */
+ for (i = size; i > 0; i--)
+ *w++ = *u++;
+ }
+#endif
+
+ return size;
+}
+
+#endif
+
+/*
+ Local Variables:
+ compile-command: "cd .. && python setup.py -q build -g && python setup.py -q build install --home ~"
+ End:
+*/
diff --git a/Modules/_ctypes/_ctypes_test.c b/Modules/_ctypes/_ctypes_test.c
new file mode 100644
index 0000000..a46f5e4
--- /dev/null
+++ b/Modules/_ctypes/_ctypes_test.c
@@ -0,0 +1,551 @@
+#include <Python.h>
+
+/*
+ Backwards compatibility:
+ Python2.2 used LONG_LONG instead of PY_LONG_LONG
+*/
+#if defined(HAVE_LONG_LONG) && !defined(PY_LONG_LONG)
+#define PY_LONG_LONG LONG_LONG
+#endif
+
+#ifdef MS_WIN32
+#include <windows.h>
+#endif
+
+#if defined(MS_WIN32) || defined(__CYGWIN__)
+#define EXPORT(x) __declspec(dllexport) x
+#else
+#define EXPORT(x) x
+#endif
+
+/* some functions handy for testing */
+
+EXPORT(char *)my_strtok(char *token, const char *delim)
+{
+ return strtok(token, delim);
+}
+
+EXPORT(char *)my_strchr(const char *s, int c)
+{
+ return strchr(s, c);
+}
+
+
+EXPORT(double) my_sqrt(double a)
+{
+ return sqrt(a);
+}
+
+EXPORT(void) my_qsort(void *base, size_t num, size_t width, int(*compare)(const void*, const void*))
+{
+ qsort(base, num, width, compare);
+}
+
+EXPORT(int *) _testfunc_ai8(int a[8])
+{
+ return a;
+}
+
+EXPORT(void) _testfunc_v(int a, int b, int *presult)
+{
+ *presult = a + b;
+}
+
+EXPORT(int) _testfunc_i_bhilfd(char b, short h, int i, long l, float f, double d)
+{
+// printf("_testfunc_i_bhilfd got %d %d %d %ld %f %f\n",
+// b, h, i, l, f, d);
+ return (int)(b + h + i + l + f + d);
+}
+
+EXPORT(float) _testfunc_f_bhilfd(char b, short h, int i, long l, float f, double d)
+{
+// printf("_testfunc_f_bhilfd got %d %d %d %ld %f %f\n",
+// b, h, i, l, f, d);
+ return (float)(b + h + i + l + f + d);
+}
+
+EXPORT(double) _testfunc_d_bhilfd(char b, short h, int i, long l, float f, double d)
+{
+// printf("_testfunc_d_bhilfd got %d %d %d %ld %f %f\n",
+// b, h, i, l, f, d);
+ return (double)(b + h + i + l + f + d);
+}
+
+EXPORT(char *) _testfunc_p_p(void *s)
+{
+ return s;
+}
+
+EXPORT(void *) _testfunc_c_p_p(int *argcp, char **argv)
+{
+ return argv[(*argcp)-1];
+}
+
+EXPORT(void *) get_strchr(void)
+{
+ return (void *)strchr;
+}
+
+EXPORT(char *) my_strdup(char *src)
+{
+ char *dst = malloc(strlen(src)+1);
+ if (!dst)
+ return NULL;
+ strcpy(dst, src);
+ return dst;
+}
+
+#ifdef HAVE_WCHAR_H
+EXPORT(wchar_t *) my_wcsdup(wchar_t *src)
+{
+ int len = wcslen(src);
+ wchar_t *ptr = malloc((len + 1) * sizeof(wchar_t));
+ if (ptr == NULL)
+ return NULL;
+ memcpy(ptr, src, (len+1) * sizeof(wchar_t));
+ return ptr;
+}
+
+EXPORT(size_t) my_wcslen(wchar_t *src)
+{
+ return wcslen(src);
+}
+#endif
+
+#ifndef MS_WIN32
+# ifndef __stdcall
+# define __stdcall /* */
+# endif
+#endif
+
+typedef struct {
+ int (*c)(int, int);
+ int (__stdcall *s)(int, int);
+} FUNCS;
+
+EXPORT(int) _testfunc_callfuncp(FUNCS *fp)
+{
+ fp->c(1, 2);
+ fp->s(3, 4);
+ return 0;
+}
+
+EXPORT(int) _testfunc_deref_pointer(int *pi)
+{
+ return *pi;
+}
+
+#ifdef MS_WIN32
+EXPORT(int) _testfunc_piunk(IUnknown FAR *piunk)
+{
+ piunk->lpVtbl->AddRef(piunk);
+ return piunk->lpVtbl->Release(piunk);
+}
+#endif
+
+EXPORT(int) _testfunc_callback_with_pointer(int (*func)(int *))
+{
+ int table[] = {1, 2, 3, 4, 5, 6, 7, 8, 9, 10};
+
+ return (*func)(table);
+}
+
+#ifdef HAVE_LONG_LONG
+EXPORT(PY_LONG_LONG) _testfunc_q_bhilfdq(char b, short h, int i, long l, float f,
+ double d, PY_LONG_LONG q)
+{
+ return (PY_LONG_LONG)(b + h + i + l + f + d + q);
+}
+
+EXPORT(PY_LONG_LONG) _testfunc_q_bhilfd(char b, short h, int i, long l, float f, double d)
+{
+ return (PY_LONG_LONG)(b + h + i + l + f + d);
+}
+
+EXPORT(int) _testfunc_callback_i_if(int value, int (*func)(int))
+{
+ int sum = 0;
+ while (value != 0) {
+ sum += func(value);
+ value /= 2;
+ }
+ return sum;
+}
+
+EXPORT(PY_LONG_LONG) _testfunc_callback_q_qf(PY_LONG_LONG value,
+ PY_LONG_LONG (*func)(PY_LONG_LONG))
+{
+ PY_LONG_LONG sum = 0;
+
+ while (value != 0) {
+ sum += func(value);
+ value /= 2;
+ }
+ return sum;
+}
+
+#endif
+
+EXPORT(int) _testfunc_ppp(char ***p)
+{
+ static char message[] = "Hello, World";
+ if (p) {
+ *p = malloc(sizeof(char *));
+ printf("malloc returned %p\n", *p);
+ **p = message;
+ return 1;
+ }
+ return 0;
+}
+
+EXPORT(void) my_free(void *p)
+{
+ printf("my_free got %p\n", p);
+}
+
+typedef struct {
+ char *name;
+ char *value;
+} SPAM;
+
+typedef struct {
+ char *name;
+ int num_spams;
+ SPAM *spams;
+} EGG;
+
+SPAM my_spams[2] = {
+ { "name1", "value1" },
+ { "name2", "value2" },
+};
+
+EGG my_eggs[1] = {
+ { "first egg", 1, my_spams }
+};
+
+EXPORT(int) getSPAMANDEGGS(EGG **eggs)
+{
+ *eggs = my_eggs;
+ return 1;
+}
+
+typedef struct tagpoint {
+ int x;
+ int y;
+} point;
+
+EXPORT(int) _testfunc_byval(point in, point *pout)
+{
+ if (pout) {
+ pout->x = in.x;
+ pout->y = in.y;
+ }
+ return in.x + in.y;
+}
+
+EXPORT (int) an_integer = 42;
+
+EXPORT(int) get_an_integer(void)
+{
+ return an_integer;
+}
+
+EXPORT(double)
+integrate(double a, double b, double (*f)(double), long nstep)
+{
+ double x, sum=0.0, dx=(b-a)/(double)nstep;
+ for(x=a+0.5*dx; (b-x)*(x-a)>0.0; x+=dx)
+ sum += f(x);
+ return sum/(double)nstep;
+}
+
+typedef struct {
+ void (*initialize)(void *(*)(int), void(*)(void *));
+} xxx_library;
+
+static void _xxx_init(void *(*Xalloc)(int), void (*Xfree)(void *))
+{
+ void *ptr;
+
+ printf("_xxx_init got %p %p\n", Xalloc, Xfree);
+ printf("calling\n");
+ ptr = Xalloc(32);
+ Xfree(ptr);
+ printf("calls done, ptr was %p\n", ptr);
+}
+
+xxx_library _xxx_lib = {
+ _xxx_init
+};
+
+EXPORT(xxx_library) *library_get(void)
+{
+ return &_xxx_lib;
+}
+
+#ifdef MS_WIN32
+/* See Don Box (german), pp 79ff. */
+EXPORT(void) GetString(BSTR *pbstr)
+{
+ *pbstr = SysAllocString(L"Goodbye!");
+}
+#endif
+
+/*
+ * Some do-nothing functions, for speed tests
+ */
+PyObject *py_func_si(PyObject *self, PyObject *args)
+{
+ char *name;
+ int i;
+ if (!PyArg_ParseTuple(args, "si", &name, &i))
+ return NULL;
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+EXPORT(void) _py_func_si(char *s, int i)
+{
+}
+
+PyObject *py_func(PyObject *self, PyObject *args)
+{
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+EXPORT(void) _py_func(void)
+{
+}
+
+EXPORT(PY_LONG_LONG) last_tf_arg_s;
+EXPORT(unsigned PY_LONG_LONG) last_tf_arg_u;
+
+struct BITS {
+ int A: 1, B:2, C:3, D:4, E: 5, F: 6, G: 7, H: 8, I: 9;
+ short M: 1, N: 2, O: 3, P: 4, Q: 5, R: 6, S: 7;
+};
+
+DL_EXPORT(void) set_bitfields(struct BITS *bits, char name, int value)
+{
+ switch (name) {
+ case 'A': bits->A = value; break;
+ case 'B': bits->B = value; break;
+ case 'C': bits->C = value; break;
+ case 'D': bits->D = value; break;
+ case 'E': bits->E = value; break;
+ case 'F': bits->F = value; break;
+ case 'G': bits->G = value; break;
+ case 'H': bits->H = value; break;
+ case 'I': bits->I = value; break;
+
+ case 'M': bits->M = value; break;
+ case 'N': bits->N = value; break;
+ case 'O': bits->O = value; break;
+ case 'P': bits->P = value; break;
+ case 'Q': bits->Q = value; break;
+ case 'R': bits->R = value; break;
+ case 'S': bits->S = value; break;
+ }
+}
+
+DL_EXPORT(int) unpack_bitfields(struct BITS *bits, char name)
+{
+ switch (name) {
+ case 'A': return bits->A;
+ case 'B': return bits->B;
+ case 'C': return bits->C;
+ case 'D': return bits->D;
+ case 'E': return bits->E;
+ case 'F': return bits->F;
+ case 'G': return bits->G;
+ case 'H': return bits->H;
+ case 'I': return bits->I;
+
+ case 'M': return bits->M;
+ case 'N': return bits->N;
+ case 'O': return bits->O;
+ case 'P': return bits->P;
+ case 'Q': return bits->Q;
+ case 'R': return bits->R;
+ case 'S': return bits->S;
+ }
+ return 0;
+}
+
+PyMethodDef module_methods[] = {
+// {"get_last_tf_arg_s", get_last_tf_arg_s, METH_NOARGS},
+// {"get_last_tf_arg_u", get_last_tf_arg_u, METH_NOARGS},
+ {"func_si", py_func_si, METH_VARARGS},
+ {"func", py_func, METH_NOARGS},
+ { NULL, NULL, 0, NULL},
+};
+
+#define S last_tf_arg_s = (PY_LONG_LONG)c
+#define U last_tf_arg_u = (unsigned PY_LONG_LONG)c
+
+EXPORT(char) tf_b(char c) { S; return c/3; }
+EXPORT(unsigned char) tf_B(unsigned char c) { U; return c/3; }
+EXPORT(short) tf_h(short c) { S; return c/3; }
+EXPORT(unsigned short) tf_H(unsigned short c) { U; return c/3; }
+EXPORT(int) tf_i(int c) { S; return c/3; }
+EXPORT(unsigned int) tf_I(unsigned int c) { U; return c/3; }
+EXPORT(long) tf_l(long c) { S; return c/3; }
+EXPORT(unsigned long) tf_L(unsigned long c) { U; return c/3; }
+EXPORT(PY_LONG_LONG) tf_q(PY_LONG_LONG c) { S; return c/3; }
+EXPORT(unsigned PY_LONG_LONG) tf_Q(unsigned PY_LONG_LONG c) { U; return c/3; }
+EXPORT(float) tf_f(float c) { S; return c/3; }
+EXPORT(double) tf_d(double c) { S; return c/3; }
+
+#ifdef MS_WIN32
+EXPORT(char) __stdcall s_tf_b(char c) { S; return c/3; }
+EXPORT(unsigned char) __stdcall s_tf_B(unsigned char c) { U; return c/3; }
+EXPORT(short) __stdcall s_tf_h(short c) { S; return c/3; }
+EXPORT(unsigned short) __stdcall s_tf_H(unsigned short c) { U; return c/3; }
+EXPORT(int) __stdcall s_tf_i(int c) { S; return c/3; }
+EXPORT(unsigned int) __stdcall s_tf_I(unsigned int c) { U; return c/3; }
+EXPORT(long) __stdcall s_tf_l(long c) { S; return c/3; }
+EXPORT(unsigned long) __stdcall s_tf_L(unsigned long c) { U; return c/3; }
+EXPORT(PY_LONG_LONG) __stdcall s_tf_q(PY_LONG_LONG c) { S; return c/3; }
+EXPORT(unsigned PY_LONG_LONG) __stdcall s_tf_Q(unsigned PY_LONG_LONG c) { U; return c/3; }
+EXPORT(float) __stdcall s_tf_f(float c) { S; return c/3; }
+EXPORT(double) __stdcall s_tf_d(double c) { S; return c/3; }
+#endif
+/*******/
+
+EXPORT(char) tf_bb(char x, char c) { S; return c/3; }
+EXPORT(unsigned char) tf_bB(char x, unsigned char c) { U; return c/3; }
+EXPORT(short) tf_bh(char x, short c) { S; return c/3; }
+EXPORT(unsigned short) tf_bH(char x, unsigned short c) { U; return c/3; }
+EXPORT(int) tf_bi(char x, int c) { S; return c/3; }
+EXPORT(unsigned int) tf_bI(char x, unsigned int c) { U; return c/3; }
+EXPORT(long) tf_bl(char x, long c) { S; return c/3; }
+EXPORT(unsigned long) tf_bL(char x, unsigned long c) { U; return c/3; }
+EXPORT(PY_LONG_LONG) tf_bq(char x, PY_LONG_LONG c) { S; return c/3; }
+EXPORT(unsigned PY_LONG_LONG) tf_bQ(char x, unsigned PY_LONG_LONG c) { U; return c/3; }
+EXPORT(float) tf_bf(char x, float c) { S; return c/3; }
+EXPORT(double) tf_bd(char x, double c) { S; return c/3; }
+EXPORT(void) tv_i(int c) { S; return; }
+
+#ifdef MS_WIN32
+EXPORT(char) __stdcall s_tf_bb(char x, char c) { S; return c/3; }
+EXPORT(unsigned char) __stdcall s_tf_bB(char x, unsigned char c) { U; return c/3; }
+EXPORT(short) __stdcall s_tf_bh(char x, short c) { S; return c/3; }
+EXPORT(unsigned short) __stdcall s_tf_bH(char x, unsigned short c) { U; return c/3; }
+EXPORT(int) __stdcall s_tf_bi(char x, int c) { S; return c/3; }
+EXPORT(unsigned int) __stdcall s_tf_bI(char x, unsigned int c) { U; return c/3; }
+EXPORT(long) __stdcall s_tf_bl(char x, long c) { S; return c/3; }
+EXPORT(unsigned long) __stdcall s_tf_bL(char x, unsigned long c) { U; return c/3; }
+EXPORT(PY_LONG_LONG) __stdcall s_tf_bq(char x, PY_LONG_LONG c) { S; return c/3; }
+EXPORT(unsigned PY_LONG_LONG) __stdcall s_tf_bQ(char x, unsigned PY_LONG_LONG c) { U; return c/3; }
+EXPORT(float) __stdcall s_tf_bf(char x, float c) { S; return c/3; }
+EXPORT(double) __stdcall s_tf_bd(char x, double c) { S; return c/3; }
+EXPORT(void) __stdcall s_tv_i(int c) { S; return; }
+#endif
+
+/********/
+
+#ifndef MS_WIN32
+
+typedef struct {
+ long x;
+ long y;
+} POINT;
+
+typedef struct {
+ long left;
+ long top;
+ long right;
+ long bottom;
+} RECT;
+
+#endif
+
+EXPORT(int) PointInRect(RECT *prc, POINT pt)
+{
+ if (pt.x < prc->left)
+ return 0;
+ if (pt.x > prc->right)
+ return 0;
+ if (pt.y < prc->top)
+ return 0;
+ if (pt.y > prc->bottom)
+ return 0;
+ return 1;
+}
+
+typedef struct {
+ short x;
+ short y;
+} S2H;
+
+EXPORT(S2H) ret_2h_func(S2H inp)
+{
+ inp.x *= 2;
+ inp.y *= 3;
+ return inp;
+}
+
+typedef struct {
+ int a, b, c, d, e, f, g, h;
+} S8I;
+
+EXPORT(S8I) ret_8i_func(S8I inp)
+{
+ inp.a *= 2;
+ inp.b *= 3;
+ inp.c *= 4;
+ inp.d *= 5;
+ inp.e *= 6;
+ inp.f *= 7;
+ inp.g *= 8;
+ inp.h *= 9;
+ return inp;
+}
+
+EXPORT(int) GetRectangle(int flag, RECT *prect)
+{
+ if (flag == 0)
+ return 0;
+ prect->left = (int)flag;
+ prect->top = (int)flag + 1;
+ prect->right = (int)flag + 2;
+ prect->bottom = (int)flag + 3;
+ return 1;
+}
+
+EXPORT(void) TwoOutArgs(int a, int *pi, int b, int *pj)
+{
+ *pi += a;
+ *pj += b;
+}
+
+#ifdef MS_WIN32
+EXPORT(S2H) __stdcall s_ret_2h_func(S2H inp) { return ret_2h_func(inp); }
+EXPORT(S8I) __stdcall s_ret_8i_func(S8I inp) { return ret_8i_func(inp); }
+#endif
+
+#ifdef MS_WIN32
+/* Should port this */
+#include <stdlib.h>
+#include <search.h>
+
+EXPORT (HRESULT) KeepObject(IUnknown *punk)
+{
+ static IUnknown *pobj;
+ if (punk)
+ punk->lpVtbl->AddRef(punk);
+ if (pobj)
+ pobj->lpVtbl->Release(pobj);
+ pobj = punk;
+ return S_OK;
+}
+
+#endif
+
+DL_EXPORT(void)
+init_ctypes_test(void)
+{
+ Py_InitModule("_ctypes_test", module_methods);
+}
diff --git a/Modules/_ctypes/_ctypes_test.h b/Modules/_ctypes/_ctypes_test.h
new file mode 100644
index 0000000..060d4d6
--- /dev/null
+++ b/Modules/_ctypes/_ctypes_test.h
@@ -0,0 +1 @@
+extern int _testfunc_i_bhilfd(char b, short h, int i, long l, float f, double d);
diff --git a/Modules/_ctypes/callbacks.c b/Modules/_ctypes/callbacks.c
new file mode 100644
index 0000000..2948d98
--- /dev/null
+++ b/Modules/_ctypes/callbacks.c
@@ -0,0 +1,518 @@
+#include "Python.h"
+#include "compile.h" /* required only for 2.3, as it seems */
+#include "frameobject.h"
+
+#include <ffi.h>
+#ifdef MS_WIN32
+#include <windows.h>
+#endif
+#include "ctypes.h"
+
+static void
+PrintError(char *msg, ...)
+{
+ char buf[512];
+ PyObject *f = PySys_GetObject("stderr");
+ va_list marker;
+
+ va_start(marker, msg);
+ vsnprintf(buf, sizeof(buf), msg, marker);
+ va_end(marker);
+ if (f)
+ PyFile_WriteString(buf, f);
+ PyErr_Print();
+}
+
+
+/* after code that pyrex generates */
+void _AddTraceback(char *funcname, char *filename, int lineno)
+{
+ PyObject *py_srcfile = 0;
+ PyObject *py_funcname = 0;
+ PyObject *py_globals = 0;
+ PyObject *empty_tuple = 0;
+ PyObject *empty_string = 0;
+ PyCodeObject *py_code = 0;
+ PyFrameObject *py_frame = 0;
+
+ py_srcfile = PyString_FromString(filename);
+ if (!py_srcfile) goto bad;
+ py_funcname = PyString_FromString(funcname);
+ if (!py_funcname) goto bad;
+ py_globals = PyDict_New();
+ if (!py_globals) goto bad;
+ empty_tuple = PyTuple_New(0);
+ if (!empty_tuple) goto bad;
+ empty_string = PyString_FromString("");
+ if (!empty_string) goto bad;
+ py_code = PyCode_New(
+ 0, /*int argcount,*/
+ 0, /*int nlocals,*/
+ 0, /*int stacksize,*/
+ 0, /*int flags,*/
+ empty_string, /*PyObject *code,*/
+ empty_tuple, /*PyObject *consts,*/
+ empty_tuple, /*PyObject *names,*/
+ empty_tuple, /*PyObject *varnames,*/
+ empty_tuple, /*PyObject *freevars,*/
+ empty_tuple, /*PyObject *cellvars,*/
+ py_srcfile, /*PyObject *filename,*/
+ py_funcname, /*PyObject *name,*/
+ lineno, /*int firstlineno,*/
+ empty_string /*PyObject *lnotab*/
+ );
+ if (!py_code) goto bad;
+ py_frame = PyFrame_New(
+ PyThreadState_Get(), /*PyThreadState *tstate,*/
+ py_code, /*PyCodeObject *code,*/
+ py_globals, /*PyObject *globals,*/
+ 0 /*PyObject *locals*/
+ );
+ if (!py_frame) goto bad;
+ py_frame->f_lineno = lineno;
+ PyTraceBack_Here(py_frame);
+ bad:
+ Py_XDECREF(py_globals);
+ Py_XDECREF(py_srcfile);
+ Py_XDECREF(py_funcname);
+ Py_XDECREF(empty_tuple);
+ Py_XDECREF(empty_string);
+ Py_XDECREF(py_code);
+ Py_XDECREF(py_frame);
+}
+
+#ifdef MS_WIN32
+/*
+ * We must call AddRef() on non-NULL COM pointers we receive as arguments
+ * to callback functions - these functions are COM method implementations.
+ * The Python instances we create have a __del__ method which calls Release().
+ *
+ * The presence of a class attribute named '_needs_com_addref_' triggers this
+ * behaviour. It would also be possible to call the AddRef() Python method,
+ * after checking for PyObject_IsTrue(), but this would probably be somewhat
+ * slower.
+ */
+static void
+TryAddRef(StgDictObject *dict, CDataObject *obj)
+{
+ IUnknown *punk;
+
+ if (NULL == PyDict_GetItemString((PyObject *)dict, "_needs_com_addref_"))
+ return;
+
+ punk = *(IUnknown **)obj->b_ptr;
+ if (punk)
+ punk->lpVtbl->AddRef(punk);
+ return;
+}
+#endif
+
+/******************************************************************************
+ *
+ * Call the python object with all arguments
+ *
+ */
+static void _CallPythonObject(void *mem,
+ ffi_type *restype,
+ SETFUNC setfunc,
+ PyObject *callable,
+ PyObject *converters,
+ void **pArgs)
+{
+ int i;
+ PyObject *result;
+ PyObject *arglist = NULL;
+ int nArgs;
+ PyGILState_STATE state = PyGILState_Ensure();
+
+ nArgs = PySequence_Length(converters);
+ /* Hm. What to return in case of error?
+ For COM, 0xFFFFFFFF seems better than 0.
+ */
+ if (nArgs < 0) {
+ PrintError("BUG: PySequence_Length");
+ goto Done;
+ }
+
+ arglist = PyTuple_New(nArgs);
+ if (!arglist) {
+ PrintError("PyTuple_New()");
+ goto Done;
+ }
+ for (i = 0; i < nArgs; ++i) {
+ /* Note: new reference! */
+ PyObject *cnv = PySequence_GetItem(converters, i);
+ StgDictObject *dict;
+ if (cnv)
+ dict = PyType_stgdict(cnv);
+ else {
+ PrintError("Getting argument converter %d\n", i);
+ goto Done;
+ }
+
+ if (dict && dict->getfunc && !IsSimpleSubType(cnv)) {
+ PyObject *v = dict->getfunc(*pArgs, dict->size);
+ if (!v) {
+ PrintError("create argument %d:\n", i);
+ Py_DECREF(cnv);
+ goto Done;
+ }
+ PyTuple_SET_ITEM(arglist, i, v);
+ /* XXX XXX XX
+ We have the problem that c_byte or c_short have dict->size of
+ 1 resp. 4, but these parameters are pushed as sizeof(int) bytes.
+ BTW, the same problem occurrs when they are pushed as parameters
+ */
+ } else if (dict) {
+ /* Hm, shouldn't we use CData_AtAddress() or something like that instead? */
+ CDataObject *obj = (CDataObject *)PyObject_CallFunctionObjArgs(cnv, NULL);
+ if (!obj) {
+ PrintError("create argument %d:\n", i);
+ Py_DECREF(cnv);
+ goto Done;
+ }
+ if (!CDataObject_Check(obj)) {
+ Py_DECREF(obj);
+ Py_DECREF(cnv);
+ PrintError("unexpected result of create argument %d:\n", i);
+ goto Done;
+ }
+ memcpy(obj->b_ptr, *pArgs, dict->size);
+ PyTuple_SET_ITEM(arglist, i, (PyObject *)obj);
+#ifdef MS_WIN32
+ TryAddRef(dict, obj);
+#endif
+ } else {
+ PyErr_SetString(PyExc_TypeError,
+ "cannot build parameter");
+ PrintError("Parsing argument %d\n", i);
+ Py_DECREF(cnv);
+ goto Done;
+ }
+ Py_DECREF(cnv);
+ /* XXX error handling! */
+ pArgs++;
+ }
+
+#define CHECK(what, x) \
+if (x == NULL) _AddTraceback(what, __FILE__, __LINE__ - 1), PyErr_Print()
+
+ result = PyObject_CallObject(callable, arglist);
+ CHECK("'calling callback function'", result);
+ if ((restype != &ffi_type_void)
+ && result && result != Py_None) { /* XXX What is returned for Py_None ? */
+ /* another big endian hack */
+ union {
+ char c;
+ short s;
+ int i;
+ long l;
+ } r;
+ PyObject *keep;
+ assert(setfunc);
+ switch (restype->size) {
+ case 1:
+ keep = setfunc(&r, result, 0);
+ CHECK("'converting callback result'", keep);
+ *(ffi_arg *)mem = r.c;
+ break;
+ case SIZEOF_SHORT:
+ keep = setfunc(&r, result, 0);
+ CHECK("'converting callback result'", keep);
+ *(ffi_arg *)mem = r.s;
+ break;
+ case SIZEOF_INT:
+ keep = setfunc(&r, result, 0);
+ CHECK("'converting callback result'", keep);
+ *(ffi_arg *)mem = r.i;
+ break;
+#if (SIZEOF_LONG != SIZEOF_INT)
+ case SIZEOF_LONG:
+ keep = setfunc(&r, result, 0);
+ CHECK("'converting callback result'", keep);
+ *(ffi_arg *)mem = r.l;
+ break;
+#endif
+ default:
+ keep = setfunc(mem, result, 0);
+ CHECK("'converting callback result'", keep);
+ break;
+ }
+ /* keep is an object we have to keep alive so that the result
+ stays valid. If there is no such object, the setfunc will
+ have returned Py_None.
+
+ If there is such an object, we have no choice than to keep
+ it alive forever - but a refcount and/or memory leak will
+ be the result. EXCEPT when restype is py_object - Python
+ itself knows how to manage the refcount of these objects.
+ */
+ if (keep == NULL) /* Could not convert callback result. */
+ PyErr_WriteUnraisable(Py_None);
+ else if (keep == Py_None) /* Nothing to keep */
+ Py_DECREF(keep);
+ else if (setfunc != getentry("O")->setfunc) {
+ if (-1 == PyErr_Warn(PyExc_RuntimeWarning,
+ "memory leak in callback function."))
+ PyErr_WriteUnraisable(Py_None);
+ }
+ }
+ Py_XDECREF(result);
+ Done:
+ Py_XDECREF(arglist);
+
+ PyGILState_Release(state);
+}
+
+typedef struct {
+ ffi_closure *pcl; /* the C callable */
+ ffi_cif cif;
+ PyObject *converters;
+ PyObject *callable;
+ SETFUNC setfunc;
+ ffi_type *restype;
+ ffi_type *atypes[0];
+} ffi_info;
+
+static void closure_fcn(ffi_cif *cif,
+ void *resp,
+ void **args,
+ void *userdata)
+{
+ ffi_info *p = userdata;
+
+ _CallPythonObject(resp,
+ p->restype,
+ p->setfunc,
+ p->callable,
+ p->converters,
+ args);
+}
+
+void FreeCallback(THUNK thunk)
+{
+ FreeClosure(((ffi_info *)thunk)->pcl);
+ PyMem_Free(thunk);
+}
+
+THUNK AllocFunctionCallback(PyObject *callable,
+ PyObject *converters,
+ PyObject *restype,
+ int is_cdecl)
+{
+ int result;
+ ffi_info *p;
+ int nArgs, i;
+ ffi_abi cc;
+
+ nArgs = PySequence_Size(converters);
+ p = (ffi_info *)PyMem_Malloc(sizeof(ffi_info) + sizeof(ffi_type) * (nArgs + 1));
+ if (p == NULL) {
+ PyErr_NoMemory();
+ return NULL;
+ }
+ p->pcl = MallocClosure();
+ if (p->pcl == NULL) {
+ PyMem_Free(p);
+ PyErr_NoMemory();
+ return NULL;
+ }
+
+ for (i = 0; i < nArgs; ++i) {
+ PyObject *cnv = PySequence_GetItem(converters, i);
+ p->atypes[i] = GetType(cnv);
+ Py_DECREF(cnv);
+ }
+ p->atypes[i] = NULL;
+
+ if (restype == Py_None) {
+ p->setfunc = NULL;
+ p->restype = &ffi_type_void;
+ } else {
+ StgDictObject *dict = PyType_stgdict(restype);
+ if (dict == NULL) {
+ PyMem_Free(p);
+ return NULL;
+ }
+ p->setfunc = dict->setfunc;
+ p->restype = &dict->ffi_type;
+ }
+
+ cc = FFI_DEFAULT_ABI;
+#if defined(MS_WIN32) && !defined(_WIN32_WCE)
+ if (is_cdecl == 0)
+ cc = FFI_STDCALL;
+#endif
+ result = ffi_prep_cif(&p->cif, cc, nArgs,
+ GetType(restype),
+ &p->atypes[0]);
+ if (result != FFI_OK) {
+ PyErr_Format(PyExc_RuntimeError,
+ "ffi_prep_cif failed with %d", result);
+ PyMem_Free(p);
+ return NULL;
+ }
+ result = ffi_prep_closure(p->pcl, &p->cif, closure_fcn, p);
+ if (result != FFI_OK) {
+ PyErr_Format(PyExc_RuntimeError,
+ "ffi_prep_closure failed with %d", result);
+ PyMem_Free(p);
+ return NULL;
+ }
+
+ p->converters = converters;
+ p->callable = callable;
+
+ return (THUNK)p;
+}
+
+/****************************************************************************
+ *
+ * callback objects: initialization
+ */
+
+void init_callbacks_in_module(PyObject *m)
+{
+ if (PyType_Ready((PyTypeObject *)&PyType_Type) < 0)
+ return;
+}
+
+#ifdef MS_WIN32
+
+static void LoadPython(void)
+{
+ if (!Py_IsInitialized()) {
+ PyEval_InitThreads();
+ Py_Initialize();
+ }
+}
+
+/******************************************************************/
+
+long Call_GetClassObject(REFCLSID rclsid, REFIID riid, LPVOID *ppv)
+{
+ PyObject *mod, *func, *result;
+ long retval;
+ static PyObject *context;
+
+ if (context == NULL)
+ context = PyString_FromString("_ctypes.DllGetClassObject");
+
+ mod = PyImport_ImportModule("ctypes");
+ if (!mod) {
+ PyErr_WriteUnraisable(context ? context : Py_None);
+ /* There has been a warning before about this already */
+ return E_FAIL;
+ }
+
+ func = PyObject_GetAttrString(mod, "DllGetClassObject");
+ Py_DECREF(mod);
+ if (!func) {
+ PyErr_WriteUnraisable(context ? context : Py_None);
+ return E_FAIL;
+ }
+
+ result = PyObject_CallFunction(func,
+ "iii", rclsid, riid, ppv);
+ Py_DECREF(func);
+ if (!result) {
+ PyErr_WriteUnraisable(context ? context : Py_None);
+ return E_FAIL;
+ }
+
+ retval = PyInt_AsLong(result);
+ if (PyErr_Occurred()) {
+ PyErr_WriteUnraisable(context ? context : Py_None);
+ retval = E_FAIL;
+ }
+ Py_DECREF(result);
+ return retval;
+}
+
+STDAPI DllGetClassObject(REFCLSID rclsid,
+ REFIID riid,
+ LPVOID *ppv)
+{
+ long result;
+ PyGILState_STATE state;
+
+ LoadPython();
+ state = PyGILState_Ensure();
+ result = Call_GetClassObject(rclsid, riid, ppv);
+ PyGILState_Release(state);
+ return result;
+}
+
+long Call_CanUnloadNow(void)
+{
+ PyObject *mod, *func, *result;
+ long retval;
+ static PyObject *context;
+
+ if (context == NULL)
+ context = PyString_FromString("_ctypes.DllCanUnloadNow");
+
+ mod = PyImport_ImportModule("ctypes");
+ if (!mod) {
+/* OutputDebugString("Could not import ctypes"); */
+ /* We assume that this error can only occur when shutting
+ down, so we silently ignore it */
+ PyErr_Clear();
+ return E_FAIL;
+ }
+ /* Other errors cannot be raised, but are printed to stderr */
+ func = PyObject_GetAttrString(mod, "DllCanUnloadNow");
+ Py_DECREF(mod);
+ if (!func) {
+ PyErr_WriteUnraisable(context ? context : Py_None);
+ return E_FAIL;
+ }
+
+ result = PyObject_CallFunction(func, NULL);
+ Py_DECREF(func);
+ if (!result) {
+ PyErr_WriteUnraisable(context ? context : Py_None);
+ return E_FAIL;
+ }
+
+ retval = PyInt_AsLong(result);
+ if (PyErr_Occurred()) {
+ PyErr_WriteUnraisable(context ? context : Py_None);
+ retval = E_FAIL;
+ }
+ Py_DECREF(result);
+ return retval;
+}
+
+/*
+ DllRegisterServer and DllUnregisterServer still missing
+*/
+
+STDAPI DllCanUnloadNow(void)
+{
+ long result;
+ PyGILState_STATE state = PyGILState_Ensure();
+ result = Call_CanUnloadNow();
+ PyGILState_Release(state);
+ return result;
+}
+
+#ifndef Py_NO_ENABLE_SHARED
+BOOL WINAPI DllMain(HINSTANCE hinstDLL, DWORD fdwReason, LPVOID lpvRes)
+{
+ switch(fdwReason) {
+ case DLL_PROCESS_ATTACH:
+ DisableThreadLibraryCalls(hinstDLL);
+ break;
+ }
+ return TRUE;
+}
+#endif
+
+#endif
+
+/*
+ Local Variables:
+ compile-command: "cd .. && python setup.py -q build_ext"
+ End:
+*/
diff --git a/Modules/_ctypes/callproc.c b/Modules/_ctypes/callproc.c
new file mode 100644
index 0000000..401d864
--- /dev/null
+++ b/Modules/_ctypes/callproc.c
@@ -0,0 +1,1522 @@
+/*
+ * History: First version dated from 3/97, derived from my SCMLIB version
+ * for win16.
+ */
+/*
+ * Related Work:
+ * - calldll http://www.nightmare.com/software.html
+ * - libffi http://sourceware.cygnus.com/libffi/
+ * - ffcall http://clisp.cons.org/~haible/packages-ffcall.html
+ * and, of course, Don Beaudry's MESS package, but this is more ctypes
+ * related.
+ */
+
+
+/*
+ How are functions called, and how are parameters converted to C ?
+
+ 1. _ctypes.c::CFuncPtr_call receives an argument tuple 'inargs' and a
+ keyword dictionary 'kwds'.
+
+ 2. After several checks, _build_callargs() is called which returns another
+ tuple 'callargs'. This may be the same tuple as 'inargs', a slice of
+ 'inargs', or a completely fresh tuple, depending on several things (is is a
+ COM method, are 'paramflags' available).
+
+ 3. _build_callargs also calculates bitarrays containing indexes into
+ the callargs tuple, specifying how to build the return value(s) of
+ the function.
+
+ 4. _CallProc is then called with the 'callargs' tuple. _CallProc first
+ allocates two arrays. The first is an array of 'struct argument' items, the
+ second array has 'void *' entried.
+
+ 5. If 'converters' are present (converters is a sequence of argtypes'
+ from_param methods), for each item in 'callargs' converter is called and the
+ result passed to ConvParam. If 'converters' are not present, each argument
+ is directly passed to ConvParm.
+
+ 6. For each arg, ConvParam stores the contained C data (or a pointer to it,
+ for structures) into the 'struct argument' array.
+
+ 7. Finally, a loop fills the 'void *' array so that each item points to the
+ data contained in or pointed to by the 'struct argument' array.
+
+ 8. The 'void *' argument array is what _call_function_pointer
+ expects. _call_function_pointer then has very little to do - only some
+ libffi specific stuff, then it calls ffi_call.
+
+ So, there are 4 data structures holding processed arguments:
+ - the inargs tuple (in CFuncPtr_call)
+ - the callargs tuple (in CFuncPtr_call)
+ - the 'struct argguments' array
+ - the 'void *' array
+
+ */
+
+#include "Python.h"
+#include "structmember.h"
+
+#ifdef MS_WIN32
+#include <windows.h>
+#else
+#include "ctypes_dlfcn.h"
+#endif
+
+#ifdef MS_WIN32
+#define alloca _alloca
+#endif
+
+#include <ffi.h>
+#include "ctypes.h"
+
+#ifdef _DEBUG
+#define DEBUG_EXCEPTIONS /* */
+#endif
+
+#ifdef MS_WIN32
+PyObject *ComError;
+
+static TCHAR *FormatError(DWORD code)
+{
+ TCHAR *lpMsgBuf;
+ DWORD n;
+ n = FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM,
+ NULL,
+ code,
+ MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), // Default language
+ (LPTSTR) &lpMsgBuf,
+ 0,
+ NULL);
+ if (n) {
+ while (isspace(lpMsgBuf[n-1]))
+ --n;
+ lpMsgBuf[n] = '\0'; /* rstrip() */
+ }
+ return lpMsgBuf;
+}
+
+void SetException(DWORD code, EXCEPTION_RECORD *pr)
+{
+ TCHAR *lpMsgBuf;
+ lpMsgBuf = FormatError(code);
+ if(lpMsgBuf) {
+ PyErr_SetFromWindowsErr(code);
+ LocalFree(lpMsgBuf);
+ } else {
+ switch (code) {
+ case EXCEPTION_ACCESS_VIOLATION:
+ /* The thread attempted to read from or write
+ to a virtual address for which it does not
+ have the appropriate access. */
+ if (pr->ExceptionInformation[0] == 0)
+ PyErr_Format(PyExc_WindowsError,
+ "exception: access violation reading %p",
+ pr->ExceptionInformation[1]);
+ else
+ PyErr_Format(PyExc_WindowsError,
+ "exception: access violation writing %p",
+ pr->ExceptionInformation[1]);
+ break;
+ case EXCEPTION_BREAKPOINT:
+ /* A breakpoint was encountered. */
+ PyErr_SetString(PyExc_WindowsError,
+ "exception: breakpoint encountered");
+ break;
+
+ case EXCEPTION_DATATYPE_MISALIGNMENT:
+ /* The thread attempted to read or write data that is
+ misaligned on hardware that does not provide
+ alignment. For example, 16-bit values must be
+ aligned on 2-byte boundaries, 32-bit values on
+ 4-byte boundaries, and so on. */
+ PyErr_SetString(PyExc_WindowsError,
+ "exception: datatype misalignment");
+ break;
+
+ case EXCEPTION_SINGLE_STEP:
+ /* A trace trap or other single-instruction mechanism
+ signaled that one instruction has been executed. */
+ PyErr_SetString(PyExc_WindowsError,
+ "exception: single step");
+ break;
+
+ case EXCEPTION_ARRAY_BOUNDS_EXCEEDED:
+ /* The thread attempted to access an array element
+ that is out of bounds, and the underlying hardware
+ supports bounds checking. */
+ PyErr_SetString(PyExc_WindowsError,
+ "exception: array bounds exceeded");
+ break;
+
+ case EXCEPTION_FLT_DENORMAL_OPERAND:
+ /* One of the operands in a floating-point operation
+ is denormal. A denormal value is one that is too
+ small to represent as a standard floating-point
+ value. */
+ PyErr_SetString(PyExc_WindowsError,
+ "exception: floating-point operand denormal");
+ break;
+
+ case EXCEPTION_FLT_DIVIDE_BY_ZERO:
+ /* The thread attempted to divide a floating-point
+ value by a floating-point divisor of zero. */
+ PyErr_SetString(PyExc_WindowsError,
+ "exception: float divide by zero");
+ break;
+
+ case EXCEPTION_FLT_INEXACT_RESULT:
+ /* The result of a floating-point operation cannot be
+ represented exactly as a decimal fraction. */
+ PyErr_SetString(PyExc_WindowsError,
+ "exception: float inexact");
+ break;
+
+ case EXCEPTION_FLT_INVALID_OPERATION:
+ /* This exception represents any floating-point
+ exception not included in this list. */
+ PyErr_SetString(PyExc_WindowsError,
+ "exception: float invalid operation");
+ break;
+
+ case EXCEPTION_FLT_OVERFLOW:
+ /* The exponent of a floating-point operation is
+ greater than the magnitude allowed by the
+ corresponding type. */
+ PyErr_SetString(PyExc_WindowsError,
+ "exception: float overflow");
+ break;
+
+ case EXCEPTION_FLT_STACK_CHECK:
+ /* The stack overflowed or underflowed as the result
+ of a floating-point operation. */
+ PyErr_SetString(PyExc_WindowsError,
+ "exception: stack over/underflow");
+ break;
+
+ case EXCEPTION_STACK_OVERFLOW:
+ /* The stack overflowed or underflowed as the result
+ of a floating-point operation. */
+ PyErr_SetString(PyExc_WindowsError,
+ "exception: stack overflow");
+ break;
+
+ case EXCEPTION_FLT_UNDERFLOW:
+ /* The exponent of a floating-point operation is less
+ than the magnitude allowed by the corresponding
+ type. */
+ PyErr_SetString(PyExc_WindowsError,
+ "exception: float underflow");
+ break;
+
+ case EXCEPTION_INT_DIVIDE_BY_ZERO:
+ /* The thread attempted to divide an integer value by
+ an integer divisor of zero. */
+ PyErr_SetString(PyExc_WindowsError,
+ "exception: integer divide by zero");
+ break;
+
+ case EXCEPTION_INT_OVERFLOW:
+ /* The result of an integer operation caused a carry
+ out of the most significant bit of the result. */
+ PyErr_SetString(PyExc_WindowsError,
+ "exception: integer overflow");
+ break;
+
+ case EXCEPTION_PRIV_INSTRUCTION:
+ /* The thread attempted to execute an instruction
+ whose operation is not allowed in the current
+ machine mode. */
+ PyErr_SetString(PyExc_WindowsError,
+ "exception: priviledged instruction");
+ break;
+
+ case EXCEPTION_NONCONTINUABLE_EXCEPTION:
+ /* The thread attempted to continue execution after a
+ noncontinuable exception occurred. */
+ PyErr_SetString(PyExc_WindowsError,
+ "exception: nocontinuable");
+ break;
+ default:
+ printf("error %d\n", code);
+ PyErr_Format(PyExc_WindowsError,
+ "exception code 0x%08x",
+ code);
+ break;
+ }
+ }
+}
+
+static DWORD HandleException(EXCEPTION_POINTERS *ptrs,
+ DWORD *pdw, EXCEPTION_RECORD *record)
+{
+ *pdw = ptrs->ExceptionRecord->ExceptionCode;
+ *record = *ptrs->ExceptionRecord;
+ return EXCEPTION_EXECUTE_HANDLER;
+}
+
+static PyObject *
+check_hresult(PyObject *self, PyObject *args)
+{
+ HRESULT hr;
+ if (!PyArg_ParseTuple(args, "i", &hr))
+ return NULL;
+ if (FAILED(hr))
+ return PyErr_SetFromWindowsErr(hr);
+ return PyInt_FromLong(hr);
+}
+
+#endif
+
+/**************************************************************/
+
+PyCArgObject *
+new_CArgObject(void)
+{
+ PyCArgObject *p;
+ p = PyObject_New(PyCArgObject, &PyCArg_Type);
+ if (p == NULL)
+ return NULL;
+ p->pffi_type = NULL;
+ p->tag = '\0';
+ p->obj = NULL;
+ memset(&p->value, 0, sizeof(p->value));
+ return p;
+}
+
+static void
+PyCArg_dealloc(PyCArgObject *self)
+{
+ Py_XDECREF(self->obj);
+ PyObject_Del(self);
+}
+
+static PyObject *
+PyCArg_repr(PyCArgObject *self)
+{
+ char buffer[256];
+ switch(self->tag) {
+ case 'b':
+ case 'B':
+ sprintf(buffer, "<cparam '%c' (%d)>",
+ self->tag, self->value.b);
+ break;
+ case 'h':
+ case 'H':
+ sprintf(buffer, "<cparam '%c' (%d)>",
+ self->tag, self->value.h);
+ break;
+ case 'i':
+ case 'I':
+ sprintf(buffer, "<cparam '%c' (%d)>",
+ self->tag, self->value.i);
+ break;
+ case 'l':
+ case 'L':
+ sprintf(buffer, "<cparam '%c' (%ld)>",
+ self->tag, self->value.l);
+ break;
+
+#ifdef HAVE_LONG_LONG
+ case 'q':
+ case 'Q':
+ sprintf(buffer,
+#ifdef MS_WIN32
+ "<cparam '%c' (%I64d)>",
+#else
+ "<cparam '%c' (%qd)>",
+#endif
+ self->tag, self->value.q);
+ break;
+#endif
+ case 'd':
+ sprintf(buffer, "<cparam '%c' (%f)>",
+ self->tag, self->value.d);
+ break;
+ case 'f':
+ sprintf(buffer, "<cparam '%c' (%f)>",
+ self->tag, self->value.f);
+ break;
+
+ case 'c':
+ sprintf(buffer, "<cparam '%c' (%c)>",
+ self->tag, self->value.c);
+ break;
+
+/* Hm, are these 'z' and 'Z' codes useful at all?
+ Shouldn't they be replaced by the functionality of c_string
+ and c_wstring ?
+*/
+ case 'z':
+ case 'Z':
+ case 'P':
+ sprintf(buffer, "<cparam '%c' (%08lx)>",
+ self->tag, (long)self->value.p);
+ break;
+
+ default:
+ sprintf(buffer, "<cparam '%c' at %08lx>",
+ self->tag, (long)self);
+ break;
+ }
+ return PyString_FromString(buffer);
+}
+
+static PyMemberDef PyCArgType_members[] = {
+ { "_obj", T_OBJECT,
+ offsetof(PyCArgObject, obj), READONLY,
+ "the wrapped object" },
+ { NULL },
+};
+
+PyTypeObject PyCArg_Type = {
+ PyObject_HEAD_INIT(NULL)
+ 0,
+ "CArgObject",
+ sizeof(PyCArgObject),
+ 0,
+ (destructor)PyCArg_dealloc, /* tp_dealloc */
+ 0, /* tp_print */
+ 0, /* tp_getattr */
+ 0, /* tp_setattr */
+ 0, /* tp_compare */
+ (reprfunc)PyCArg_repr, /* tp_repr */
+ 0, /* tp_as_number */
+ 0, /* tp_as_sequence */
+ 0, /* tp_as_mapping */
+ 0, /* tp_hash */
+ 0, /* tp_call */
+ 0, /* tp_str */
+ 0, /* tp_getattro */
+ 0, /* tp_setattro */
+ 0, /* tp_as_buffer */
+ Py_TPFLAGS_DEFAULT, /* tp_flags */
+ 0, /* tp_doc */
+ 0, /* tp_traverse */
+ 0, /* tp_clear */
+ 0, /* tp_richcompare */
+ 0, /* tp_weaklistoffset */
+ 0, /* tp_iter */
+ 0, /* tp_iternext */
+ 0, /* tp_methods */
+ PyCArgType_members, /* tp_members */
+};
+
+/****************************************************************/
+/*
+ * Convert a PyObject * into a parameter suitable to pass to an
+ * C function call.
+ *
+ * 1. Python integers are converted to C int and passed by value.
+ *
+ * 2. 3-tuples are expected to have a format character in the first
+ * item, which must be 'i', 'f', 'd', 'q', or 'P'.
+ * The second item will have to be an integer, float, double, long long
+ * or integer (denoting an address void *), will be converted to the
+ * corresponding C data type and passed by value.
+ *
+ * 3. Other Python objects are tested for an '_as_parameter_' attribute.
+ * The value of this attribute must be an integer which will be passed
+ * by value, or a 2-tuple or 3-tuple which will be used according
+ * to point 2 above. The third item (if any), is ignored. It is normally
+ * used to keep the object alive where this parameter refers to.
+ * XXX This convention is dangerous - you can construct arbitrary tuples
+ * in Python and pass them. Would it be safer to use a custom container
+ * datatype instead of a tuple?
+ *
+ * 4. Other Python objects cannot be passed as parameters - an exception is raised.
+ *
+ * 5. ConvParam will store the converted result in a struct containing format
+ * and value.
+ */
+
+union result {
+ char c;
+ char b;
+ short h;
+ int i;
+ long l;
+#ifdef HAVE_LONG_LONG
+ PY_LONG_LONG q;
+#endif
+ double d;
+ float f;
+ void *p;
+};
+
+struct argument {
+ ffi_type *ffi_type;
+ PyObject *keep;
+ union result value;
+};
+
+/*
+ * Convert a single Python object into a PyCArgObject and return it.
+ */
+static int ConvParam(PyObject *obj, int index, struct argument *pa)
+{
+ pa->keep = NULL; /* so we cannot forget it later */
+ if (PyCArg_CheckExact(obj)) {
+ PyCArgObject *carg = (PyCArgObject *)obj;
+ pa->ffi_type = carg->pffi_type;
+ Py_INCREF(obj);
+ pa->keep = obj;
+ memcpy(&pa->value, &carg->value, sizeof(pa->value));
+ return 0;
+ }
+
+ /* check for None, integer, string or unicode and use directly if successful */
+ if (obj == Py_None) {
+ pa->ffi_type = &ffi_type_pointer;
+ pa->value.p = NULL;
+ return 0;
+ }
+
+ if (PyInt_Check(obj)) {
+ pa->ffi_type = &ffi_type_sint;
+ pa->value.i = PyInt_AS_LONG(obj);
+ return 0;
+ }
+
+ if (PyLong_Check(obj)) {
+ pa->ffi_type = &ffi_type_sint;
+ pa->value.i = (long)PyLong_AsUnsignedLong(obj);
+ if (pa->value.i == -1 && PyErr_Occurred()) {
+ PyErr_Clear();
+ pa->value.i = PyLong_AsLong(obj);
+ if (pa->value.i == -1 && PyErr_Occurred()) {
+ PyErr_SetString(PyExc_OverflowError,
+ "long int too long to convert");
+ return -1;
+ }
+ }
+ return 0;
+ }
+
+ if (PyString_Check(obj)) {
+ pa->ffi_type = &ffi_type_pointer;
+ pa->value.p = PyString_AS_STRING(obj);
+ Py_INCREF(obj);
+ pa->keep = obj;
+ return 0;
+ }
+
+#ifdef CTYPES_UNICODE
+ if (PyUnicode_Check(obj)) {
+#ifdef HAVE_USABLE_WCHAR_T
+ pa->ffi_type = &ffi_type_pointer;
+ pa->value.p = PyUnicode_AS_UNICODE(obj);
+ Py_INCREF(obj);
+ pa->keep = obj;
+ return 0;
+#else
+ int size = PyUnicode_GET_SIZE(obj);
+ size += 1; /* terminating NUL */
+ size *= sizeof(wchar_t);
+ pa->value.p = PyMem_Malloc(size);
+ if (!pa->value.p)
+ return -1;
+ memset(pa->value.p, 0, size);
+ pa->keep = PyCObject_FromVoidPtr(pa->value.p, PyMem_Free);
+ if (!pa->keep) {
+ PyMem_Free(pa->value.p);
+ return -1;
+ }
+ if (-1 == PyUnicode_AsWideChar((PyUnicodeObject *)obj,
+ pa->value.p, PyUnicode_GET_SIZE(obj)))
+ return -1;
+ return 0;
+#endif
+ }
+#endif
+
+ {
+ PyObject *arg;
+ arg = PyObject_GetAttrString(obj, "_as_parameter_");
+ /* Which types should we exactly allow here?
+ integers are required for using Python classes
+ as parameters (they have to expose the '_as_parameter_'
+ attribute)
+ */
+ if (arg == 0) {
+ PyErr_Format(PyExc_TypeError,
+ "Don't know how to convert parameter %d", index);
+ return -1;
+ }
+ if (PyCArg_CheckExact(arg)) {
+ PyCArgObject *carg = (PyCArgObject *)arg;
+ pa->ffi_type = carg->pffi_type;
+ memcpy(&pa->value, &carg->value, sizeof(pa->value));
+ pa->keep = arg;
+ return 0;
+ }
+ if (PyInt_Check(arg)) {
+ pa->ffi_type = &ffi_type_sint;
+ pa->value.i = PyInt_AS_LONG(arg);
+ pa->keep = arg;
+ return 0;
+ }
+ Py_DECREF(arg);
+ PyErr_Format(PyExc_TypeError,
+ "Don't know how to convert parameter %d", index);
+ return -1;
+ }
+}
+
+
+ffi_type *GetType(PyObject *obj)
+{
+ StgDictObject *dict;
+ if (obj == NULL)
+ return &ffi_type_sint;
+ dict = PyType_stgdict(obj);
+ if (dict == NULL)
+ return &ffi_type_sint;
+#if defined(MS_WIN32) && !defined(_WIN32_WCE)
+ /* This little trick works correctly with MSVC.
+ It returns small structures in registers
+ */
+ if (dict->ffi_type.type == FFI_TYPE_STRUCT) {
+ if (dict->ffi_type.size <= 4)
+ return &ffi_type_sint32;
+ else if (dict->ffi_type.size <= 8)
+ return &ffi_type_sint64;
+ }
+#endif
+ return &dict->ffi_type;
+}
+
+
+/*
+ * libffi uses:
+ *
+ * ffi_status ffi_prep_cif(ffi_cif *cif, ffi_abi abi,
+ * unsigned int nargs,
+ * ffi_type *rtype,
+ * ffi_type **atypes);
+ *
+ * and then
+ *
+ * void ffi_call(ffi_cif *cif, void *fn, void *rvalue, void **avalues);
+ */
+static int _call_function_pointer(int flags,
+ PPROC pProc,
+ void **avalues,
+ ffi_type **atypes,
+ ffi_type *restype,
+ void *resmem,
+ int argcount)
+{
+ PyThreadState *_save = NULL; /* For Py_BLOCK_THREADS and Py_UNBLOCK_THREADS */
+ ffi_cif cif;
+ int cc;
+#ifdef MS_WIN32
+ int delta;
+ DWORD dwExceptionCode = 0;
+ EXCEPTION_RECORD record;
+#endif
+ /* XXX check before here */
+ if (restype == NULL) {
+ PyErr_SetString(PyExc_RuntimeError,
+ "No ffi_type for result");
+ return -1;
+ }
+
+ cc = FFI_DEFAULT_ABI;
+#if defined(MS_WIN32) && !defined(_WIN32_WCE)
+ if ((flags & FUNCFLAG_CDECL) == 0)
+ cc = FFI_STDCALL;
+#endif
+ if (FFI_OK != ffi_prep_cif(&cif,
+ cc,
+ argcount,
+ restype,
+ atypes)) {
+ PyErr_SetString(PyExc_RuntimeError,
+ "ffi_prep_cif failed");
+ return -1;
+ }
+
+ if ((flags & FUNCFLAG_PYTHONAPI) == 0)
+ Py_UNBLOCK_THREADS
+#ifdef MS_WIN32
+#ifndef DEBUG_EXCEPTIONS
+ __try {
+#endif
+ delta =
+#endif
+ ffi_call(&cif, (void *)pProc, resmem, avalues);
+#ifdef MS_WIN32
+#ifndef DEBUG_EXCEPTIONS
+ }
+ __except (HandleException(GetExceptionInformation(),
+ &dwExceptionCode, &record)) {
+ ;
+ }
+#endif
+#endif
+ if ((flags & FUNCFLAG_PYTHONAPI) == 0)
+ Py_BLOCK_THREADS
+#ifdef MS_WIN32
+ if (dwExceptionCode) {
+ SetException(dwExceptionCode, &record);
+ return -1;
+ }
+ if (delta < 0) {
+ if (flags & FUNCFLAG_CDECL)
+ PyErr_Format(PyExc_ValueError,
+ "Procedure called with not enough "
+ "arguments (%d bytes missing) "
+ "or wrong calling convention",
+ -delta);
+ else
+ PyErr_Format(PyExc_ValueError,
+ "Procedure probably called with not enough "
+ "arguments (%d bytes missing)",
+ -delta);
+ return -1;
+ } else if (delta > 0) {
+ PyErr_Format(PyExc_ValueError,
+ "Procedure probably called with too many "
+ "arguments (%d bytes in excess)",
+ delta);
+ return -1;
+ }
+#endif
+ if ((flags & FUNCFLAG_PYTHONAPI) && PyErr_Occurred())
+ return -1;
+ return 0;
+}
+
+/*
+ * Convert the C value in result into a Python object, depending on restype.
+ *
+ * - If restype is NULL, return a Python integer.
+ * - If restype is None, return None.
+ * - If restype is a simple ctypes type (c_int, c_void_p), call the type's getfunc,
+ * pass the result to checker and return the result.
+ * - If restype is another ctypes type, return an instance of that.
+ * - Otherwise, call restype and return the result.
+ */
+static PyObject *GetResult(PyObject *restype, void *result, PyObject *checker)
+{
+ StgDictObject *dict;
+ PyObject *retval, *v;
+
+ if (restype == NULL)
+ return PyInt_FromLong(*(int *)result);
+
+ if (restype == Py_None) {
+ Py_INCREF(Py_None);
+ return Py_None;
+ }
+
+ dict = PyType_stgdict(restype);
+ if (dict == NULL)
+ return PyObject_CallFunction(restype, "i", *(int *)result);
+
+ if (dict->getfunc && !IsSimpleSubType(restype)) {
+ retval = dict->getfunc(result, dict->size);
+ /* If restype is py_object (detected by comparing getfunc with
+ O_get), we have to call Py_DECREF because O_get has already
+ called Py_INCREF.
+ */
+ if (dict->getfunc == getentry("O")->getfunc)
+ Py_DECREF(retval);
+ } else
+ retval = CData_FromBaseObj(restype, NULL, 0, result);
+
+ if (!checker || !retval)
+ return retval;
+
+ v = PyObject_CallFunctionObjArgs(checker, retval, NULL);
+ if (v == NULL)
+ _AddTraceback("GetResult", __FILE__, __LINE__-2);
+ Py_DECREF(retval);
+ return v;
+}
+
+/*
+ * Raise a new exception 'exc_class', adding additional text to the original
+ * exception string.
+ */
+void Extend_Error_Info(PyObject *exc_class, char *fmt, ...)
+{
+ va_list vargs;
+ PyObject *tp, *v, *tb, *s, *cls_str, *msg_str;
+
+ va_start(vargs, fmt);
+ s = PyString_FromFormatV(fmt, vargs);
+ va_end(vargs);
+ if (!s)
+ return;
+
+ PyErr_Fetch(&tp, &v, &tb);
+ PyErr_NormalizeException(&tp, &v, &tb);
+ cls_str = PyObject_Str(tp);
+ if (cls_str) {
+ PyString_ConcatAndDel(&s, cls_str);
+ PyString_ConcatAndDel(&s, PyString_FromString(": "));
+ } else
+ PyErr_Clear();
+ msg_str = PyObject_Str(v);
+ if (msg_str)
+ PyString_ConcatAndDel(&s, msg_str);
+ else {
+ PyErr_Clear();
+ PyString_ConcatAndDel(&s, PyString_FromString("???"));
+ }
+ PyErr_SetObject(exc_class, s);
+ Py_XDECREF(tp);
+ Py_XDECREF(v);
+ Py_XDECREF(tb);
+ Py_DECREF(s);
+}
+
+
+#ifdef MS_WIN32
+
+static PyObject *
+GetComError(HRESULT errcode, GUID *riid, IUnknown *pIunk)
+{
+ HRESULT hr;
+ ISupportErrorInfo *psei = NULL;
+ IErrorInfo *pei = NULL;
+ BSTR descr=NULL, helpfile=NULL, source=NULL;
+ GUID guid;
+ DWORD helpcontext=0;
+ LPOLESTR progid;
+ PyObject *obj;
+ TCHAR *text;
+
+ hr = pIunk->lpVtbl->QueryInterface(pIunk, &IID_ISupportErrorInfo, (void **)&psei);
+ if (FAILED(hr))
+ goto failed;
+ hr = psei->lpVtbl->InterfaceSupportsErrorInfo(psei, riid);
+ psei->lpVtbl->Release(psei);
+
+ if (FAILED(hr))
+ goto failed;
+ hr = GetErrorInfo(0, &pei);
+ if (hr != S_OK)
+ goto failed;
+
+ pei->lpVtbl->GetDescription(pei, &descr);
+ pei->lpVtbl->GetGUID(pei, &guid);
+ pei->lpVtbl->GetHelpContext(pei, &helpcontext);
+ pei->lpVtbl->GetHelpFile(pei, &helpfile);
+ pei->lpVtbl->GetSource(pei, &source);
+
+ failed:
+ if (pei)
+ pei->lpVtbl->Release(pei);
+
+ progid = NULL;
+ ProgIDFromCLSID(&guid, &progid);
+
+/* XXX Is COMError derived from WindowsError or not? */
+ text = FormatError(errcode);
+#ifdef _UNICODE
+ obj = Py_BuildValue("iu(uuuiu)",
+#else
+ obj = Py_BuildValue("is(uuuiu)",
+#endif
+ errcode,
+ text,
+ descr, source, helpfile, helpcontext,
+ progid);
+ if (obj) {
+ PyErr_SetObject(ComError, obj);
+ Py_DECREF(obj);
+ }
+ LocalFree(text);
+
+ if (descr)
+ SysFreeString(descr);
+ if (helpfile)
+ SysFreeString(helpfile);
+ if (source)
+ SysFreeString(source);
+
+ return NULL;
+}
+#endif
+
+/*
+ * Requirements, must be ensured by the caller:
+ * - argtuple is tuple of arguments
+ * - argtypes is either NULL, or a tuple of the same size as argtuple
+ *
+ * - XXX various requirements for restype, not yet collected
+ */
+PyObject *_CallProc(PPROC pProc,
+ PyObject *argtuple,
+#ifdef MS_WIN32
+ IUnknown *pIunk,
+ GUID *iid,
+#endif
+ int flags,
+ PyObject *argtypes, /* misleading name: This is a tuple of
+ methods, not types: the .from_param
+ class methods of the types */
+ PyObject *restype,
+ PyObject *checker)
+{
+ int i, n, argcount, argtype_count;
+ void *resbuf;
+ struct argument *args, *pa;
+ ffi_type **atypes;
+ ffi_type *rtype;
+ void **avalues;
+ PyObject *retval = NULL;
+
+ n = argcount = PyTuple_GET_SIZE(argtuple);
+#ifdef MS_WIN32
+ /* an optional COM object this pointer */
+ if (pIunk)
+ ++argcount;
+#endif
+
+ args = (struct argument *)alloca(sizeof(struct argument) * argcount);
+ memset(args, 0, sizeof(struct argument) * argcount);
+ argtype_count = argtypes ? PyTuple_GET_SIZE(argtypes) : 0;
+#ifdef MS_WIN32
+ if (pIunk) {
+ args[0].ffi_type = &ffi_type_pointer;
+ args[0].value.p = pIunk;
+ pa = &args[1];
+ } else
+#endif
+ pa = &args[0];
+
+ /* Convert the arguments */
+ for (i = 0; i < n; ++i, ++pa) {
+ PyObject *converter;
+ PyObject *arg;
+ int err;
+
+ arg = PyTuple_GET_ITEM(argtuple, i); /* borrowed ref */
+ /* For cdecl functions, we allow more actual arguments
+ than the length of the argtypes tuple.
+ This is checked in _ctypes::CFuncPtr_Call
+ */
+ if (argtypes && argtype_count > i) {
+ PyObject *v;
+ converter = PyTuple_GET_ITEM(argtypes, i);
+ v = PyObject_CallFunctionObjArgs(converter,
+ arg,
+ NULL);
+ if (v == NULL) {
+ Extend_Error_Info(PyExc_ArgError, "argument %d: ", i+1);
+ goto cleanup;
+ }
+
+ err = ConvParam(v, i+1, pa);
+ Py_DECREF(v);
+ if (-1 == err) {
+ Extend_Error_Info(PyExc_ArgError, "argument %d: ", i+1);
+ goto cleanup;
+ }
+ } else {
+ err = ConvParam(arg, i+1, pa);
+ if (-1 == err) {
+ Extend_Error_Info(PyExc_ArgError, "argument %d: ", i+1);
+ goto cleanup; /* leaking ? */
+ }
+ }
+ }
+
+ rtype = GetType(restype);
+ resbuf = alloca(max(rtype->size, sizeof(ffi_arg)));
+
+ avalues = (void **)alloca(sizeof(void *) * argcount);
+ atypes = (ffi_type **)alloca(sizeof(ffi_type *) * argcount);
+ for (i = 0; i < argcount; ++i) {
+ atypes[i] = args[i].ffi_type;
+ if (atypes[i]->type == FFI_TYPE_STRUCT)
+ avalues[i] = (void *)args[i].value.p;
+ else
+ avalues[i] = (void *)&args[i].value;
+ }
+
+ if (-1 == _call_function_pointer(flags, pProc, avalues, atypes,
+ rtype, resbuf, argcount))
+ goto cleanup;
+
+#ifdef WORDS_BIGENDIAN
+ /* libffi returns the result in a buffer with sizeof(ffi_arg). This
+ causes problems on big endian machines, since the result buffer
+ address cannot simply be used as result pointer, instead we must
+ adjust the pointer value:
+ */
+ if (rtype->size < sizeof(ffi_arg))
+ resbuf = (char *)resbuf + sizeof(ffi_arg) - rtype->size;
+#endif
+
+#ifdef MS_WIN32
+ if (iid && pIunk) {
+ if (*(int *)resbuf & 0x80000000)
+ retval = GetComError(*(HRESULT *)resbuf, iid, pIunk);
+ else
+ retval = PyInt_FromLong(*(int *)resbuf);
+ } else if (flags & FUNCFLAG_HRESULT) {
+ if (*(int *)resbuf & 0x80000000)
+ retval = PyErr_SetFromWindowsErr(*(int *)resbuf);
+ else
+ retval = PyInt_FromLong(*(int *)resbuf);
+ } else
+#endif
+ retval = GetResult(restype, resbuf, checker);
+ cleanup:
+ for (i = 0; i < argcount; ++i)
+ Py_XDECREF(args[i].keep);
+ return retval;
+}
+
+#ifdef MS_WIN32
+
+#ifdef _UNICODE
+# define PYBUILD_TSTR "u"
+#else
+# define PYBUILD_TSTR "s"
+# ifndef _T
+# define _T(text) text
+# endif
+#endif
+
+static char format_error_doc[] =
+"FormatError([integer]) -> string\n\
+\n\
+Convert a win32 error code into a string. If the error code is not\n\
+given, the return value of a call to GetLastError() is used.\n";
+static PyObject *format_error(PyObject *self, PyObject *args)
+{
+ PyObject *result;
+ TCHAR *lpMsgBuf;
+ DWORD code = 0;
+ if (!PyArg_ParseTuple(args, "|i:FormatError", &code))
+ return NULL;
+ if (code == 0)
+ code = GetLastError();
+ lpMsgBuf = FormatError(code);
+ if (lpMsgBuf) {
+ result = Py_BuildValue(PYBUILD_TSTR, lpMsgBuf);
+ LocalFree(lpMsgBuf);
+ } else {
+ result = Py_BuildValue("s", "<no description>");
+ }
+ return result;
+}
+
+static char load_library_doc[] =
+"LoadLibrary(name) -> handle\n\
+\n\
+Load an executable (usually a DLL), and return a handle to it.\n\
+The handle may be used to locate exported functions in this\n\
+module.\n";
+static PyObject *load_library(PyObject *self, PyObject *args)
+{
+ TCHAR *name;
+ PyObject *nameobj;
+ PyObject *ignored;
+ HMODULE hMod;
+ if (!PyArg_ParseTuple(args, "O|O:LoadLibrary", &nameobj, &ignored))
+ return NULL;
+#ifdef _UNICODE
+ name = alloca((PyString_Size(nameobj) + 1) * sizeof(WCHAR));
+ {
+ int r;
+ char *aname = PyString_AsString(nameobj);
+ if(!aname)
+ return NULL;
+ r = MultiByteToWideChar(CP_ACP, 0, aname, -1, name, PyString_Size(nameobj) + 1);
+ name[r] = 0;
+ }
+#else
+ name = PyString_AsString(nameobj);
+ if(!name)
+ return NULL;
+#endif
+
+ hMod = LoadLibrary(name);
+ if (!hMod)
+ return PyErr_SetFromWindowsErr(GetLastError());
+ return Py_BuildValue("i", hMod);
+}
+
+static char free_library_doc[] =
+"FreeLibrary(handle) -> void\n\
+\n\
+Free the handle of an executable previously loaded by LoadLibrary.\n";
+static PyObject *free_library(PyObject *self, PyObject *args)
+{
+ HMODULE hMod;
+ if (!PyArg_ParseTuple(args, "i:FreeLibrary", &hMod))
+ return NULL;
+ if (!FreeLibrary(hMod))
+ return PyErr_SetFromWindowsErr(GetLastError());
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+/* obsolete, should be removed */
+/* Only used by sample code (in samples\Windows\COM.py) */
+static PyObject *
+call_commethod(PyObject *self, PyObject *args)
+{
+ IUnknown *pIunk;
+ int index;
+ PyObject *arguments;
+ PPROC *lpVtbl;
+ PyObject *result;
+ CDataObject *pcom;
+ PyObject *argtypes = NULL;
+
+ if (!PyArg_ParseTuple(args,
+ "OiO!|O!",
+ &pcom, &index,
+ &PyTuple_Type, &arguments,
+ &PyTuple_Type, &argtypes))
+ return NULL;
+
+ if (argtypes && (PyTuple_GET_SIZE(arguments) != PyTuple_GET_SIZE(argtypes))) {
+ PyErr_Format(PyExc_TypeError,
+ "Method takes %d arguments (%d given)",
+ PyTuple_GET_SIZE(argtypes), PyTuple_GET_SIZE(arguments));
+ return NULL;
+ }
+
+ if (!CDataObject_Check(pcom) || (pcom->b_size != sizeof(void *))) {
+ PyErr_Format(PyExc_TypeError,
+ "COM Pointer expected instead of %s instance",
+ pcom->ob_type->tp_name);
+ return NULL;
+ }
+
+ if ((*(void **)(pcom->b_ptr)) == NULL) {
+ PyErr_SetString(PyExc_ValueError,
+ "The COM 'this' pointer is NULL");
+ return NULL;
+ }
+
+ pIunk = (IUnknown *)(*(void **)(pcom->b_ptr));
+ lpVtbl = (PPROC *)(pIunk->lpVtbl);
+
+ result = _CallProc(lpVtbl[index],
+ arguments,
+#ifdef MS_WIN32
+ pIunk,
+ NULL,
+#endif
+ FUNCFLAG_HRESULT, /* flags */
+ argtypes, /* self->argtypes */
+ NULL, /* self->restype */
+ NULL); /* checker */
+ return result;
+}
+
+static char copy_com_pointer_doc[] =
+"CopyComPointer(a, b) -> integer\n";
+
+static PyObject *
+copy_com_pointer(PyObject *self, PyObject *args)
+{
+ PyObject *p1, *p2, *r = NULL;
+ struct argument a, b;
+ IUnknown *src, **pdst;
+ if (!PyArg_ParseTuple(args, "OO:CopyComPointer", &p1, &p2))
+ return NULL;
+ a.keep = b.keep = NULL;
+
+ if (-1 == ConvParam(p1, 0, &a) || -1 == ConvParam(p2, 1, &b))
+ goto done;
+ src = (IUnknown *)a.value.p;
+ pdst = (IUnknown **)b.value.p;
+
+ if (pdst == NULL)
+ r = PyInt_FromLong(E_POINTER);
+ else {
+ if (src)
+ src->lpVtbl->AddRef(src);
+ *pdst = src;
+ r = PyInt_FromLong(S_OK);
+ }
+ done:
+ Py_XDECREF(a.keep);
+ Py_XDECREF(b.keep);
+ return r;
+}
+#else
+
+static PyObject *py_dl_open(PyObject *self, PyObject *args)
+{
+ char *name;
+ void * handle;
+#ifdef RTLD_LOCAL
+ int mode = RTLD_NOW | RTLD_LOCAL;
+#else
+ /* cygwin doesn't define RTLD_LOCAL */
+ int mode = RTLD_NOW;
+#endif
+ if (!PyArg_ParseTuple(args, "z|i:dlopen", &name, &mode))
+ return NULL;
+ mode |= RTLD_NOW;
+ handle = ctypes_dlopen(name, mode);
+ if (!handle) {
+ PyErr_SetString(PyExc_OSError,
+ ctypes_dlerror());
+ return NULL;
+ }
+ return PyLong_FromVoidPtr(handle);
+}
+
+static PyObject *py_dl_close(PyObject *self, PyObject *args)
+{
+ void * handle;
+
+ if (!PyArg_ParseTuple(args, "i:dlclose", &handle))
+ return NULL;
+ if (dlclose(handle)) {
+ PyErr_SetString(PyExc_OSError,
+ ctypes_dlerror());
+ return NULL;
+ }
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+static PyObject *py_dl_sym(PyObject *self, PyObject *args)
+{
+ char *name;
+ void *handle;
+ void *ptr;
+
+ if (!PyArg_ParseTuple(args, "is:dlsym", &handle, &name))
+ return NULL;
+ ptr = ctypes_dlsym(handle, name);
+ if (!ptr) {
+ PyErr_SetString(PyExc_OSError,
+ ctypes_dlerror());
+ return NULL;
+ }
+ return Py_BuildValue("i", ptr);
+}
+#endif
+
+/*
+ * Only for debugging so far: So that we can call CFunction instances
+ *
+ * XXX Needs to accept more arguments: flags, argtypes, restype
+ */
+static PyObject *
+call_function(PyObject *self, PyObject *args)
+{
+ PPROC func;
+ PyObject *arguments;
+ PyObject *result;
+
+ if (!PyArg_ParseTuple(args,
+ "iO!",
+ &func,
+ &PyTuple_Type, &arguments))
+ return NULL;
+
+ result = _CallProc(func,
+ arguments,
+#ifdef MS_WIN32
+ NULL,
+ NULL,
+#endif
+ 0, /* flags */
+ NULL, /* self->argtypes */
+ NULL, /* self->restype */
+ NULL); /* checker */
+ return result;
+}
+
+/*
+ * Only for debugging so far: So that we can call CFunction instances
+ *
+ * XXX Needs to accept more arguments: flags, argtypes, restype
+ */
+static PyObject *
+call_cdeclfunction(PyObject *self, PyObject *args)
+{
+ PPROC func;
+ PyObject *arguments;
+ PyObject *result;
+
+ if (!PyArg_ParseTuple(args,
+ "iO!",
+ &func,
+ &PyTuple_Type, &arguments))
+ return NULL;
+
+ result = _CallProc(func,
+ arguments,
+#ifdef MS_WIN32
+ NULL,
+ NULL,
+#endif
+ FUNCFLAG_CDECL, /* flags */
+ NULL, /* self->argtypes */
+ NULL, /* self->restype */
+ NULL); /* checker */
+ return result;
+}
+
+/*****************************************************************
+ * functions
+ */
+static char sizeof_doc[] =
+"sizeof(C type) -> integer\n"
+"sizeof(C instance) -> integer\n"
+"Return the size in bytes of a C instance";
+
+static PyObject *
+sizeof_func(PyObject *self, PyObject *obj)
+{
+ StgDictObject *dict;
+
+ dict = PyType_stgdict(obj);
+ if (dict)
+ return PyInt_FromLong(dict->size);
+
+ if (CDataObject_Check(obj))
+ return PyInt_FromLong(((CDataObject *)obj)->b_size);
+ PyErr_SetString(PyExc_TypeError,
+ "this type has no size");
+ return NULL;
+}
+
+static char alignment_doc[] =
+"alignment(C type) -> integer\n"
+"alignment(C instance) -> integer\n"
+"Return the alignment requirements of a C instance";
+
+static PyObject *
+align_func(PyObject *self, PyObject *obj)
+{
+ StgDictObject *dict;
+
+ dict = PyType_stgdict(obj);
+ if (dict)
+ return PyInt_FromLong(dict->align);
+
+ dict = PyObject_stgdict(obj);
+ if (dict)
+ return PyInt_FromLong(dict->align);
+
+ PyErr_SetString(PyExc_TypeError,
+ "no alignment info");
+ return NULL;
+}
+
+static char byref_doc[] =
+"byref(C instance) -> byref-object\n"
+"Return a pointer lookalike to a C instance, only usable\n"
+"as function argument";
+
+/*
+ * We must return something which can be converted to a parameter,
+ * but still has a reference to self.
+ */
+static PyObject *
+byref(PyObject *self, PyObject *obj)
+{
+ PyCArgObject *parg;
+ if (!CDataObject_Check(obj)) {
+ PyErr_Format(PyExc_TypeError,
+ "byref() argument must be a ctypes instance, not '%s'",
+ obj->ob_type->tp_name);
+ return NULL;
+ }
+
+ parg = new_CArgObject();
+ if (parg == NULL)
+ return NULL;
+
+ parg->tag = 'P';
+ parg->pffi_type = &ffi_type_pointer;
+ Py_INCREF(obj);
+ parg->obj = obj;
+ parg->value.p = ((CDataObject *)obj)->b_ptr;
+ return (PyObject *)parg;
+}
+
+static char addressof_doc[] =
+"addressof(C instance) -> integer\n"
+"Return the address of the C instance internal buffer";
+
+static PyObject *
+addressof(PyObject *self, PyObject *obj)
+{
+ if (CDataObject_Check(obj))
+ return PyLong_FromVoidPtr(((CDataObject *)obj)->b_ptr);
+ PyErr_SetString(PyExc_TypeError,
+ "invalid type");
+ return NULL;
+}
+
+static int
+converter(PyObject *obj, void **address)
+{
+ *address = PyLong_AsVoidPtr(obj);
+ return address != NULL;
+}
+
+static PyObject *
+My_PyObj_FromPtr(PyObject *self, PyObject *args)
+{
+ PyObject *ob;
+ if (!PyArg_ParseTuple(args, "O&:PyObj_FromPtr", converter, &ob))
+ return NULL;
+ Py_INCREF(ob);
+ return ob;
+}
+
+static PyObject *
+My_Py_INCREF(PyObject *self, PyObject *arg)
+{
+ Py_INCREF(arg); /* that's what this function is for */
+ Py_INCREF(arg); /* that for returning it */
+ return arg;
+}
+
+static PyObject *
+My_Py_DECREF(PyObject *self, PyObject *arg)
+{
+ Py_DECREF(arg); /* that's what this function is for */
+ Py_INCREF(arg); /* that's for returning it */
+ return arg;
+}
+
+#ifdef CTYPES_UNICODE
+
+static char set_conversion_mode_doc[] =
+"set_conversion_mode(encoding, errors) -> (previous-encoding, previous-errors)\n\
+\n\
+Set the encoding and error handling ctypes uses when converting\n\
+between unicode and strings. Returns the previous values.\n";
+
+static PyObject *
+set_conversion_mode(PyObject *self, PyObject *args)
+{
+ char *coding, *mode;
+ PyObject *result;
+
+ if (!PyArg_ParseTuple(args, "zs:set_conversion_mode", &coding, &mode))
+ return NULL;
+ result = Py_BuildValue("(zz)", conversion_mode_encoding, conversion_mode_errors);
+ if (coding) {
+ PyMem_Free(conversion_mode_encoding);
+ conversion_mode_encoding = PyMem_Malloc(strlen(coding) + 1);
+ strcpy(conversion_mode_encoding, coding);
+ } else {
+ conversion_mode_encoding = NULL;
+ }
+ PyMem_Free(conversion_mode_errors);
+ conversion_mode_errors = PyMem_Malloc(strlen(mode) + 1);
+ strcpy(conversion_mode_errors, mode);
+ return result;
+}
+#endif
+
+static char cast_doc[] =
+"cast(cobject, ctype) -> ctype-instance\n\
+\n\
+Create an instance of ctype, and copy the internal memory buffer\n\
+of cobject to the new instance. Should be used to cast one type\n\
+of pointer to another type of pointer.\n\
+Doesn't work correctly with ctypes integers.\n";
+
+static int cast_check_pointertype(PyObject *arg, PyObject **pobj)
+{
+ StgDictObject *dict;
+
+ if (PointerTypeObject_Check(arg)) {
+ *pobj = arg;
+ return 1;
+ }
+ dict = PyType_stgdict(arg);
+ if (dict) {
+ if (PyString_Check(dict->proto)
+ && (strchr("sPzUZXO", PyString_AS_STRING(dict->proto)[0]))) {
+ /* simple pointer types, c_void_p, c_wchar_p, BSTR, ... */
+ *pobj = arg;
+ return 1;
+ }
+ }
+ if (PyType_Check(arg)) {
+ PyErr_Format(PyExc_TypeError,
+ "cast() argument 2 must be a pointer type, not %s",
+ ((PyTypeObject *)arg)->tp_name);
+ } else {
+ PyErr_Format(PyExc_TypeError,
+ "cast() argument 2 must be a pointer type, not a %s",
+ arg->ob_type->tp_name);
+ }
+ return 0;
+}
+
+static PyObject *cast(PyObject *self, PyObject *args)
+{
+ PyObject *obj, *ctype;
+ struct argument a;
+ CDataObject *result;
+
+ /* We could and should allow array types for the second argument
+ also, but we cannot use the simple memcpy below for them. */
+ if (!PyArg_ParseTuple(args, "OO&:cast", &obj, &cast_check_pointertype, &ctype))
+ return NULL;
+ if (-1 == ConvParam(obj, 1, &a))
+ return NULL;
+ result = (CDataObject *)PyObject_CallFunctionObjArgs(ctype, NULL);
+ if (result == NULL) {
+ Py_XDECREF(a.keep);
+ return NULL;
+ }
+ // result->b_size
+ // a.ffi_type->size
+ memcpy(result->b_ptr, &a.value,
+ min(result->b_size, (int)a.ffi_type->size));
+ Py_XDECREF(a.keep);
+ return (PyObject *)result;
+}
+
+
+PyMethodDef module_methods[] = {
+ {"cast", cast, METH_VARARGS, cast_doc},
+#ifdef CTYPES_UNICODE
+ {"set_conversion_mode", set_conversion_mode, METH_VARARGS, set_conversion_mode_doc},
+#endif
+#ifdef MS_WIN32
+ {"CopyComPointer", copy_com_pointer, METH_VARARGS, copy_com_pointer_doc},
+ {"FormatError", format_error, METH_VARARGS, format_error_doc},
+ {"LoadLibrary", load_library, METH_VARARGS, load_library_doc},
+ {"FreeLibrary", free_library, METH_VARARGS, free_library_doc},
+ {"call_commethod", call_commethod, METH_VARARGS },
+ {"_check_HRESULT", check_hresult, METH_VARARGS},
+#else
+ {"dlopen", py_dl_open, METH_VARARGS,
+ "dlopen(name, flag={RTLD_GLOBAL|RTLD_LOCAL}) open a shared library"},
+ {"dlclose", py_dl_close, METH_VARARGS, "dlclose a library"},
+ {"dlsym", py_dl_sym, METH_VARARGS, "find symbol in shared library"},
+#endif
+ {"alignment", align_func, METH_O, alignment_doc},
+ {"sizeof", sizeof_func, METH_O, sizeof_doc},
+ {"byref", byref, METH_O, byref_doc},
+ {"addressof", addressof, METH_O, addressof_doc},
+ {"call_function", call_function, METH_VARARGS },
+ {"call_cdeclfunction", call_cdeclfunction, METH_VARARGS },
+ {"PyObj_FromPtr", My_PyObj_FromPtr, METH_VARARGS },
+ {"Py_INCREF", My_Py_INCREF, METH_O },
+ {"Py_DECREF", My_Py_DECREF, METH_O },
+ {NULL, NULL} /* Sentinel */
+};
+
+/*
+ Local Variables:
+ compile-command: "cd .. && python setup.py -q build -g && python setup.py -q build install --home ~"
+ End:
+*/
diff --git a/Modules/_ctypes/cfield.c b/Modules/_ctypes/cfield.c
new file mode 100644
index 0000000..0f69d74
--- /dev/null
+++ b/Modules/_ctypes/cfield.c
@@ -0,0 +1,1563 @@
+#include "Python.h"
+#include "structmember.h"
+
+#include <ffi.h>
+#ifdef MS_WIN32
+#include <windows.h>
+#endif
+#include "ctypes.h"
+
+/******************************************************************/
+/*
+ CField_Type
+*/
+static PyObject *
+CField_new(PyTypeObject *type, PyObject *args, PyObject *kwds)
+{
+ CFieldObject *obj;
+ obj = (CFieldObject *)type->tp_alloc(type, 0);
+ return (PyObject *)obj;
+}
+
+/*
+ * Expects the size, index and offset for the current field in *psize and
+ * *poffset, stores the total size so far in *psize, the offset for the next
+ * field in *poffset, the alignment requirements for the current field in
+ * *palign, and returns a field desriptor for this field.
+ */
+/*
+ * bitfields extension:
+ * bitsize != 0: this is a bit field.
+ * pbitofs points to the current bit offset, this will be updated.
+ * prev_desc points to the type of the previous bitfield, if any.
+ */
+PyObject *
+CField_FromDesc(PyObject *desc, int index,
+ int *pfield_size, int bitsize, int *pbitofs,
+ int *psize, int *poffset, int *palign,
+ int pack, int big_endian)
+{
+ CFieldObject *self;
+ PyObject *proto;
+ int size, align, length;
+ SETFUNC setfunc = NULL;
+ GETFUNC getfunc = NULL;
+ StgDictObject *dict;
+ int fieldtype;
+#define NO_BITFIELD 0
+#define NEW_BITFIELD 1
+#define CONT_BITFIELD 2
+#define EXPAND_BITFIELD 3
+
+ self = (CFieldObject *)PyObject_CallObject((PyObject *)&CField_Type,
+ NULL);
+ if (self == NULL)
+ return NULL;
+ dict = PyType_stgdict(desc);
+ if (!dict) {
+ PyErr_SetString(PyExc_TypeError,
+ "has no _stginfo_");
+ Py_DECREF(self);
+ return NULL;
+ }
+ if (bitsize /* this is a bitfield request */
+ && *pfield_size /* we have a bitfield open */
+#ifdef MS_WIN32
+ && dict->size * 8 == *pfield_size /* MSVC */
+#else
+ && dict->size * 8 <= *pfield_size /* GCC */
+#endif
+ && (*pbitofs + bitsize) <= *pfield_size) {
+ /* continue bit field */
+ fieldtype = CONT_BITFIELD;
+#ifndef MS_WIN32
+ } else if (bitsize /* this is a bitfield request */
+ && *pfield_size /* we have a bitfield open */
+ && dict->size * 8 >= *pfield_size
+ && (*pbitofs + bitsize) <= dict->size * 8) {
+ /* expand bit field */
+ fieldtype = EXPAND_BITFIELD;
+#endif
+ } else if (bitsize) {
+ /* start new bitfield */
+ fieldtype = NEW_BITFIELD;
+ *pbitofs = 0;
+ *pfield_size = dict->size * 8;
+ } else {
+ /* not a bit field */
+ fieldtype = NO_BITFIELD;
+ *pbitofs = 0;
+ *pfield_size = 0;
+ }
+
+ size = dict->size;
+ length = dict->length;
+ proto = desc;
+
+ /* Field descriptors for 'c_char * n' are be scpecial cased to
+ return a Python string instead of an Array object instance...
+ */
+ if (ArrayTypeObject_Check(proto)) {
+ StgDictObject *adict = PyType_stgdict(proto);
+ StgDictObject *idict;
+ if (adict && adict->proto) {
+ idict = PyType_stgdict(adict->proto);
+ if (idict->getfunc == getentry("c")->getfunc) {
+ struct fielddesc *fd = getentry("s");
+ getfunc = fd->getfunc;
+ setfunc = fd->setfunc;
+ }
+#ifdef CTYPES_UNICODE
+ if (idict->getfunc == getentry("u")->getfunc) {
+ struct fielddesc *fd = getentry("U");
+ getfunc = fd->getfunc;
+ setfunc = fd->setfunc;
+ }
+#endif
+ }
+ }
+
+ self->setfunc = setfunc;
+ self->getfunc = getfunc;
+ self->index = index;
+
+ Py_XINCREF(proto);
+ self->proto = proto;
+
+ switch (fieldtype) {
+ case NEW_BITFIELD:
+ if (big_endian)
+ self->size = (bitsize << 16) + *pfield_size - *pbitofs - bitsize;
+ else
+ self->size = (bitsize << 16) + *pbitofs;
+ *pbitofs = bitsize;
+ /* fall through */
+ case NO_BITFIELD:
+ if (pack)
+ align = min(pack, dict->align);
+ else
+ align = dict->align;
+ if (align && *poffset % align) {
+ int delta = align - (*poffset % align);
+ *psize += delta;
+ *poffset += delta;
+ }
+
+ if (bitsize == 0)
+ self->size = size;
+ *psize += size;
+
+ self->offset = *poffset;
+ *poffset += size;
+
+ *palign = align;
+ break;
+
+ case EXPAND_BITFIELD:
+ /* XXX needs more */
+ *psize += dict->size - *pfield_size/8;
+
+ *pfield_size = dict->size * 8;
+
+ if (big_endian)
+ self->size = (bitsize << 16) + *pfield_size - *pbitofs - bitsize;
+ else
+ self->size = (bitsize << 16) + *pbitofs;
+
+ self->offset = *poffset - size; /* poffset is already updated for the NEXT field */
+ *pbitofs += bitsize;
+ break;
+
+ case CONT_BITFIELD:
+ if (big_endian)
+ self->size = (bitsize << 16) + *pfield_size - *pbitofs - bitsize;
+ else
+ self->size = (bitsize << 16) + *pbitofs;
+
+ self->offset = *poffset - size; /* poffset is already updated for the NEXT field */
+ *pbitofs += bitsize;
+ break;
+ }
+
+ return (PyObject *)self;
+}
+
+static int
+CField_set(CFieldObject *self, PyObject *inst, PyObject *value)
+{
+ CDataObject *dst;
+ char *ptr;
+ assert(CDataObject_Check(inst));
+ dst = (CDataObject *)inst;
+ ptr = dst->b_ptr + self->offset;
+ return CData_set(inst, self->proto, self->setfunc, value,
+ self->index, self->size, ptr);
+}
+
+static PyObject *
+CField_get(CFieldObject *self, PyObject *inst, PyTypeObject *type)
+{
+ CDataObject *src;
+ if (inst == NULL) {
+ Py_INCREF(self);
+ return (PyObject *)self;
+ }
+ assert(CDataObject_Check(inst));
+ src = (CDataObject *)inst;
+ return CData_get(self->proto, self->getfunc, inst,
+ self->index, self->size, src->b_ptr + self->offset);
+}
+
+static PyMemberDef CField_members[] = {
+ { "offset", T_UINT,
+ offsetof(CFieldObject, offset), READONLY,
+ "offset in bytes of this field"},
+ { "size", T_UINT,
+ offsetof(CFieldObject, size), READONLY,
+ "size in bytes of this field"},
+ { NULL },
+};
+
+static int
+CField_traverse(CFieldObject *self, visitproc visit, void *arg)
+{
+ Py_VISIT(self->proto);
+ return 0;
+}
+
+static int
+CField_clear(CFieldObject *self)
+{
+ Py_CLEAR(self->proto);
+ return 0;
+}
+
+static void
+CField_dealloc(PyObject *self)
+{
+ CField_clear((CFieldObject *)self);
+ self->ob_type->tp_free((PyObject *)self);
+}
+
+static PyObject *
+CField_repr(CFieldObject *self)
+{
+ PyObject *result;
+ int bits = self->size >> 16;
+ int size = self->size & 0xFFFF;
+ const char *name;
+
+ name = ((PyTypeObject *)self->proto)->tp_name;
+
+ if (bits)
+ result = PyString_FromFormat("<Field type=%s, ofs=%d:%d, bits=%d>",
+ name, self->offset, size, bits);
+ else
+ result = PyString_FromFormat("<Field type=%s, ofs=%d, size=%d>",
+ name, self->offset, size);
+ return result;
+}
+
+PyTypeObject CField_Type = {
+ PyObject_HEAD_INIT(NULL)
+ 0, /* ob_size */
+ "_ctypes.CField", /* tp_name */
+ sizeof(CFieldObject), /* tp_basicsize */
+ 0, /* tp_itemsize */
+ CField_dealloc, /* tp_dealloc */
+ 0, /* tp_print */
+ 0, /* tp_getattr */
+ 0, /* tp_setattr */
+ 0, /* tp_compare */
+ (reprfunc)CField_repr, /* tp_repr */
+ 0, /* tp_as_number */
+ 0, /* tp_as_sequence */
+ 0, /* tp_as_mapping */
+ 0, /* tp_hash */
+ 0, /* tp_call */
+ 0, /* tp_str */
+ 0, /* tp_getattro */
+ 0, /* tp_setattro */
+ 0, /* tp_as_buffer */
+ Py_TPFLAGS_DEFAULT | Py_TPFLAGS_HAVE_GC, /* tp_flags */
+ "Structure/Union member", /* tp_doc */
+ (traverseproc)CField_traverse, /* tp_traverse */
+ (inquiry)CField_clear, /* tp_clear */
+ 0, /* tp_richcompare */
+ 0, /* tp_weaklistoffset */
+ 0, /* tp_iter */
+ 0, /* tp_iternext */
+ 0, /* tp_methods */
+ CField_members, /* tp_members */
+ 0, /* tp_getset */
+ 0, /* tp_base */
+ 0, /* tp_dict */
+ (descrgetfunc)CField_get, /* tp_descr_get */
+ (descrsetfunc)CField_set, /* tp_descr_set */
+ 0, /* tp_dictoffset */
+ 0, /* tp_init */
+ 0, /* tp_alloc */
+ CField_new, /* tp_new */
+ 0, /* tp_free */
+};
+
+
+/******************************************************************/
+/*
+ Accessor functions
+*/
+
+/* Derived from Modules/structmodule.c:
+ Helper routine to get a Python integer and raise the appropriate error
+ if it isn't one */
+
+static int
+get_long(PyObject *v, long *p)
+{
+ long x;
+ if (!PyInt_Check(v) && !PyLong_Check(v)) {
+ PyErr_Format(PyExc_TypeError,
+ "int expected instead of %s instance",
+ v->ob_type->tp_name);
+ return -1;
+ }
+ x = PyInt_AsUnsignedLongMask(v);
+ if (x == -1 && PyErr_Occurred())
+ return -1;
+ *p = x;
+ return 0;
+}
+
+/* Same, but handling unsigned long */
+
+static int
+get_ulong(PyObject *v, unsigned long *p)
+{
+ unsigned long x;
+ if (!PyInt_Check(v) && !PyLong_Check(v)) {
+ PyErr_Format(PyExc_TypeError,
+ "int expected instead of %s instance",
+ v->ob_type->tp_name);
+ return -1;
+ }
+ x = PyInt_AsUnsignedLongMask(v);
+ if (x == -1 && PyErr_Occurred())
+ return -1;
+ *p = x;
+ return 0;
+}
+
+#ifdef HAVE_LONG_LONG
+
+/* Same, but handling native long long. */
+
+static int
+get_longlong(PyObject *v, PY_LONG_LONG *p)
+{
+ PY_LONG_LONG x;
+ if (!PyInt_Check(v) && !PyLong_Check(v)) {
+ PyErr_Format(PyExc_TypeError,
+ "int expected instead of %s instance",
+ v->ob_type->tp_name);
+ return -1;
+ }
+ x = PyInt_AsUnsignedLongLongMask(v);
+ if (x == -1 && PyErr_Occurred())
+ return -1;
+ *p = x;
+ return 0;
+}
+
+/* Same, but handling native unsigned long long. */
+
+static int
+get_ulonglong(PyObject *v, unsigned PY_LONG_LONG *p)
+{
+ unsigned PY_LONG_LONG x;
+ if (!PyInt_Check(v) && !PyLong_Check(v)) {
+ PyErr_Format(PyExc_TypeError,
+ "int expected instead of %s instance",
+ v->ob_type->tp_name);
+ return -1;
+ }
+ x = PyInt_AsUnsignedLongLongMask(v);
+ if (x == -1 && PyErr_Occurred())
+ return -1;
+ *p = x;
+ return 0;
+}
+
+#endif
+
+/*****************************************************************
+ * Integer fields, with bitfield support
+ */
+
+/* how to decode the size field, for integer get/set functions */
+#define LOW_BIT(x) ((x) & 0xFFFF)
+#define NUM_BITS(x) ((x) >> 16)
+
+/* This seems nore a compiler issue than a Windows/non-Windows one */
+#ifdef MS_WIN32
+# define BIT_MASK(size) ((1 << NUM_BITS(size))-1)
+#else
+# define BIT_MASK(size) ((1LL << NUM_BITS(size))-1)
+#endif
+
+/* This macro CHANGES the first parameter IN PLACE. For proper sign handling,
+ we must first shift left, then right.
+*/
+#define GET_BITFIELD(v, size) \
+ if (NUM_BITS(size)) { \
+ v <<= (sizeof(v)*8 - LOW_BIT(size) - NUM_BITS(size)); \
+ v >>= (sizeof(v)*8 - NUM_BITS(size)); \
+ }
+
+/* This macro RETURNS the first parameter with the bit field CHANGED. */
+#define SET(x, v, size) \
+ (NUM_BITS(size) ? \
+ ( ( x & ~(BIT_MASK(size) << LOW_BIT(size)) ) | ( (v & BIT_MASK(size)) << LOW_BIT(size) ) ) \
+ : v)
+
+/* byte swapping macros */
+#define SWAP_2(v) \
+ ( ( (v >> 8) & 0x00FF) | \
+ ( (v << 8) & 0xFF00) )
+
+#define SWAP_4(v) \
+ ( ( (v & 0x000000FF) << 24 ) | \
+ ( (v & 0x0000FF00) << 8 ) | \
+ ( (v & 0x00FF0000) >> 8 ) | \
+ ( ((v >> 24) & 0xFF)) )
+
+#ifdef _MSC_VER
+#define SWAP_8(v) \
+ ( ( (v & 0x00000000000000FFL) << 56 ) | \
+ ( (v & 0x000000000000FF00L) << 40 ) | \
+ ( (v & 0x0000000000FF0000L) << 24 ) | \
+ ( (v & 0x00000000FF000000L) << 8 ) | \
+ ( (v & 0x000000FF00000000L) >> 8 ) | \
+ ( (v & 0x0000FF0000000000L) >> 24 ) | \
+ ( (v & 0x00FF000000000000L) >> 40 ) | \
+ ( ((v >> 56) & 0xFF)) )
+#else
+#define SWAP_8(v) \
+ ( ( (v & 0x00000000000000FFLL) << 56 ) | \
+ ( (v & 0x000000000000FF00LL) << 40 ) | \
+ ( (v & 0x0000000000FF0000LL) << 24 ) | \
+ ( (v & 0x00000000FF000000LL) << 8 ) | \
+ ( (v & 0x000000FF00000000LL) >> 8 ) | \
+ ( (v & 0x0000FF0000000000LL) >> 24 ) | \
+ ( (v & 0x00FF000000000000LL) >> 40 ) | \
+ ( ((v >> 56) & 0xFF)) )
+#endif
+
+#define SWAP_INT SWAP_4
+
+#if SIZEOF_LONG == 4
+# define SWAP_LONG SWAP_4
+#elif SIZEOF_LONG == 8
+# define SWAP_LONG SWAP_8
+#endif
+/*****************************************************************
+ * The setter methods return an object which must be kept alive, to keep the
+ * data valid which has been stored in the memory block. The ctypes object
+ * instance inserts this object into its 'b_objects' list.
+ *
+ * For simple Python types like integers or characters, there is nothing that
+ * has to been kept alive, so Py_None is returned in these cases. But this
+ * makes inspecting the 'b_objects' list, which is accessible from Python for
+ * debugging, less useful.
+ *
+ * So, defining the _CTYPES_DEBUG_KEEP symbol returns the original value
+ * instead of Py_None.
+ */
+
+#ifdef _CTYPES_DEBUG_KEEP
+#define _RET(x) Py_INCREF(x); return x
+#else
+#define _RET(X) Py_INCREF(Py_None); return Py_None
+#endif
+
+/*****************************************************************
+ * integer accessor methods, supporting bit fields
+ */
+
+static PyObject *
+b_set(void *ptr, PyObject *value, unsigned size)
+{
+ long val;
+ if (get_long(value, &val) < 0)
+ return NULL;
+ *(char *)ptr = (char)SET(*(char *)ptr, (char)val, size);
+ _RET(value);
+}
+
+
+static PyObject *
+b_get(void *ptr, unsigned size)
+{
+ char val = *(char *)ptr;
+ GET_BITFIELD(val, size);
+ return PyInt_FromLong(val);
+}
+
+static PyObject *
+B_set(void *ptr, PyObject *value, unsigned size)
+{
+ unsigned long val;
+ if (get_ulong(value, &val) < 0)
+ return NULL;
+ *(unsigned char *)ptr = (unsigned char)SET(*(unsigned char*)ptr,
+ (unsigned short)val, size);
+ _RET(value);
+}
+
+
+static PyObject *
+B_get(void *ptr, unsigned size)
+{
+ unsigned char val = *(unsigned char *)ptr;
+ GET_BITFIELD(val, size);
+ return PyInt_FromLong(val);
+}
+
+static PyObject *
+h_set(void *ptr, PyObject *value, unsigned size)
+{
+ long val;
+ if (get_long(value, &val) < 0)
+ return NULL;
+ *(short *)ptr = (short)SET(*(short *)ptr, (short)val, size);
+ _RET(value);
+}
+
+
+static PyObject *
+h_set_sw(void *ptr, PyObject *value, unsigned size)
+{
+ long val;
+ short field;
+ if (get_long(value, &val) < 0)
+ return NULL;
+ field = SWAP_2(*(short *)ptr);
+ field = SET(field, (short)val, size);
+ *(short *)ptr = SWAP_2(field);
+ _RET(value);
+}
+
+static PyObject *
+h_get(void *ptr, unsigned size)
+{
+ short val = *(short *)ptr;
+ GET_BITFIELD(val, size);
+ return PyInt_FromLong(val);
+}
+
+static PyObject *
+h_get_sw(void *ptr, unsigned size)
+{
+ short val = *(short *)ptr;
+ val = SWAP_2(val);
+ GET_BITFIELD(val, size);
+ return PyInt_FromLong(val);
+}
+
+static PyObject *
+H_set(void *ptr, PyObject *value, unsigned size)
+{
+ unsigned long val;
+ if (get_ulong(value, &val) < 0)
+ return NULL;
+ *(unsigned short *)ptr = (unsigned short)SET(*(unsigned short *)ptr,
+ (unsigned short)val, size);
+ _RET(value);
+}
+
+static PyObject *
+H_set_sw(void *ptr, PyObject *value, unsigned size)
+{
+ unsigned long val;
+ unsigned short field;
+ if (get_ulong(value, &val) < 0)
+ return NULL;
+ field = SWAP_2(*(unsigned short *)ptr);
+ field = SET(field, (unsigned short)val, size);
+ *(unsigned short *)ptr = SWAP_2(field);
+ _RET(value);
+}
+
+
+static PyObject *
+H_get(void *ptr, unsigned size)
+{
+ unsigned short val = *(unsigned short *)ptr;
+ GET_BITFIELD(val, size);
+ return PyInt_FromLong(val);
+}
+
+static PyObject *
+H_get_sw(void *ptr, unsigned size)
+{
+ unsigned short val = *(unsigned short *)ptr;
+ val = SWAP_2(val);
+ GET_BITFIELD(val, size);
+ return PyInt_FromLong(val);
+}
+
+static PyObject *
+i_set(void *ptr, PyObject *value, unsigned size)
+{
+ long val;
+ if (get_long(value, &val) < 0)
+ return NULL;
+ *(int *)ptr = (int)SET(*(int *)ptr, (int)val, size);
+ _RET(value);
+}
+
+static PyObject *
+i_set_sw(void *ptr, PyObject *value, unsigned size)
+{
+ long val;
+ int field;
+ if (get_long(value, &val) < 0)
+ return NULL;
+ field = SWAP_INT(*(int *)ptr);
+ field = SET(field, (int)val, size);
+ *(int *)ptr = SWAP_INT(field);
+ _RET(value);
+}
+
+
+static PyObject *
+i_get(void *ptr, unsigned size)
+{
+ int val = *(int *)ptr;
+ GET_BITFIELD(val, size);
+ return PyInt_FromLong(val);
+}
+
+static PyObject *
+i_get_sw(void *ptr, unsigned size)
+{
+ int val = *(int *)ptr;
+ val = SWAP_INT(val);
+ GET_BITFIELD(val, size);
+ return PyInt_FromLong(val);
+}
+
+#ifdef MS_WIN32
+/* short BOOL - VARIANT_BOOL */
+static PyObject *
+vBOOL_set(void *ptr, PyObject *value, unsigned size)
+{
+ switch (PyObject_IsTrue(value)) {
+ case -1:
+ return NULL;
+ case 0:
+ *(short int *)ptr = VARIANT_FALSE;
+ _RET(value);
+ default:
+ *(short int *)ptr = VARIANT_TRUE;
+ _RET(value);
+ }
+}
+
+static PyObject *
+vBOOL_get(void *ptr, unsigned size)
+{
+ return PyBool_FromLong((long)*(short int *)ptr);
+}
+#endif
+
+static PyObject *
+I_set(void *ptr, PyObject *value, unsigned size)
+{
+ unsigned long val;
+ if (get_ulong(value, &val) < 0)
+ return NULL;
+ *(unsigned int *)ptr = (unsigned int)SET(*(unsigned int *)ptr, (unsigned int)val, size);
+ _RET(value);
+}
+
+static PyObject *
+I_set_sw(void *ptr, PyObject *value, unsigned size)
+{
+ unsigned long val;
+ unsigned int field;
+ if (get_ulong(value, &val) < 0)
+ return NULL;
+ field = SWAP_INT(*(unsigned int *)ptr);
+ field = (unsigned int)SET(field, (unsigned int)val, size);
+ *(unsigned int *)ptr = SWAP_INT(field);
+ _RET(value);
+}
+
+
+static PyObject *
+I_get(void *ptr, unsigned size)
+{
+ unsigned int val = *(unsigned int *)ptr;
+ GET_BITFIELD(val, size);
+ return PyLong_FromUnsignedLong(val);
+}
+
+static PyObject *
+I_get_sw(void *ptr, unsigned size)
+{
+ unsigned int val = *(unsigned int *)ptr;
+ val = SWAP_INT(val);
+ GET_BITFIELD(val, size);
+ return PyLong_FromUnsignedLong(val);
+}
+
+static PyObject *
+l_set(void *ptr, PyObject *value, unsigned size)
+{
+ long val;
+ if (get_long(value, &val) < 0)
+ return NULL;
+ *(long *)ptr = (long)SET(*(long *)ptr, val, size);
+ _RET(value);
+}
+
+static PyObject *
+l_set_sw(void *ptr, PyObject *value, unsigned size)
+{
+ long val;
+ long field;
+ if (get_long(value, &val) < 0)
+ return NULL;
+ field = SWAP_LONG(*(long *)ptr);
+ field = (long)SET(field, val, size);
+ *(long *)ptr = SWAP_LONG(field);
+ _RET(value);
+}
+
+
+static PyObject *
+l_get(void *ptr, unsigned size)
+{
+ long val = *(long *)ptr;
+ GET_BITFIELD(val, size);
+ return PyInt_FromLong(val);
+}
+
+static PyObject *
+l_get_sw(void *ptr, unsigned size)
+{
+ long val = *(long *)ptr;
+ val = SWAP_LONG(val);
+ GET_BITFIELD(val, size);
+ return PyInt_FromLong(val);
+}
+
+static PyObject *
+L_set(void *ptr, PyObject *value, unsigned size)
+{
+ unsigned long val;
+ if (get_ulong(value, &val) < 0)
+ return NULL;
+ *(unsigned long *)ptr = (unsigned long)SET(*(unsigned long *)ptr, val, size);
+ _RET(value);
+}
+
+static PyObject *
+L_set_sw(void *ptr, PyObject *value, unsigned size)
+{
+ unsigned long val;
+ unsigned long field;
+ if (get_ulong(value, &val) < 0)
+ return NULL;
+ field = SWAP_LONG(*(unsigned long *)ptr);
+ field = (unsigned long)SET(field, val, size);
+ *(unsigned long *)ptr = SWAP_LONG(field);
+ _RET(value);
+}
+
+
+static PyObject *
+L_get(void *ptr, unsigned size)
+{
+ unsigned long val = *(unsigned long *)ptr;
+ GET_BITFIELD(val, size);
+ return PyLong_FromUnsignedLong(val);
+}
+
+static PyObject *
+L_get_sw(void *ptr, unsigned size)
+{
+ unsigned long val = *(unsigned long *)ptr;
+ val = SWAP_LONG(val);
+ GET_BITFIELD(val, size);
+ return PyLong_FromUnsignedLong(val);
+}
+
+#ifdef HAVE_LONG_LONG
+static PyObject *
+q_set(void *ptr, PyObject *value, unsigned size)
+{
+ PY_LONG_LONG val;
+ if (get_longlong(value, &val) < 0)
+ return NULL;
+ *(PY_LONG_LONG *)ptr = (PY_LONG_LONG)SET(*(PY_LONG_LONG *)ptr, val, size);
+ _RET(value);
+}
+
+static PyObject *
+q_set_sw(void *ptr, PyObject *value, unsigned size)
+{
+ PY_LONG_LONG val;
+ PY_LONG_LONG field;
+ if (get_longlong(value, &val) < 0)
+ return NULL;
+ field = SWAP_8(*(PY_LONG_LONG *)ptr);
+ field = (PY_LONG_LONG)SET(field, val, size);
+ *(PY_LONG_LONG *)ptr = SWAP_8(field);
+ _RET(value);
+}
+
+static PyObject *
+q_get(void *ptr, unsigned size)
+{
+ PY_LONG_LONG val = *(PY_LONG_LONG *)ptr;
+ GET_BITFIELD(val, size);
+ return PyLong_FromLongLong(val);
+}
+
+static PyObject *
+q_get_sw(void *ptr, unsigned size)
+{
+ PY_LONG_LONG val = *(PY_LONG_LONG *)ptr;
+ val = SWAP_8(val);
+ GET_BITFIELD(val, size);
+ return PyLong_FromLongLong(val);
+}
+
+static PyObject *
+Q_set(void *ptr, PyObject *value, unsigned size)
+{
+ unsigned PY_LONG_LONG val;
+ if (get_ulonglong(value, &val) < 0)
+ return NULL;
+ *(unsigned PY_LONG_LONG *)ptr = (unsigned PY_LONG_LONG)SET(*(unsigned PY_LONG_LONG *)ptr, val, size);
+ _RET(value);
+}
+
+static PyObject *
+Q_set_sw(void *ptr, PyObject *value, unsigned size)
+{
+ unsigned PY_LONG_LONG val;
+ unsigned PY_LONG_LONG field;
+ if (get_ulonglong(value, &val) < 0)
+ return NULL;
+ field = SWAP_8(*(unsigned PY_LONG_LONG *)ptr);
+ field = (unsigned PY_LONG_LONG)SET(field, val, size);
+ *(unsigned PY_LONG_LONG *)ptr = SWAP_8(field);
+ _RET(value);
+}
+
+static PyObject *
+Q_get(void *ptr, unsigned size)
+{
+ unsigned PY_LONG_LONG val = *(unsigned PY_LONG_LONG *)ptr;
+ GET_BITFIELD(val, size);
+ return PyLong_FromUnsignedLongLong(val);
+}
+
+static PyObject *
+Q_get_sw(void *ptr, unsigned size)
+{
+ unsigned PY_LONG_LONG val = *(unsigned PY_LONG_LONG *)ptr;
+ val = SWAP_8(val);
+ GET_BITFIELD(val, size);
+ return PyLong_FromUnsignedLongLong(val);
+}
+#endif
+
+/*****************************************************************
+ * non-integer accessor methods, not supporting bit fields
+ */
+
+
+
+static PyObject *
+d_set(void *ptr, PyObject *value, unsigned size)
+{
+ double x;
+
+ x = PyFloat_AsDouble(value);
+ if (x == -1 && PyErr_Occurred()) {
+ PyErr_Format(PyExc_TypeError,
+ " float expected instead of %s instance",
+ value->ob_type->tp_name);
+ return NULL;
+ }
+ *(double *)ptr = x;
+ _RET(value);
+}
+
+static PyObject *
+d_get(void *ptr, unsigned size)
+{
+ return PyFloat_FromDouble(*(double *)ptr);
+}
+
+static PyObject *
+d_set_sw(void *ptr, PyObject *value, unsigned size)
+{
+ double x;
+
+ x = PyFloat_AsDouble(value);
+ if (x == -1 && PyErr_Occurred()) {
+ PyErr_Format(PyExc_TypeError,
+ " float expected instead of %s instance",
+ value->ob_type->tp_name);
+ return NULL;
+ }
+#ifdef WORDS_BIGENDIAN
+ if (_PyFloat_Pack8(x, (unsigned char *)ptr, 1))
+ return NULL;
+#else
+ if (_PyFloat_Pack8(x, (unsigned char *)ptr, 0))
+ return NULL;
+#endif
+ _RET(value);
+}
+
+static PyObject *
+d_get_sw(void *ptr, unsigned size)
+{
+#ifdef WORDS_BIGENDIAN
+ return PyFloat_FromDouble(_PyFloat_Unpack8(ptr, 1));
+#else
+ return PyFloat_FromDouble(_PyFloat_Unpack8(ptr, 0));
+#endif
+}
+
+static PyObject *
+f_set(void *ptr, PyObject *value, unsigned size)
+{
+ float x;
+
+ x = (float)PyFloat_AsDouble(value);
+ if (x == -1 && PyErr_Occurred()) {
+ PyErr_Format(PyExc_TypeError,
+ " float expected instead of %s instance",
+ value->ob_type->tp_name);
+ return NULL;
+ }
+ *(float *)ptr = x;
+ _RET(value);
+}
+
+static PyObject *
+f_get(void *ptr, unsigned size)
+{
+ return PyFloat_FromDouble(*(float *)ptr);
+}
+
+static PyObject *
+f_set_sw(void *ptr, PyObject *value, unsigned size)
+{
+ float x;
+
+ x = (float)PyFloat_AsDouble(value);
+ if (x == -1 && PyErr_Occurred()) {
+ PyErr_Format(PyExc_TypeError,
+ " float expected instead of %s instance",
+ value->ob_type->tp_name);
+ return NULL;
+ }
+#ifdef WORDS_BIGENDIAN
+ if (_PyFloat_Pack4(x, (unsigned char *)ptr, 1))
+ return NULL;
+#else
+ if (_PyFloat_Pack4(x, (unsigned char *)ptr, 0))
+ return NULL;
+#endif
+ _RET(value);
+}
+
+static PyObject *
+f_get_sw(void *ptr, unsigned size)
+{
+#ifdef WORDS_BIGENDIAN
+ return PyFloat_FromDouble(_PyFloat_Unpack4(ptr, 1));
+#else
+ return PyFloat_FromDouble(_PyFloat_Unpack4(ptr, 0));
+#endif
+}
+
+/*
+ py_object refcounts:
+
+ 1. If we have a py_object instance, O_get must Py_INCREF the returned
+ object, of course. If O_get is called from a function result, no py_object
+ instance is created - so callproc.c::GetResult has to call Py_DECREF.
+
+ 2. The memory block in py_object owns a refcount. So, py_object must call
+ Py_DECREF on destruction. Maybe only when b_needsfree is non-zero.
+*/
+static PyObject *
+O_get(void *ptr, unsigned size)
+{
+ PyObject *ob = *(PyObject **)ptr;
+ if (ob == NULL) {
+ if (!PyErr_Occurred())
+ /* Set an error if not yet set */
+ PyErr_SetString(PyExc_ValueError,
+ "PyObject is NULL?");
+ return NULL;
+ }
+ Py_INCREF(ob);
+ return ob;
+}
+
+static PyObject *
+O_set(void *ptr, PyObject *value, unsigned size)
+{
+ /* Hm, does the memory block need it's own refcount or not? */
+ *(PyObject **)ptr = value;
+ Py_INCREF(value);
+ return value;
+}
+
+
+static PyObject *
+c_set(void *ptr, PyObject *value, unsigned size)
+{
+ if (!PyString_Check(value) || (1 != PyString_Size(value))) {
+ PyErr_Format(PyExc_TypeError,
+ "one character string expected");
+ return NULL;
+ }
+ *(char *)ptr = PyString_AS_STRING(value)[0];
+ _RET(value);
+}
+
+
+static PyObject *
+c_get(void *ptr, unsigned size)
+{
+ return PyString_FromStringAndSize((char *)ptr, 1);
+}
+
+#ifdef CTYPES_UNICODE
+/* u - a single wchar_t character */
+static PyObject *
+u_set(void *ptr, PyObject *value, unsigned size)
+{
+ int len;
+
+ if (PyString_Check(value)) {
+ value = PyUnicode_FromEncodedObject(value,
+ conversion_mode_encoding,
+ conversion_mode_errors);
+ if (!value)
+ return NULL;
+ } else if (!PyUnicode_Check(value)) {
+ PyErr_Format(PyExc_TypeError,
+ "unicode string expected instead of %s instance",
+ value->ob_type->tp_name);
+ return NULL;
+ } else
+ Py_INCREF(value);
+
+ len = PyUnicode_GET_SIZE(value);
+ if (len != 1) {
+ Py_DECREF(value);
+ PyErr_SetString(PyExc_TypeError,
+ "one character unicode string expected");
+ return NULL;
+ }
+
+ *(wchar_t *)ptr = PyUnicode_AS_UNICODE(value)[0];
+ Py_DECREF(value);
+
+ _RET(value);
+}
+
+
+static PyObject *
+u_get(void *ptr, unsigned size)
+{
+ return PyUnicode_FromWideChar((wchar_t *)ptr, 1);
+}
+
+/* U - a unicode string */
+static PyObject *
+U_get(void *ptr, unsigned size)
+{
+ PyObject *result;
+ unsigned int len;
+ Py_UNICODE *p;
+
+ size /= sizeof(wchar_t); /* we count character units here, not bytes */
+
+ result = PyUnicode_FromWideChar((wchar_t *)ptr, size);
+ if (!result)
+ return NULL;
+ /* We need 'result' to be able to count the characters with wcslen,
+ since ptr may not be NUL terminated. If the length is smaller (if
+ it was actually NUL terminated, we construct a new one and throw
+ away the result.
+ */
+ /* chop off at the first NUL character, if any. */
+ p = PyUnicode_AS_UNICODE(result);
+ for (len = 0; len < size; ++len)
+ if (!p[len])
+ break;
+
+ if (len < size) {
+ PyObject *ob = PyUnicode_FromWideChar((wchar_t *)ptr, len);
+ Py_DECREF(result);
+ return ob;
+ }
+ return result;
+}
+
+static PyObject *
+U_set(void *ptr, PyObject *value, unsigned length)
+{
+ unsigned int size;
+
+ /* It's easier to calculate in characters than in bytes */
+ length /= sizeof(wchar_t);
+
+ if (PyString_Check(value)) {
+ value = PyUnicode_FromEncodedObject(value,
+ conversion_mode_encoding,
+ conversion_mode_errors);
+ if (!value)
+ return NULL;
+ } else if (!PyUnicode_Check(value)) {
+ PyErr_Format(PyExc_TypeError,
+ "unicode string expected instead of %s instance",
+ value->ob_type->tp_name);
+ return NULL;
+ } else
+ Py_INCREF(value);
+ size = PyUnicode_GET_SIZE(value);
+ if (size > length) {
+ PyErr_Format(PyExc_ValueError,
+ "string too long (%d, maximum length %d)",
+ size, length);
+ Py_DECREF(value);
+ return NULL;
+ } else if (size < length-1)
+ /* copy terminating NUL character if there is space */
+ size += 1;
+ PyUnicode_AsWideChar((PyUnicodeObject *)value, (wchar_t *)ptr, size);
+ return value;
+}
+
+#endif
+
+static PyObject *
+s_get(void *ptr, unsigned size)
+{
+ PyObject *result;
+
+ result = PyString_FromString((char *)ptr);
+ if (!result)
+ return NULL;
+ /* chop off at the first NUL character, if any.
+ * On error, result will be deallocated and set to NULL.
+ */
+ size = min(size, strlen(PyString_AS_STRING(result)));
+ if (result->ob_refcnt == 1) {
+ /* shorten the result */
+ _PyString_Resize(&result, size);
+ return result;
+ } else
+ /* cannot shorten the result */
+ return PyString_FromStringAndSize(ptr, size);
+}
+
+static PyObject *
+s_set(void *ptr, PyObject *value, unsigned length)
+{
+ char *data;
+ unsigned size;
+
+ data = PyString_AsString(value);
+ if (!data)
+ return NULL;
+ size = strlen(data);
+ if (size < length) {
+ /* This will copy the leading NUL character
+ * if there is space for it.
+ */
+ ++size;
+ } else if (size > length) {
+ PyErr_Format(PyExc_ValueError,
+ "string too long (%d, maximum length %d)",
+ size, length);
+ return NULL;
+ }
+ /* Also copy the terminating NUL character if there is space */
+ memcpy((char *)ptr, data, size);
+ _RET(value);
+}
+
+static PyObject *
+z_set(void *ptr, PyObject *value, unsigned size)
+{
+ if (value == Py_None) {
+ *(char **)ptr = NULL;
+ Py_INCREF(value);
+ return value;
+ }
+ if (PyString_Check(value)) {
+ *(char **)ptr = PyString_AS_STRING(value);
+ Py_INCREF(value);
+ return value;
+ } else if (PyUnicode_Check(value)) {
+ PyObject *str = PyUnicode_AsEncodedString(value,
+ conversion_mode_encoding,
+ conversion_mode_errors);
+ if (str == NULL)
+ return NULL;
+ *(char **)ptr = PyString_AS_STRING(str);
+ return str;
+ } else if (PyInt_Check(value) || PyLong_Check(value)) {
+ *(char **)ptr = (char *)PyInt_AsUnsignedLongMask(value);
+ _RET(value);
+ }
+ PyErr_Format(PyExc_TypeError,
+ "string or integer address expected instead of %s instance",
+ value->ob_type->tp_name);
+ return NULL;
+}
+
+static PyObject *
+z_get(void *ptr, unsigned size)
+{
+ /* XXX What about invalid pointers ??? */
+ if (*(void **)ptr) {
+#if defined(MS_WIN32) && !defined(_WIN32_WCE)
+ if (IsBadStringPtrA(*(char **)ptr, -1)) {
+ PyErr_Format(PyExc_ValueError,
+ "invalid string pointer %p",
+ ptr);
+ return NULL;
+ }
+#endif
+ return PyString_FromString(*(char **)ptr);
+ } else {
+ Py_INCREF(Py_None);
+ return Py_None;
+ }
+}
+
+#ifdef CTYPES_UNICODE
+static PyObject *
+Z_set(void *ptr, PyObject *value, unsigned size)
+{
+ if (value == Py_None) {
+ *(wchar_t **)ptr = NULL;
+ Py_INCREF(value);
+ return value;
+ }
+ if (PyString_Check(value)) {
+ value = PyUnicode_FromEncodedObject(value,
+ conversion_mode_encoding,
+ conversion_mode_errors);
+ if (!value)
+ return NULL;
+ } else if (PyInt_Check(value) || PyLong_Check(value)) {
+ *(wchar_t **)ptr = (wchar_t *)PyInt_AsUnsignedLongMask(value);
+ Py_INCREF(Py_None);
+ return Py_None;
+ } else if (!PyUnicode_Check(value)) {
+ PyErr_Format(PyExc_TypeError,
+ "unicode string or integer address expected instead of %s instance",
+ value->ob_type->tp_name);
+ return NULL;
+ } else
+ Py_INCREF(value);
+#ifdef HAVE_USABLE_WCHAR_T
+ /* HAVE_USABLE_WCHAR_T means that Py_UNICODE and wchar_t is the same
+ type. So we can copy directly. Hm, are unicode objects always NUL
+ terminated in Python, internally?
+ */
+ *(wchar_t **)ptr = PyUnicode_AS_UNICODE(value);
+ return value;
+#else
+ {
+ /* We must create a wchar_t* buffer from the unicode object,
+ and keep it alive */
+ PyObject *keep;
+ wchar_t *buffer;
+
+ int size = PyUnicode_GET_SIZE(value);
+ size += 1; /* terminating NUL */
+ size *= sizeof(wchar_t);
+ buffer = (wchar_t *)PyMem_Malloc(size);
+ if (!buffer)
+ return NULL;
+ memset(buffer, 0, size);
+ keep = PyCObject_FromVoidPtr(buffer, PyMem_Free);
+ if (!keep) {
+ PyMem_Free(buffer);
+ return NULL;
+ }
+ *(wchar_t **)ptr = (wchar_t *)buffer;
+ if (-1 == PyUnicode_AsWideChar((PyUnicodeObject *)value,
+ buffer, PyUnicode_GET_SIZE(value))) {
+ Py_DECREF(value);
+ return NULL;
+ }
+ Py_DECREF(value);
+ return keep;
+ }
+#endif
+}
+
+static PyObject *
+Z_get(void *ptr, unsigned size)
+{
+ wchar_t *p;
+ p = *(wchar_t **)ptr;
+ if (p)
+ return PyUnicode_FromWideChar(p, wcslen(p));
+ else {
+ Py_INCREF(Py_None);
+ return Py_None;
+ }
+}
+#endif
+
+#ifdef MS_WIN32
+static PyObject *
+BSTR_set(void *ptr, PyObject *value, unsigned size)
+{
+ BSTR bstr;
+
+ /* convert value into a PyUnicodeObject or NULL */
+ if (Py_None == value) {
+ value = NULL;
+ } else if (PyString_Check(value)) {
+ value = PyUnicode_FromEncodedObject(value,
+ conversion_mode_encoding,
+ conversion_mode_errors);
+ if (!value)
+ return NULL;
+ } else if (PyUnicode_Check(value)) {
+ Py_INCREF(value); /* for the descref below */
+ } else {
+ PyErr_Format(PyExc_TypeError,
+ "unicode string expected instead of %s instance",
+ value->ob_type->tp_name);
+ return NULL;
+ }
+
+ /* create a BSTR from value */
+ if (value) {
+ bstr = SysAllocStringLen(PyUnicode_AS_UNICODE(value),
+ PyUnicode_GET_SIZE(value));
+ Py_DECREF(value);
+ } else
+ bstr = NULL;
+
+ /* free the previous contents, if any */
+ if (*(BSTR *)ptr)
+ SysFreeString(*(BSTR *)ptr);
+
+ /* and store it */
+ *(BSTR *)ptr = bstr;
+
+ /* We don't need to keep any other object */
+ _RET(value);
+}
+
+
+static PyObject *
+BSTR_get(void *ptr, unsigned size)
+{
+ BSTR p;
+ p = *(BSTR *)ptr;
+ if (p)
+ return PyUnicode_FromWideChar(p, SysStringLen(p));
+ else {
+ /* Hm, it seems NULL pointer and zero length string are the
+ same in BSTR, see Don Box, p 81
+ */
+ Py_INCREF(Py_None);
+ return Py_None;
+ }
+}
+#endif
+
+static PyObject *
+P_set(void *ptr, PyObject *value, unsigned size)
+{
+ void *v;
+ if (value == Py_None) {
+ *(void **)ptr = NULL;
+ _RET(value);
+ }
+
+ v = PyLong_AsVoidPtr(value);
+ if (PyErr_Occurred()) {
+ /* prevent the SystemError: bad argument to internal function */
+ if (!PyInt_Check(value) && !PyLong_Check(value)) {
+ PyErr_SetString(PyExc_TypeError,
+ "cannot be converted to pointer");
+ }
+ return NULL;
+ }
+ *(void **)ptr = v;
+ _RET(value);
+}
+
+static PyObject *
+P_get(void *ptr, unsigned size)
+{
+ if (*(void **)ptr == NULL) {
+ Py_INCREF(Py_None);
+ return Py_None;
+ }
+ return PyLong_FromVoidPtr(*(void **)ptr);
+}
+
+static struct fielddesc formattable[] = {
+ { 's', s_set, s_get, &ffi_type_pointer},
+ { 'b', b_set, b_get, &ffi_type_schar},
+ { 'B', B_set, B_get, &ffi_type_uchar},
+ { 'c', c_set, c_get, &ffi_type_schar},
+ { 'd', d_set, d_get, &ffi_type_double, d_set_sw, d_get_sw},
+ { 'f', f_set, f_get, &ffi_type_float, f_set_sw, f_get_sw},
+ { 'h', h_set, h_get, &ffi_type_sshort, h_set_sw, h_get_sw},
+ { 'H', H_set, H_get, &ffi_type_ushort, H_set_sw, H_get_sw},
+ { 'i', i_set, i_get, &ffi_type_sint, i_set_sw, i_get_sw},
+ { 'I', I_set, I_get, &ffi_type_uint, I_set_sw, I_get_sw},
+/* XXX Hm, sizeof(int) == sizeof(long) doesn't hold on every platform */
+/* As soon as we can get rid of the type codes, this is no longer a problem */
+#if SIZEOF_LONG == 4
+ { 'l', l_set, l_get, &ffi_type_sint, l_set_sw, l_get_sw},
+ { 'L', L_set, L_get, &ffi_type_uint, L_set_sw, L_get_sw},
+#elif SIZEOF_LONG == 8
+ { 'l', l_set, l_get, &ffi_type_slong, l_set_sw, l_get_sw},
+ { 'L', L_set, L_get, &ffi_type_ulong, L_set_sw, L_get_sw},
+#else
+# error
+#endif
+#ifdef HAVE_LONG_LONG
+ { 'q', q_set, q_get, &ffi_type_slong, q_set_sw, q_get_sw},
+ { 'Q', Q_set, Q_get, &ffi_type_ulong, Q_set_sw, Q_get_sw},
+#endif
+ { 'P', P_set, P_get, &ffi_type_pointer},
+ { 'z', z_set, z_get, &ffi_type_pointer},
+#ifdef CTYPES_UNICODE
+ { 'u', u_set, u_get, NULL}, /* ffi_type set later */
+ { 'U', U_set, U_get, &ffi_type_pointer},
+ { 'Z', Z_set, Z_get, &ffi_type_pointer},
+#endif
+#ifdef MS_WIN32
+ { 'X', BSTR_set, BSTR_get, &ffi_type_pointer},
+ { 'v', vBOOL_set, vBOOL_get, &ffi_type_sshort},
+#endif
+ { 'O', O_set, O_get, &ffi_type_pointer},
+ { 0, NULL, NULL, NULL},
+};
+
+/*
+ Ideas: Implement VARIANT in this table, using 'V' code.
+ Use '?' as code for BOOL.
+*/
+
+struct fielddesc *
+getentry(char *fmt)
+{
+ static int initialized = 0;
+ struct fielddesc *table = formattable;
+
+ if (!initialized) {
+ initialized = 1;
+#ifdef CTYPES_UNICODE
+ if (sizeof(wchar_t) == sizeof(short))
+ getentry("u")->pffi_type = &ffi_type_sshort;
+ else if (sizeof(wchar_t) == sizeof(int))
+ getentry("u")->pffi_type = &ffi_type_sint;
+ else if (sizeof(wchar_t) == sizeof(long))
+ getentry("u")->pffi_type = &ffi_type_slong;
+#endif
+ }
+
+ for (; table->code; ++table) {
+ if (table->code == fmt[0])
+ return table;
+ }
+ return NULL;
+}
+
+typedef struct { char c; char x; } s_char;
+typedef struct { char c; short x; } s_short;
+typedef struct { char c; int x; } s_int;
+typedef struct { char c; long x; } s_long;
+typedef struct { char c; float x; } s_float;
+typedef struct { char c; double x; } s_double;
+typedef struct { char c; char *x; } s_char_p;
+typedef struct { char c; void *x; } s_void_p;
+
+/*
+#define CHAR_ALIGN (sizeof(s_char) - sizeof(char))
+#define SHORT_ALIGN (sizeof(s_short) - sizeof(short))
+#define INT_ALIGN (sizeof(s_int) - sizeof(int))
+#define LONG_ALIGN (sizeof(s_long) - sizeof(long))
+*/
+#define FLOAT_ALIGN (sizeof(s_float) - sizeof(float))
+#define DOUBLE_ALIGN (sizeof(s_double) - sizeof(double))
+/* #define CHAR_P_ALIGN (sizeof(s_char_p) - sizeof(char*)) */
+#define VOID_P_ALIGN (sizeof(s_void_p) - sizeof(void*))
+
+/*
+#ifdef HAVE_USABLE_WCHAR_T
+typedef struct { char c; wchar_t x; } s_wchar;
+typedef struct { char c; wchar_t *x; } s_wchar_p;
+
+#define WCHAR_ALIGN (sizeof(s_wchar) - sizeof(wchar_t))
+#define WCHAR_P_ALIGN (sizeof(s_wchar_p) - sizeof(wchar_t*))
+#endif
+*/
+
+#ifdef HAVE_LONG_LONG
+typedef struct { char c; PY_LONG_LONG x; } s_long_long;
+#define LONG_LONG_ALIGN (sizeof(s_long_long) - sizeof(PY_LONG_LONG))
+#endif
+
+/* from ffi.h:
+typedef struct _ffi_type
+{
+ size_t size;
+ unsigned short alignment;
+ unsigned short type;
+ struct _ffi_type **elements;
+} ffi_type;
+*/
+
+/* align and size are bogus for void, but they must not be zero */
+ffi_type ffi_type_void = { 1, 1, FFI_TYPE_VOID };
+
+ffi_type ffi_type_uint8 = { 1, 1, FFI_TYPE_UINT8 };
+ffi_type ffi_type_sint8 = { 1, 1, FFI_TYPE_SINT8 };
+
+ffi_type ffi_type_uint16 = { 2, 2, FFI_TYPE_UINT16 };
+ffi_type ffi_type_sint16 = { 2, 2, FFI_TYPE_SINT16 };
+
+ffi_type ffi_type_uint32 = { 4, 4, FFI_TYPE_UINT32 };
+ffi_type ffi_type_sint32 = { 4, 4, FFI_TYPE_SINT32 };
+
+ffi_type ffi_type_uint64 = { 8, LONG_LONG_ALIGN, FFI_TYPE_UINT64 };
+ffi_type ffi_type_sint64 = { 8, LONG_LONG_ALIGN, FFI_TYPE_SINT64 };
+
+ffi_type ffi_type_float = { sizeof(float), FLOAT_ALIGN, FFI_TYPE_FLOAT };
+ffi_type ffi_type_double = { sizeof(double), DOUBLE_ALIGN, FFI_TYPE_DOUBLE };
+
+/* ffi_type ffi_type_longdouble */
+
+ffi_type ffi_type_pointer = { sizeof(void *), VOID_P_ALIGN, FFI_TYPE_POINTER };
+
+/*---------------- EOF ----------------*/
diff --git a/Modules/_ctypes/ctypes.h b/Modules/_ctypes/ctypes.h
new file mode 100644