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
                { /* requesting token's priority is not higher than   */
                  /* that of any user: enqueue requestor & return r=1 */
                  enqueue(f,tkn,pri,event,0.0); r=1;
		  if (tr) then msg(7,tkn,fname(f),1,L3[f]);
		}
              else
                { /* preempt user of server k.  suspend event, save   */
                  /* event number & remaining event time, & enqueue   */
                  /* preempted token.  If remaining event time is 0   */
                  /* (preemption occurred at the instant release was  */
                  /* to occur, set 'te' > 0 for proper enqueueing     */
                  /* (see 'enlist').  Update facility & server stati- */
                  /* stics for the preempted token, and set r = 0 to  */
                  /* reserve the facility for the preempting token.   */
                  if (tr) then msg(8,tkn,fname(f),2,0);
		  j=L1[k]; i=suspend(j); ev=L3[i]; te=L5[i]-clock;
                  if (te==0.0) then te=1.0e-99; put_elm(i);
		  enqueue(f,j,L2[k],ev,te);
                  if (tr) then
                    {msg(10,-1,"",j,L3[f]); msg(12,-1,fname(f),tkn,0);}
                  L3[k]++; L4[k]+=clock-L5[k];
                  L2[f]--; L4[f+1]++; r=0;
                }
	  }
      if (r==0) then
        { /* reserve server k of facility */
          L1[k]=tkn; L2[k]=pri; L5[k]=clock; L2[f]++;
        }
      return(r);
    }

/*------------------------  RELEASE FACILITY  ------------------------*/
void release( int f, int tkn )
    {
      int i,j=0,k,m; real te;
      /* locate server (j) reserved by releasing token */
      k=f+1+L1[f];     /* index of last server element */
      for (i=f+2; i<=k; i++) if (L1[i]==tkn) then {j=i; break;}
      if (j==0) then error(7,NULL); /* no server reserved */
      L1[j]=0; L3[j]++; L4[j]+=clock-L5[j]; L2[f]--;
      if (tr) then msg(9,tkn,fname(f),0,0);
      if (L3[f]>0) then
	{ /* queue not empty:  dequeue request ('k' =  */
          /* index of element) & update queue measures */
          k=L1[f+1]; L1[f+1]=L1[k]; te=L4[k];
          L5[f+1]+=L3[f]*(clock-L5[f]); L3[f]--; L4[f]++; L5[f]=clock;
          if (tr) then msg(11,-1,"",L2[k],L3[f]);
          if (te==0.0) then
            then
              { /* blocked request:  place request at head of event   */
                /* list (so its facility request can be re-initiated  */
                /* before any other requests scheduled for this time) */
		L5[k]=clock; L1[k]=evl; evl=k; m=4;
              }
            else
              { /* return after preemption:  reserve facility for de- */
		/* queued request & reschedule remaining event time   */
                L1[j]=L2[k]; L2[j]=(int)L5[k]; L5[j]=clock; L2[f]++;
                if (tr) then msg(12,-1,fname(f),L2[k],0);
                L5[k]=clock+te; enlist(&evl,k); m=5;
              }
          if (tr) then msg(m,-1,"",L3[k],0);
	}
    }

/*-----------------------  GET FACILITY STATUS  ----------------------*/
status( int f )
    {
      return(L1[f]==L2[f]? 1:0);
    }

/*--------------------  GET CURRENT QUEUE LENGTH  --------------------*/
inq( int f )
    {
      return(L3[f]);
    }

/*--------------------  GET FACILITY UTILIZATION  --------------------*/
real U( int f )
    {
      int i; real b=0.0,t=clock-start;
      if (t>0.0) then
        {
          for (i=f+2; i<=f+L1[f]+1; i++) b+=L4[i];
          b/=t;
        }
      return(b);
    }

/*----------------------  GET MEAN BUSY PERIOD  ----------------------*/
real B( int f )
    {
      int i,n=0; real b=0.0;
      for (i=f+2; i<=f+L1[f]+1; i++) {b+=L4[i]; n+=L3[i];}
		return((n>0)? b/n:b);
    }

/*--------------------  GET AVERAGE QUEUE LENGTH  --------------------*/
real Lq( int f )
    {
      real t=clock-start;
      return((t>0.0)? (L5[f+1]/t):0.0);
    }

/*-----------------------  TURN TRACE ON/OFF  ------------------------*/
void trace( int n ) {
   switch(n) {
	  case 0: tr=0; break;
	  case 1:
	  case 2:
	  case 3: tr=n; tl=-1.0; break;
	 default: break;
	}
}

/*--------------------  GENERATE TRACE MESSAGE  ----------------------*/
void msg(int n,int i,char *s,int q1,int q2)
	 {
		static char *m[14] = {"",  "SCHEDULE", "CAUSE", "CANCEL",
		  "   RESCHEDULE","   RESUME", "   SUSPEND", "REQUEST", "PREEMPT",
		  "RELEASE", "   QUEUE", "   DEQUEUE", "   RESERVE", "FACILITY" };
		if (clock>tl)     /* print time stamp (if time has advanced) */
		  then {tl=clock; fprintf(opf,"  time %-12.3f  ",clock);}
		  else fprintf(opf,"%21s",m[0]);
		if (i>=0)         /* print token number if specified */
		  then fprintf(opf,"--  token %-4d  -- ",i);
		  else fprintf(opf,"--              -- ");
		fprintf(opf,"%s %s",m[n],s);  /* print basic message */
		switch(n)
		  { /* append qualifier */
			 case 1:
			 case 2:
			 case 3:
          case 4:
          case 5:
          case 6:  fprintf(opf," EVENT %d",q1); break;
          case 7:
          case 8:  switch(q1)
                     {
                       case 0: fprintf(opf,":  RESERVED"); break;
                       case 1: fprintf(opf,":  QUEUED  (inq = %d)",q2);
                               break;
                       case 2: fprintf(opf,":  INTERRUPT"); break;
                       default: break;
                     }
                   break;
          case 9:  break;
          case 10:
          case 11: fprintf(opf," token %d  (inq = %d)",q1,q2); break;
          case 12: fprintf(opf," for token %d",q1); break;
          case 13: fprintf(opf,":  f = %d",q1); break;
          default: break;
        }
      fprintf(opf,"\n"); end_line();
	 }


/*-------------------------  TRACE LINE END  -------------------------*/
void end_line()
  {
	 if ((--lft)==0) then
		{ /* end of page/screen.  for trace 1, advance page if print- */
		  /* er output;  screen output is free-running.  for trace 2, */
		  /* pause on full screen;  for trace 3, pause after line.    */
		  switch(tr)
			 {
				case 1: if (opf==display)
							 then lft=sl;
							 else endpage();
						  break;
				case 2: if (mtr)
							 then {putchar('\n'); lft=sl; pause();}
							 else endpage();
						  break;
				case 3: lft=sl; break;
			 }
		}
	 if (tr==3) then pause();
  }



/*-----------------------------  PAUSE  ------------------------------*/
void pause(void)
  { /* pause execution via 'mtr' call (if active) */
 /* if (mtr) then mtr(tr,1); else */ getch();
  }

/*------------------  DISPLAY ERROR MESSAGE & EXIT  ------------------*/
void error( int n, char *s ) {
  FILE *dest;
  static char
  *m[8]= { "Simulation Error at Time %.3f \n",
			  "Empty Element Pool \n",
			  "Empty Name Space \n",
			  "Facility Defined After Queue/Schedule \n",
			  "Negative Event Time \n",
			  "Empty Event List \n",
			  "Preempted Token Not in Event List \n",
			  "Release of Idle/Unowned Facility \n" };

  dest=opf;
  while (1)
  {
	  fprintf(dest,"\n*** %s%.3f\n",m[0],clock);
	  if (n) then fprintf(dest,"    %s\n",m[n]);
	  if (s!=NULL) then fprintf(dest,"     %s\n",s);
	  if (dest==display) then break; else dest=display;
  }
  if (opf!=display) then report();
  exit(0);
  //sprintf ( ss, m [ 0 ], clock );
  //if ( n ) strcat ( ss, m [ n ] );
  //strcat ( ss, s );
  //MessageBox ( 0, ss, "ERRO", MB_ICONHAND | MB_OK );
} // error

/*----------------------  RETURN CLOCK POINTER  ----------------------*/
real *p_time(void)
  { /* This function is used by 'dis' to con- */
	 /* trol updating of time-based displays   */
	 return(&clock);
  }

/*-----------------  GET LAST QUEUE ENTRY/EXIT TIME  -----------------*/
real qext( int f )
    { /* This function is used by the time series display module. */
      return(L5[f]);
    }


/*------------------------  GENERATE REPORT  -------------------------*/
void report( void )
  {
	 newpage();
	 reportf();
	 endpage();
  }


/*--------------------  GENERATE FACILITY REPORT  --------------------*/
void reportf( void )
  {
	 int f;
	 if ((f=fchn)==0)
		then fprintf(opf,"\nno facilities defined:  report abandoned\n");
		else
		  { /* f = 0 at end of facility chain */
			 while(f) {f=rept_page(f); if (f>0) then endpage();}
		  }
  }

/*----------------------  GENERATE REPORT PAGE  ----------------------*/
int rept_page(int fnxt)
	 {
		int f,i,n; char fn[19];
		static char *s[7]= {
		  "smpl SIMULATION REPORT", " MODEL: ", "TIME: ", "INTERVAL: ",
		  "MEAN BUSY     MEAN QUEUE        OPERATION COUNTS",
		  " FACILITY          UTIL.    ",
		  " PERIOD        LENGTH     RELEASE   PREEMPT   QUEUE" };
		fprintf(opf,"\n%51s\n\n\n",s[0]);
		fprintf(opf,"%-s%-54s%-s%11.3f\n",s[1],mname(),s[2],clock);
      fprintf(opf,"%68s%11.3f\n\n",s[3],clock-start);
      fprintf(opf,"%75s\n",s[4]);
      fprintf(opf,"%s%s\n",s[5],s[6]);
      f=fnxt; lft-=8;
      while(f && lft--)
        {
			 n=0; for (i=f+2; i<=f+L1[f]+1; i++) n+=L3[i];
          if (L1[f]==1)
            then sprintf(fn,"%s",fname(f));
				else sprintf(fn,"%s[%d]",fname(f),L1[f]);
          fprintf(opf," %-17s%6.4f %10.3f %13.3f %11d %9d %7d\n",
            fn,U(f),B(f),Lq(f),n,(int)L4[f+1],(int)L4[f]);
			 f=L2[f+1];
		  }
      return(f);
    }

/*---------------------------  COUNT LINES  --------------------------*/
int lns( int i)
	 {
		lft-=i;  if (lft<=0) then endpage();
		return(lft);
	 }

/*----------------------------  END PAGE  ----------------------------*/
void endpage()
  {
	 int c;
	 if (opf==display)
		then
		  { /* screen output: push to top of screen & pause */
			 while(lft>0) {putc('\n',opf); lft--;}
			 printf("\n[ENTER] to continue:");  getchar();
		 /* if (mtr) then clr_scr(); else */ printf("\n\n");
		  }
		else if (lft<pl) then putc(FF,opf);
	 newpage();
  }

/*----------------------------  NEW PAGE  ----------------------------*/
void newpage( void )
  { /* set line count to top of page/screen after page change/screen  */
	 /* clear by 'smpl', another SMPL module, or simulation program    */
	 lft=(opf==display)? sl:pl;
  }

/*------------------------  REDIRECT OUTPUT  -------------------------*/
FILE *sendto(FILE *dest)
	 {
      if (dest!=NULL) then opf=dest;
      return(opf);
	 }



// end smpl.c