ipsc.c

spice中支持多层次元件模型仿真的可单独运行的插件源码

  led((long) 1);		/* Green LED on */

  /* recv work directory from host */

  if(_crecv(2, workdir, 256))
    Error("PBEGIN: error receving workdir", (long) -1);
  if(chdir(workdir) != 0)
    Error("PBEGIN: failed to switch to work directory", (long) -1);

  if (DEBUG) {
    (void) printf("node=%ld, nproc=%ld, workdir=%s\n",
		  NODEID_(), NNODES_(), workdir);
    (void) fflush(stdout);
  }
#endif

  /* Register the handler for NXTVAL service */

  nxtval_server = NNODES_() - 1;

  if (mynode() == nxtval_server)
    hrecv(TYPE_NXTVAL, nxtval_buffer, sizeof nxtval_buffer, nxtval_handler);

  /* Synchronize processes and zero all timers on return to user code */

  SYNCH_(&type);
  start = MTIME_() - start;
  MtimeReset();

  /* If logging events make the file events.<nodeid> */

#ifdef EVENTLOG
  if (eventfile=malloc((unsigned) 11)) {
    (void) sprintf(eventfile, "events.%03ld", NODEID_());
    evlog(EVKEY_ENABLE, EVKEY_FILENAME, eventfile,
	  EVKEY_BEGIN, EVENT_PROCESS,
	  EVKEY_STR_INT, "Startup used (cs)", start,
	  EVKEY_STR_INT, "No. of processes", NNODES_(),
	  EVKEY_DISABLE,
	  EVKEY_LAST_ARG);
    (void) free(eventfile);
  }
#endif

  masktrap(0);  /* Ensure trap is enabled */

  SYNCH_(&type);
}

void PEND_()
/*
  Zero effect for ipsc version ... for flash switch off green LED.
*/
{
#ifdef EVENTLOG
  long start=MTIME_();
#endif

  if (DEBUG) {
    (void) printf("node %ld called pend\n",NODEID_());
    (void) fflush(stdout);
  }

  /* If logging events log end of process and dump trace */
#ifdef EVENTLOG
  evlog(EVKEY_ENABLE,
	EVKEY_END, EVENT_PROCESS,
	EVKEY_STR_INT, "Time (cs) waiting to finish", MTIME_()-start,
	EVKEY_DUMP,
	EVKEY_LAST_ARG);
#endif

#ifndef DELTA
  led((long) 0);
#endif
}

void SETDBG_(onoff)
     long *onoff;
/*
  Define value of debug flag
*/
{
  DEBUG = *onoff;
}

/*ARGSUSED*/
void SYNCH_(type)
     long *type;
/*
  Synchronize processes
*/
{
  gsync();
}

long NXTVAL_(mproc)
     long *mproc;
/*
  Get next value of shared counter.

  mproc > 0 ... returns requested value
  mproc < 0 ... server blocks until abs(mproc) processes are queued
                and returns junk
  mproc = 0 ... indicates to server that I am about to terminate

  this needs to be extended so that clusters of processes with
  shared memory collectively get a bunch of values from the server
  thus reducing the overhead of calling nextvalue.
*/
{
  long buf[2];
  long lenbuf = sizeof buf;
  long lenmes, nodefrom;
  long sync = 1;

  buf[0] = *mproc;
  buf[1] = 1;

  if (DEBUG_) {
    (void) printf("nxtval: me=%d, mproc=%d\n",NODEID_(), *mproc);
    (void) fflush(stdout);
  }

  csend(TYPE_NXTVAL, (char *) buf, lenbuf, nxtval_server, 0);
  crecv(TYPE_NXTVAL_REPLY, (char *) buf, lenbuf);

  return buf[0];
}

void PBFTOC_()
/*
  should never call this on ipsc
*/
{
  Error("PBFTOC_: what the hell are we doing here?",(long) -1);
}

void PARERR_(code)
  long *code;
/*
  Handle request for application error termination
*/
{
  Error("FORTRAN error detected", *code);
}

void STATS_()
/*
  Print out statistics for communications ... not yet implemented
*/
{
  (void) fprintf(stderr,"STATS_ not yet supported\n");
  (void) fflush(stderr);
}

void WAITCOM_(nodesel)
     long *nodesel;
/*
  Wait for all messages (send/receive) to complete between
  this node and node *nodesel or everyone if *nodesel == -1.

  !! CURRENTLY ALWAYS WAIT FOR ALL COMMS TO FINISH ... IGNORES NODESEL !!
  
  long *node = node with which to ensure communication is complete
*/
{
  long i;
#ifdef EVENTLOG
  evlog(EVKEY_BEGIN,     "Waitcom",
	EVKEY_STR_INT,   "n_in_msg_q", (int) n_in_msg_q,
	EVKEY_LAST_ARG);
#endif

  for (i=0; i<n_in_msg_q; i++) {
    if (DEBUG) {
      (void) printf("WAITCOM: %ld waiting for msgid %ld, #%ld\n",NODEID_(),
		    msg_q[i].msg_id, i);
      (void) fflush(stdout);
    }
    msgwait(msg_q[i].msg_id);
  }
  n_in_msg_q = 0;
#ifdef EVENTLOG
  evlog(EVKEY_END, "Waitcom", EVKEY_LAST_ARG);
#endif
}

static void nxtval_handler(msgtype, msglen, requesting_node, pid)
      long msgtype, msglen, requesting_node, pid;
{
  static long cnt     = 0;     /* actual counter */
  static long ndone   = 0;     /* no. finished for this loop */
  static long done_list[512];  /* list of processes finished with this loop */
  long lencnt = sizeof cnt;    /* length of cnt */
  long node   = -1;            /* select any node */
  long type   = TYPE_NXTVAL_REPLY;   /* message type */
  long mproc;                  /* no. of processes running loop */
  long nval;                   /* no. of values requested */
  long sync = 1;               /* all info goes synchronously */
  long lenbuf = sizeof nxtval_buffer;    /* length of buffer */

  if (msglen != lenbuf) 
    Error("NextValueServer: lenmsg != lenbuf", msglen);

  mproc = nxtval_buffer[0];
  nval  = nxtval_buffer[1];
  if (DEBUG_) {
    (void) printf("NVS: from=%d, mproc=%d, ndone=%d\n",
                  requesting_node, mproc, ndone);
    (void) fflush(stdout);
  }

  if (mproc == 0)
    Error("NVS: invalid mproc ", mproc);
  else if (mproc > 0) {
      
    /* This is what we are here for */

    csend(type, (char *) &cnt, sizeof cnt, requesting_node, 0);
    cnt += nval;
  }
  else if (mproc < 0) {

    /* This process has finished the loop. Wait until all mproc
       processes have finished before releasing it */

    done_list[ndone++] = requesting_node;

    if (ndone == -mproc) {
      while (ndone--) {
        long nodeto = done_list[ndone];
        csend(type, (char *) &cnt, sizeof cnt, nodeto, 0);
      }
      cnt = 0;
      ndone = 0;
    }
  }
  hrecv(TYPE_NXTVAL, nxtval_buffer, sizeof nxtval_buffer, nxtval_handler);
}

void BRDCST_(type, buf, lenbuf, originator)
     long *type;
     char *buf;
     long *lenbuf;
     long *originator;
/*
  broadcast buffer to all other processes from process originator
  ... all processes call this routine specifying the same
  orginating process.
*/
{
  long me = NODEID_();
  long ttype = MAKETYPE(*type, *originator);

  if (CHKTYPE(*type))
    Error("BRDCST_: invalid type specified",*type);

  if (me == *originator)
    csend(ttype, buf, *lenbuf, (long) -1, (long) 0);
  else
    crecv(ttype, buf, *lenbuf);
}

#define GOP_BUF_SIZE 50000
#define MAX(a,b) (((a) >= (b)) ? (a) : (b))
#define MIN(a,b) (((a) <= (b)) ? (a) : (b))
#define ABS(a) (((a) >= 0) ? (a) : (-(a)))

static double gop_work[GOP_BUF_SIZE];

/*ARGSUSED*/
void DGOP_(ptype, x, pn, op)
     double *x;
     long *ptype, *pn;
     char *op;
{
  double *work = gop_work;
  long nleft  = *pn;
  long buflen = MIN(nleft,GOP_BUF_SIZE); /* Try to get even sized buffers */
  long nbuf   = (nleft-1) / buflen + 1;

  buflen = (nleft-1) / nbuf + 1;

  if (strncmp(op,"abs",3) == 0) {
    long n = *pn;
    while(n--)
      x[n] = ABS(x[n]);
  }
  
  while (nleft) {
    long ndo = MIN(nleft, buflen);

    if (strncmp(op,"+",1) == 0)
      gdsum(x, ndo, work);
    else if (strncmp(op,"*",1) == 0)
      gdprod(x, ndo, work);
    else if (strncmp(op,"max",3) == 0 || strncmp(op,"absmax",6) == 0)
      gdhigh(x, ndo, work);
    else if (strncmp(op,"min",3) == 0 || strncmp(op,"absmax",6) == 0)
      gdlow(x, ndo, work);
    else
      Error("DGOP: unknown operation requested", (long) *pn);

    nleft -= ndo; x+= ndo;
  }
}

/*ARGSUSED*/
void IGOP_(ptype, x, pn, op)
     long *x;
     long *ptype, *pn;
     char *op;
{
  long *work = (long *) gop_work;
  long nleft  = *pn;
  long buflen = MIN(nleft,2*GOP_BUF_SIZE); /* Try to get even sized buffers */
  long nbuf   = (nleft-1) / buflen + 1;

  buflen = (nleft-1) / nbuf + 1;

  if (strncmp(op,"abs",3) == 0) {
    long n = *pn;
    while(n--)
      x[n] = ABS(x[n]);
  }
  
  while (nleft) {
    long ndo = MIN(nleft, buflen);

    if (strncmp(op,"+",1) == 0)
      gisum(x, ndo, work);
    else if (strncmp(op,"*",1) == 0)
      giprod(x, ndo, work);
    else if (strncmp(op,"max",3) == 0 || strncmp(op,"absmax",6) == 0)
      gihigh(x, ndo, work);
    else if (strncmp(op,"min",3) == 0 || strncmp(op,"absmax",6) == 0)
      gilow(x, ndo, work);
    else
      Error("DGOP: unknown operation requested", (long) *pn);

    nleft -= ndo; x+= ndo;
  }
}