static int
ForeachLoopStep (ClientData data[], Tcl_Interp * interp, int result)
{
ForeachState *const statePtr = data[0];
Tcl_Obj *const varPtr = data[1];
DBFHandle const dbfHandle = data[2];
Tcl_Obj *const bodyPtr = data[3];
switch (result)
{
case TCL_CONTINUE:
result = TCL_OK;
case TCL_OK:
break;
case TCL_BREAK:
result = TCL_OK;
goto done;
case TCL_ERROR:
default:
goto done;
}
if (statePtr->length > ++statePtr->i)
{
if ((result =
ForeachAssignments (interp, statePtr, varPtr, dbfHandle)) != TCL_OK)
{
goto done;
}
Tcl_NRAddCallback (interp, ForeachLoopStep, statePtr, varPtr, dbfHandle,
bodyPtr);
return Tcl_NREvalObj (interp, bodyPtr, 0);
}
Tcl_ResetResult (interp);
done:
ckfree ((char *) statePtr);
return result;
}
NRCommandDef (foreach, clientData, interp, objc, objv)
{
Handle *handle;
DBFHandle dbfHandle;
int recordCount, fieldCount;
ForeachState *statePtr;
if (objc != 4)
{
Tcl_WrongNumArgs (interp, 1, objv, "var filename command");
return TCL_ERROR;
}
if (DbfGetHandleFromObj (interp, objv[2], &handle) != TCL_OK)
{
return TCL_ERROR;
}
if ((recordCount = DBFGetRecordCount (dbfHandle = handle->dbfHandle)) == 0)
{
return TCL_OK;
}
if ((fieldCount = DBFGetFieldCount (dbfHandle)) == 0)
{
return TCL_OK;
}
statePtr = (ForeachState *) ckalloc (sizeof (*statePtr));
statePtr->i = 0;
statePtr->length = recordCount;
statePtr->size = fieldCount;
if (ForeachAssignments (interp, statePtr, objv[1], dbfHandle) != TCL_OK)
{
return TCL_ERROR;
}
Tcl_NRAddCallback (interp, ForeachLoopStep, statePtr, objv[1], dbfHandle,
objv[3]);
return Tcl_NREvalObj (interp, objv[3], 0);
}
static int
Tcl_InvokeClassProcedureMethod(
Tcl_Interp *interp,
Tcl_Obj *namePtr, /* name of the method */
Tcl_Namespace *nsPtr, /* namespace for calling method */
ProcedureMethod *pmPtr, /* method type specific data */
int objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Arguments as actually seen. */
{
Proc *procPtr = pmPtr->procPtr;
int flags = FRAME_IS_METHOD;
CallFrame frame;
CallFrame *framePtr = &frame;
CallFrame **framePtrPtr1 = &framePtr;
Tcl_CallFrame **framePtrPtr = (Tcl_CallFrame **)framePtrPtr1;
Command cmd;
int result;
memset(&cmd, 0, sizeof(Command));
cmd.nsPtr = (Namespace *) nsPtr;
cmd.clientData = NULL;
pmPtr->procPtr->cmdPtr = &cmd;
result = TclProcCompileProc(interp, pmPtr->procPtr,
pmPtr->procPtr->bodyPtr, (Namespace *) nsPtr, "body of method",
Tcl_GetString(namePtr));
if (result != TCL_OK) {
return result;
}
/*
* Make the stack frame and fill it out with information about this call.
* This operation may fail.
*/
flags |= FRAME_IS_PROC;
result = TclPushStackFrame(interp, framePtrPtr, nsPtr, flags);
if (result != TCL_OK) {
return result;
}
framePtr->clientData = NULL;
framePtr->objc = objc;
framePtr->objv = objv;
framePtr->procPtr = procPtr;
/*
* Give the pre-call callback a chance to do some setup and, possibly,
* veto the call.
*/
if (pmPtr->preCallProc != NULL) {
int isFinished;
result = pmPtr->preCallProc(pmPtr->clientData, interp, NULL,
(Tcl_CallFrame *) framePtr, &isFinished);
if (isFinished || result != TCL_OK) {
Tcl_PopCallFrame(interp);
TclStackFree(interp, framePtr);
goto done;
}
}
/*
* Now invoke the body of the method. Note that we need to take special
* action when doing unknown processing to ensure that the missing method
* name is passed as an argument.
*/
if (pmPtr->postCallProc) {
Tcl_NRAddCallback(interp, CallFinalizePMCall, nsPtr,
(Tcl_NRPostProc *)pmPtr->postCallProc, pmPtr->clientData, NULL);
}
return TclNRInterpProcCore(interp, namePtr, 1, pmPtr->errProc);
done:
return result;
}
