selectors.c 8.17 KB
/*
 * Copyright (C) 1996-1998 by the Board of Trustees
 *    of Leland Stanford Junior University.
 * 
 * This file is part of the SimOS distribution. 
 * See LICENSE file for terms of the license. 
 *
 */

/*******************************************************************
 * Tcl interface to selectors
 *******************************************************************/

#include <stdio.h>
#include <stdlib.h>
#include "tcl_init.h"
#include "simtypes.h"
#include "simutil.h"
#include "statrecord.h"
#include "sim_error.h"
#include "syslimits.h"
#include "string.h"

#define CHECK_SEL(sel, selName)    \
   selName = argv[2];              \
   sel = SelLookup(selName);       \
   if (sel == NULL) {              \
      Tcl_AppendResult(interp, "no selector named \"", selName, "\"", NULL);   \
      return TCL_ERROR;            \
   }                         

typedef struct SelCmd SelCmd;
typedef struct Selector Selector;

struct Selector {
   char *name;
   Tcl_HashTable buckets;
   StatRecordSwitch *simosSwitch;
};
   

static void SelSetBucket(Selector *sel, int cpuNum, char *bucketName);
static Selector *SelLookup(char *name);

static int cmdCreate(Tcl_Interp *interp, int argc, char *argv[]);
static int cmdSet(Tcl_Interp *interp, int argc, char *argv[]);
static int cmdDisable(Tcl_Interp *interp, int argc, char *argv[]);

/* Got rid of dump--done through tcl manipulation of primitives */

/*static int cmdDump(Tcl_Interp *interp, int argc, char *argv[]); */
static int cmdGetData(Tcl_Interp *interp, int argc, char *argv[]);
static int cmdForEach(Tcl_Interp *interp, int argc, char *argv[]);
static int cmdGetFields(Tcl_Interp *interp, int argc, char *argv[]);

static tclcmd selCmds[] = {
{  "create",      3, cmdCreate,      " create selName"}, 
{   "set",         5, cmdSet,         " set selName cpuNum bucketName"},
/*{ "dump",       -1, cmdDump,        " dump selName ?(filename|log)?"}, */
{   "getData",    -1, cmdGetData,     " getdata selName bucketName ?fieldList?"},
{   "foreach",     5, cmdForEach,     " foreach selName {bname} {script}"},
{   "getFields",   3, cmdGetFields,   " getfields selName"},
{   "disable",     3, cmdDisable,     " disable cpuNum"},
{   NULL,          0, NULL,           NULL}
};

static Tcl_HashTable selectors;

void SelectorInit(Tcl_Interp *interp) 
{
   Tcl_InitHashTable(&selectors, TCL_STRING_KEYS);
   Tcl_CreateCommand(interp, "selector", DispatchCmd, (ClientData) selCmds, NULL);
}
   
int cmdCreate(Tcl_Interp *interp, int argc, char *argv[]) {

   Selector *sel;
   char *selName;
   int i;
   Tcl_HashEntry *entry;
   int new;

   selName = argv[2];
   entry = Tcl_CreateHashEntry(&selectors, selName, &new);

   if (!new) {
      Tcl_AppendResult(interp, "selector name already taken \"", selName, "\"", NULL);
      return TCL_ERROR;
   }

   sel = (Selector *) ZMALLOC(sizeof(Selector), "selectorcmdCreate");

   /* Each selector keeps track of its buckets. */
   sel->name = Tcl_GetHashKey(&selectors, entry);
   Tcl_InitHashTable(&(sel->buckets), TCL_STRING_KEYS);

   /* Now create the selector (switch in statrecord land) */
   sel->simosSwitch = StatRecordNewSwitch(selName);

   /* Initialize the selector to point to trash for all cpus.*/
   for (i = 0; i < SIM_MAXCPUS; i++) {
      SelSetBucket(sel, i, "trash");
   }

   Tcl_SetHashValue(entry, sel);
   return TCL_OK;
}

int cmdSet(Tcl_Interp *interp, int argc, char *argv[]) {
   
   Selector *sel;
   char *selName;
   int cpuNum;

   CHECK_SEL(sel,selName);

   if (Tcl_GetInt(interp, argv[3], &cpuNum) != TCL_OK) {
      Tcl_AppendResult(interp, "bad cpunum \"", argv[3], "\"", NULL);
      return TCL_ERROR;
   }
    
   SelSetBucket(sel, cpuNum, argv[4]);

   return TCL_OK;
}

/* Return list of fields & values for the given bucket.  If no field list
   argument is given, returns a list of all fields. <<What was supposed to happen
   for an empty list?>>.

   Lists are in this form:

   {fieldName fieldValue fieldName fieldValue .....}
*/

int cmdGetData(Tcl_Interp *interp, int argc, char *argv[]) {
   Selector *sel;
   char *selName;
   StatRecordBucket *bucket;
   Tcl_HashEntry *entry;

   CHECK_SEL(sel, selName);

   if (argc != 4 && argc != 5) {
      Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], selCmds[3].usage,
                       "\"", NULL);
      return TCL_ERROR;
   }
   
   entry = Tcl_FindHashEntry(&sel->buckets, argv[3]);
   
   if (entry == NULL) {
      Tcl_AppendResult(interp, "no bucket named \"", argv[3], "\" in this selector", NULL);
      return TCL_ERROR;
   }

   bucket = (StatRecordBucket*) Tcl_GetHashValue(entry);

   if (argc == 5) {
      /* Process field list */
      int listArgc;
      char **listArgv;
      int i;

      if (Tcl_SplitList(interp, argv[4], &listArgc, &listArgv) != TCL_OK) {
         Tcl_AppendResult(interp, "can't parse field list", NULL);
         return TCL_ERROR;
      }

      /* Create a list with the appropriate field values. For now,
         we don't every display the field names.  The available field
         names should be made available through some other mechanism.
      */
      for (i = 0; i < listArgc; i++) {
         char buf[50];
         PrintLLD(buf,StatRecordFieldValue(bucket, listArgv[i]));
         Tcl_AppendElement(interp, buf);
      }
      
      free((char*) listArgv);
   } else {
      int i, j;

      /* Otherwise, enumerate all fields and values */
      j = StatRecordNumFields();
      for (i = 0; i < j; i++) {
         char buf[50];
         PrintLLD(buf, StatRecordFieldValueByIndex(bucket, i));
         Tcl_AppendElement(interp, buf);
      }
   }
   return TCL_OK;
}

/* Iterate through all of the buckets, calling the associated script
   with the given name. Scott did you ever figure out how to put
   this stuff in a separate function? 
*/
int cmdForEach(Tcl_Interp *interp, int argc, char *argv[]) {

   Selector *sel;
   char *selName;
   Tcl_HashEntry *entryPtr;
   Tcl_HashSearch search;
   int listArgc;
   char **listArgv;

   CHECK_SEL(sel, selName);

   if (Tcl_SplitList(interp, argv[3], &listArgc, &listArgv) != TCL_OK ||
       listArgc != 1) {
      Tcl_AppendResult(interp, "can't parse arg list", NULL);
      return TCL_ERROR;
   }

   /* Currently we don't create a new function. Scott what was the decision
      here? 
   */

   for (entryPtr = Tcl_FirstHashEntry(&sel->buckets, &search);
        entryPtr != NULL;
        entryPtr = Tcl_NextHashEntry(&search)) {

      /* Set the current value ... */
      if (Tcl_SetVar(interp, listArgv[0], Tcl_GetHashKey(&sel->buckets, entryPtr),0) 
          == NULL) {

         Tcl_AppendResult(interp, "Error in bucket enumeration", NULL);
         return TCL_ERROR;
      }
      
      /* and evaluate! */
      Tcl_Eval(interp, argv[4]);
   }

   return TCL_OK;
}

/* return a list of the statrecord fields used for the given
bucket.  Currently, it's all of them.
*/
int cmdGetFields(Tcl_Interp *interp, int argc, char *argv[]) {
   Selector *sel;
   char *selName;
   int i,j;

   CHECK_SEL(sel, selName);

   j = StatRecordNumFields();
   for (i = 0; i < j; i++) {
      Tcl_AppendElement(interp, StatRecordGetFieldName(i));
   }

   return TCL_OK;
}
   
   

int cmdDisable(Tcl_Interp *interp, int argc, char *argv[]) {
   
   int cpuNum;


   if (Tcl_GetInt(interp, argv[2], &cpuNum) != TCL_OK) {
      Tcl_AppendResult(interp, "bad cpunum \"", argv[3], "\"", NULL);
      return TCL_ERROR;
   }
   StatRecordDisableCPU(cpuNum);
   return TCL_OK;
}
/* Set the given selector to the given bucketName.
   Allocate the bucket if needed.
*/
   
void SelSetBucket(Selector *sel, int cpuNum, char *bucketName) {

   StatRecordBucket *bucket;
   Tcl_HashEntry *entry = Tcl_FindHashEntry(&sel->buckets, bucketName);

   if (entry) {
      bucket = (StatRecordBucket*) Tcl_GetHashValue(entry);
      ASSERT(bucket);
   } else {
      int newval;

      entry  = Tcl_CreateHashEntry(&sel->buckets, bucketName, &newval);
      ASSERT(newval);

      bucket = StatRecordNewBucket();
      Tcl_SetHashValue(entry, bucket);
   }

   StatRecordSetSwitch(sel->simosSwitch, cpuNum, bucket);

}

Selector *SelLookup(char *name) {
   Tcl_HashEntry *entry;

   entry = Tcl_FindHashEntry(&selectors, name);
      
   if (entry == NULL) {
      return NULL;
   }

   return (Selector*) Tcl_GetHashValue(entry);
}