/* (C) Copyright International Business Machines Corporation 23 January */
/* 1990.  All Rights Reserved. */
/*  */
/* See the file USERAGREEMENT distributed with this software for full */
/* terms and conditions of use. */
/* File: mainloop.c */
/* Author: David F. Bacon */
#ifndef lint
static char sccsinfo[] = "@(#)mainloop.c	1.21 3/13/90";
#endif

#include <stdio.h>

#include "li.h"
#include "storage.h"
#include "accessors.h"

#include "interpform.cd"

/* Following macro inlines the corresponding function... we don't want */
/* to incur the cost of a function call in the main loop */
#define trace_level(x) (tracing_level >= (x))
extern int tracing_level;
#define prof_level(x) (profile_level >= (x))
extern int profile_level;

extern void (*func2op_map[])();

schedblock schedb;		/* debug.c looks at this (too bad) */
pcb *current;		/* current process (looked at by profiling) */


/*ARGSUSED*/
int
imain(argc, argv, envp)
int argc;
char *argv[], *envp[];
{
    void init_cherm();
    void init_errors();
    void init_scheduling();
    void init_debug();
    void init_trace();
    void init_prof();
    void write_profile();
    void init_storage();
    void make_quopy_datareps();
    void make_rootmsg();
    void create_root();
    void init_signalio();
    int main_loop();
    void term_storage();
    void init_distrib();

    object Rootmsg;
    int rc;


    make_quopy_datareps();
    init_storage();

    init_cherm();		/* lets us call L-I functions from within */
				/*  the interpreter. */
    init_errors();		/* initialize the error processor. */

#ifdef DEBUG
    init_debug();
#endif

#ifdef TRACE
    init_trace();
    init_prof();
#endif

    init_signalio();
    init_distrib();

    init_scheduling(&schedb);
    make_rootmsg(argc, argv, &schedb, &Rootmsg);
    create_root(&schedb, &Rootmsg);

    rc = main_loop(&schedb);
    
#ifdef TRACE
    if (prof_level(1))
      write_profile();
#endif

    term_storage();

    return(rc);
}



/* LI instruction tracing routine */
#ifdef TRACE
#define DO_LITRACE(cop,current)						      \
{									      \
    void litrace();							      \
									      \
    if (profile_level is 1)						      \
      if (current->profile isnt nil)					      \
        current->profile[current->ip].integer++;			      \
    if (trace_level(10))	/* trace each li instruction */		      \
      li_trace(current,cop);						      \
    else if (trace_level(5))	/* trace calls and returns */		      \
      switch(dot(cop, operation__opcode).integer) {			      \
	case opcode__call:						      \
	case opcode__return:						      \
	case opcode__return_exception:					      \
	case opcode__create:						      \
	case opcode__procedure:						      \
	case opcode__endprocess:					      \
	  li_trace(current,cop);					      \
	  break;							      \
      }									      \
}
#else
#define DO_LITRACE(cop, current) {}
#endif

#ifdef NOINLINE
void do_litrace(cop, current)
valcell cop;
pcb *current;
    DO_LITRACE(cop, current)
#else
#define do_litrace DO_LITRACE
#endif


/* Following code interprets a single LI instruction. */
#define HINTERP(current, sched)                                               \
{									      \
    argblock args;							      \
									      \
    register object **ostack;						      \
    object *data;							      \
									      \
    register object *obj;						      \
    valcell coperands;		/* interpform!operand_list */		      \
    valcell cop;		/* interform!operation */		      \
    register valcell *op;       /* interform!operand */			      \
    register valcell *offsets;						      \
    register int i,j;							      \
									      \
    cop = get_elem(dot(dcdot(current->prog, program__LI_PROGRAM), prog__code),\
		   current->ip);					      \
    coperands = dot(cop, operation__operands);				      \
									      \
    ostack = args.operandstack;						      \
    data = (object *) current->ep.h->data;				      \
    									      \
 /* as long as there are operands, slurp them up.  translator has the */      \
 /* obligation to ensure that MAXARGS isn't exceeded. */		      \
									      \
    /* point to the operands vector */					      \
    op = coperands.table->tbls[0].rep.vec->elements;			      \
    for (i = 0; i < coperands.table->size ; i++, op++)			      \
      {									      \
	/* special case for null operands used in certain instructions */     \
	if (op->table->size is 0) {					      \
	    *ostack++ = NO_OBJECT;					      \
	    continue;							      \
	}								      \
									      \
	/* point at the offset list for this operand */			      \
	offsets = op->table->tbls[0].rep.vec->elements;			      \
	/* get root object address */					      \
	obj = data + offsets->integer;					      \
	/* now factor in component offsets, if any */			      \
	for (j = 1 ; j < op->table->size; j++)				      \
	  obj = obj->value.record->data + (++offsets)->integer;		      \
									      \
	*ostack++ = obj;						      \
    }									      \
  									      \
    *ostack = nil;							      \
									      \
    args.qualifiers = dot(dot(cop, operation__qualifier), VARIANT_COMPONENT); \
    args.nextop = current->ip+1;					      \
    args.sched = sched;							      \
									      \
    do_litrace(cop,current);						      \
    									      \
    (*func2op_map[dot(cop, operation__opcode).integer])(&args);		      \
				/* invoke the operator */		      \
									      \
    current->ip = args.nextop;	/* next is whatever the operator set it to, */\
				/*  irregardless of whether or not we  */     \
				/*  committed. */			      \
									      \
									      \
}

#ifdef NOINLINE
void
hinterp(current, sched)
pcb *current;
schedblock *sched;
    HINTERP(current, sched)
#else
#define hinterp HINTERP
#endif


int
main_loop(sched)
schedblock *sched;
{
    void add_procs();
    void fd_poll();
    void fd_block();
    extern int fd_waitcount;
    extern int sigio_flag;


    while (TRUE) {
        if (sigio_flag)		/* revive processes for async I/O */
	  fd_poll(sched);

	sched->advance(sched);	/* choose a current process */

	current = sched->ready; /* get next ready process. */
	if (not current) {	/* if none... */
	    if (fd_waitcount)
	      fd_block();
	    else
	      return 0;
	    continue;
	  }

	if (current->interpreter) { /* if it is a non-default interpreter */
#ifdef TRACE
	    if (trace_level(10)) {
		void foreign_trace();
		foreign_trace(current);
	    }
#endif
	    (*current->interpreter)(current, sched);
				/* call the current process's interpreter */
				/*  on the current process and the argument */
				/*  block. */

	}
	else {
	    hinterp(current, sched);
	}
    }
}
