static void GetTNworker(int nArgs, int cycs)
{
IOStream *file;
long i, n= 0;
long *ncycs= 0;
double *times= 0;
Array *array;
HistoryInfo *history;
Dimension *dims;
if (nArgs!=1) YError("get_times/get_ncycs takes exactly one argument");
file= yarg_file(0);
history= file->history;
if (history) {
n= history->nRecords;
if (cycs) ncycs= history->ncyc;
else times= history->time;
}
if (n<=0 || (cycs? (!ncycs) : (!times))) {
PushDataBlock(RefNC(&nilDB));
return;
}
dims= tmpDims;
tmpDims= 0;
FreeDimension(dims);
tmpDims= NewDimension(n, 1L, (Dimension *)0);
array= PushDataBlock(NewArray(cycs? &longStruct : &doubleStruct, tmpDims));
if (cycs)
for (i=0 ; i<n ; i++) array->value.l[i]= ncycs[i];
else
for (i=0 ; i<n ; i++) array->value.d[i]= times[i];
}
void Y__write(int nArgs)
{
Symbol *keySymbols[1];
Symbol *stack= YGetKeywords(sp-nArgs+1, nArgs, wrtKeys, keySymbols);
IOStream *file= 0;
long address= 0;
int got_address= 0;
Symbol *object= 0;
Operand op;
StructDef *base;
char *type;
while (stack<=sp) {
if (!stack->ops) {
stack+= 2;
continue;
}
if (!file) {
file= YGetFile(stack);
if (file->history) file= file->history->child;
} else if (!got_address) {
got_address= 1;
address= YGetInteger(stack);
} else if (!object) {
object= stack;
} else {
object= 0;
}
stack++;
}
if (!object) YError("_write takes exactly three arguments");
sp->ops->FormOperand(object, &op);
if (!op.ops->isArray)
YError("third argument to _write must be array or scalar data");
if (YNotNil(keySymbols[0])) type= YGetString(keySymbols[0]);
else type= StructName(op.type.base);
if (!HashFind(&file->structTable, type, 0L))
YError("data type of third argument to _write undefined for this file");
base= file->structList[hashIndex];
if (op.type.base==&charStruct) {
/* special case type char, to have a way to do literal writes */
YcWrite(file, op.value, address, op.type.number);
} else {
YWrite(op.value, address, base, op.type.number, (Strider *)0);
}
PushDataBlock(RefNC(&nilDB));
}
void Y__jc(int nArgs)
{
IOStream *file;
HistoryInfo *history;
int noRecord;
if (nArgs!=2) YError("jc takes exactly two arguments");
file= yarg_file(1);
history= file->history;
if (!history)
YError("binary file passed to jc has no history records");
noRecord= JumpToCycle(history, YGetInteger(sp));
if (!CalledAsSubroutine()) {
if (noRecord) PushDataBlock(RefNC(&nilDB));
else PushLongValue(history->ncyc[history->recNumber]);
}
}
void
Y_spawn(int nargs)
{
Dimension *dims = 0;
char **argv = yarg_q(nargs-1, &dims);
long argc = 1;
Operand op;
Operand *pop = yarg_op(nargs-2, &op);
long callout=-1, callerr=-1;
spawn_proc *proc;
if (nargs<2 || nargs>3)
YError("spawn: accepts precisely two or three arguments");
if (dims) {
if (dims->next)
YError("spawn: first argument must be string or 1D array of strings");
argc = dims->number;
}
if (!argv || !argv[0] || !argv[0][0])
YError("spawn: first element of first argument must be process name");
if (!pop || (op.ops!=&functionOps && op.ops!=&builtinOps))
YError("spawn: second argument must be callback function");
if (op.ops==&builtinOps) callout = ((BIFunction *)op.value)->index;
else callout = ((Function *)op.value)->code[0].index;
if (nargs == 3) {
pop = yarg_op(0, &op);
if (!pop || (op.ops!=&functionOps && op.ops!=&builtinOps))
YError("spawn: third argument must be callback function");
if (op.ops==&builtinOps) callerr = ((BIFunction *)op.value)->index;
else callerr = ((Function *)op.value)->code[0].index;
}
if (argv[argc-1]) {
/* must construct a 0-terminated argv list */
typedef struct tmpobj {
int references;
Operations *ops;
void (*zapper)(void *to);
char *argv[1];
} tmpobj;
tmpobj *tmp;
long i;
/* CheckStack(2); fnctn.c guarantees at least 2 free stack slots */
tmp = PushDataBlock(y_new_tmpobj(sizeof(tmpobj)+argc*sizeof(char*),
p_free));
for (i=0 ; i<argc ; i++) tmp->argv[i] = argv[i];
tmp->argv[i] = 0;
argv = tmp->argv;
/* tmp will be cleaned up when stack cleared */
}
/* push result object onto stack */
proc = p_malloc(sizeof(spawn_proc));
proc->references = 0;
proc->ops = &spawn_ops;
proc->proc = p_spawn(argv[0], argv, spawn_callback, proc, callerr>=0);
proc->argv0 = p_strcpy(argv[0]);
proc->callout = callout;
proc->callerr = callerr;
proc->next = spawn_list;
spawn_list = proc;
PushDataBlock(proc);
if (!proc->proc) {
Drop(1);
PushDataBlock(RefNC(&nilDB));
}
if (!spawn_setclean) {
spawn_setclean = 1;
spawn_prevclean = CleanUpForExit;
CleanUpForExit = spawn_cleanup;
}
}
void Y__jt(int nArgs)
{
Operand op;
IOStream *file;
HistoryInfo *history;
double targetTime= 0.0;
Symbol *stack= sp-nArgs+1;
long recNumber;
int noRecord;
if (nArgs!=1 && nArgs!=2)
YError("jt takes exactly one or two arguments");
stack->ops->FormOperand(stack, &op);
if (op.ops==&streamOps) {
/* first argument is explicit binary file */
file= op.value;
history= file->history;
if (!history)
YError("binary file passed to jt has no history records");
recNumber= history->recNumber;
if (nArgs>1) {
sp->ops->FormOperand(sp, &op);
if (op.ops==&rangeOps) { /* jt, file, - */
/* look for jt, file, - (backup 1 record) */
Range *range= op.value;
if ((range->nilFlags&(~(R_MINNIL|R_MAXNIL|R_PSEUDO))) ||
range->inc!=1)
YError("did you want jt, file, - (jump to previous record)?");
noRecord= recNumber>=0? JumpRecord(history, recNumber-1) :
JumpRecord(history, history->nRecords-1);
} else if (op.ops==&voidOps) { /* jt, file, [] */
noRecord= recNumber>=0? JumpRecord(history, recNumber+1) :
JumpRecord(history, 0);
} else { /* jt, file, time */
targetTime= YGetReal(sp);
noRecord= JumpToTime(history, targetTime);
if (noRecord) {
if (history->time) {
noRecord= 2;
targetTime= history->time[history->recNumber];
} else {
noRecord= 3;
}
}
}
} else { /* jt, file */
noRecord= recNumber>=0? JumpRecord(history, recNumber+1) :
JumpRecord(history, 0);
}
} else { /* jt, time */
IOFileLink *link;
if (nArgs!=1)
YError("did you want jt, file, time (instead of jt, time, file)?");
targetTime= YGetReal(sp);
for (link=yBinaryFiles ; link ; link=link->next) {
file= link->ios;
if (!file) continue;
history= file->history;
if (!history || history->recNumber<0) continue;
JumpToTime(history, targetTime);
}
noRecord= 3;
}
if (!CalledAsSubroutine()) {
if (noRecord>2) PushDataBlock(RefNC(&nilDB));
if (noRecord>1) PushDoubleValue(targetTime);
else if (noRecord) PushIntValue(0);
else PushIntValue(1);
}
}
void
Y_lsdir(int nArgs)
{
Symbol *stack = sp-nArgs+1;
Symbol *glob = 0;
Dimension *dims;
y_dirlist *dlist;
char *name, **list;
long i;
int is_dir = 0;
if (nArgs<1 || nArgs>2) YError("lsdir takes one or two arguments");
if (nArgs==2) {
if (!stack->ops || sp->ops!=&referenceSym)
YError("lsdir second argument not simple variable reference");
glob = &globTab[sp->index];
sp--;
}
dlist = y_new_tmpobj(sizeof(y_dirlist), y_zap_dirlist);
dlist->dir = 0;
dlist->fils = dlist->subs = 0;
dlist->nfils = dlist->nsubs = 0;
PushDataBlock(dlist);
name = YGetString(stack);
if (!name)
YError("first argument to lsdir must be a non-nil scalar string");
dlist->dir = p_dopen(name);
if (!dlist->dir) {
Drop(1);
PushLongValue(0);
return;
}
while ((name = p_dnext(dlist->dir, &is_dir))) {
if (is_dir && nArgs==2)
y_add_item(&dlist->subs, &dlist->nsubs, p_strcpy(name));
else
y_add_item(&dlist->fils, &dlist->nfils, p_strcpy(name));
}
if (stack->ops==&dataBlockSym) {
stack->ops = &intScalar;
Unref(stack->value.db);
}
if (dlist->nfils) {
char *nm;
dims = tmpDims;
tmpDims = 0;
FreeDimension(dims);
tmpDims = NewDimension(dlist->nfils, 1L, (Dimension *)0);
stack->value.db = (DataBlock *)NewArray(&stringStruct, tmpDims);
stack->ops = &dataBlockSym;
list = ((Array *)stack->value.db)->value.q;
for (i=0 ; i<dlist->nfils ; i++) {
nm = dlist->fils[i];
dlist->fils[i] = 0;
list[i] = nm;
}
list = dlist->fils;
dlist->fils = 0;
p_free(list);
} else {
stack->value.db = (DataBlock *)(RefNC(&nilDB));
stack->ops = &dataBlockSym;
}
if (glob) {
if (glob->ops==&dataBlockSym) {
glob->ops = &intScalar;
Unref(glob->value.db);
}
if (dlist->nsubs) {
char *nm;
dims = tmpDims;
tmpDims = 0;
FreeDimension(dims);
tmpDims = NewDimension(dlist->nsubs, 1L, (Dimension *)0);
glob->value.db = (DataBlock *)NewArray(&stringStruct, tmpDims);
glob->ops = &dataBlockSym;
list = ((Array *)glob->value.db)->value.q;
for (i=0 ; i<dlist->nsubs ; i++) {
nm = dlist->subs[i];
dlist->subs[i] = 0;
list[i] = nm;
}
list = dlist->subs;
dlist->subs = 0;
p_free(list);
} else {
glob->value.db = (DataBlock *)(RefNC(&nilDB));
glob->ops = &dataBlockSym;
}
}
Drop(1);
}