/*
 * tclMutexTest.c --
 *
 *	This file implements the testmutex command.
 *
 * Copyright (c) 2025 Ashok P. Nadkarni.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#undef BUILD_tcl
#undef STATIC_BUILD
#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
#include "tclInt.h"

#ifdef HAVE_UNISTD_H
#   include <unistd.h>
#   ifdef _POSIX_PRIORITY_SCHEDULING
#       include <sched.h>
#   endif
#endif

#if TCL_THREADS
/*
 * Types related to Tcl_Mutex tests.
 */

TCL_DECLARE_MUTEX(testContextMutex)

static inline void
LockTestContext(
    int numRecursions)
{
    for (int j = 0; j < numRecursions; ++j) {
	Tcl_MutexLock(&testContextMutex);
    }
}

static inline void
UnlockTestContext(
    int numRecursions)
{
    for (int j = 0; j < numRecursions; ++j) {
	Tcl_MutexUnlock(&testContextMutex);
    }
}

/*
 * ProducerConsumerContext is used in producer consumer tests to
 * simulate a resource queue.
 */
typedef struct {
    Tcl_Condition canEnqueue;	/* Signal producer if queue not full */
    Tcl_Condition canDequeue;	/* Signal consumer if queue not empty */
    unsigned long long totalEnqueued;	/* Total enqueued so far */
    unsigned long long totalDequeued;	/* Total dequeued so far */
    int available;		/* Number of "resources" available */
    int capacity;		/* Max number allowed in queue */
} ProducerConsumerQueue;

/*
 * MutexSharedContext holds context shared amongst all threads in a test.
 * Should only be modified under testContextMutex lock unless only single
 * thread has access.
 */
typedef struct {
    int numThreads;		/* Number of threads in test run */
    int numRecursions;		/* Number of mutex lock recursions */
    int numIterations;		/* Number of times each thread should loop */
    int yield;			/* Whether threads should yield when looping */
    union {
	unsigned long long counter;		/* Used in lock tests */
	ProducerConsumerQueue queue;	/* Used in condition variable tests */
    } u;
} MutexSharedContext;

/*
 * MutexThreadContext holds context specific to each test thread. This
 * is passed as the clientData argument to each test thread.
 */
typedef struct {
    MutexSharedContext *sharedContextPtr; /* Pointer to shared context */
    Tcl_ThreadId threadId;		  /* Only access in creator */
    unsigned long long numOperations;		  /* Use is dependent on the test */
    unsigned long long timeouts;		  /* Timeouts on condition variables */
} MutexThreadContext;

/* Used to track how many test threads running. Also used as trigger */
static volatile int mutexThreadCount;

static Tcl_ThreadCreateType	CounterThreadProc(void *clientData);
static int			TestMutexLock(Tcl_Interp *interp,
				    MutexSharedContext *contextPtr);
static int			TestConditionVariable(Tcl_Interp *interp,
				    MutexSharedContext *contextPtr);
static Tcl_ThreadCreateType	ConsumerThreadProc(void *clientData);
static Tcl_ThreadCreateType	ProducerThreadProc(void *clientData);

static inline void
YieldToOtherThreads(void)
{
#if defined(_WIN32)
    Sleep(0);
#elif defined(_POSIX_PRIORITY_SCHEDULING)
    (void) sched_yield();
#else
    volatile int i;
    for (i = 0; i < 1000; ++i) {
	/* Just some random delay */
    }
#endif
}

#ifdef __cplusplus
extern "C" {
#endif
extern int		Tcltest_Init(Tcl_Interp *interp);
#ifdef __cplusplus
}
#endif

// Get the difference (in microseconds) between two Tcl_GetTime() timestamps.
#define USEC_DIFF(before, after) \
    (1000000 * ((after).sec - (before).sec) + ((after).usec - (before).usec))

/*
 *----------------------------------------------------------------------
 *
 * TestMutexCmd --
 *
 *	This procedure is invoked to process the "testmutex" Tcl command.
 *
 *	testmutex counter ?numthreads? ?numrecursions? ?numiterations?
 *	testmutex conditionvariable ?numthreads? ?numrecursions? ?numiterations?
 *
 * Results:
 *	A standard Tcl result.
 *
 *----------------------------------------------------------------------
 */

static int
TestMutexObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static const char *const mutexOptions[] = {
	"lock", "condition", NULL
    };
    enum options {
	LOCK, CONDITION
    } option;
    MutexSharedContext context = {
	2,		/* numThreads */
	1,		/* numRecursions */
	1000000,	/* numIterations */
	1,		/* yield */
	{0},		/* u.counter */
    };

    if (objc < 2 || objc > 6) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"option ?numthreads? ?numrecursions? ?numiterations? ?yield?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], mutexOptions, "option", 0,
	    &option) != TCL_OK) {
	return TCL_ERROR;
    }
    if (objc > 2 && Tcl_GetIntFromObj(interp, objv[2],
	    &context.numThreads) != TCL_OK) {
	return TCL_ERROR;
    }
    if (objc > 3 && Tcl_GetIntFromObj(interp, objv[3],
	    &context.numRecursions) != TCL_OK) {
	return TCL_ERROR;
    }
    if (objc > 4 && Tcl_GetIntFromObj(interp, objv[4],
	    &context.numIterations) != TCL_OK) {
	return TCL_ERROR;
    }
    if (objc > 5 && Tcl_GetIntFromObj(interp, objv[5],
	    &context.yield) != TCL_OK) {
	return TCL_ERROR;
    }

    if (context.numIterations <= 0 || context.numRecursions <= 0 ||
	    context.numThreads <= 0) {
	Tcl_SetResult(interp,
		"thread, recursion and iteration counts must be positive",
		TCL_STATIC);
	return TCL_ERROR;
    }

    int result = TCL_OK;
    switch (option) {
    case LOCK:
	result = TestMutexLock(interp, &context);
	break;
    case CONDITION:
	result = TestConditionVariable(interp, &context);
	break;
    }
    return result;
}

/*
 *------------------------------------------------------------------------
 *
 * TestMutexLock --
 *
 *	Implements the "testmutex lock" command to test Tcl_MutexLock.
 *
 * Results:
 *	A Tcl result code.
 *
 * Side effects:
 *	Stores a result in the interpreter.
 *
 *------------------------------------------------------------------------
 */
static int
TestMutexLock(
    Tcl_Interp *interp,
    MutexSharedContext *contextPtr)
{
    MutexThreadContext *threadContextsPtr = (MutexThreadContext *)
	    Tcl_Alloc(sizeof(*threadContextsPtr) * contextPtr->numThreads);

    contextPtr->u.counter = 0;
    mutexThreadCount = 0;
    for (int i = 0; i < contextPtr->numThreads; i++) {
	threadContextsPtr[i].sharedContextPtr = contextPtr;
	threadContextsPtr[i].numOperations = 0; /* Init though not used */

	if (Tcl_CreateThread(&threadContextsPtr[i].threadId,
		CounterThreadProc, &threadContextsPtr[i],
		TCL_THREAD_STACK_DEFAULT, TCL_THREAD_JOINABLE) != TCL_OK) {
	    Tcl_Panic("Failed to create %d'th thread\n", i);
	}
    }
    mutexThreadCount = contextPtr->numThreads; /* Will fire off all test threads */

    /* Wait for all threads */
    for (int i = 0; i < contextPtr->numThreads; i++) {
	int threadResult;
	Tcl_JoinThread(threadContextsPtr[i].threadId, &threadResult);
    }
    Tcl_Free(threadContextsPtr);

    Tcl_SetObjResult(interp, Tcl_NewWideUIntObj(contextPtr->u.counter));
    return TCL_OK;
}

/*
 *------------------------------------------------------------------------
 *
 * CounterThreadProc --
 *
 *	Increments a shared counter a specified number of times and exits
 *	the thread.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *------------------------------------------------------------------------
 */
static Tcl_ThreadCreateType
CounterThreadProc(
    void *clientData)
{
    MutexThreadContext *threadContextPtr = (MutexThreadContext *)clientData;
    MutexSharedContext *contextPtr = threadContextPtr->sharedContextPtr;

    /* Spin wait until given the run signal */
    while (mutexThreadCount < contextPtr->numThreads) {
	YieldToOtherThreads();
    }

    for (int i = 0; i < contextPtr->numIterations; i++) {
	LockTestContext(contextPtr->numRecursions);
	unsigned long long temp = contextPtr->u.counter;
	if (contextPtr->yield) {
	    /* Some delay. No one else is supposed to modify the counter */
	    YieldToOtherThreads();
	}
	contextPtr->u.counter = temp + 1; /* Increment original value read */
	UnlockTestContext(contextPtr->numRecursions);
    }

    Tcl_ExitThread(0);
    TCL_THREAD_CREATE_RETURN;
}

/*
 *------------------------------------------------------------------------
 *
 * TestConditionVariable --
 *
 *	Implements the "testmutex condition" command to test Tcl_Condition*.
 *	The test emulates a producer-consumer scenario.
 *
 * Results:
 *	A Tcl result code.
 *
 * Side effects:
 *	Stores a result in the interpreter.
 *
 *------------------------------------------------------------------------
 */
static int
TestConditionVariable(
    Tcl_Interp *interp,
    MutexSharedContext *contextPtr)
{
    if (contextPtr->numThreads < 2) {
	Tcl_SetResult(interp, "Need at least 2 threads.", TCL_STATIC);
	return TCL_ERROR;
    }
    int numProducers = contextPtr->numThreads / 2;
    int numConsumers = contextPtr->numThreads - numProducers;

    contextPtr->u.queue.canDequeue = NULL;
    contextPtr->u.queue.canEnqueue = NULL;

    /*
     * available tracks how many elements in the virtual queue
     * capacity is max length of virtual queue.
     */
    contextPtr->u.queue.totalEnqueued = 0;
    contextPtr->u.queue.totalDequeued = 0;
    contextPtr->u.queue.available = 0;
    contextPtr->u.queue.capacity = 3; /* Arbitrary for now */

    MutexThreadContext *consumerContextsPtr = (MutexThreadContext *)Tcl_Alloc(
	    sizeof(*consumerContextsPtr) * numConsumers);
    MutexThreadContext *producerContextsPtr = (MutexThreadContext *)Tcl_Alloc(
	    sizeof(*producerContextsPtr) * numProducers);

    mutexThreadCount = 0;

    for (int i = 0; i < numConsumers; i++) {
	consumerContextsPtr[i].sharedContextPtr = contextPtr;
	consumerContextsPtr[i].numOperations = 0;
	consumerContextsPtr[i].timeouts = 0;

	if (Tcl_CreateThread(&consumerContextsPtr[i].threadId,
		ConsumerThreadProc, &consumerContextsPtr[i],
		TCL_THREAD_STACK_DEFAULT, TCL_THREAD_JOINABLE) != TCL_OK) {
	    Tcl_Panic("Failed to create %d'th thread\n", (int) i);
	}
    }

    for (int i = 0; i < numProducers; i++) {
	producerContextsPtr[i].sharedContextPtr = contextPtr;
	producerContextsPtr[i].numOperations = 0;
	producerContextsPtr[i].timeouts = 0;

	if (Tcl_CreateThread(&producerContextsPtr[i].threadId,
		ProducerThreadProc, &producerContextsPtr[i],
		TCL_THREAD_STACK_DEFAULT, TCL_THREAD_JOINABLE) != TCL_OK) {
	    Tcl_Panic("Failed to create %d'th thread\n", (int) i);
	}
    }

    mutexThreadCount = contextPtr->numThreads; /* Will trigger all threads */

    /* Producer total, thread, timeouts, Consumer total, thread, timeouts */
    Tcl_Obj *results[6];
    results[1] = Tcl_NewListObj(numProducers, NULL);
    results[4] = Tcl_NewListObj(numConsumers, NULL);

    unsigned long long producerTimeouts = 0;
    unsigned long long producerOperations = 0;
    unsigned long long consumerTimeouts = 0;
    unsigned long long consumerOperations = 0;
    for (int i = 0; i < numProducers; i++) {
	int threadResult;
	Tcl_JoinThread(producerContextsPtr[i].threadId, &threadResult);
	producerOperations += producerContextsPtr[i].numOperations;
	Tcl_ListObjAppendElement(NULL, results[1],
		Tcl_NewWideUIntObj(producerContextsPtr[i].numOperations));
	producerTimeouts += producerContextsPtr[i].timeouts;
    }
    for (int i = 0; i < numConsumers; i++) {
	int threadResult;
	Tcl_JoinThread(consumerContextsPtr[i].threadId, &threadResult);
	consumerOperations += consumerContextsPtr[i].numOperations;
	Tcl_ListObjAppendElement(NULL, results[4],
		Tcl_NewWideUIntObj(consumerContextsPtr[i].numOperations));
	consumerTimeouts += consumerContextsPtr[i].timeouts;
    }

    results[0] = Tcl_NewWideUIntObj(producerOperations);
    results[2] = Tcl_NewWideUIntObj(producerTimeouts);
    results[3] = Tcl_NewWideUIntObj(consumerOperations);
    results[5] = Tcl_NewWideUIntObj(consumerTimeouts);
    Tcl_SetObjResult(interp, Tcl_NewListObj(6, results));

    Tcl_Free(producerContextsPtr);
    Tcl_Free(consumerContextsPtr);

    Tcl_ConditionFinalize(&contextPtr->u.queue.canDequeue);
    Tcl_ConditionFinalize(&contextPtr->u.queue.canEnqueue);

    return TCL_OK;
}

/*
 *------------------------------------------------------------------------
 *
 * ProducerThreadProc --
 *
 *	Acts as a "producer" that enqueues to the virtual resource queue.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *------------------------------------------------------------------------
 */

static const Tcl_Time CONDITION_TIMEOUT = {5, 0};

static Tcl_ThreadCreateType
ProducerThreadProc(
    void *clientData)
{
    MutexThreadContext *threadContextPtr = (MutexThreadContext *)clientData;
    MutexSharedContext *contextPtr = threadContextPtr->sharedContextPtr;

    /* Limit on total number of operations across all threads */
    unsigned long long limit;
    limit = contextPtr->numThreads * (unsigned long long) contextPtr->numIterations;

    /* Spin wait until given the run signal */
    while (mutexThreadCount < contextPtr->numThreads) {
	YieldToOtherThreads();
    }

    LockTestContext(contextPtr->numRecursions);
    while (contextPtr->u.queue.totalEnqueued < limit) {
	if (contextPtr->u.queue.available == contextPtr->u.queue.capacity) {
	    Tcl_Time before, after;
	    Tcl_GetTime(&before);
	    Tcl_ConditionWait(&contextPtr->u.queue.canEnqueue,
		    &testContextMutex, &CONDITION_TIMEOUT);
	    Tcl_GetTime(&after);
	    if (USEC_DIFF(before, after) >= 1000000 * CONDITION_TIMEOUT.sec) {
		threadContextPtr->timeouts += 1;
	    }
	} else {
	    contextPtr->u.queue.available += 1; /* Enqueue operation */
	    contextPtr->u.queue.totalEnqueued += 1;
	    threadContextPtr->numOperations += 1;
	    Tcl_ConditionNotify(&contextPtr->u.queue.canDequeue);
	    if (contextPtr->yield) {
		/* Simulate real work by unlocking before yielding */
		UnlockTestContext(contextPtr->numRecursions);
		YieldToOtherThreads();
		LockTestContext(contextPtr->numRecursions);
	    }
	}
    }
    UnlockTestContext(contextPtr->numRecursions);

    Tcl_ExitThread(0);
    TCL_THREAD_CREATE_RETURN;
}

/*
 *------------------------------------------------------------------------
 *
 * ConsumerThreadProc --
 *
 *	Acts as a "consumer" that dequeues from the virtual resource queue.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *------------------------------------------------------------------------
 */
static Tcl_ThreadCreateType
ConsumerThreadProc(
    void *clientData)
{
    MutexThreadContext *threadContextPtr = (MutexThreadContext *)clientData;
    MutexSharedContext *contextPtr = threadContextPtr->sharedContextPtr;

    /* Limit on total number of operations across all threads */
    unsigned long long limit;
    limit = contextPtr->numThreads * (unsigned long long) contextPtr->numIterations;

    /* Spin wait until given the run signal */
    while (mutexThreadCount < contextPtr->numThreads) {
	YieldToOtherThreads();
    }

    LockTestContext(contextPtr->numRecursions);
    while (contextPtr->u.queue.totalDequeued < limit) {
	if (contextPtr->u.queue.available == 0) {
	    Tcl_Time before, after;
	    Tcl_GetTime(&before);
	    Tcl_ConditionWait(&contextPtr->u.queue.canDequeue,
		    &testContextMutex, &CONDITION_TIMEOUT);
	    Tcl_GetTime(&after);
	    if (USEC_DIFF(before, after) >= 1000000 * CONDITION_TIMEOUT.sec) {
		threadContextPtr->timeouts += 1;
	    }
	} else {
	    contextPtr->u.queue.totalDequeued += 1;
	    threadContextPtr->numOperations += 1;
	    contextPtr->u.queue.available -= 1;
	    Tcl_ConditionNotify(&contextPtr->u.queue.canEnqueue);
	    if (contextPtr->yield) {
		/* Simulate real work by unlocking before yielding */
		UnlockTestContext(contextPtr->numRecursions);
		YieldToOtherThreads();
		LockTestContext(contextPtr->numRecursions);
	    }
	}
    }
    UnlockTestContext(contextPtr->numRecursions);

    Tcl_ExitThread(0);
    TCL_THREAD_CREATE_RETURN;
}

/*
 *----------------------------------------------------------------------
 *
 * TclMutex_Init --
 *
 *	Initialize the testmutex command.
 *
 * Results:
 *	TCL_OK if the package was properly initialized.
 *
 * Side effects:
 *	Add the "testmutex" command to the interp.
 *
 *----------------------------------------------------------------------
 */

int
TclMutex_Init(
    Tcl_Interp *interp)		/* The current Tcl interpreter */
{
    Tcl_CreateObjCommand(interp, "testmutex", TestMutexObjCmd, NULL, NULL);
    return TCL_OK;
}
#endif /* TCL_THREADS */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */