CELL * executeLibfunction(CELL * pCell, CELL * params)
{
CELL * arg;
UINT args[14];
int count;
#ifdef FFI
if(pCell->type == CELL_IMPORT_FFI)
if(((FFIMPORT *)pCell->aux)->type != 0)
return executeLibFFI(pCell, params);
#endif
count = 0;
while(params->type != CELL_NIL && count < 14)
{
arg = evaluateExpression(params);
switch(arg->type)
{
case CELL_LONG:
case CELL_STRING:
case CELL_PRIMITIVE:
args[count++] = arg->contents;
break;
#ifndef NEWLISP64
/* change 64-bit to 32-bit */
case CELL_INT64:
args[count++] = *(INT64 *)&arg->aux;
break;
#endif
case CELL_FLOAT:
#ifndef NEWLISP64
args[count++] = arg->aux;
#endif
args[count++] = arg->contents;
break;
default:
args[count++] = (UINT)arg;
break;
}
params = (CELL *)params->next;
}
#if defined(WINDOWS) || defined(CYGWIN)
if(pCell->type == CELL_IMPORT_DLL)
return(stuffInteger(stdcallFunction(pCell->contents, args, count)));
else
#endif
return(stuffInteger(cdeclFunction(pCell->contents, args, count)));
}
CELL * p_trace(CELL * params)
{
if(params != nilCell)
{
params = evaluateExpression(params);
if(isNumber(params->type))
{
traceFlag |= TRACE_PRINT_EVAL;
getIntegerExt(params, &tracePrintDevice, FALSE);
return(stuffInteger(tracePrintDevice));
}
if(!isNil(params))
{
openTrace();
traceFlag |= TRACE_IN_DEBUG;
}
else
closeTrace();
}
if(traceFlag & TRACE_IN_DEBUG) return(trueCell);
if(traceFlag & TRACE_PRINT_EVAL) return(stuffInteger(tracePrintDevice));
return(nilCell);
}
CELL * p_length(CELL * params)
{
size_t length;
SYMBOL * symbol;
params = evaluateExpression(params);
length = 0;
switch(params->type)
{
case CELL_LONG:
length = sizeof(UINT); break;
#ifndef NEWLISP64
case CELL_INT64:
length = sizeof(INT64); break;
#endif
case CELL_FLOAT:
length = sizeof(double); break;
case CELL_STRING:
length = params->aux - 1; break;
case CELL_CONTEXT:
symbol = translateCreateSymbol( ((SYMBOL*)params->contents)->name, CELL_NIL,
(SYMBOL*)params->contents, TRUE);
params = (CELL *)symbol->contents;
if(params->type == CELL_STRING)
length = params->aux - 1;
else if(isList(params->type))
length = listlen((CELL *)params->contents);
break;
case CELL_SYMBOL:
symbol = (SYMBOL *)params->contents;
length = strlen(symbol->name);
break;
case CELL_DYN_SYMBOL:
length = strlen((char *)params->contents);
break;
case CELL_EXPRESSION:
case CELL_LAMBDA:
case CELL_MACRO:
length = listlen((CELL *)params->contents);
break;
case CELL_ARRAY:
length = (params->aux - 1) / sizeof(UINT);
default:
break;
}
return(stuffInteger(length));
}
void traceEntry(CELL * cell, CELL * pCell, CELL * args)
{
if(traceFlag & (TRACE_IN_ENTRY | TRACE_IN_EXIT | TRACE_DEBUG_NEXT)) return;
traceFlag |= TRACE_IN_ENTRY;
#ifdef DEBUGGER
int defaultFuncFlag = FALSE;
#endif
if(traceFlag & TRACE_SIGNAL)
{
traceFlag &= ~TRACE_SIGNAL;
executeSymbol(symHandler[currentSignal - 1], stuffInteger(currentSignal), NULL);
traceFlag &= ~TRACE_IN_ENTRY;
return;
}
if(traceFlag & TRACE_SIGINT)
{
traceFlag &= ~TRACE_SIGINT;
longjmp(errorJump, ERR_USER_RESET);
}
if(traceFlag & TRACE_TIMER)
{
traceFlag &= ~TRACE_TIMER;
executeSymbol(timerEvent, NULL, NULL);
traceFlag &= ~TRACE_IN_ENTRY;
return;
}
if(traceFlag & TRACE_PRINT_EVAL)
{
if(cell->type == CELL_EXPRESSION) tracePrint("entry", cell);
traceFlag &= ~TRACE_IN_ENTRY;
return;
}
#ifdef DEBUGGER
if(debugStackIdx > 1)
{
if(debugPrintFunction(cell))
getDebuggerInput(DEBUG_ENTRY);
if(!traceFlag) return;
}
if(traceFlag & TRACE_DEBUG_NEXT)
{
traceFlag &= ~TRACE_IN_ENTRY;
return;
}
if(pCell->type == CELL_CONTEXT)
{
defaultFuncFlag = TRUE;
currentFunc = translateCreateSymbol(
((SYMBOL*)pCell->contents)->name,
CELL_NIL,
(SYMBOL*)pCell->contents,
TRUE);
pCell = (CELL *)currentFunc->contents;
}
if((pCell->type == CELL_LAMBDA || pCell->type == CELL_FEXPR)
&& args->type == CELL_SYMBOL)
{
if(debugStackIdx == 0) /* startup */
traceFlag &= ~TRACE_DEBUG_NEXT;
if(!defaultFuncFlag)
currentFunc = (SYMBOL *)args->contents;
pushDebugStack(recursionCount);
pushDebugStack(currentFunc);
}
#endif /* no_DEBUG */
traceFlag &= ~TRACE_IN_ENTRY;
}
CELL * p_find(CELL * params)
{
char * key;
char * str;
ssize_t found;
CELL * next;
CELL * keyCell;
CELL * funcCell;
size_t size;
long options = -1;
size_t offset = 0;
UINT * resultIdxSave;
keyCell = evaluateExpression(params);
params = getEvalDefault(params->next, &next);
if(keyCell->type == CELL_STRING && next->type == CELL_STRING)
{
key = (char *)keyCell->contents;
str = (char *)next->contents;
size = next->aux - 1;
if(params != nilCell)
{
if(params->next != nilCell)
getInteger(params->next, (UINT*)&offset);
if(offset > size) offset = size;
params = evaluateExpression(params);
if(!isNil(params))
getIntegerExt(params, (UINT *)&options, FALSE);
}
if(options == -1)
found = searchBuffer(str + offset, size - offset, key, keyCell->aux - 1, TRUE);
else
found = searchBufferRegex(str, (int)offset, key, (int)size, options, NULL) - offset;
if(found < 0) return(nilCell);
}
else
{
/* list mode with optional functor */
if(!isList(next->type)) return(nilCell);
next = (CELL *)next->contents;
found = 0;
if(params != nilCell)
funcCell = evaluateExpression(params);
else funcCell = NULL;
/* do regex when first arg is string and option# is present */
if(funcCell && isNumber(funcCell->type) && keyCell->type == CELL_STRING)
{
getIntegerExt(funcCell, (UINT*)&options, FALSE);
key = (char *)keyCell->contents;
while(next != nilCell)
{
if(next->type == CELL_STRING)
{
if(searchBufferRegex((char *)next->contents, 0,
key, next->aux - 1 , options, NULL) != -1) break;
}
found++;
next = next->next;
}
if(next == nilCell) return(nilCell);
else return(stuffInteger(found));
}
resultIdxSave = resultStackIdx;
while(next != nilCell)
{
if(compareFunc(keyCell, next, funcCell) == 0)
{
if(funcCell)
{
deleteList((CELL*)sysSymbol[0]->contents);
sysSymbol[0]->contents = (UINT)copyCell(next);
}
break;
}
found++;
next = next->next;
cleanupResults(resultIdxSave);
}
if(next == nilCell) return(nilCell);
}
return(stuffInteger(found + offset));
}
CELL * p_replace(CELL * params)
{
CELL * keyCell;
CELL * repCell;
CELL * funcCell = NULL;
CELL * list;
CELL * cell;
CELL * newList;
char * keyStr;
char * buff;
char * newBuff;
UINT cnt;
size_t newLen;
long options;
UINT * resultIdxSave;
SYMBOL * refSymbol;
keyCell = copyCell(evaluateExpression(params));
pushResult(keyCell);
params = getEvalDefault(params->next, &cell);
newList = cell;
refSymbol = symbolCheck;
if(symbolCheck && (isProtected(symbolCheck->flags) || isBuiltin(symbolCheck->flags)))
return(errorProcExt2(ERR_SYMBOL_PROTECTED, stuffSymbol(symbolCheck)));
cnt = 0;
resultIdxSave = resultStackIdx;
if(isList(cell->type))
{
cell->aux = (UINT)nilCell; /* undo last element optimization */
list = (CELL *)cell->contents;
if(params != nilCell)
{
repCell = params;
if(params->next != nilCell)
funcCell = evaluateExpression(params->next);
}
else
repCell = NULL;
COMPARE_START:
if(compareFunc(keyCell, list, funcCell) == 0)
{
if(repCell != NULL)
{
/* take out usage of sysSymbol0] in 10.2
should only be used for regex replacements
then $it doesn't need to be a copy */
deleteList((CELL*)sysSymbol[0]->contents);
itSymbol->contents = (UINT)copyCell(list);
sysSymbol[0]->contents = itSymbol->contents;
cell->contents = (UINT)copyCell(evaluateExpression(repCell));
cell = (CELL*)cell->contents;
cell->next = list->next;
}
else /* remove mode */
cell->contents = (UINT)list->next;
list->next = nilCell;
deleteList(list);
cnt++;
if(repCell != NULL)
list = cell;
else /* remove mode */
{
list = (CELL*)cell->contents;
if(list != nilCell)
goto COMPARE_START;
}
}
while(list->next != nilCell)
{
if(compareFunc(keyCell, list->next, funcCell) == 0)
{
cell = list->next; /* cell = old elmnt */
if(repCell != NULL)
{
/* take out usage of sysSymbol0] in 10.2
should only be used for regex replacements */
deleteList((CELL*)sysSymbol[0]->contents);
itSymbol->contents = (UINT)copyCell(cell);
sysSymbol[0]->contents = itSymbol->contents;
list->next = copyCell(evaluateExpression(repCell));
list = list->next;
}
list->next = cell->next;
cell->next = nilCell;
deleteList(cell);
cnt++;
}
else
list = list->next;
cleanupResults(resultIdxSave);
}
deleteList((CELL*)sysSymbol[0]->contents);
/* sysSymbol[0] should not be used here, introduce $count */
sysSymbol[0]->contents = (UINT)stuffInteger(cnt);
itSymbol->contents = (UINT)nilCell;
symbolCheck = refSymbol;
pushResultFlag = FALSE;
return(newList);
}
if(cell->type == CELL_STRING)
{
if(keyCell->type != CELL_STRING)
return(errorProc(ERR_STRING_EXPECTED));
keyStr = (char *)keyCell->contents;
buff = (char *)cell->contents;
repCell = params;
if(repCell == nilCell)
return(errorProc(ERR_MISSING_ARGUMENT));
options = -1;
if(repCell->next != nilCell)
getInteger(repCell->next, (UINT*)&options);
newBuff = replaceString(keyStr, keyCell->aux - 1,
buff, (size_t)cell->aux -1, repCell, &cnt, options, &newLen);
if(newBuff != NULL)
{
freeMemory(buff);
cell->contents = (UINT)newBuff;
cell->aux = newLen + 1;
}
deleteList((CELL*)sysSymbol[0]->contents);
sysSymbol[0]->contents = (UINT)stuffInteger(cnt);
symbolCheck = refSymbol;
pushResultFlag = FALSE;
return(cell);
}
return(errorProcExt(ERR_LIST_OR_STRING_EXPECTED, cell));
}
