Exemplo n.º 1
0
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];
}
Exemplo n.º 2
0
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));
}
Exemplo n.º 3
0
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]);
  }
}
Exemplo n.º 4
0
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;
  }
}
Exemplo n.º 5
0
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);
  }
}
Exemplo n.º 6
0
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);
}