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)); }