/* (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. */
#ifndef lint
static char sccsinfo[] = "@(#)trace.c	1.9 3/15/90";
#endif

/* Hermes execution trace support
** Andy Lowry, Apr 1989
**/

#include <stdio.h>
#include "ops.h"
#include "cfunc.h"
#include "accessors.h"
#include "interpform.cd"

extern char *op_names[];	/* names for all LI opcodes */

#define TRACEFLAG "HTRACE"
#define INDENTATION "  "	/* amount to indent each call-level */

int tracing_level;		/* controls how detailed the tracing is */

void
init_trace()
{
  char *getenv();
  char *tracestring;

  tracestring = getenv(TRACEFLAG);

  if (tracestring)
    tracing_level = atoi(tracestring);
  else
    tracing_level = 0;
}


status
trace_level(l)
int l;
{
  return(tracing_level >= l);
}

void
set_trace_level(l)
int l;
{
  tracing_level = l;
}


void
li_trace(proc,op)
pcb *proc;			/* PCB of process executing instruction */
valcell op;			/* interpform!operation record */
{
#ifdef TRACE
  int opcode;
  int i,j;
  valcell operands;
  valcell operand;
  valcell prog;
  valcell qual;
  char *qualstring;
  char *progname;

  opcode = dot(op,operation__opcode).integer; /* grab the opcode */
  operands = dot(op,operation__operands);
  prog = dcdot(proc->prog, program__LI_PROGRAM);
  if (drdot(prog, prog__name)->number is dr_bottom.number)
    progname = "(no name)";
  else
    progname = vstringval(dot(prog, prog__name));

  (void) fprintf(stderr,"%-15s/%4u: ", progname, proc->ip);

  for (i = 0; i < proc->call_level; i++)
    (void) fprintf(stderr,INDENTATION); /* indent according to call level */

  (void) fprintf(stderr,"%s(",op_names[opcode]);
  for (i = 0; i < operands.table->size; i++) {
    if (i isnt 0)
      (void) fprintf(stderr,",");
    operand = get_elem(operands, i);
    if (operand.table->size is 0)
      (void) fprintf(stderr,"-");	/* no operand */
    else
      for (j = 0; j < operand.table->size; j++) {
	if (j isnt 0)
	  (void) fprintf(stderr,".");
	(void) fprintf(stderr,"%d",get_elem(operand,j).integer);
      }
  }
  (void) fprintf(stderr,") ");
  qual = dot(op, operation__qualifier).variant->data[VARIANT_COMPONENT].value;
  qualstring = nil;
  switch(case_of(dot(op, operation__qualifier))) {
    case qualifier_type__absent:
      break;			/* no qualifier */
    case qualifier_type__boolean:
      qualstring = qual.boolean ? "true" : "false";
      break;
    case qualifier_type__integer:
      (void) fprintf(stderr, "{%d}", qual.integer);
      break;
    case qualifier_type__real:
      qualstring = "real";
      break;
    case qualifier_type__string:
      (void) fprintf(stderr, "{\"%s\"}",  vstringval(qual));
      break;
    case qualifier_type__integer_pair:
      (void) fprintf(stderr, "{[%d,%d]}",
		     dot(qual,0).integer, dot(qual,1).integer);
      break;
    case qualifier_type__polymorph_info:
      qualstring = "poly";
      break;
    case qualifier_type__code:
      progname = vstringval(dot(qual,prog__name));
      (void) fprintf(stderr,"{code for %s}", progname);
      break;
    case qualifier_type__exception:
      qualstring = "exception";
      break;
    case qualifier_type__block:
      qualstring = "block";
      break;
    case qualifier_type__select:
      (void) fprintf(stderr,"{");
      for (i = 0; i < size_of(qual); i++)
	(void) fprintf(stderr,"%s%d", (i is 0 ? "" : ", "),
		       get_elem(qual,i).integer);
      (void) fprintf(stderr,"}");
      break;
    case qualifier_type__new_table:
      qualstring = "newtable";
      break;
    case qualifier_type__program:
      progname = vstringval(dot(dcdot(qual.program,program__LI_PROGRAM),
				prog__name));
      (void) fprintf(stderr,"{program %s}", progname);
      break;
    case qualifier_type__typename:
      qualstring = "typename";
      break;
    case qualifier_type__attributename:
      qualstring = "attributename";
      break;
    default:
      qualstring = "UNKNOWN QUALIFIER";
  }
  if (qualstring isnt nil)
    (void) fprintf(stderr,"{%s}\n",qualstring);
  else
    (void) fprintf(stderr,"\n");
#endif
}

foreign_trace(proc)
pcb *proc;
{
#ifdef TRACE
    extern cproc_entry cproctab[];
    int i;
    for (i = 0; cproctab[i].funcp isnt nil; i++)
      if (cproctab[i].funcp is proc->interpreter)
	break;
    if (cproctab[i].funcp is nil)
      (void) fprintf(stderr,"%-20s: [Non-Hermes Process]\n", "???");
    else
      (void) fprintf(stderr,"%-20s: [C-Hermes Process]\n", cproctab[i].name);
#endif
}


#ifndef TRACE
/*ARGSUSED*/
#endif
NILOP(o_trace)
{
#ifdef TRACE
    set_trace_level(args->qualifiers.integer);
#endif
}
