CELL * sublist(CELL * list, ssize_t offset, ssize_t length)
{
CELL * subList;
CELL * cell;
if(offset < 0)
offset = convertNegativeOffset(offset, list);
if(length < 0)
{
length = listlen(list) - offset + length;
if(length < 0) length = 0;
}
subList = getCell(CELL_EXPRESSION);
if(length == 0) return(subList);
while(offset-- && list != nilCell)
list = list->next;
if(list == nilCell) return(subList);
cell = copyCell(list);
subList->contents = (UINT)cell;
--length;
while(length--)
{
list = list->next;
if(list == nilCell) break;
cell->next = copyCell(list);
cell = cell->next;
}
return(subList);
}
CELL * p_nth(CELL * params)
{
CELL * list;
CELL * cell;
CELL * (*implicitIndexFunc)(CELL *, CELL *);
SYMBOL * symbolRef;
cell = getEvalDefault(params->next, &list); /* list or string to be indexed */
symbolRef = symbolCheck;
params = copyCell(params); /* indices */
pushResult(params);
if(isList(list->type))
implicitIndexFunc = implicitIndexList;
else if(list->type == CELL_ARRAY)
implicitIndexFunc = implicitIndexArray;
else if(list->type == CELL_STRING)
{
list = implicitIndexString(list, params);
if((symbolCheck = symbolRef))
{
pushResult(list);
pushResultFlag = FALSE;
}
return(list);
}
else return(errorProcExt(ERR_LIST_EXPECTED, list));
cell = (*implicitIndexFunc)(list, params);
symbolCheck = symbolRef;
pushResultFlag = FALSE;
return(cell);
}
void MeshPartition::extractToVtkGrid(vtkUnstructuredGrid *new_grid)
{
checkLNodes();
allocateGrid(new_grid, m_Cells.size(), m_Nodes.size());
for (int i_nodes = 0; i_nodes < m_Nodes.size(); ++i_nodes) {
vec3_t x;
m_Grid->GetPoints()->GetPoint(m_Nodes[i_nodes], x.data());
new_grid->GetPoints()->SetPoint(i_nodes, x.data());
copyNodeData(m_Grid, m_Nodes[i_nodes], new_grid, i_nodes);
}
foreach (vtkIdType id_cell, m_Cells) {
/*
vtkIdType N_pts, *pts;
vtkIdType type_cell = m_Grid->GetCellType(id_cell);
m_Grid->GetCellPoints(id_cell, N_pts, pts);
QVector<vtkIdType> new_pts(N_pts);
for (int i = 0; i < N_pts; ++i) {
new_pts[i] = m_LNodes[pts[i]];
}
// update for polyhedral cells here
vtkIdType id_new_cell = new_grid->InsertNextCell(type_cell, N_pts, new_pts.data());
*/
vtkIdType id_new_cell = copyCell(m_Grid, id_cell, new_grid, m_LNodes);
copyCellData(m_Grid, id_cell, new_grid, id_new_cell);
}
CELL * p_dup(CELL * params)
{
CELL * list;
CELL * expr;
char * str;
ssize_t n, len;
expr = evaluateExpression(params);
if((params = params->next) != nilCell)
getInteger(params, (UINT *)&n);
else n = 2;
if(n < 0) n = 0;
if(expr->type == CELL_STRING && !getFlag(params->next) )
{
len = expr->aux - 1;
list = getCell(CELL_STRING);
str = allocMemory(len * n + 1);
list->contents = (UINT)str;
list->aux = (len * n + 1);
*(str + len * n) = 0;
while(n--)
{
memcpy(str, (char *)expr->contents, len);
str += len;
}
return(list);
}
list = getCell(CELL_EXPRESSION);
if(n-- > 0)
{
list->contents = (UINT)copyCell(expr);
params = (CELL *)list->contents;
while(n--)
{
params->next = copyCell(expr);
params = params->next;
}
}
return(list);
}
CELL * p_debug(CELL * params)
{
CELL * result;
openTrace();
traceFlag |= TRACE_IN_DEBUG;
result = copyCell(evaluateExpression(params));
closeTrace();
return(result);
}
/*
* getAnimLoops()
*/
void getAnimLoops(bta_t *bta, btstring_t *anim, anim_t *ba)
{
bta_loop_t *l;
bta_cell_t *c;
uint8_t i, j;
uint16_t offset;
int16_t cycleCount;
uint8_t ncells;
animbox_t *ab;
btstring_t *buf;
for (i = 0; i < ba->nloops; i++) {
ncells = anim_countCells(anim, ba->base[i].offset);
l = bta_loop_new(bta, i, ncells);
offset = ba->base[i].offset;
cycleCount = ba->base[i].cycles;
offset += 2;
buf = bts_strdup(bta->base->gfx);
for (j = 0; j < ncells; j++) {
if (cycleCount == 0) {
cycleCount = 1;
}
ab = getAnimBox(anim, offset);
c = bta_cell_new(ab->x, ab->y, ab->width, ab->height,
cycleCount, NULL);
c->gfx = bts_new(ab->height * ab->width);
offset = copyCell(anim, offset, c->gfx, ab);
bta_cell_4bitTo8bit(c);
bta_cell_scale(c);
c = cellToRGBA(c, buf);
bta_cell_set(bta, i, j, c);
cycleCount = str_read16be(&anim->buf[offset]);
offset += 2;
free(ab);
}
bts_free(buf);
}
}
/* only for symbols starting with underscore character _ */
void collectSymbolAssocs(SYMBOL * sPtr, CELL * assocList)
{
CELL * cell;
if(sPtr != NIL_SYM && sPtr != NULL)
{
collectSymbolAssocs(sPtr->left, assocList);
if(*sPtr->name == '_')
{
cell = makeCell(CELL_EXPRESSION, (UINT)stuffString(sPtr->name + 1));
((CELL *)cell->contents)->next = copyCell((CELL *)sPtr->contents);
if(assocList->contents == (UINT)nilCell)
assocList->contents = (UINT)cell;
else
((CELL *)assocList->aux)->next = cell;
assocList->aux = (UINT)cell;
}
collectSymbolAssocs(sPtr->right, assocList);
}
}
/**
* Class constructor.
*/
DatasetEditWidget::DatasetEditWidget(QWidget *parent):
QWidget(parent),
ui(new Ui::DatasetEditWidget),
model(NULL),
contextMenu(NULL)
{
//autogenerated stuff
ui->setupUi(this);
//connects signals and slots
connect(ui->tableView, SIGNAL(customContextMenuRequested(QPoint)), this, SLOT(showContextMenu()));
connect(ui->patternCountBox, SIGNAL(valueChanged(int)), this, SLOT(changePatternCount(int)));
connect(ui->inputCountBox, SIGNAL(valueChanged(int)), this, SLOT(changeInputCount(int)));
connect(ui->outputCountBox, SIGNAL(valueChanged(int)), this, SLOT(changeOutputCount(int)));
connect(ui->closeButton, SIGNAL(pressed()), this, SLOT(closeBtnPressed()));
//context menu of editor
contextMenu = new QMenu(this);
contextMenu->addAction(tr("Cut"), this, SLOT(cutCell()), Qt::CTRL | Qt::Key_X);
contextMenu->addAction(tr("Copy"), this, SLOT(copyCell()), Qt::CTRL | Qt::Key_C);
contextMenu->addAction(tr("Paste"), this, SLOT(pasteCell()), Qt::CTRL | Qt::Key_V);
contextMenu->addAction(tr("Delete"), this, SLOT(deleteCell()), Qt::Key_Delete);
this->addActions(contextMenu->actions());
}
CELL * p_push(CELL * params)
{
CELL * newCell;
CELL * list;
CELL * cell = NULL;
CELL * listOrg;
SYMBOL * symbolRef;
int insert = 0, evalFlag = 0;
ssize_t index;
newCell = evaluateExpression(params);
params = getEvalDefault(params->next, &list);
listOrg = list;
if((symbolRef = symbolCheck))
{
if(isProtected(symbolCheck->flags))
return(errorProcExt2(ERR_SYMBOL_PROTECTED, stuffSymbol(symbolCheck)));
if(isNil((CELL *)symbolCheck->contents))
{
deleteList((CELL*)symbolCheck->contents);
listOrg = makeCell(CELL_EXPRESSION, (UINT)copyCell(newCell));
symbolCheck->contents = (UINT)listOrg;
goto PUSH_RETURN;
}
}
if(!isList(list->type))
{
if(list->type == CELL_STRING)
{
pushOnString(newCell, list, params);
goto PUSH_RETURN;
}
else
return(errorProcExt(ERR_LIST_OR_STRING_EXPECTED, list));
}
if(params == nilCell)
index = 0;
else
{
cell = (CELL*)params->next;
params = evaluateExpression(params);
if(isList(params->type))
{
evalFlag = FALSE;
params = getIntegerExt((CELL*)params->contents, (UINT*)&index, FALSE);
}
else
{
evalFlag = TRUE;
getIntegerExt(params, (UINT*)&index, FALSE);
params = cell;
}
}
if(index == -1)
{
if(params == nilCell)
{
newCell = copyCell(newCell);
cell = (CELL*)list->aux;
list->aux = (UINT)newCell;
if(cell != nilCell && cell != trueCell)
cell->next = newCell;
else if(list->contents == (UINT)nilCell)
list->contents = (UINT)newCell;
else
{
cell = (CELL *)list->contents;
while(cell->next != nilCell)
cell = cell->next;
cell->next = newCell;
}
goto PUSH_RETURN;
}
}
list->aux = (UINT)nilCell; /* undo last element optimization */
while(isList(list->type))
{
cell = list;
list = (CELL *)list->contents;
if(index < 0)
{
index = listlen(list) + index;
if(index == -1)
{
index = 0;
insert = INSERT_BEFORE;
}
else if(index >= 0) insert = INSERT_AFTER;
else errorProc(ERR_LIST_INDEX_OUTOF_BOUNDS);
}
else insert = INSERT_BEFORE;
while(index--)
{
if(list == nilCell)
{
if(index >= 0) errorProc(ERR_LIST_INDEX_OUTOF_BOUNDS);
insert = INSERT_END;
break;
}
cell = list;
list = list->next;
}
if(params == nilCell || !isList(list->type)) break;
params = getIntegerExt(params, (UINT*)&index, evalFlag);
}
newCell = copyCell(newCell);
if(insert == INSERT_BEFORE || list == nilCell)
{
if(list == (CELL*)cell->contents)
{
cell->contents = (UINT)newCell;
newCell->next = list;
}
else
{
cell->next = newCell;
newCell->next = list;
}
}
else if(insert == INSERT_AFTER || insert == INSERT_END)
{
cell = list->next;
list->next = newCell;
newCell->next = cell;
}
PUSH_RETURN:
symbolCheck = symbolRef;
pushResultFlag = FALSE;
return(listOrg);
}
void RestrictToAvailableVolumeCells::operate()
{
QList<vtkIdType> vol_cells, surf_cells;
for (vtkIdType id_cell = 0; id_cell < m_Grid->GetNumberOfCells(); ++id_cell) {
if (isVolume(id_cell, m_Grid)) {
vol_cells.append(id_cell);
}
}
foreach (vtkIdType id_cell, vol_cells) {
for (int i = 0; i < m_Part.c2cGSize(id_cell); ++i) {
vtkIdType id_neigh = m_Part.c2cGG(id_cell, i);
if (id_neigh >= 0) {
if (isSurface(id_neigh, m_Grid)) {
surf_cells.append(id_neigh);
}
}
}
}
MeshPartition vol_part(m_Grid);
vol_part.setCells(vol_cells + surf_cells);
EG_VTKSP(vtkUnstructuredGrid, new_grid1);
vol_part.extractToVtkGrid(new_grid1);
MeshPartition new_part1(new_grid1, true);
QList<QVector<vtkIdType> > new_faces;
for (vtkIdType id_cell = 0; id_cell < new_grid1->GetNumberOfCells(); ++id_cell) {
if (isVolume(id_cell, new_grid1)) {
for (int i = 0; i < new_part1.c2cGSize(id_cell); ++i) {
vtkIdType id_neigh = new_part1.c2cGG(id_cell, i);
if (id_neigh == -1) {
QVector<vtkIdType> pts;
getFaceOfCell(new_grid1, id_cell, i, pts);
new_faces.append(pts);
}
}
}
}
EG_VTKSP(vtkUnstructuredGrid, new_grid2);
allocateGrid(new_grid2, new_grid1->GetNumberOfCells() + new_faces.size(), new_grid1->GetNumberOfPoints());
EG_VTKDCC(vtkIntArray, cell_code1, new_grid1, "cell_code");
EG_VTKDCC(vtkIntArray, cell_code2, new_grid2, "cell_code");
for (vtkIdType id_node = 0; id_node < new_grid1->GetNumberOfPoints(); ++id_node) {
vec3_t x;
new_grid1->GetPoint(id_node, x.data());
new_grid2->GetPoints()->SetPoint(id_node, x.data());
copyNodeData(new_grid1, id_node, new_grid2, id_node);
}
int bc_new = 0;
for (vtkIdType id_cell = 0; id_cell < new_grid1->GetNumberOfCells(); ++id_cell) {
copyCell(new_grid1, id_cell, new_grid2);
copyCellData(new_grid1, id_cell, new_grid2, id_cell);
if (isSurface(id_cell, new_grid1)) {
bc_new = max(bc_new, cell_code1->GetValue(id_cell) + 1);
} else {
cell_code2->SetValue(id_cell, 0);
}
}
foreach (QVector<vtkIdType> face, new_faces) {
vtkIdType type = VTK_POLYGON;
if (face.size() == 3) {
type = VTK_TRIANGLE;
} else if (face.size() == 4) {
type = VTK_QUAD;
}
vtkIdType id_cell = new_grid2->InsertNextCell(type, face.size(), face.data());
cell_code2->SetValue(id_cell, bc_new);
}
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_select(CELL * params)
{
size_t n = 0, idx = 0;
ssize_t index;
CELL * list, * cell;
CELL * result = NULL;
CELL * head;
int evalFlag = TRUE;
char * str, * newStr;
#ifdef SUPPORT_UTF8
int * wstr;
int * wnewStr;
size_t len;
#endif
params = getEvalDefault(params, &head);
cell = evaluateExpression(params);
if(isList(cell->type))
{
evalFlag = FALSE;
cell = params = (CELL *)cell->contents;
}
if(head->type == CELL_STRING)
{
if((n = listlen(params)) == 0) return(stuffString(""));
str = (char *)head->contents;
#ifndef SUPPORT_UTF8
newStr = (char *)allocMemory(n + 1);
idx = 0;
while(params->type != CELL_NIL)
{
if(idx == 0)
{
getIntegerExt(cell, (UINT *)&index, FALSE);
params = params->next;
}
else
params = getIntegerExt(params, (UINT *)&index, evalFlag);
index = adjustNegativeIndex(index, head->aux -1);
*(newStr + idx++) = *(str + index);
}
*(newStr + n) = 0;
#else
wstr = allocMemory(head->aux * sizeof(int));
len = utf8_wstr(wstr, str, head->aux - 1);
wnewStr = allocMemory((n + 1) * sizeof(int));
idx = 0;
while(params->type != CELL_NIL)
{
if(idx == 0)
{
getIntegerExt(cell, (UINT *)&index, FALSE);
params = params->next;
}
else
params = getIntegerExt(params, (UINT *)&index, evalFlag);
index = adjustNegativeIndex(index, len);
*(wnewStr + idx++) = *(wstr + index);
}
*(wnewStr + n) = 0;
newStr = allocMemory(UTF8_MAX_BYTES * n + 1);
n = wstr_utf8(newStr, wnewStr, UTF8_MAX_BYTES * n);
newStr = reallocMemory(newStr, n + 1);
free(wstr); free(wnewStr);
#endif
result = getCell(CELL_STRING);
result->aux = n + 1;
result->contents = (UINT)newStr;
return(result);
}
if(!isList(head->type))
return(errorProcExt(ERR_LIST_OR_STRING_EXPECTED, head));
head = (CELL *)head->contents;
list = head;
n = 0;
while(params->type != CELL_NIL)
{
if(n++ == 0)
{
getIntegerExt(cell, (UINT *)&index, FALSE);
params = params->next;
}
else
params = getIntegerExt(params, (UINT *)&index, evalFlag);
if(index < 0) index = convertNegativeOffset(index, head);
if(index < idx) list = head, idx = 0;
while(idx < index && list != nilCell) list = list->next, idx++;
if(list == nilCell)
errorProc(ERR_LIST_INDEX_OUTOF_BOUNDS);
if(result == NULL)
{
result = getCell(CELL_EXPRESSION);
cell = copyCell(list);
result->contents = (UINT)cell;
}
else
{
cell->next = copyCell(list);
cell = cell->next;
}
}
return((result == NULL) ? getCell(CELL_EXPRESSION) : result);
}
CELL * p_deleteSymbol(CELL * params)
{
SYMBOL * sPtr = NULL;
CELL * cell;
CELL * ctx;
int checkReferences = TRUE;
cell = evaluateExpression(params);
if(cell->type != CELL_SYMBOL)
return(errorProcExt(ERR_SYMBOL_EXPECTED, params));
sPtr = (SYMBOL*)cell->contents;
if(sPtr == mainContext) return(nilCell);
if(symbolType(sPtr) == CELL_CONTEXT)
{
ctx = (CELL*)sPtr->contents;
if(ctx->contents == (UINT)sPtr)
{
sPtr->flags &= ~SYMBOL_PROTECTED;
cell = ctx;
}
}
if(sPtr->flags & (SYMBOL_PROTECTED | SYMBOL_BUILTIN) )
return(nilCell);
/* nil as extra parameter deletes without reference checking.
true as extra parameter deletes only if no references are found,
No extra parameter assumes reference checking is on and if
a reference is found it is replaced with nil.
*/
params = params->next;
/* extra parameter is specified as nil */
if(params != nilCell && !getFlag(params))
checkReferences = FALSE;
/* extra parameter is specified as true */
else if(getFlag(params))
{
if(cell->type == CELL_CONTEXT)
{
if(externalReferences(sPtr, FALSE) > 0)
{
sPtr->flags |= SYMBOL_PROTECTED;
return(nilCell);
}
checkReferences = FALSE;
}
else
{
if(references(sPtr, FALSE) > 1)
return(nilCell);
checkReferences = FALSE;
}
}
if(cell->type == CELL_CONTEXT)
{
deleteContextSymbols(cell, checkReferences);
cell->type = CELL_SYMBOL; /* demote */
deleteList((CELL *)sPtr->contents);
sPtr->contents = (UINT)copyCell(nilCell);
}
else
deleteFreeSymbol(sPtr, checkReferences);
return(trueCell);
}
CELL * p_importLib(CELL * params)
{
char * libName;
char * funcName;
void * hLibrary;
CELL * pCell;
SYMBOL * symbol;
char * error;
#ifdef CYGWIN
char * options = NULL;
int type = CELL_IMPORT_DLL;
#else
int type = CELL_IMPORT_CDECL;
#endif
params = getString(params, &libName);
if(params != nilCell)
params = getString(params, &funcName);
else funcName = NULL;
#ifdef CYGWIN
if(params != nilCell)
{
if(params->next == nilCell)
{
params = getString(params, &options);
if(strcmp(options, "cdecl") == 0)
type = CELL_IMPORT_CDECL;
}
#ifdef FFI
else type = CELL_IMPORT_FFI;
#endif
}
#else
if(params->next != nilCell)
type = CELL_IMPORT_FFI;
#endif
hLibrary = 0;
#ifdef TRU64
if((hLibrary = dlopen(libName, RTLD_LAZY)) == 0)
#else
if((hLibrary = dlopen(libName, RTLD_GLOBAL|RTLD_LAZY)) == 0)
#endif
return(errorProcExt2(ERR_IMPORT_LIB_NOT_FOUND, stuffString((char *)dlerror())));
if(funcName == NULL)
return(trueCell);
symbol = translateCreateSymbol(funcName, type, currentContext, TRUE);
if(isFFIsymbol(symbol->flags)) /* don't redefine */
return (copyCell((CELL *)symbol->contents));
if(isProtected(symbol->flags))
return(errorProcExt2(ERR_SYMBOL_PROTECTED, stuffSymbol(symbol)));
pCell = getCell(type);
deleteList((CELL *)symbol->contents);
symbol->contents = (UINT)pCell;
dlerror(); /* clear potential error */
pCell->contents = (UINT)dlsym(hLibrary, funcName);
if((error = (char *)dlerror()) != NULL)
return(errorProcExt2(ERR_IMPORT_FUNC_NOT_FOUND, stuffString(error)));
#ifdef FFI
symbol->flags |= SYMBOL_FFI | SYMBOL_PROTECTED;
if(pCell->type == CELL_IMPORT_FFI)
{
pCell->aux = (UINT)calloc(sizeof(FFIMPORT), 1);
((FFIMPORT *)pCell->aux)->name = symbol->name;
return(copyCell(ffiPreparation(pCell, params, FFI_FUNCTION)));
}
#endif
pCell->aux = (UINT)symbol->name;
return(copyCell(pCell));
}
CELL * p_extend(CELL * params)
{
CELL * target;
CELL * head;
CELL * tail;
SYMBOL * symbolRef;
char * pStr;
size_t size;
params = getEvalDefault(params, &target);
if((symbolRef = symbolCheck))
{
if(isProtected(symbolRef->flags))
return(errorProcExt2(ERR_SYMBOL_PROTECTED, stuffSymbol(symbolRef)));
if(isNil((CELL *)symbolRef->contents))
{
deleteList((CELL*)symbolRef->contents);
head = evaluateExpression(params);
if(isList(head->type) || head->type == CELL_STRING)
target = copyCell(head);
symbolRef->contents = (UINT)target;
params = params->next;
}
}
if(isList(target->type))
{
tail = (CELL *)target->aux;
target->aux = (UINT)nilCell;
if(tail == nilCell)
{
tail = (CELL *)target->contents;
while(tail->next != nilCell)
tail = tail->next;
}
while(params != nilCell)
{
params = getListHead(params, &head);
if(head == nilCell) continue;
if(target->contents == (UINT)nilCell)
{
target->contents = (UINT)copyList(head);
tail = lastCellCopied;
}
else
{
tail->next = copyList(head);
target->aux = (UINT)lastCellCopied;
tail = (CELL *)target->aux;
}
}
}
else if(target->type == CELL_STRING)
{
while(params != nilCell)
{
params = getStringSize(params, &pStr, &size, TRUE);
appendCellString(target, pStr, size);
}
}
else return(errorProcExt(ERR_LIST_OR_STRING_EXPECTED, target));
symbolCheck = symbolRef;
pushResultFlag = FALSE;
return(target);
}
CELL * p_rotate(CELL * params)
{
CELL * cell;
CELL * list;
CELL * previous;
CELL * last = NULL;
size_t length, index;
size_t count;
cell = params;
if(cell->next != nilCell) getInteger(cell->next, (UINT *)&count);
else count = 1;
getEvalDefault(params, &list);
if(symbolCheck && isProtected(symbolCheck->flags))
return(errorProcExt2(ERR_SYMBOL_PROTECTED, stuffSymbol(symbolCheck)));
if(list->type == CELL_STRING)
{
length = list->aux - 1;
if((count = adjustCount(count, length)) == 0)
{
pushResultFlag = FALSE;
return(list);
}
cell = copyCell(list);
memcpy((char*)cell->contents, (char *)(list->contents + length - count), count);
memcpy((char*)(cell->contents + count), (char *)list->contents, length - count);
memcpy((char*)list->contents, (char*)cell->contents, length);
deleteList(cell);
pushResultFlag = FALSE;
return(list);
}
if(!isList(list->type))
return(errorProcExt(ERR_LIST_EXPECTED, cell));
list->aux = (UINT)nilCell; /* undo last element optimization */
cell = (CELL *)list->contents;
length = 0;
while(cell != nilCell)
{
++length;
last = cell;
cell = cell->next;
}
if((count = adjustCount(count, length))== 0)
{
pushResultFlag = FALSE;
return(list);
}
index = length - count;
previous = cell = (CELL *)list->contents;
while(index--)
{
previous = cell;
cell = cell->next;
}
previous->next = nilCell;
last->next = (CELL *)list->contents;
list->contents = (UINT)cell;
pushResultFlag = FALSE;
return(list);
}
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));
}
CELL * findAllList(CELL * pattern, CELL * list, CELL * exprCell)
{
CELL * result = nilCell;
CELL * cell = NULL;
CELL * exprRes;
CELL * match;
CELL * funcCell;
int errNo;
UINT * resultIdxSave;
funcCell = evaluateExpression(exprCell->next);
resultIdxSave = resultStackIdx;
if(funcCell == nilCell && !isList(pattern->type))
return(errorProcExt(ERR_LIST_EXPECTED, pattern));
while(list != nilCell)
{
if(funcCell == nilCell)
{
/* match only takes lists*/
if(!isList(list->type))
goto CONTINUE_NEXT;
match = patternMatchL((CELL *)pattern->contents, (CELL *)list->contents, TRUE);
if(match == NULL || match == nilCell)
goto CONTINUE_NEXT;
deleteList(match);
}
else
{
cleanupResults(resultIdxSave);
if(compareFunc(pattern, list, funcCell) != 0)
goto CONTINUE_NEXT;
}
/* take out sysSymbol in future, should only be used in regex */
deleteList((CELL*)sysSymbol[0]->contents);
sysSymbol[0]->contents = (UINT)copyCell(list);
itSymbol->contents = (UINT)list;
if(exprCell != nilCell)
{
if((exprRes = evaluateExpressionSafe(exprCell, &errNo)) == NULL)
{
pushResult(result); /* push for later deletion */
longjmp(errorJump, errNo);
}
}
else
exprRes = list;
exprRes = copyCell(exprRes);
if(result == nilCell)
{
cell = exprRes;
result = makeCell(CELL_EXPRESSION, (UINT)cell);
}
else
{
cell->next = exprRes;
cell = cell->next;
}
CONTINUE_NEXT:
list = list->next;
}
if(result == nilCell)
return(getCell(CELL_EXPRESSION));
itSymbol->contents = (UINT)nilCell;
return(result);
}
CELL * findAllString(char * pattern, char * str, size_t size, CELL * params)
{
long options = 0;
ssize_t findPos = -1;
int len;
int offset = 0;
CELL * result = nilCell;
CELL * cell = NULL;
CELL * exprCell;
CELL * exprRes;
UINT * resultIdxSave;
int errNo;
int lastPos = -1;
exprCell = params;
if((params = params->next) != nilCell)
getInteger(params, (UINT *)&options);
resultIdxSave = resultStackIdx;
while( (findPos = searchBufferRegex(str, offset, pattern, (int)size, options, &len)) != -1)
{
if(exprCell != nilCell)
{
itSymbol->contents = sysSymbol[0]->contents;
if((exprRes = evaluateExpressionSafe(exprCell, &errNo)) == NULL)
{
pushResult(result); /* push for later deletion */
longjmp(errorJump, errNo);
}
exprRes = copyCell(exprRes);
}
else
exprRes = stuffStringN(str + findPos, len);
if(lastPos == findPos)
{
++findPos;
pushResult(exprRes);
goto FINDALL_CONTINUE;
}
lastPos = findPos;
if(result == nilCell)
{
cell = exprRes;
result = makeCell(CELL_EXPRESSION, (UINT)cell);
}
else
{
cell->next = exprRes;
cell = cell->next;
}
FINDALL_CONTINUE:
offset = (findPos + len);
cleanupResults(resultIdxSave);
}
if(result == nilCell)
return(getCell(CELL_EXPRESSION));
itSymbol->contents = (UINT)nilCell;
return(result);
}
CELL * p_importLib(CELL * params)
{
char * libName;
char * funcName;
char * options = NULL;
HINSTANCE hLibrary;
CELL * pCell;
SYMBOL * symbol;
FARPROC initProc;
int type = CELL_IMPORT_DLL;
params = getString(params, &libName);
params = getString(params, &funcName);
if(params != nilCell)
{
if(params->next == nilCell)
params = getString(params, &options);
#ifdef FFI
else
type = CELL_IMPORT_FFI;
#endif
}
if( (UINT)(hLibrary = LoadLibrary(libName)) < 32)
return(errorProcExt2(ERR_IMPORT_LIB_NOT_FOUND, stuffString(libName)));
if(options != NULL && strcmp(options, "cdecl") == 0)
type = CELL_IMPORT_CDECL;
symbol = translateCreateSymbol(funcName, type, currentContext, TRUE);
if(isFFIsymbol(symbol->flags)) /* don't redefine return current def */
return (copyCell((CELL *)symbol->contents));
if(isProtected(symbol->flags))
return(errorProcExt2(ERR_SYMBOL_PROTECTED, stuffSymbol(symbol)));
pCell = getCell(type);
deleteList((CELL *)symbol->contents);
symbol->contents = (UINT)pCell;
if((pCell->contents = (UINT)GetProcAddress(hLibrary, (LPCSTR)funcName)) == 0)
return(errorProcExt2(ERR_IMPORT_FUNC_NOT_FOUND, stuffString(funcName)));
/* put name of imported DLL into DLLs space for loadStartup() */
initProc = GetProcAddress(hLibrary, (LPCSTR)"dllName");
if(initProc != 0) (*initProc)(libName);
#ifdef FFI
symbol->flags |= SYMBOL_FFI | SYMBOL_PROTECTED;
if(pCell->type == CELL_IMPORT_FFI)
{
pCell->aux = (UINT)calloc(sizeof(FFIMPORT), 1);
((FFIMPORT *)pCell->aux)->name = symbol->name;
return(copyCell(ffiPreparation(pCell, params, FFI_FUNCTION)));
}
#endif
pCell->aux = (UINT)symbol->name;
return(copyCell(pCell));
}
SYMBOL * translateCreateSymbol
(char * token, int type, SYMBOL * context, int forceFlag)
{
SYMBOL * sPtr;
CELL * cell = NULL;
size_t len;
cell = (CELL *)context->contents;
root = (SYMBOL *)cell->aux;
if(forceFlag)
sPtr = findInsertSymbol(token, FORCE_CREATION);
else /* try to inherit from MAIN, if not here create in current context */
{
sPtr = findInsertSymbol(token, LOOKUP_ONLY);
if(sPtr == NULL)
{
if(context != mainContext)
{
root = (SYMBOL *)((CELL *)mainContext->contents)->aux;
sPtr = findInsertSymbol(token, LOOKUP_ONLY);
/* since 7.2.7 only inherit primitives and other globals */
if(sPtr != NULL && !(sPtr->flags & SYMBOL_GLOBAL))
{
if(symbolType(sPtr) != CELL_CONTEXT
|| (SYMBOL *)((CELL*)sPtr->contents)->contents != sPtr)
sPtr = NULL;
}
root = (SYMBOL *)cell->aux;
}
if(sPtr == NULL)
sPtr = findInsertSymbol(token, FORCE_CREATION);
}
}
/* the symbol existed already, return */
if(sPtr->contents != 0)
return(sPtr);
/* root might have changed, after symbol insertion */
cell->aux = (UINT)root;
/* a new symbol has been allocated by findInsertSymbol() */
if(type != CELL_PRIMITIVE)
{
len = strlen(token);
sPtr->name = (char *)allocMemory(len + 1);
memcpy(sPtr->name, token, len + 1);
cell = copyCell(nilCell);
sPtr->contents = (UINT)cell;
/* make a new context symbol */
if(type == CELL_CONTEXT && context == mainContext)
{
cell->type = CELL_CONTEXT;
cell->contents = (UINT)sPtr;
cell->aux = 0;
sPtr->flags |= (SYMBOL_PROTECTED | SYMBOL_GLOBAL);
}
}
else
{
sPtr->name = token;
sPtr->contents = (UINT)nilCell;
}
sPtr->context = context;
return(sPtr);
}
