void Y_rmdir(int nArgs)
{
char *name;
if (nArgs!=1) YError("rmdir takes exactly one argument");
name = YGetString(sp);
if (!name) YError("argument to rmdir must be a non-nil scalar string");
if (p_rmdir(name) != 0) {
/* legacy code assumes rmdir,name will not fail if name missing */
/* if (CalledAsSubroutine()) YError("cannot remove directory"); */
PushIntValue(-1);
} else {
PushIntValue(0);
}
}
void Y_add_next_file(int nArgs)
{
Operand op;
IOStream *file;
HistoryInfo *history;
char *filename= 0;
int create;
Symbol *stack= sp-nArgs+1;
if (nArgs<1 || nArgs>3)
YError("add_next_file takes exactly 1, 2, or 3 arguments");
file= YGetFile(stack++);
history= file->history;
if (!history || history->nRecords<1)
YError("file has no history records in add_next_file");
create= (file->permissions&2)? 1 : 0;
if (stack<=sp) {
stack->ops->FormOperand(stack, &op);
stack++;
if (op.ops==&stringOps && !op.type.dims)
filename= ((char **)op.value)[0];
else if (op.ops!=&voidOps)
YError("bad filename argument in add_next_file");
if (stack<=sp) {
stack->ops->FormOperand(stack, &op);
if (op.ops!=&voidOps) create= (YGetInteger(stack)!=0);
}
}
PushIntValue(AddNextFile(history, filename, create));
}
void Y__jr(int nArgs)
{
IOStream *file;
HistoryInfo *history;
int hasRecord;
int amSubroutine= CalledAsSubroutine();
if (nArgs!=2) YError("jr takes exactly two arguments");
file= yarg_file(1);
history= file->history;
if (!history) {
if (amSubroutine)
YError("binary file passed to jc has no history records");
hasRecord= 0;
} else {
long n= history->nRecords;
long i= YGetInteger(sp);
if (i<1) i+= n;
if (i>=1 && i<=n) hasRecord= !JumpRecord(history, i-1);
else hasRecord= 0;
}
if (!amSubroutine) PushIntValue(hasRecord);
}
void Y__not_pdb(int nArgs)
{
IOStream *file;
int familyOK, notOK;
if (nArgs!=2) YError("_not_pdb takes exactly two arguments");
file= yarg_file(1);
familyOK= (int)YGetInteger(sp);
if (!pdb_open) pdb_open= Globalize("yPDBopen", 0L);
if (globTab[pdb_open].ops!=&longScalar &&
globTab[pdb_open].ops!=&intScalar)
YError("yPDBopen variable must be an int or long scalar");
yPDBopen= (int)YGetInteger(&globTab[pdb_open]);
notOK= YtestPDB(file, familyOK);
if (notOK>1) {
YWarning("file is open as a PDB file, but partially broken");
notOK= 0;
} else if (notOK==1) {
/* check for a Clog file if it didn't have a PDB header */
notOK= CLopen(file, familyOK);
}
PushIntValue(notOK);
PopTo(sp-3);
Drop(2);
}
void
Y__dist(int n)
{
if (n!=5) YError("_dist takes exactly 5 arguments");
PushIntValue(_dist(yarg_sp(4), yarg_sl(3), yarg_sl(2),
yarg_sf(1), yarg_sf(0)));
}
void
Y___op_vmlmb_get_fmin(int n)
{
if (n!=4) YError("__op_vmlmb_get_fmin takes exactly 4 arguments");
PushIntValue(op_vmlmb_get_fmin(yarg_c(3,0), yarg_l(2,0), yarg_d(1,0),
yarg_d(0,0)));
}
void
Y___op_vmlmb_set_fmin(int n)
{
if (n!=5) YError("__op_vmlmb_set_fmin takes exactly 5 arguments");
PushIntValue(op_vmlmb_set_fmin(yarg_c(4,0), yarg_l(3,0), yarg_d(2,0),
yarg_sd(1), yarg_d(0,0)));
}
void
Y___op_vmlmb_next(int n)
{
if (n!=8) YError("__op_vmlmb_next takes exactly 8 arguments");
PushIntValue(op_vmlmb_next(yarg_d(7,0), yarg_d(6,0), yarg_d(5,0),
yarg_sp(4), yarg_sp(3), yarg_c(2,0), yarg_l(1,0), yarg_d(0,0)));
}
void
Y__get2dPhase(int n)
{
if (n!=11) YError("_get2dPhase takes exactly 11 arguments");
PushIntValue(_get2dPhase(yarg_sp(10), yarg_si(9), yarg_si(8),
yarg_si(7), yarg_sp(6), yarg_si(5), yarg_si(4), yarg_sp(3),
yarg_sp(2), yarg_sp(1), yarg_sp(0)));
}
void
Y___op_csrch(int n)
{
if (n!=12) YError("__op_csrch takes exactly 12 arguments");
PushIntValue(op_csrch(yarg_sd(11), yarg_sd(10), yarg_d(9,0),
yarg_sd(8), yarg_sd(7), yarg_sd(6), yarg_sd(5), yarg_sd(4),
yarg_i(3,0), yarg_c(2,0), yarg_l(1,0), yarg_d(0,0)));
}
void
Y___op_vmlmb_first(int n)
{
if (n!=12) YError("__op_vmlmb_first takes exactly 12 arguments");
PushIntValue(op_vmlmb_first(yarg_sl(11), yarg_sl(10), yarg_sd(9),
yarg_sd(8), yarg_sd(7), yarg_sd(6), yarg_sd(5), yarg_sd(4),
yarg_sd(3), yarg_c(2,0), yarg_l(1,0), yarg_d(0,0)));
}
void Y_ml4search(int nArgs)
{
char *filename=YGetString(sp-nArgs+1);
char *varname=YGetString(sp-nArgs+2);
FILE *fs;
fs = openmat(filename);
if (fs == NULL) YError(p_strncat("Can't open file ",filename,0));
PushIntValue(matfind(fs,varname,50000));
}
void Y_ml4endian(int nArgs)
{
PushIntValue(*(char*)&_TestEndian);
}
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_sort(int nArgs)
{
Operand op;
Array *result;
long *ilist, i, j, which, nDims, origin;
Dimension *tmp;
void (*ysort)(long *list, long n);
if (nArgs!=1 && nArgs!=2)
YError("sort takes exactly one or two arguments");
if (nArgs==2) { which= YGetInteger(sp)-1; Drop(1); }
else which= 0; /* use 0-origin which here */
/* get array to be sorted */
sp->ops->FormOperand(sp, &op);
if (op.ops->typeID <= T_LONG) {
op.ops->ToLong(&op);
ysort= &ysortL;
longData= op.value;
} else if (op.ops->typeID <= T_DOUBLE) {
op.ops->ToDouble(&op);
ysort= &ysortD;
doubleData= op.value;
} else if (op.ops==&stringOps) {
ysort= &ysortQ;
stringData= op.value;
} else {
YError("sort function requires integer, real, or string operand");
ysort= 0;
}
/* figure out stride for the sort */
nDims= CountDims(op.type.dims);
if (nDims==0) {
PushIntValue(0);
sp->ops= &longScalar;
sp->value.l= 0;
return;
}
if (which<0) which+= nDims;
if (which<0 || which>=nDims)
YError("2nd argument to sort function out of range");
if (nDims<2) {
sortStride= 1;
sortSize= op.type.number;
} else {
which= nDims-1-which;
tmp= op.type.dims;
while (which--) tmp= tmp->next;
sortStride= TotalNumber(tmp->next);
sortSize= sortStride*tmp->number;
}
sortLimit= 7*sortStride; /* use straight insertion for <7 elements */
/* push result Array, then fill it with index to be sorted */
result= PushDataBlock(NewArray(&longStruct, op.type.dims));
ilist= result->value.l;
for (i=0 ; i<op.type.number ; i++) ilist[i]= i;
for (i=0 ; i<sortStride ; i++)
for (j=0 ; j<op.type.number ; j+=sortSize)
ysort(&ilist[i+j], sortSize);
if ((origin= op.type.dims->origin))
for (i=0 ; i<op.type.number ; i++) ilist[i]+= origin;
}
void Y_merge(int nArgs)
{
Operand t, f;
Operations *ops;
Dimension *dims;
int *cond;
long i, n;
void *rslt= 0;
StructDef *base;
if (nArgs!=3) YError("merge function takes exactly three arguments");
if (sp->ops==&referenceSym) ReplaceRef(sp);
True(); /* convert condition to type int, values 0 or 1 */
sp->ops->FormOperand(sp, &t);
dims= t.type.dims;
n= t.type.number;
cond= t.value;
if (!(sp-2)->ops)
YError("merge function recognizes no keyword arguments");
(sp-2)->ops->FormOperand(sp-2, &t);
(sp-1)->ops->FormOperand(sp-1, &f);
if (t.ops==&voidOps) {
t.type.number= 0;
if (f.ops==&voidOps) f.type.number= 0;
ops= f.ops;
base= f.type.base;
} else if (f.ops==&voidOps) {
f.type.number= 0;
ops= t.ops;
base= t.type.base;
} else {
ops= t.ops->Promote[f.ops->promoteID](&t, &f);
base= t.type.base;
if (ops==&structOps && !StructEqual(base, f.type.base))
YError("two different struct instance types cannot be merged");
}
if (!ops || !ops->isArray)
YError("merge requires array or nil arguments");
if (t.type.number+f.type.number != n)
YError("number of trues + number of falses not number of conditions");
if (!dims) {
if (base==&doubleStruct) {
PushDoubleValue(0.0);
rslt= &sp->value.d;
} else if (base==&longStruct) {
PushLongValue(0L);
rslt= &sp->value.l;
} else if (base==&intStruct) {
PushIntValue(0);
rslt= &sp->value.i;
}
}
if (!rslt) {
Array *result= PushDataBlock(NewArray(base, dims));
rslt= result->value.c;
}
for (i=0 ; i<n ; i++) if (cond[i]) t.type.number--;
if (t.type.number)
YError("number of falses does not match number of 0 conditions");
MrgCpy[ops->typeID](base, rslt, t.value, f.value, cond, n);
}
