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_add_variable(int nArgs)
{
Operand op;
IOStream *file;
long address;
char *name;
StructDef *base;
Symbol *stack= sp-nArgs+1;
if (nArgs<4) YError("add_variable requires at least four arguments");
file= YGetFile(stack++);
address= YGetInteger(stack++);
name= YGetString(stack++);
stack->ops->FormOperand(stack, &op);
if (op.ops==&structDefOps) base= op.value;
else if (op.ops==&stringOps && !op.type.dims) {
char *typeName= ((char **)op.value)[0];
if (!typeName || !HashFind(&file->structTable, typeName, 0L))
YError("4th argument refers to non-existent data type");
base= file->structList[hashIndex];
} else {
YError("4th argument must be either string or struct definition");
base= 0;
}
nArgs-= 4;
stack++;
BuildDimList(stack, nArgs);
AddVariable(file, address, name, base, tmpDims);
}
void Y_add_member(int nArgs)
{
Operand op;
IOStream *file;
long offset;
char *structName, *name;
StructDef *memType, *base;
Symbol *stack= sp-nArgs+1;
if (nArgs<5) YError("add_member requires at least five arguments");
file= YGetFile(stack++);
structName= YGetString(stack++);
offset= YGetInteger(stack++);
name= YGetString(stack++);
stack->ops->FormOperand(stack, &op);
if (op.ops==&structDefOps) memType= op.value;
else if (op.ops==&stringOps && !op.type.dims) {
char *typeName= ((char **)op.value)[0];
if (!HashFind(&file->structTable, typeName, 0L))
YError("5th argument refers to non-existent data type");
memType= file->structList[hashIndex];
} else {
YError("5th argument must be either string or struct definition");
memType= 0;
}
if (HashFind(&file->structTable, structName, 0L))
base= file->structList[hashIndex];
else
base= AddStruct(file, structName, 0L);
if (!base) YError("unable to create given struct_name in add_member");
nArgs-= 5;
stack++;
BuildDimList(stack, nArgs);
if (AddMember(base, offset, name, memType, tmpDims))
YError("add_member failed -- duplicate member name?");
Drop(nArgs);
}
void Y_dump_clog(int nArgs)
{
IOStream *file;
char *name;
if (nArgs!=2) YError("dump_clog takes exactly two arguments");
file= yarg_file(1);
name= YGetString(sp);
if (DumpClogFile(file, name))
YError("dump_clog failed -- unable to open output file");
Drop(2);
}
void
Y_mpeg_create(int nArgs)
{
char *filename = (nArgs>=1 && nArgs<=2)? YGetString(sp-nArgs+1) : 0;
long bad_params[4] = { -1, -1, -1, -1 };
long *params = 0;
if (nArgs == 2) {
Dimension *dims = 0;
params = YGet_L(sp-nArgs+2, 1, &dims);
if (!dims || dims->next || dims->number!=4) params = bad_params;
}
PushDataBlock(ympg_create(filename, params));
}
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_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_ml4scan(int nArgs)
{
char *filename=YGetString(sp-nArgs+1);
int maxvar=0;
int returnString=(1-yarg_subroutine());
if (nArgs==1) {
maxvar=10000;
} else if (nArgs==2) {
maxvar=YGetInteger(sp-nArgs+2);
} else {
YError("ml4scan takes one or two arguments");
}
FILE *fs;
fs = openmat(filename);
if (fs == NULL) YError(p_strncat("Can't open file ",filename,0));
matscan(fs,maxvar,returnString);
matclose(filename);
}
void Y_ml4close(int nArgs)
{
char *filename=YGetString(sp-nArgs+1);
matclose(filename);
}
void Y_ml4read(int nArgs)
{
char *filename="";
char *varname="";
int leave_open = 0;
if (nArgs==2) {
filename=YGetString(sp-nArgs+1);
varname=YGetString(sp-nArgs+2);
leave_open = 0;
} else if (nArgs==3) {
filename=YGetString(sp-nArgs+1);
varname=YGetString(sp-nArgs+2);
leave_open=YGetInteger(sp-nArgs+3);
}
unsigned long bytes_read;
int type,namelen;
unsigned long nElements,nBytesToRead;
int mrows,mcols,imagf;
FILE *fs;
int fileptr;
int endian = 'L';
int size=0,i;
fs = openmat(filename);
if (fs == NULL) YError(p_strncat("Can't open file ",filename,0));
if (!matfind(fs,varname,50000)) YError(p_strncat("No Such variable ",varname,0));
fileptr = ftell(fs);
if (DEBUG) printf("@ position %d\n",fileptr);
bytes_read = fread(&type,sizeof(int),1,fs);
if (bytes_read==0) {
matclose(filename);
YError("Premature end of file");; // end of file
}
fread(&mrows,sizeof(int),1,fs);
fread(&mcols,sizeof(int),1,fs);
fread(&imagf,sizeof(int),1,fs);
fread(&namelen,sizeof(int),1,fs);
if (namelen & 0xffff0000) {
if (DEBUG) printf("Big endian file\n");
endian = 'B';
SWAP_INT(type);
SWAP_INT(mrows);
SWAP_INT(mcols);
SWAP_INT(imagf);
SWAP_INT(namelen);
}
type = type%1000;
if (DEBUG) printf("rows,cols,namelen= %d %d %d\n",mrows,mcols,namelen);
if (namelen>255) {
fseek(fs,fileptr,SEEK_SET); // leave file ptr at begginning of this variable
matclose(filename);
YError("Variable name too long!");
}
fread(tempvarname,(unsigned int)namelen,1,fs);
// if ((*varname!='*') && strcmp(varname,tempvarname)) { // error if not same varname
if (!matchvarname(tempvarname,varname)) { // error if not same varname
fseek(fs,fileptr,SEEK_SET); // leave file ptr at begginning of this variable
matclose(filename);
YError(p_strncat("Can't find variable",varname,0));
}
nElements = (unsigned)mrows*(unsigned)mcols;
Dimension *tmp=tmpDims;
tmpDims=0;
FreeDimension(tmp);
if (mrows<=1) {
tmpDims= NewDimension(mcols, 1L, (Dimension *)0);
} else if (mcols<=1) {
tmpDims= NewDimension(mrows, 1L, (Dimension *)0);
} else {
tmpDims= NewDimension(mrows, 1L, (Dimension *)0);
tmpDims= NewDimension(mcols, 1L, tmpDims);
}
if (type==0) {
// 8-byte doubles
size = 8;
Array *a= PushDataBlock(NewArray(&doubleStruct, tmpDims));
double *data = a->value.d;
bytes_read = fread((void *)data,size,nElements,fs);
if (endian=='B') { for (i=0;i<nElements;i++) SWAP_DOUBLE(data[i]); }
} else if (type==10) {
// 4-byte reals
size = 4;
Array *a= PushDataBlock(NewArray(&floatStruct, tmpDims));
float *data = a->value.f;
bytes_read = fread((void *)data,size,nElements,fs);
if (endian=='B') { for (i=0;i<nElements;i++) SWAP_FLOAT(data[i]); }
} else if ((type==120) || (type==20)) {
// 4-byte int
size = 4;
Array *a= PushDataBlock(NewArray(&intStruct, tmpDims));
int *data = a->value.l;
bytes_read = fread((void *)data,size,nElements,fs);
if (endian=='B') { for (i=0;i<nElements;i++) SWAP_INT(data[i]); }
} else if (type==30) {
// 2-byte signed (30) shorts
size = 2;
Array *a= PushDataBlock(NewArray(&shortStruct, tmpDims));
short *data = a->value.s;
bytes_read = fread((void *)data,size,nElements,fs);
if (endian=='B') { for (i=0;i<nElements;i++) SWAP_SHORT(data[i]); }
} else if (type==40) {
// 2-byte unsigned (40) shorts
size = 2;
Array *a= PushDataBlock(NewArray(&shortStruct, tmpDims));
short *data = a->value.s;
Array *b= PushDataBlock(NewArray(&longStruct, tmpDims));
long *data2 = b->value.l;
bytes_read = fread((void *)data,size,nElements,fs);
if (endian=='B') { for (i=0;i<nElements;i++) SWAP_SHORT(data[i]); }
for (i=1;i<=nElements;i++) *(data2++) = (((long)*(data++))|0xFFFF0000)+65535;
} else if (type==50) {
// 1-byte signed or unsigned chars (50)
size = 1;
Array *a= PushDataBlock(NewArray(&charStruct, tmpDims));
char *data = a->value.c;
bytes_read = fread((void *)data,size,nElements,fs);
} else if (type==51) {
// text (51)
size = 1;
Array *a= PushDataBlock(NewArray(&stringStruct, (Dimension *)0));
char *buf;
a->value.q[0] = buf = p_malloc(nElements+1);
if (DEBUG) printf("strlen: %d\n",(int)strlen((void *)a->value.q[0]));
// bytes_read = fread(a->value.q[0],1,nElements,fs);
bytes_read = fread(buf,1,nElements,fs);
*((char *)buf + nElements) = 0; // append a NULL to text string
} else {
matclose(filename);
sprintf(message,"Unknown type %d",type);
YError(message);
}
if (bytes_read!=nElements) {
fseek(fs,nElements*size,SEEK_CUR);
matclose(filename);
if (DEBUG) printf("read:%ld expected:%ld\n",bytes_read,nBytesToRead);
YError("Premature end of file");
}
if (!leave_open) matclose(filename);
}
void Y_install_struct(int nArgs)
{
IOStream *file;
long size= 0, align= 0, order= 0, *layout= 0;
Dimension *dims;
FPLayout fpLayout;
char *structName;
StructDef *base, *model;
Symbol *stack= sp-nArgs+1;
if (nArgs!=2 && nArgs!=5 && nArgs!=6)
YError("install_struct requires 2, 5, or 6 arguments");
file= YGetFile(stack++);
structName= YGetString(stack++);
if (nArgs>2) {
size= YGetInteger(stack++);
align= YGetInteger(stack++);
order= YGetInteger(stack++);
if (nArgs==6) {
layout= YGet_L(stack, 1, &dims);
if (!layout || TotalNumber(dims)!=7)
YError("layout argument must be array of 7 longs in install_struct");
fpLayout.sgnAddr= (int)layout[0];
fpLayout.expAddr= (int)layout[1];
fpLayout.expSize= (int)layout[2];
fpLayout.manAddr= (int)layout[3];
fpLayout.manSize= (int)layout[4];
fpLayout.manNorm= (int)layout[5];
fpLayout.expBias= layout[6];
}
}
if (HashFind(&file->structTable, structName, 0L)) {
if (hashIndex<=6 && nArgs<=2)
YError("install_struct cannot change primitive type into a struct");
base= file->structList[hashIndex];
if (hashIndex>=8 && base->dataOps)
YError("install_struct cannot redefine non-primitive data type");
model= base->model;
if (model) while (model->model) model= model->model;
base->dataOps= 0;
} else {
base= AddStruct(file, structName, 0L);
model= 0;
}
if (!base) YError("unable to create given struct_name in install_struct");
if (nArgs>2) {
int addressType= 1;
if (order>=size && size>1) {
order= 0;
addressType= 2;
}
if (DefinePrimitive(base, size, (int)align, addressType, (int)order,
layout? &fpLayout : 0, model, (Converter *)0))
YError("failed to define primitive data type in add_member");
}
InstallStruct(base, (StructDef *)0);
Drop(nArgs);
}
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);
}
void Y_remove(int nArgs)
{
if (nArgs!=1) YError("remove takes exactly one argument");
p_remove(YGetString(sp));
}
void Y_rename(int nArgs)
{
if (nArgs!=2) YError("rename takes exactly two arguments");
p_rename(YGetString(sp-1), YGetString(sp));
}
