#include "common.h"

#ifdef INFORMATION

Function calls all run through DoFunction().

A function call can either be to a system routine or a user routine.

User routines are like C macros, executed in the context of the caller, so the argument

are never evaluated prior to the call. If you evaluated an argument during the mustering,

you could get bad answers.Consider:

One has a function : ^ foo(^ arg1^ arg2) ^ arg2^ arg1

And one has a call^ foo(($val = 1) $val)

This SHOULD look like inline code : $val $val = 1

But evaluation at argument time would alter the value of $val and pass THAT as ^ arg2.Wrong.

System routines are proper functions, whose callArgumentList may or may not be evaluated.

The description of a system routine tells

how many callArgumentList it expectsand in what way.Routines that set variables always pass

that designator as the first(unevaluated) argumentand all the rest are evaluated callArgumentList.

The following argument passing is supported

1. Evaluated - each argument is evaluated and stored(except for a storage argument).

If the routine takes optional callArgumentList these are already also evaluatedand stored,

and the argument after the last actual argument is a null string.

2. STREAM_ARG - the entire argument stream is passed unevaled as a single argument,

allowing the routine to handle processing them itself.

All calls have a context of "executingBase" which is the start of the rule causing this

evaluation. All calls are passed a "buffer" which is spot in the currentOutputBase it

should write any answers.

Anytime a single argument is expected, one can pass a whole slew of them by making

them into a stream, encasing them with().The parens will be strippedand the

entire mess passed unevaluated.This makes it analogous to STREAM_ARG, but the latter

requires no excess parens to delimit it.

All calls create a CALLFRAME. These contain, among other data, the argument values being

passed to the function. The variable currentCallFrame is always the one for the currently executing

function and has currentCallFrame->arguments array of the arguments (1-based).

User functions have named arguments, either $_ local variables or ^xxx read-write variables.

Function variables in a function signature like ^myfunc(^arg1 ^arg2 $_arg3) are compiled into

indexed references like ^1 and ^2 into the frame's argument list. Those references refer to the

arguments in the call frame of the user function even though other system functions may have been

invoked underneath. Hense all function variable references translate using the frame pointed to by

currentFNVarFrame.

Memory management :

Incoming variables to functions have their data copied into stack space pointed at by the call frame's

argument list. This memory frees automaticall when the call frame is popped on function completion.

'

Regular heap space is used to hold permanent data(e.g.variable assignment for non - local variables.

#endif

#define ENCODE_MARKER 123

#define END_TEXT_CHUNK '`'

#define END_TEXT_CHUNK_STRING "``"

#define SIZELIM 200

#define MAX_TOPIC_KEYS 5000

#define PLANMARK -1

#define RULEMARK -2

#define MAX_TEST_PATTERN 10000

#define NO_WINNER 10000

static char testoutputbacktrace[MAX_WORD_SIZE];

static int testoutputbacktracecount = 0;

static char* nullArguments[MAX_ARG_LIMIT + 1] =

{ "","","","","","","","", "","","","","","","","", "","","","","","","","", "","","","","","","","" };

APICall csapicall = NO_API_CALL;

HEAPREF patternwordthread = NULL;

char* fnOutput = NULL;

static bool changedNL = false;

char* rawtestpatterninput = NULL;

bool directAnalyze = false;

static char lognames[MAX_LOG_NAMES][200];

static char* codeStart = NULL;

char* realCode = NULL;

static char testoutputFail[200];

int rulesExecuted = 0;

HEAPREF memoryMarkThreadList = NULL;

HEAPREF memoryVariableThreadList = NULL;

HEAPREF memoryVariableChangesThreadList = NULL;

bool planning = false;

int debugValue = 0;

char* testpatterninput = NULL;

char testpatternlabel[100];

char* style = NULL;

#define MAX_REUSE_SAFETY 100

static int reuseIndex = 0;

char* traceTestPatternBuffer = NULL; // where api traces get stored

int testPatternIndex = -1;

static char* traceBase = NULL;

static int traceIndex = 0;

static char* reuseSafety[MAX_REUSE_SAFETY + 1];

static int reuseSafetyCount[MAX_REUSE_SAFETY + 1];

static char* months[] = { (char*)"January",(char*)"February",(char*)"March",(char*)"April",(char*)"May",(char*)"June",(char*)"July",(char*)"August",(char*)"September",(char*)"October",(char*)"November",(char*)"December" };

static char* days[] = { (char*)"Sunday",(char*)"Monday",(char*)"Tuesday",(char*)"Wednesday",(char*)"Thursday",(char*)"Friday",(char*)"Saturday" };

long http_response = 0;

char lastcurltime[100] = { '\0' };

int globalDepth = 0;

int maxGlobalSeen = 0;

char* stringPlanBase = 0;

char* backtrackPoint = 0; // plan code backtrace data

unsigned int currentIterator = 0; // next value of iterator

HEAPREF savedSentencesThreadList = NULL;

bool softRestart = false;

bool backtrackable = false;

char* lastInputSubstitution = NULL;

TestMode wasCommand; // special result passed back from some commands to control chatscript

static unsigned int spellSet; // place to store word-facts on words spelled per a pattern

int tracepatterndata = 0;

static unsigned int internalConceptIndex = 0;

static int rhymeSet;

CALLFRAME* currentFNVarFrame = NULL; // argument list access for interpreting ^0

CALLFRAME* currentCallFrame = NULL; // argument list access for current function

char* currentPlanBuffer;

#include <map>

using namespace std;

extern std::map <WORDP, HEAPINDEX> triedData; // per volley index into heap space

typedef std::map<WORDP, double> wordScore_t;

//////////////////////////////////////////////////////////

/// BASIC FUNCTION CODE

//////////////////////////////////////////////////////////

unsigned int callindex = 0;

CALLFRAME* ChangeDepth(int value, const char* name, bool nostackCutback, char* code)

{

if (value == 0) // secondary call from userfunction. frame is now valid

{

CALLFRAME* frame = frameList[globalDepth];

if (showDepth) Log(USERLOG, "same depth %u %s \r\n", globalDepth, name);

if (name) frame->label = (char*)name; // override

if (code) frame->code = code;

#ifndef DISCARDTESTING

if (debugCall) (*debugCall)(frame->label, true);

#endif

return frame;

}

else if (value < 0) // leaving depth

{

bool abort = false;

CALLFRAME* frame = frameList[globalDepth];

frameList[globalDepth] = NULL;

#ifndef DISCARDTESTING

if (globalDepth && *name && debugCall)

{

char* result = (*debugCall)((char*)name, false);

if (result) abort = true;

}

#endif

if (frame->memindex != bufferIndex)

{

ReportBug((char*)"INFO: depth %d not closing bufferindex correctly at %s bufferindex now %d was %d\r\n", globalDepth, name, bufferIndex, frame->memindex);

bufferIndex = frame->memindex; // recover release

}

frame->name = NULL;

frame->rule = NULL;

frame->label = NULL;

currentRuleID = frame->oldRuleID;

currentTopicID = frame->oldTopic;

currentRuleTopic = frame->oldRuleTopic;

currentRule = frame->oldRule;

currentFNVarFrame = frame->currentFNVarFrame;

currentCallFrame = frame->currentCallFrame;

// engine functions that are streams should not destroy potential local adjustments

if (!nostackCutback)

stackFree = (char*)frame; // deallocoate ARGUMENT space

if (showDepth) Log(USERLOG, "-depth %d %s bufferindex %d heapused:%d\r\n", globalDepth, name, bufferIndex, (int)(heapBase - heapFree));

globalDepth += value;

if (globalDepth < 0) { ReportBug((char*)"bad global depth in %s", name); globalDepth = 0; }

return (abort) ? (CALLFRAME*)1 : NULL; // abort code

}

else // value > 0

{

++callindex;

stackFree = (char*)(((uint64)stackFree + 7) & 0xFFFFFFFFFFFFFFF8ULL);

CALLFRAME* frame = (CALLFRAME*)stackFree;

stackFree += sizeof(CALLFRAME);

memset(frame, 0, sizeof(CALLFRAME));

frame->label = (char*)name;

frame->index = callindex; // debugging

frame->code = code;

frame->heapstart = heapFree;

frame->rule = (currentRule) ? currentRule : (char*)"";

memcpy(&frame->arguments, nullArguments, sizeof(nullArguments));

frame->outputlevel = outputlevel + 1;

frame->oldRuleID = currentRuleID;

frame->oldTopic = currentTopicID;

frame->oldRuleTopic = currentRuleTopic;

frame->currentFNVarFrame = currentFNVarFrame; // inherit to pass along

frame->currentCallFrame = currentCallFrame;

currentCallFrame = frame;

frame->oldRule = currentRule;

frame->memindex = bufferIndex;

frame->heapDepth = heapBase - heapFree;

globalDepth += value;

if (showDepth) Log(USERLOG, "+depth %d %s bufferindex %d heapused: %d stackused:%d gap:%d\r\n", globalDepth, name, bufferIndex, (int)(heapBase - heapFree), (int)(stackFree - stackStart), (int)(heapFree - stackFree));

frameList[globalDepth] = frame; // define argument start space - release back to here on exit

#ifndef DISCARDTESTING

if (globalDepth && *name != '*' && debugCall) (*debugCall)((char*)name, true);

#endif

if (globalDepth >= (MAX_GLOBAL - 1)) ReportBug((char*)"FATAL: globaldepth too deep at %s\r\n", name);

if (globalDepth > maxGlobalSeen) maxGlobalSeen = globalDepth;

return frame;

}

}

FunctionResult SetLanguageCode(char* buffer)

{

char* arg1 = ARGUMENT(1);

MakeUpperCase(arg1);

return SetLanguage(arg1) ? NOPROBLEM_BIT : FAILRULE_BIT;

}

void InitFunctionSystem() // register all functions

{

unsigned int k = 0;

SystemFunctionInfo* fn;

while ((fn = &systemFunctionSet[++k]) && fn->word)

{

if (*fn->word == '^') // not a header

{

WORDP D = StoreWord((char*)fn->word, 0);

AddInternalFlag(D, FUNCTION_NAME);

D->x.codeIndex = (unsigned short)k;

}

}

for (unsigned int i = 0; i < MAX_LOG_NAMES; ++i) // for ^log function

{

lognames[i][0] = 0;

logfiles[i] = NULL;

}

oldunmarked[255] = 0; // global unmarking has nothing for ^marking functions

}

unsigned char* GetDefinition(WORDP D)

{

unsigned char* defn = D->w.fndefinition; // raw definition w link

if (!defn) return NULL;

return defn + 4; // skip link field, leaves botid, flags , count

}

unsigned int MACRO_ARGUMENT_COUNT(unsigned char* defn) // 0e(

{// botid flags count ( ...

if (!defn || !*defn) return 0;

while (IsDigit(*++defn)) { ; } // skip space then botid

while (IsDigit(*++defn)) { ; } // skip macro arguments descriptor

unsigned char c = (unsigned char)*++defn;

return (c >= 'a') ? (c - 'a' + 15) : (c - 'A');

}

char* InitDisplay(char* list)

{

char word[MAX_WORD_SIZE];

list += 2; // skip ( and space

while (1)

{

list = ReadCompiledWord((char*)list, word);

if (*word == ')') break; // end of display is signaled by )

if (*word == USERVAR_PREFIX)

{

// printf("saving %s for %d %s\r\n", word, globalDepth, GetCallFrame(globalDepth)->label);

if (!AllocateStackSlot(word)) return 0;

}

}

return list;

}

void RestoreDisplay(char** base, char* list)

{

char word[MAX_WORD_SIZE];

list += 2; // skip ( and space

char** slot = base; // display table starts here

while (1)

{

list = ReadCompiledWord(list, word);

if (*word == ')') break;

if (*word == USERVAR_PREFIX)

{

// printf("restoring %s for %d %s\r\n", word, globalDepth, GetCallFrame(globalDepth)->label);

slot = RestoreStackSlot(word, slot);

}

}

}

#ifdef WIN32

#define MAKEWORDX(a, b) ((unsigned short)(((BYTE)(((DWORD_PTR)(a)) & 0xff)) | ((unsigned short)((BYTE)(((DWORD_PTR)(b)) & 0xff))) << 8))

FunctionResult InitWinsock()

{

static bool first = true;

if (first) // prevent DB close from closing WSAStartup to improve performance

{

first = false;

WSADATA wsaData;

unsigned short wVersionRequested = MAKEWORDX(2, 0); // Request WinSock v2.0

if (WSAStartup(wVersionRequested, &wsaData) != 0)

{

if (trace & TRACE_SQL && CheckTopicTrace()) Log(USERLOG, "WSAStartup failed\r\n");

return FAILRULE_BIT;

}

}

return NOPROBLEM_BIT;

}

#endif

static char* GetPossibleFunctionArgument(char* arg, char* word)

{

char* ptr = ReadCompiledWord(arg, word);

if (*word == '^' && IsDigit(word[1]))

{

char* value = FNVAR(word);

if (*value == LCLVARDATA_PREFIX && value[1] == LCLVARDATA_PREFIX)

value += 2; // already evaled data -- but bug remains

strcpy(word, value);

}

// this gets us what was passed by name, $xxx.hi will be a json ref.

return ptr;

}

FunctionResult JavascriptArgEval(unsigned int index, char* buffer)

{

FunctionResult result;

char argNum[10];

sprintf(argNum, "^%u", index+1);

char* arg = FNVAR(argNum);

GetCommandArg(arg, buffer, result, OUTPUT_UNTOUCHEDSTRING);

return result;

}

char* SaveBacktrack(int id) // --defunct call

{

// save: id, oldbacktrack point, currentfact, current dict, HEAPINDEX?

char* mark = AllocateHeap(NULL, 4, sizeof(int), false);

if (!mark) return NULL;

int* i = (int*)mark;

i[0] = id; // 1st int is a backtrack label - plan (-1) or rule (other)

i[1] = (int)(stringPlanBase - backtrackPoint); // 2nd is old backtrack point value

i[2] = Fact2Index(lastFactUsed); // 4th is fact base

i[3] = Word2Index(dictionaryFree); // 5th is word base (this entry is NOT used)

return backtrackPoint = mark;

}

unsigned char* FindAppropriateDefinition(WORDP D, FunctionResult & result, bool findright)

{

int64 botid;

unsigned char* defn = D->w.fndefinition; // raw definition w link

if (!defn) return NULL;

unsigned char* allaccess = NULL;

unsigned int link = (defn[0] << 24) + (defn[1] << 16) + (defn[2] << 8) + (defn[3]);

defn += 4; // skip jump

defn = (unsigned char*)ReadInt64((char*)defn, botid);

if (botid == 0) allaccess = defn; // default access

while (!(myBot & botid) && (findright || !compiling) && link) // wrong bot, but have link to another bots can share code

{

if (!botid) allaccess = defn;

defn = (unsigned char*)Index2Heap(link); // next defn

link = (defn[0] << 24) + (defn[1] << 16) + (defn[2] << 8) + (defn[3]);

defn += 4; // skip jump

defn = (unsigned char*)ReadInt64((char*)defn, botid);

}

if (!botid && !myBot) { ; } // matches

else if (compiling && !findright) { ; } // during compilation most recent always matches

else if (!(myBot & botid)) defn = allaccess;

result = (!defn) ? FAILRULE_BIT : NOPROBLEM_BIT;

return defn; // point at (

}

int GetFnArgCount(char* func, int& flags)

{

int args = 0;

if (*func == '^') // how many arguments does function accept

{

size_t len = strlen(func);

if (func[len - 1] == ' ') func[--len] = 0; // trailing blank, remove

WORDP D = FindWord(func, len, LOWERCASE_LOOKUP);

if (D && D->internalBits & FUNCTION_NAME)

{

FunctionResult fnresult;

char* definition = (char*)FindAppropriateDefinition(D, fnresult);

if (definition)

{

definition = ReadInt((char*)definition, flags);

unsigned char c = (unsigned char)*definition;

args = (c >= 'a') ? (c - 'a' + 15) : (c - 'A'); // expected args, leaving us at ( args ...

}

}

}

return args;

}

static char* FlushMark() // throw away this backtrack point, maybe reclaim its heap space

{

if (!backtrackPoint) return NULL;

// we are keeping facts and variable changes, so we cannot reassign the string free space back because it may be in use.

if (backtrackPoint == heapFree) ResetHeapFree(backtrackPoint + (4 * sizeof(int)));

int* i = (int*)backtrackPoint;

return backtrackPoint = stringPlanBase - i[1];

}

static void RestoreMark()

{ // undo all changes

if (!backtrackPoint) return;

int* i = ((int*)backtrackPoint); // skip id

// revert facts

FACT* oldF = Index2Fact(i[2]);

while (lastFactUsed > oldF) FreeFact(lastFactUsed--); // undo facts to start

// revert dict entries

WORDP oldD = Index2Word(i[3]);

// trim dead facts at ends of sets

for (unsigned int store = 0; store <= MAX_FIND_SETS; ++store)

{

unsigned int count = FACTSET_COUNT(store) + 1;

while (--count >= 1)

{

if (!(factSet[store][count]->flags & FACTDEAD)) break; // stop having found a live fact

}

if (count) SET_FACTSET_COUNT(store, count); // new end

}

DictionaryRelease(oldD, backtrackPoint);

backtrackPoint = stringPlanBase - i[1];

}

static void StoreCompileErrors(MEANING M)

{

if (errorIndex)

{

MEANING M1 = GetUniqueJsonComposite((char*)"ja-", FACTTRANSIENT);

WORDP field = StoreWord("errors", AS_IS);

unsigned int flags = JSON_OBJECT_FACT | FACTTRANSIENT | JSON_ARRAY_VALUE;

CreateFact(M, MakeMeaning(field), M1, flags);

flags = JSON_ARRAY_FACT | FACTTRANSIENT | JSON_STRING_VALUE;

for (unsigned int i = 0; i < errorIndex; ++i)

{

char index[MAX_WORD_SIZE];

sprintf(index, "%u", i);

field = StoreWord(index, AS_IS);

char* errmsg = errors[i];

while (*errmsg == '.' || *errmsg == ',') ++errmsg; // skip tabbing data

size_t len = strlen(errmsg);

while (errmsg[len - 1] == '\n' || errmsg[len - 1] == '\r') errmsg[--len] = 0;

WORDP err = StoreWord(errmsg, AS_IS);

CreateFact(M1, MakeMeaning(field), MakeMeaning(err), flags);

}

}

}

void RefreshMark()

{ // undo all changes but leave rule mark in place

if (!backtrackPoint) return;

int* i = (int*)backtrackPoint; // point past id, backtrack

// revert facts

FACT* oldF = Index2Fact(i[2]);

while (lastFactUsed > oldF) FreeFact(lastFactUsed--); // undo facts to start

// revert dict entries

WORDP oldD = Index2Word(i[3]);

// trim dead facts at ends of sets

for (unsigned int store = 0; store <= MAX_FIND_SETS; ++store)

{

unsigned int count = FACTSET_COUNT(store) + 1;

while (--count >= 1)

{

if (!(factSet[store][count]->flags & FACTDEAD)) break; // stop having found a live fact

}

if (count) SET_FACTSET_COUNT(store, count); // new end

}

DictionaryRelease(oldD, backtrackPoint);

}

static void UpdatePlanBuffer()

{

size_t len = strlen(currentPlanBuffer);

if (len) // we have output, prep next output

{

currentPlanBuffer += len; // cumulative output into buffer

*++currentPlanBuffer = ' '; // add a space

currentPlanBuffer[1] = 0;

}

}

static int WildStartPosition(char* arg)

{

int x = GetWildcardID(arg);

if (x == ILLEGAL_MATCHVARIABLE) return ILLEGAL_MATCHVARIABLE;

unsigned int n = WILDCARD_START(wildcardPosition[x]);

if (n == 0 || n > wordCount) n = atoi(wildcardCanonicalText[x]);

if (n == 0 || n > wordCount) n = 1;

return n;

}

static int WildEndPosition(char* arg)

{

int x = GetWildcardID(arg);

if (x == ILLEGAL_MATCHVARIABLE) return ILLEGAL_MATCHVARIABLE;

unsigned int n = WILDCARD_END_ONLY(wildcardPosition[x]);

if (n == 0 || n > wordCount) n = atoi(wildcardCanonicalText[x]);

if (n == 0 || n > wordCount) n = 1;

return n;

}

static FunctionResult PlanCode(WORDP plan, char* buffer)

{ // failing to find a responder is not failure.

#ifdef INFORMATION

A plan sets a recover point for backtrackingand clears it one way or another when it exits.

A rule sets a backpoint only if it finds some place to backtrack.The rule will clear that point one way or another when it finishes.

Undoable changes to variables are handled by creating special facts.

#endif

if (trace & (TRACE_MATCH | TRACE_PATTERN) && CheckTopicTrace()) Log(USERLOG, "\r\n\r\nPlan: %s ", plan->word);

WORDP originalPlan = plan;

bool oldplan = planning;

bool oldbacktrackable = backtrackable;

char* oldbacktrackPoint = backtrackPoint;

char* oldStringPlanBase = stringPlanBase;

stringPlanBase = heapFree;

backtrackPoint = heapFree;

backtrackable = false;

unsigned int oldWithinLoop = withinLoop;

withinLoop = 0;

planning = true;

int holdd = globalDepth;

char* oldCurrentPlanBuffer = currentPlanBuffer;

unsigned int tindex = topicIndex;

FunctionResult result = NOPROBLEM_BIT;

ChangeDepth(1, originalPlan->word); // plancode

// where future plans will increment naming

char name[MAX_WORD_SIZE];

strcpy(name, plan->word);

char* end = name + WORDLENGTH(plan);

*end = '.';

*++end = 0;

unsigned int n = 0;

while (result == NOPROBLEM_BIT) // loop on plans to use

{

*buffer = 0;

currentPlanBuffer = buffer; // where we are in buffer writing across rules of a plan

int topicid = plan->x.topicIndex;

if (!topicid)

{

result = FAILRULE_BIT;

break;

}

int pushed = PushTopic(topicid); // sets currentTopicID

if (pushed < 0)

{

result = FAILRULE_BIT;

break;

}

char* xxplanMark = SaveBacktrack(PLANMARK); // base of changes the plan has made -- defunct call

char* base = GetTopicData(topicid);

int ruleID = 0;

currentRuleTopic = currentTopicID;

currentRule = base;

currentRuleID = ruleID;

char* ruleMark = NULL;

bool fail = false;

CALLFRAME* frame = ChangeDepth(1, GetTopicName(currentTopicID)); // plancode

char* locals = GetTopicLocals(currentTopicID);

bool updateDisplay = locals && DifferentTopicContext(-1, currentTopicID);

frame->display = (char**)stackFree;

if (updateDisplay && !InitDisplay(locals)) fail = true;

while (!fail && base && *base) // loop on rules of topic

{

currentRule = base;

ruleMark = SaveBacktrack(RULEMARK); // allows rule to be completely undone if it fails -- defunct call

backtrackable = false;

result = TestRule(ruleID, base, currentPlanBuffer); // do rule at base

if (!result || (result & ENDTOPIC_BIT)) // rule didnt fail

{

UpdatePlanBuffer(); // keep any results

if (result & ENDTOPIC_BIT) break; // no more rules are needed

}

else if (backtrackable) // rule failed

{

while (backtrackable)

{

if (trace & (TRACE_MATCH | TRACE_PATTERN) && CheckTopicTrace()) Log(USERLOG, "Backtrack \r\n");

*currentPlanBuffer = 0;

RefreshMark(); // undo all of rule, but leave undo marker in place

backtrackable = false;

result = DoOutput(currentPlanBuffer, currentRule, currentRuleID); // redo the rule per normal

if (!result || result & ENDTOPIC_BIT) break; // rule didnt fail

}

if (result & ENDTOPIC_BIT) break; // rule succeeded eventually

}

FlushMark(); // cannot revert changes after this

base = FindNextRule(NEXTTOPLEVEL, base, ruleID);

}

if (updateDisplay) RestoreDisplay(frame->display, locals);

ChangeDepth(-1, frame->label); // plan

if (backtrackPoint == ruleMark) FlushMark(); // discard rule undo

if (trace & (TRACE_MATCH | TRACE_PATTERN) && CheckTopicTrace())

{

char* xname = GetTopicName(currentTopicID);

if (*xname == '^') Log(USERLOG, "Result: %s Plan: %s \r\n", ResultCode(result), name);

else Log(USERLOG, "Result: %s Topic: %s \r\n", ResultCode(result), xname);

}

if (pushed) PopTopic();

if (result & ENDTOPIC_BIT)

{

FlushMark(); // drop our access to this space, we are as done as we can get on this rule

break; // we SUCCEEDED, the plan is done

}

// flush any deeper stack back to spot we started

if (result & FAILCODES) topicIndex = tindex;

// or remove topics we matched on so we become the new master path

RestoreMark(); // undo failed plan

sprintf(end, (char*)"%u", ++n);

plan = FindWord(name);

result = (!plan) ? FAILRULE_BIT : NOPROBLEM_BIT;

if (!result && trace & (TRACE_MATCH | TRACE_PATTERN) && CheckTopicTrace()) Log(USERLOG, "NextPlan %s\r\n", name);

}

if (globalDepth != holdd) ReportBug((char*)"PlanCode didn't balance");

ChangeDepth(-1, originalPlan->word); // plancode

if (*currentPlanBuffer == ' ') *currentPlanBuffer = 0; // remove trailing space

// revert to callers environment

planning = oldplan;

currentPlanBuffer = oldCurrentPlanBuffer;

withinLoop = oldWithinLoop;

backtrackable = oldbacktrackable;

stringPlanBase = oldStringPlanBase;

backtrackPoint = oldbacktrackPoint;

result = (FunctionResult)(result & (-1 ^ (ENDTOPIC_BIT | ENDRULE_BIT)));

return result; // these are swallowed

}

static char* SystemCall(char* buffer, char* ptr, CALLFRAME * frame, FunctionResult & result, bool& streamArg)

{

WORDP D = frame->name;

bool showtrace = ((trace & (TRACE_OUTPUT | TRACE_USERFN)) || (D->internalBits & MACRO_TRACE)) && !(D->internalBits & NOTRACE_FN) && CheckTopicTrace();

if (showtrace) Log(USERLOG, "%s(", D->word);

unsigned int nArguments = 0;

int callArgumentIndex = 0;

char* paren = ptr;

ptr = SkipWhitespace(ptr + 1); // aim to next major thing after (

SystemFunctionInfo* info = &systemFunctionSet[D->x.codeIndex];

char* start = ptr;

int flags = 0x00000100; // do we leave this unevaled?

while (ptr && *ptr != ')' && *ptr != ENDUNIT) // read arguments

{

char word[MAX_WORD_SIZE];

*word = 0;

if (info->argumentCount != STREAM_ARG) // break them up

{

if (info->argumentCount == UNEVALED)

{

ptr = ReadCompiledWordOrCall(ptr, buffer);

strcpy(word, buffer);

}

// unevaled counted arg

else if (info->argumentCount != VARIABLE_ARG_COUNT && info->argumentCount & (flags << nArguments))

{

ptr = ReadCompiledWord(ptr, buffer);

strcpy(word, buffer);

}

else // VARIABLE ARG OR COUNTED ARG

{

ReadCompiledWord(ptr, word);

ptr = GetCommandArg(ptr, buffer, result, OUTPUT_UNTOUCHEDSTRING);

}

frame->arguments[++callArgumentIndex] = AllocateStack(buffer);

ptr = SkipWhitespace(ptr);

if (frame->arguments[callArgumentIndex] && frame->arguments[callArgumentIndex][0] == USERVAR_PREFIX &&

strstr(frame->arguments[callArgumentIndex], "$_")) // NOT by reference but by value somewhere in the chain

{

frame->arguments[callArgumentIndex] = AllocateStack(GetUserVariable(frame->arguments[callArgumentIndex], false)); // pass by unmarked value - no one will try to store thru it

}

if (showtrace)

{

if (!strcmp(word, frame->arguments[callArgumentIndex]))

{

if (nArguments) Log(USERLOG, " %s", word);

else Log(USERLOG, "%s", word);

}

else

{

if (nArguments) Log(USERLOG, " %s`%s`", word, frame->arguments[callArgumentIndex]);

else Log(USERLOG, "%s`%s`", word, frame->arguments[callArgumentIndex]);

}

}

++nArguments;

if (result != NOPROBLEM_BIT)

{

if (showtrace) Log(USERLOG, "FAILED argument\r\n");

return ptr; // arg failed

}

}

else // swallow unevaled arg stream

{

ptr = BalanceParen(paren, false, false); // start after (, point after closing ) if one can, to next token - it may point 2 after ) or it may point 1 after )

char* beforeendparen = ptr--; // higher level will move past this closing paren

while (*--beforeendparen != ')') { ; } // back up to closing

size_t len = beforeendparen - start; // length of argument bytes not including paren, and end up after paren

if (len >= maxBufferSize) // bad pointer from balance paren

{

ReportBug("BalanceParen failed");

result = FAILRULE_BIT;

return ptr;

}

while (start[len - 1] == ' ') --len; // dont want trailing blanks

frame->arguments[++callArgumentIndex] = AllocateStack(start, len);

streamArg = true;

if (showtrace)

{

if (len < 100)

{

char* end = strchr(start, ')');

if (end) *end = 0;

Log(USERLOG, start);

if (end) *end = ')';

}

else Log(USERLOG, "...");

}

}

if (!frame->arguments[callArgumentIndex])

{ // only need to check once, at end of attempting it

ReportBug("FATAL: Stack space exhausted %s", D->word);

result = FAILRULE_BIT;

return ptr;

}

if (info->argumentCount == STREAM_ARG) break; // end of arguments

ptr = SkipWhitespace(ptr);

}

frame->n_arguments = callArgumentIndex;

if (showtrace)

{

if (info->properties != SAMELINE) Log(USERLOG, ")\r\n");

else Log(USERLOG, ") "); // result will be on same line with no additional step

}

*buffer = 0; // remove any leftover argument data

fnOutput = start; // for text debugger

adjustIndent++;

if (result & ENDCODES); // failed during argument processing

else result = (*info->fn)(buffer);

return ptr;

}

char* GetArgOfMacro(CALLFRAME* frame, int i, char* buffer, int limit)

{

char* x = frame->arguments[i];

if (*x == USERVAR_PREFIX)

{

strncpy(buffer, GetUserVariable(x, false), limit);

x = buffer;

}

else if (*x == '_' && IsDigit(x[1]))

{

int id = GetWildcardID(x);

if (id >= 0)

{

strncpy(buffer, wildcardOriginalText[id], limit);

x = buffer;

}

}

else if (*x == '\'' && x[1] == '_' && IsDigit(x[2]))

{

int id = GetWildcardID(x + 1);

if (id >= 0)

{

strncpy(buffer, wildcardCanonicalText[id], limit);

x = buffer;

}

}

else if (*x == LCLVARDATA_PREFIX) x += 2; // skip ``

return x;

}

static void UnbindVariables(HEAPREF list) // undo all variable changes

{

while (list)

{

uint64 variable;

uint64 value;

uint64 internalbits;

list = UnpackHeapval(list, variable, value, internalbits);

//Log(STDUSERLOG,"UnbindVariables: %s reset to %s \r\n", ((WORDP)variable)->word, (char*)value);

((WORDP)variable)->w.userValue = (char*)value;

((WORDP)variable)->internalBits = (unsigned int)internalbits;

}

}

static void BindVariables(CALLFRAME * frame, FunctionResult & result, char* buffer, bool showtrace, char* originalArgs)

{

if (!frame->display) return;

char var[MAX_WORD_SIZE];

char* list = (char*)(frame->definition + 2); // skip ( and space xxxx

char* val;

for (int i = 1; i <= (int)frame->n_arguments; ++i)

{

list = ReadCompiledWord(list, var);

val = frame->arguments[i]; // constants wont have `` in front of them

if (*var == USERVAR_PREFIX) // var not currency

{

WORDP arg = FindWord(var);

if (!arg) continue; // should never happen

if (*val == USERVAR_PREFIX && !IsDigit(val[1])) val = GetUserVariable(val, false); // not currency

else if (*val == SYSVAR_PREFIX)

{

Output(val, buffer, result, 0);

val = AllocateStack(buffer, 0, true);

*buffer = 0;

}

else if (val[0] == ENDUNIT && val[1] == ENDUNIT) val += 2; // skip over noeval marker

else if (val[0] == '\'' && val[1] == '_' && IsDigit(val[2]))

{

int id = GetWildcardID(val + 1);

if (id >= 0) val = AllocateStack(wildcardOriginalText[id], 0, true);

else val = AllocateStack("");

}

else if (val[0] == '_' && IsDigit(val[1]))

{

int id = GetWildcardID(val);

if (id >= 0) val = AllocateStack(wildcardCanonicalText[id], 0, true);

else val = AllocateStack("");

}

else if (*val && *(val - 1) != '`') val = AllocateStack(val, 0, true);

arg->w.userValue = val;

#ifndef DISCARDTESTING

if (debugVar) (*debugVar)(arg->word, arg->w.userValue);

#endif

}

else // ^var

{

}

if (showtrace && originalArgs) // variable args may run out of display values

{

Log(USERLOG, " ");

char* end = strchr(originalArgs, '|');

if (end) *end = 0;

if (strcmp(originalArgs, val)) Log(USERLOG, "%s`%s`", originalArgs, val);

else Log(USERLOG, "%s", originalArgs);

if (end) originalArgs = end + 1;

else originalArgs = NULL;

}

}

if (showtrace) Log(USERLOG, ")\r\n");

}

static char* InvokeUser(char*& buffer, char* ptr, FunctionResult & result, CALLFRAME * frame,

unsigned int& expectedArgCount, int givenArgCount, char*& startRawArg, bool showtrace, char* originalArgs)

{

WORDP D = frame->name;

// handle any display variables -- MUST BE DONE AFTER computing arguments and before saving them onto vars

if ((D->internalBits & FUNCTION_BITS) != IS_PLAN_MACRO && frame->definition && frame->definition[0] == '(')

{

frame->display = (char**)stackFree;

frame->code = InitDisplay((char*)frame->definition); // will return 0 if runs out of heap space

if (!frame->code) result = FAILRULE_BIT;

}

// now if expectedArgCount are local vars instead of ^, set them up (we have protected them by now)

if (D->internalBits & MACRO_TRACE && !(D->internalBits & NOTRACE_FN)) trace = (unsigned int)D->inferMark;

BindVariables(frame, result, buffer, showtrace, originalArgs);

FreeBuffer(); // allocated by caller

*buffer = 0; // remove any leftover argument data

// run the definition

adjustIndent += 3; // call level and then invocation level

if (D->internalBits & NOTRACE_FN) trace = 0;

char* paren = strchr(frame->label, '(');

*paren = '{';

paren[1] = '}';

if (result & ENDCODES)

{

ChangeDepth(0, NULL);

}

else if (frame->definition && (D->internalBits & FUNCTION_BITS) == IS_PLAN_MACRO)

{

frame->n_arguments = D->w.planArgCount;

ChangeDepth(0, NULL);

result = PlanCode(D, buffer); // run a plan

}

#ifndef DISCARDJAVASCRIPT

else if (frame->code && *frame->code == '*' && !strncmp((char*)frame->code, "*JavaScript", 11))

{

ChangeDepth(0, NULL);

result = RunJavaScript((char*)frame->code + 11, buffer, expectedArgCount); // point at space after label

}

#endif

else if (frame->definition)

{

unsigned int flags = OUTPUT_FNDEFINITION;

if (!(D->internalBits & IS_OUTPUT_MACRO)) flags |= OUTPUT_NOTREALBUFFER;// if we are outputmacro, we are merely extending an existing buffer

Output((char*)frame->code, buffer, result, flags);

}

fnOutput = buffer; // for text debugger

// undo any display variables

if (frame->display) RestoreDisplay(frame->display, frame->definition);

if (result & ENDCALL_BIT) result = (FunctionResult)(result ^ ENDCALL_BIT); // terminated user call

return ptr;

}

CALLFRAME* GetCallFrame(int depth)

{

if (depth <= 0) return NULL;

if (depth > globalDepth) return NULL;

return frameList[depth];

}

static char* UserCall(char* buffer, char* ptr, CALLFRAME * frame, FunctionResult & result)

{

WORDP D = frame->name;

char* originalbuffer = buffer;

unsigned int nArguments = 0;

ptr = SkipWhitespace(ptr + 1); // aim to next major thing after (

unsigned int argflags = 0;

unsigned int expectedArgCount = 0;

bool showtrace = ((trace & (TRACE_OUTPUT | TRACE_USERFN)) || (D->internalBits & MACRO_TRACE)) && !(D->internalBits & NOTRACE_FN) && CheckTopicTrace();

if ((D->internalBits & FUNCTION_BITS) == IS_PLAN_MACRO) expectedArgCount = D->w.planArgCount;

else if (!D->w.fndefinition)

{

ReportBug((char*)"INFO: Missing function definition for %s\r\n", D->word);

result = FAILRULE_BIT;

}

else

{

frame->definition = (char*)FindAppropriateDefinition(D, result, true);

if (frame->definition)

{

int flags;

frame->definition = ReadInt((char*)frame->definition, flags);

argflags = flags;

unsigned char c = (unsigned char)*frame->definition++;

expectedArgCount = (c >= 'a') ? (c - 'a' + 15) : (c - 'A'); // expected args, leaving us at ( args ...

}

else result = FAILRULE_BIT;

}

frame->n_arguments = expectedArgCount;

if (showtrace) Log(USERLOG, "calling %s(", D->word);

// now process arguments

char* startRawArg = ptr;

char* definition = frame->definition;

char* originalArgs = AllocateBuffer("usercall");

int callArgumentIndex = 0;

while (definition && ptr && *ptr && *ptr != ')') // ptr is after opening (and before an arg but may have white space

{

if (currentRule == NULL) // this is a table function- DONT EVAL ITS ARGUMENTS AND... keep quoted item intact

{

ptr = ReadCompiledWord(ptr, buffer); // return dq args as is

#ifndef DISCARDSCRIPTCOMPILER

if (compiling && ptr == NULL) BADSCRIPT((char*)"TABLE-11 Arguments to %s ran out", D->word)

#endif

}

else

{

bool stripQuotes = (argflags & (1 << nArguments)) ? 1 : 0; // want to use quotes

// arguments to user functions are not evaluated, they will be used, in place, in the function.

// EXCEPT evaluation of ^arguments must be immediate to maintain current context- both ^arg and ^"xxx" stuff

if (showtrace)

{

char word[MAX_WORD_SIZE];