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 YAsyncError(const char *msg)
{
extern void YError(const char *msg);
ClearList();
if (*msg) YError(msg);
else YError("<YAsyncError or FBLOWUP called>");
}
static int GetNextLine(p_file *file, int context)
{
/* assert file!=0 */
if (file && (yg_blocking || y_read_prompt)) return 0;
if (!Ygets(&ypBuffer, file)) {
if (file) {
int hadEOF= Yfeof(file);
int hadError= Yferror(file);
p_fclose(file);
ypIncludes[nYpIncludes-1].file= 0;
/* Any errors here are serious enough to warrant a panic stop. */
if (hadError)
YError("****ABORTING PARSE**** error reading include file");
if (!hadEOF)
YError("****ABORTING PARSE**** include file not ASCII text");
}
return 0; /* just a normal EOF */
}
if (nYpIncludes) {
long lnum= ++ypIncludes[nYpIncludes-1].lastLineRead;
if (context==NL_MAIN || context==NL_NOINPUT) ypBeginLine= lnum;
} else {
if (context==NL_MAIN || context==NL_NOINPUT) ypBeginLine= 0;
else ypBeginLine--;
}
return 1;
}
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_digitize(int nArgs)
{
long number, origin, nbins, i, ip;
double *x, *bins;
Dimension *dimsx, *dimsb;
long *ibin;
if (nArgs!=2) YError("digitize takes exactly two arguments");
bins= YGet_D(sp, 0, &dimsb);
x= YGet_D(sp-1, 0, &dimsx);
if (!dimsb || dimsb->number<2 || dimsb->next)
YError("2nd argument to digitize must be 1D with >=2 elements");
nbins= dimsb->number;
origin= dimsb->origin;
number= TotalNumber(dimsx);
if (dimsx) {
Array *array= PushDataBlock(NewArray(&longStruct, dimsx));
ibin= array->value.l;
} else {
PushLongValue(0L);
ibin= &sp->value.l;
}
ip= 0;
for (i=0 ; i<number ; i++)
ibin[i]= ip= origin+hunt(bins, nbins, x[i], ip);
}
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__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_arc(int nArgs)
{
Operand op;
int promoteID;
long number, i;
if (nArgs != 1) YError("arc takes exactly one argument");
if (! sp->ops) YError("unexpected keyword");
sp->ops->FormOperand(sp, &op);
promoteID = op.ops->promoteID;
if (promoteID == T_DOUBLE) {
const double rad = TWO_PI;
const double scl = ONE_OVER_TWO_PI;
double *x, *y;
x = op.value;
y = build_result(&op, &doubleStruct);
number = op.type.number;
for (i=0 ; i<number ; ++i) y[i] = x[i] - rad*round(scl*x[i]);
pop_to_d(sp - 2);
} else if (promoteID <= T_FLOAT) {
const float rad = JOIN(TWO_PI,F);
const float scl = JOIN(ONE_OVER_TWO_PI,F);
float *x, *y;
if (promoteID != T_FLOAT) op.ops->ToFloat(&op);
x = op.value;
y = build_result(&op, &floatStruct);
number = op.type.number;
for (i=0 ; i<number ; ++i) y[i] = x[i] - rad*roundf(scl*x[i]);
PopTo(sp - 2);
} else {
YError("expecting non-complex numeric argument");
}
Drop(1);
}
void Y_add_record(int nArgs)
{
IOStream *file;
HistoryInfo *history;
Dimension *dims;
double *time= 0;
long *ncyc= 0, *address= 0;
long nRecs= 0;
int flags;
Symbol *stack= sp-nArgs+1;
if (nArgs<1 || nArgs>4)
YError("add_record requires between one and four arguments");
file= YGetFile(stack++);
if (stack<=sp) {
time= YGet_D(stack++, 1, &dims);
if (time) nRecs= TotalNumber(dims);
if (stack<=sp) {
ncyc= YGet_L(stack++, 1, &dims);
if (ncyc) {
if (nRecs) {
if (nRecs!=TotalNumber(dims))
YError("inconsistent number of ncycs in add_record");
} else {
nRecs= TotalNumber(dims);
}
}
if (stack<=sp) {
address= YGet_L(stack++, 1, &dims);
if (address) {
if (nRecs) {
if (nRecs!=TotalNumber(dims))
YError("inconsistent number of addresses in add_record");
} else {
nRecs= TotalNumber(dims);
}
}
}
}
}
/* if this file has no history, add one */
history= file->history;
if (!history) history= AddHistory(file, 0L);
/* if no records were specified, current record becomes none */
if (!nRecs) history->recNumber= -1;
/* add the specified records */
flags= (time? 1 : 0)|(ncyc? 2 : 0);
while (nRecs--) {
AddRecord(history, flags, time? time[0]:0.0, ncyc? ncyc[0]:0L,
(address && address[0]>=0)? address[0]:-1L);
if (time) time++;
if (ncyc) ncyc++;
if (address) address++;
}
if (history->nRecords>0) JumpRecord(history, history->nRecords-1);
}
void
Y_set_vars(int nArgs)
{
Symbol *stack = sp - nArgs + 1;
IOStream *file, *child;
char **vars, **rvars;
long i, nvars, nrvars;
Dimension *dims;
if (nArgs<2 || nArgs>3 || !stack[0].ops || !stack[1].ops)
YError("set_vars takes exactly two or three arguments");
file = YGetFile(stack++);
child = file->history? file->history->child : 0;
vars = YGet_Q(stack++, 1, &dims);
nvars = (vars&&dims)? (dims->next? -1 : dims->number) : 0;
if (nArgs==3) {
rvars = YGet_Q(stack++, 1, &dims);
nrvars = (vars&&dims)? (dims->next? -1 : dims->number) : 0;
} else {
rvars = 0;
nrvars = 0;
}
if (nvars<0 || nrvars<0) YError("set_vars var lists must be 1D");
if ((nvars && nvars!=file->dataTable.nItems) ||
(nrvars && nrvars!=(child? child->dataTable.nItems : 0)))
YError("set_vars var lists must match number of vars in file");
if (nvars) {
HashTable tmp;
y_hashtmp *h = y_new_tmpobj(sizeof(y_hashtmp), y_zap_hashtmp);
HashInit(&h->table, nvars);
PushDataBlock(h);
for (i=0 ; i<nvars ; i++)
if (HashAdd(&h->table, vars[i], 0)) break;
if (i<nvars) YError("duplicate names in set_vars static var list");
if (p_signalling) p_abort();
tmp = h->table;
h->table = file->dataTable;
file->dataTable = tmp;
Drop(1);
}
if (nrvars) {
HashTable tmp;
y_hashtmp *h = y_new_tmpobj(sizeof(y_hashtmp), y_zap_hashtmp);
HashInit(&h->table, nvars);
PushDataBlock(h);
for (i=0 ; i<nrvars ; i++)
if (HashAdd(&h->table, rvars[i], 0)) break;
if (i<nrvars) YError("duplicate names in set_vars record var list");
if (p_signalling) p_abort();
tmp = h->table;
h->table = child->dataTable;
child->dataTable = tmp;
Drop(1);
}
}
DratMesh *YGetDMesh(Symbol *s, int nilOK)
{
DratMesh *dm;
if (s->ops==&referenceSym) ReplaceRef(s);
if (s->ops!=&dataBlockSym || s->value.db->ops!=&meshOps)
YError("expecting Drat-Mesh argument");
dm= (DratMesh *)s->value.db;
if (!nilOK && dm->mesh.mesh.kmax<2)
YError("mesh has not yet been updated -- call update_mesh");
return (DratMesh *)s->value.db;
}
void Y__init_drat(int nArgs)
{
/* be sure that Ray_Path structure in drat.i has been read and
matches C struct defined in this file */
if (!HashFind(&yStructTable, "Ray_Path", 0L))
YError("(BUG) Ray_Path struct not found in _init_drat");
sdRay_Path= yStructList[hashIndex];
if (sdRay_Path->size != sizeof(Ray_Path)) {
sdRay_Path= 0;
YError("(BUG) Ray_Path wrong size in _init_drat");
}
}
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_read_clog(int nArgs)
{
IOStream *file;
char *name;
if (nArgs!=2) YError("read_clog takes exactly two arguments");
file= yarg_file(1);
name= yarg_sq(0);
if (ReadClogFile(file, name))
YError("read_clog failed -- unable to read input file");
Drop(1);
}
void Y__init_pdb(int nArgs)
{
IOStream *file;
int close102;
if (nArgs!=2) YError("_init_pdb takes exactly two arguments");
file= yarg_file(1);
close102= ((int)YGetInteger(sp)) & 017;
if (YinitPDB(file, close102))
YError("unable to initialize PDB file (no write permission?)");
Drop(1);
}
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__lf2d_line_integ_adjoint(int n)
{
if (n!=6) YError("_lf2d_line_integ_adjoint takes exactly 6 arguments");
lf2d_line_integ_adjoint(yarg_sp(5), yarg_sd(4), yarg_sd(3),
yarg_d(2,0), yarg_d(1,0), yarg_si(0));
}
void
Y__lf2d_direct(int n)
{
if (n!=6) YError("_lf2d_direct takes exactly 6 arguments");
lf2d_direct(yarg_sp(5), yarg_sd(4), yarg_sd(3), yarg_d(2,0),
yarg_d(1,0), yarg_si(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_get_primitives(int nArgs)
{
IOStream *file;
Dimension *dims;
Array *array;
long *p;
FPLayout *fpl;
int i, j;
if (nArgs!=1) YError("get_primitives requires exactly one argument");
file = yarg_file(0);
dims = tmpDims;
tmpDims = 0;
FreeDimension(dims);
tmpDims = NewDimension(32L, 1L, (Dimension *)0);
array = PushDataBlock(NewArray(&longStruct, tmpDims));
p = array->value.l;
for (i=j=0 ; i<6 ; i++) {
p[j++] = file->structList[i]->size;
p[j++] = file->structList[i]->alignment;
p[j++] = file->structList[i]->order;
}
p[1] = file->structAlign;
for (i=4 ; i<6 ; i++) {
fpl = file->structList[i]->fpLayout;
p[j++] = fpl->sgnAddr;
p[j++] = fpl->expAddr;
p[j++] = fpl->expSize;
p[j++] = fpl->manAddr;
p[j++] = fpl->manSize;
p[j++] = fpl->manNorm;
p[j++] = fpl->expBias;
}
}
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_set_filesize(int nArgs)
{
IOStream *file;
HistoryInfo *history;
long size;
if (nArgs!=2) YError("set_filesize takes exactly two arguments");
file= yarg_file(1);
history= file->history;
if (!history)
YError("binary file passed to set_filesize has no history records");
size= YGetInteger(sp);
if (size<file->blockSize) size= file->blockSize;
history->fileSize= size;
}
void Y__get_msize(int nArgs)
{
DratMesh *dm;
if (nArgs!=1) YError("_get_msize takes exactly one argument");
dm= YGetDMesh(sp, 0);
PushLongValue(dm->mesh.mesh.klmax);
}
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___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__lf2d_line_integ_sparser(int n)
{
if (n!=7) YError("_lf2d_line_integ_sparser takes exactly 7 arguments");
lf2d_line_integ_sparser(yarg_sp(6), yarg_sd(5), yarg_sd(4),
yarg_sl(3), yarg_sl(2), yarg_d(1,0), yarg_si(0));
}
void Y__raw_pcens(int nArgs)
{
if (nArgs!=7) YError("_raw_pcens takes exactly 7 arguments");
DoPtCenter(YGet_D(sp-6,0,D0), YGet_D(sp-5,0,D0), (long)YGetInteger(sp-4),
(long)YGetInteger(sp-3), &YGetDMesh(sp-2,0)->mesh,
YGet_L(sp-1,0,D0), (long)YGetInteger(sp));
}
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)));
}
static void
ympg_link(void)
{
if (!ympg_initialized) {
char *yavc_path[] = { 0, 0, "libavcodec", "/lib/libavcodec",
"/usr/lib/libavcodec", "/usr/local/lib/libavcodec",
"/sw/lib/libavcodec", 0 };
char **yavc_name = yavc_path;
char *yavc_env = Ygetenv("Y_LIBAVCODEC");
void *dll = 0;
/* look for libavcodec first at name in Y_LIBAVCODEC environment
* variable (not including .so or other extension), then Y_HOME/lib,
* then as simply "libavcodec" (current working directory?),
* then in system places /lib, /usr/lib, /usr/local/lib
*/
if (yavc_env && yavc_env[0]) yavc_path[0] = yavc_env;
else yavc_name++;
if (yHomeDir && yHomeDir[0]) {
char *yhscan = yHomeDir;
while (yhscan[1]) yhscan++;
yavc_path[1] = p_strncat(yHomeDir, (yhscan[0]=='/')? "lib/libavcodec" :
"/lib/libavcodec", 0);
} else {
yavc_name++;
}
for ( ; *yavc_name ; yavc_name++) {
dll = p_dlopen(*yavc_name);
if (dll) {
int i, mask;
for (i=0,mask=1 ; i<NSYMS ; i++,mask=2)
if (p_dlsym(dll, ympg_symadd[i].name, ympg_symadd[i].is_data,
ympg_symadd[i].paddr) != 0) break;
if (i < NSYMS)
YError("mpeg_create: found libavcodec, but missing symbols");
break;
}
}
if (yavc_env) p_free(yavc_env);
p_free(yavc_path[1]);
yavc_path[0] = yavc_path[1] = yavc_env = 0;
/* is this wrong? do we want to allow user to install it later? */
if (!dll) ympg_initialized = 2;
}
if (ympg_initialized)
YError("mpeg_create: unable to find or dynamically link to libavcodec");
}