smpl.c

排队论中的一个仿真程序

/**********************************************************************/
/*                                                                    */
/*                           File "smpl.c"                            */
/*                     smpl Simulation Subsystem                      */
/*                                                                    */
/*  For information on the SMPL/PC        (c) 1987  M. H. MacDougall  */
/*  simulation environment, write                                     */
/*      M. H. MacDougall                                              */
/*      P. O. Box 2089                                                */
/*      Sunnyvale, CA 94087-2089                                      */
/*                                                                    */
/**********************************************************************/

#include <stdio.h>
#include "smpl.h"

typedef double real;
#define then

#define nl 2048       /* element pool length                 */
#define ns 256       /* namespace length                    */
#define pl 58        /* printer page length   (lines used   */
#define sl 23        /* screen page length     by 'smpl')   */
#define FF 12        /* form feed                           */

static FILE
  *display=stdout,   /* screen display file                 */
  *opf=stdout;       /* current output destination          */

static int
  event,             /* current simulation event            */
  token,             /* last token dispatched               */
  blk,               /* next available block index          */
  avl,               /* available element list header       */
  evl,               /* event list header                   */
  fchn,              /* facility descriptor chain header    */
  avn,               /* next available namespace position   */
  tr,                /* event trace flag                    */
  mr,                /* monitor activation flag             */
  lft=sl;            /* lines left on current page/screen   */

static real
  clock,             /* current simulation time             */
  start,             /* simulation interval start time      */
  tl;                /* last trace message issue time       */

static int
  l1[nl],
  l2[nl],            /*       facility descriptor,          */
  l3[nl];            /*            queue, &                 */
static real          /*           event list                */
  l4[nl],            /*          element pool               */
  l5[nl];

static char
  name[ns];          /* model and facility name space       */

static save_name();
static enlist();
static resetf();
static enqueue();
static msg();
static end_line();
static rept_page();

extern stream(int n);

/*---------------  INITIALIZE SIMULATION SUBSYSTEM  ------------------*/
smpl(m,s)
  int m; char *s;
    {
      int i; static int rns=1;
      blk=1; avl= -1; avn=0;       /* element pool & namespace headers */
      evl=fchn=0;           /* event list & descriptor chain headers  */
      clock=start=tl=0.0;   /* sim., interval start, last trace times */
      event=tr=0;                 /* current event no. & trace flags  */
      for (i=0; i<nl; i++)  {l1[i]=l2[i]=l3[i]=0; l4[i]=l5[i]=0.0;}
      i=save_name(s,50);                   /* model name -> namespace */
      rns=stream(rns); rns= ++rns>15? 1:rns;  /* set random no. stream */
      mr=(m>0)? 1:0;                              /* set monitor flag */
   /* if (mr) then {opf=display; init_mtr(1);} */
    }

/*-----------------------  RESET MEASUREMENTS  -----------------------*/
reset()
  {
    resetf(); start=clock;
  }

/*---------------------------  SAVE NAME  ----------------------------*/
static save_name(s,m)
  char *s; int m;
    {
      int i,n;
      n=strlen(s); if (n>m) then n=m;
      if (avn+n>ns) then error(2,NULL); /* namespace exhausted */
      i=avn; avn+=n+1; strncpy(&name[i],s,n);
      if (n==m) then name[avn++]='\0';
      return(i);
    }

/*-------------------------  GET MODEL NAME  -------------------------*/
char *mname()
  {
    return(name);
  }

/*------------------------  GET FACILITY NAME  -----------------------*/
char *fname(f)
  int f;
    {
      return(&name[l3[f+1]]);
    }

/*---------------------------  GET BLOCK  ----------------------------*/
static get_blk(n)
  int n;
    {
      int i;
      if (blk==0) then error(3,NULL); /* block request after schedule */
      i=blk; blk+=n;
      if (blk>=nl) then error(1,NULL);      /* element pool exhausted */
      return(i);
    }

/*--------------------------  GET ELEMENT  ---------------------------*/
static get_elm()
  {
    int i;
    if (avl<=0) then
      {
        if (avl==0) then error(1,NULL);     /* empty element list */
     /* if (mr && !tr) then init_mtr(2); */
        /* build the free element list from the block of elements */
        /* remaining after all facilities have been defined       */
        for (i=blk; i<(nl-1); i++) l1[i]=i+1;
        avl=blk; blk=0;
      }
    i=avl; avl=l1[i];
    return(i);
  }

/*-------------------------  RETURN ELEMENT  -------------------------*/
static put_elm(i)
  int i;
    {
      l1[i]=avl; avl=i;
    }

/*-------------------------  SCHEDULE EVENT  -------------------------*/
schedule(ev,te,tkn)
  int ev,tkn; real te;
    {
      int i;
      if (te<0.0) then error(4,NULL); /* negative event time */
      i=get_elm(); l2[i]=tkn; l3[i]=ev; l4[i]=0.0; l5[i]=clock+te;
      enlist(&evl,i);
      if (tr) then msg(1,tkn,"",ev,0);
    }

/*---------------------------  CAUSE EVENT  --------------------------*/
cause(ev,tkn)
  int *ev,*tkn;
    {
      int i;
      if (evl==0) then error(5,NULL);       /* empty event list  */
      i=evl; *tkn=token=l2[i]; *ev=event=l3[i]; clock=l5[i];
      evl=l1[i]; put_elm(i);  /* delink element & return to pool */
      if (tr) then msg(2,*tkn,"",event,0);
   /* if (mr && (tr!=3)) then mtr(tr,0); */
    }

/*--------------------------  RETURN TIME  ---------------------------*/
real time()
  {
    return(clock);
  }

/*--------------------------  CANCEL EVENT  --------------------------*/
cancel(ev)
  int ev;
    {
      int pred,succ=evl,tkn;
      while((succ!=0) && (l3[succ]!=ev)) {pred=succ; succ=l1[pred];}
      if (succ==0) then return(-1);
      tkn=l2[succ]; if (tr) then msg(3,tkn,"",l3[succ],0);
      if (succ==evl)
        then evl=l1[succ];                 /* unlink  event */
        else l1[pred]=l1[succ];            /* list entry &  */
      put_elm(succ);                       /* deallocate it */
      return(tkn);
    }

/*-------------------------  SUSPEND EVENT  --------------------------*/
static suspend(tkn)
  int tkn;
    {
      int pred,succ=evl;
      while((succ!=0) && (l2[succ]!=tkn)) {pred=succ; succ=l1[pred];}
      if (succ==0) then error(6,NULL);  /* no event scheduled for tkn */
      if (succ==evl)
        then evl=l1[succ];       /* unlink  event */
        else l1[pred]=l1[succ];  /* list entry    */
      if (tr) then msg(6,-1,"",l3[succ],0);
      return(succ);
    }

/*--------------  ENTER ELEMENT IN QUEUE OR EVENT LIST  --------------*/
static enlist(head,elm)
  int *head,elm;
    { /* 'head' points to head of queue/event list */
      int pred,succ; real arg,v;
      arg=l5[elm]; succ= *head;
      while(1)
        { /* scan for position to insert entry:  event list is order- */
          /* ed in ascending 'arg' values, queues in descending order */
          if (succ==0)
            then break;  /* end of list */
            else
              {
                v=l5[succ];
                if (*head==evl)
                  then
                    { /* event list  */
                      if (v>arg) then break;
                    }
                  else
                    { /* queue: if entry is for a preempted token-    */
                      /* (l4, the remaining event time, >0), insert   */
                      /* entry at beginning of its priority class;    */
                      /* otherwise, insert it at the end              */
                      if ((v<arg) || ((v==arg) && (l4[elm]>0.0)))
                        then break;
                    }
              }
          pred=succ; succ=l1[pred];
        }
      l1[elm]=succ; if (succ!=*head) then l1[pred]=elm; else *head=elm;
    }

/*-------------------------  DEFINE FACILITY  ------------------------*/
facility(s,n)
  char *s; int n;
    {
      int f,i;
      f=get_blk(n+2); l1[f]=n; l3[f+1]=save_name(s,(n>1 ? 14:17));
      if (fchn==0)
        then fchn=f;
        else {i=fchn; while(l2[i+1]) i=l2[i+1]; l2[i+1]=f;}
      l2[f+1]=0;
      if (tr) then msg(13,-1,fname(f),f,0);
      return(f);
    }

/*---------------  RESET FACILITY & QUEUE MEASUREMENTS  --------------*/
static resetf()
  {
    int i=fchn,j;
      while(i)
        {
          l4[i]=l4[i+1]=l5[i+1]=0.0;
          for (j=i+2; j<=(i+l1[i]+1); j++) {l3[j]=0; l4[j]=0.0;}
          i=l2[i+1];  /* advance to next facility */
        }
  }

/*------------------------  REQUEST FACILITY  ------------------------*/
request(f,tkn,pri)
  int f,tkn,pri;
    {
      int i,r;
      if (l2[f]<l1[f])
        then
          { /* facility nonbusy - reserve 1st-found nonbusy server    */
            for (i=f+2; l1[i]!=0; i++);
            l1[i]=tkn; l2[i]=pri; l5[i]=clock; l2[f]++; r=0;
          }
        else
          { /* facility busy - enqueue token marked w/event, priority */
            enqueue(f,tkn,pri,event,0.0); r=1;
          }
      if (tr) then msg(7,tkn,fname(f),r,l3[f]);
      return(r);
    }

/*-------------------------  ENQUEUE TOKEN  --------------------------*/
static enqueue(f,j,pri,ev,te)
  int f,j,pri,ev; real te;
    {
      int i;
      l5[f+1]+=l3[f]*(clock-l5[f]); l3[f]++; l5[f]=clock;
      i=get_elm(); l2[i]=j; l3[i]=ev; l4[i]=te; l5[i]=(real)pri;
      enlist(&l1[f+1],i);
    }

/*------------------------  PREEMPT FACILITY  ------------------------*/
preempt(f,tkn,pri)
  int f,tkn,pri;
    {
      int ev,i,j,k,r; real te;
      if (l2[f]<l1[f])
        then
          { /* facility nonbusy - locate 1st-found nonbusy server     */
            for (k=f+2; l1[k]!=0; k++); r=0;
            if (tr) then msg(8,tkn,fname(f),0,0);
          }
        else
          { /* facility busy - find server with lowest-priority user  */
            k=f+2; j=l1[f]+f+1;  /* indices of server elements 1 & n  */
            for (i=f+2; i<=j; i++) if (l2[i]<l2[k]) then k=i;
            if (pri<=l2[k])
              then