Index: /trunk/CDFCones/CalTower.cc
===================================================================
--- /trunk/CDFCones/CalTower.cc	(revision 2)
+++ /trunk/CDFCones/CalTower.cc	(revision 2)
@@ -0,0 +1,1 @@
+#include "CalTower.hh"
Index: /trunk/CDFCones/CalTower.hh
===================================================================
--- /trunk/CDFCones/CalTower.hh	(revision 2)
+++ /trunk/CDFCones/CalTower.hh	(revision 2)
@@ -0,0 +1,52 @@
+#ifndef _CAL_TOWER_HH_
+#define _CAL_TOWER_HH_
+
+#include <cmath>
+
+const double TOWER_THETA[23] = {  3.000,  5.700,  8.400, 11.100, 13.800, 16.500, 19.200, 21.900, 24.600, 27.300, 30.000, 33.524,
+				  36.822, 40.261, 43.614, 47.436, 51.790, 56.735, 62.310, 68.516, 75.297, 82.526, 90.000 };
+
+class CalTower
+{
+ public:
+
+  double Et,eta,phi;
+  int iEta,iPhi;
+
+  CalTower(): Et(0), eta(0), phi(0), iEta(-1), iPhi(-1) {}
+  CalTower(double Et0, double eta0, double phi0): Et(Et0), eta(eta0), phi(phi0)
+  {
+    if(fabs(eta) < -log(tan(TOWER_THETA[0]*M_PI/180/2))){
+      if(eta <= 0){
+	for(int i = 0; i < 22; i++)
+	  if(eta < -log(tan((180 - TOWER_THETA[i + 1])*M_PI/180/2))){
+	    iEta = 4 + i;
+	    break;
+	  }
+      }
+      else{
+	for(int i = 0; i < 22; i++)
+	  if(-eta < -log(tan((180 - TOWER_THETA[i + 1])*M_PI/180/2))){
+	    iEta = 47 - i;
+	    break;
+	  }
+      }
+      if(iEta >= 8 && iEta < 14 || iEta >= 38 && iEta < 44)
+	iPhi = int(phi/2/M_PI*48)%48;
+      else
+	iPhi = int(phi/2/M_PI*24)%24;
+    }
+    else{
+      iEta = -1;
+      iPhi = -1;
+    }
+  }
+  CalTower(double Et0, double eta0, double phi0, int iEta0, int iPhi0): Et(Et0), eta(eta0), phi(phi0), iEta(iEta0), iPhi(iPhi0) {}
+  CalTower(const CalTower& c): Et(c.Et), eta(c.eta), phi(c.phi), iEta(c.iEta), iPhi(c.iPhi) {}
+  bool isEqual(CalTower c)
+  {
+    return Et == c.Et && eta == c.eta && phi == c.phi && iEta == c.iEta && iPhi == c.iPhi;
+  }
+};
+
+#endif
Index: /trunk/CDFCones/Centroid.cc
===================================================================
--- /trunk/CDFCones/Centroid.cc	(revision 2)
+++ /trunk/CDFCones/Centroid.cc	(revision 2)
@@ -0,0 +1,1 @@
+#include "Centroid.hh"
Index: /trunk/CDFCones/Centroid.hh
===================================================================
--- /trunk/CDFCones/Centroid.hh	(revision 2)
+++ /trunk/CDFCones/Centroid.hh	(revision 2)
@@ -0,0 +1,53 @@
+#ifndef _CENTROID_HH_
+#define _CENTROID_HH_
+
+#include <cmath>
+
+class Centroid
+{
+ public:
+
+  double Et,eta,phi;
+
+  Centroid(): Et(0), eta(0), phi(0) {}
+  Centroid(double centroidEt, double centroidEta, double centroidPhi): Et(centroidEt), eta(centroidEta), phi(centroidPhi) {}
+  Centroid(const Centroid& c): Et(c.Et), eta(c.eta), phi(c.phi) {}
+  void add(Centroid c)
+  {
+    double newEt = Et + c.Et;
+    eta = (Et*eta + c.Et*c.eta)/newEt;
+    double dPhi = c.phi - phi;
+    if(dPhi > M_PI)
+      dPhi -= 2*M_PI;
+    else if(dPhi < -M_PI)
+      dPhi += 2*M_PI;
+    phi += dPhi*c.Et/newEt;
+    while(phi < 0)
+      phi += 2*M_PI;
+    while(phi >= 2*M_PI)
+      phi -= 2*M_PI;
+    Et = newEt;
+  }
+  void subtract(Centroid c)
+  {
+    double newEt = Et - c.Et;
+    eta = (Et*eta - c.Et*c.eta)/newEt;
+    double dPhi = c.phi - phi;
+    if(dPhi > M_PI)
+      dPhi -= 2*M_PI;
+    else if(dPhi < -M_PI)
+      dPhi += 2*M_PI;
+    phi -= dPhi*c.Et/newEt;
+    while(phi < 0)
+      phi += 2*M_PI;
+    while(phi >= 2*M_PI)
+      phi -= 2*M_PI;
+    Et = newEt;
+  }
+  bool isEqual(Centroid c)
+  {
+    return Et == c.Et && eta == c.eta && phi == c.phi;
+  }
+};
+
+#endif
Index: /trunk/CDFCones/Cluster.cc
===================================================================
--- /trunk/CDFCones/Cluster.cc	(revision 2)
+++ /trunk/CDFCones/Cluster.cc	(revision 2)
@@ -0,0 +1,1 @@
+#include "Cluster.hh"
Index: /trunk/CDFCones/Cluster.hh
===================================================================
--- /trunk/CDFCones/Cluster.hh	(revision 2)
+++ /trunk/CDFCones/Cluster.hh	(revision 2)
@@ -0,0 +1,45 @@
+#ifndef _CLUSTER_HH_
+#define _CLUSTER_HH_
+
+#include "PhysicsTower.hh"
+#include "LorentzVector.hh"
+#include "Centroid.hh"
+#include <vector>
+
+class Cluster
+{
+ public:
+  std::vector<PhysicsTower> towerList;
+  LorentzVector fourVector;
+  Centroid centroid;
+
+  Cluster()
+  {
+    clear();
+  }
+  void clear()
+  {
+    towerList.clear();
+    fourVector = LorentzVector();
+    centroid = Centroid();
+  }
+  void addTower(PhysicsTower p)
+  {
+    towerList.push_back(p);
+    fourVector.add(p.fourVector);
+    centroid.add(Centroid(p.Et(),p.eta(),p.phi()));
+  }
+  void removeTower(PhysicsTower p)
+  {
+    for(std::vector<PhysicsTower>::iterator towerIter = towerList.begin(); towerIter != towerList.end(); towerIter++)
+      if(towerIter->isEqual(p)){
+	fourVector.subtract(towerIter->fourVector);
+	centroid.subtract(Centroid(towerIter->Et(),towerIter->eta(),towerIter->phi()));
+	towerList.erase(towerIter);
+	break;
+      }
+  }
+  int size(){return towerList.size();}
+};
+
+#endif
Index: /trunk/CDFCones/ClusterComparisons.cc
===================================================================
--- /trunk/CDFCones/ClusterComparisons.cc	(revision 2)
+++ /trunk/CDFCones/ClusterComparisons.cc	(revision 2)
@@ -0,0 +1,1 @@
+#include "ClusterComparisons.hh"
Index: /trunk/CDFCones/ClusterComparisons.hh
===================================================================
--- /trunk/CDFCones/ClusterComparisons.hh	(revision 2)
+++ /trunk/CDFCones/ClusterComparisons.hh	(revision 2)
@@ -0,0 +1,33 @@
+#ifndef _CLUSTER_COMPARISONS_HH_
+#define _CLUSTER_COMPARISONS_HH_
+
+#include "Cluster.hh"
+
+class ClusterFourVectorEtGreater
+{
+ public:
+  int operator()(const Cluster& c1, const Cluster& c2) const
+  {
+    return c1.fourVector.Et() > c2.fourVector.Et();
+  }
+};
+
+class ClusterCentroidEtGreater
+{
+ public:
+  int operator()(const Cluster& c1, const Cluster& c2) const
+  {
+    return c1.centroid.Et > c2.centroid.Et;
+  }
+};
+
+class ClusterPtGreater
+{
+ public:
+  int operator()(const Cluster& c1, const Cluster& c2) const
+  {
+    return c1.fourVector.pt() > c2.fourVector.pt();
+  }
+};
+
+#endif
Index: /trunk/CDFCones/JetCluAlgorithm.cc
===================================================================
--- /trunk/CDFCones/JetCluAlgorithm.cc	(revision 2)
+++ /trunk/CDFCones/JetCluAlgorithm.cc	(revision 2)
@@ -0,0 +1,289 @@
+#include "JetCluAlgorithm.hh"
+#include "ClusterComparisons.hh"
+#include "Centroid.hh"
+#include <algorithm>
+#include <cmath>
+
+void JetCluAlgorithm::makeSeedTowers(std::vector<PhysicsTower>& towers, std::vector<Cluster>& seedTowers)
+{
+  for(int iEta = 4; iEta < 48; iEta++){
+    bool seg24 = true;
+    if(iEta >= 8 && iEta < 14 || iEta >= 38 && iEta < 44)
+      seg24 = false;
+    for(int iPhi = 0; iPhi < 24; iPhi++){
+      Cluster seed;
+      for(std::vector<PhysicsTower>::iterator towerIter = towers.begin(); towerIter != towers.end(); towerIter++)
+	if(towerIter->iEta() == iEta &&
+	   (seg24 && towerIter->iPhi() == iPhi || !seg24 && (towerIter->iPhi() == 2*iPhi || towerIter->iPhi() == 2*iPhi + 1)))
+	  seed.addTower(*towerIter);
+      if(seed.centroid.Et > _seedThreshold)
+	seedTowers.push_back(seed);
+    }
+  }
+  sort(seedTowers.begin(),seedTowers.end(),ClusterCentroidEtGreater());
+}
+
+void JetCluAlgorithm::buildPreClusters(std::vector<Cluster>& seedTowers, std::vector<PhysicsTower>& towers,
+				       std::vector<Cluster>& preClusters)
+{
+  std::vector<Centroid> leadingSeedTowers;
+  for(std::vector<Cluster>::iterator seedTowerIter = seedTowers.begin(); seedTowerIter != seedTowers.end(); seedTowerIter++){
+    bool seedTowerAddedToPreCluster = false;
+    std::vector<Cluster>::iterator preClusterIter = preClusters.begin();
+    std::vector<Centroid>::iterator leadingSeedTowerIter = leadingSeedTowers.begin();
+    while(preClusterIter != preClusters.end() && !seedTowerAddedToPreCluster){
+      double dEta = fabs(seedTowerIter->centroid.eta - leadingSeedTowerIter->eta);
+      double dPhi = fabs(seedTowerIter->centroid.phi - leadingSeedTowerIter->phi);
+      if(dPhi > M_PI)
+	dPhi = 2*M_PI - dPhi;
+      if(dEta <= _coneRadius && dPhi <= _coneRadius){
+	int iEtaSeedTower = seedTowerIter->towerList.begin()->iEta();
+	int iPhiSeedTower = seedTowerIter->towerList.begin()->iPhi();
+	if(iEtaSeedTower >= 8 && iEtaSeedTower < 14 || iEtaSeedTower >= 38 && iEtaSeedTower < 44)
+	  iPhiSeedTower = iPhiSeedTower/2;
+ 	for(std::vector<PhysicsTower>::iterator preClusterTowerIter = preClusterIter->towerList.begin();
+	    preClusterTowerIter != preClusterIter->towerList.end() && !seedTowerAddedToPreCluster;
+	    preClusterTowerIter++){
+	  int iEtaPreClusterTower = preClusterTowerIter->iEta();
+	  int iPhiPreClusterTower = preClusterTowerIter->iPhi();
+	  if(iEtaPreClusterTower >= 8 && iEtaPreClusterTower < 14 || iEtaPreClusterTower >= 38 && iEtaPreClusterTower < 44)
+	    iPhiPreClusterTower = iPhiPreClusterTower/2;
+	  int dIEta = abs(iEtaSeedTower - iEtaPreClusterTower);
+	  int dIPhi = abs(iPhiSeedTower - iPhiPreClusterTower);
+	  if(dIPhi > 12)
+	    dIPhi = 24 - dIPhi;
+	  int adj = dIPhi*dIPhi + dIEta*dIEta;
+	  if(adj <= _adjacencyCut){
+	    for(std::vector<PhysicsTower>::iterator seedTowerTowerIter = seedTowerIter->towerList.begin();
+		seedTowerTowerIter != seedTowerIter->towerList.end();
+		seedTowerTowerIter++)
+	      preClusterIter->addTower(*seedTowerTowerIter);
+	    seedTowerAddedToPreCluster = true;
+	  }
+	}
+      }
+      preClusterIter++;
+      leadingSeedTowerIter++;
+    }
+    if(!seedTowerAddedToPreCluster){
+      Cluster newPreCluster;
+      for(std::vector<PhysicsTower>::iterator seedTowerTowerIter = seedTowerIter->towerList.begin();
+	  seedTowerTowerIter != seedTowerIter->towerList.end();
+	  seedTowerTowerIter++)
+	newPreCluster.addTower(*seedTowerTowerIter);
+      preClusters.push_back(newPreCluster);
+      leadingSeedTowers.push_back(Centroid(newPreCluster.centroid.Et,newPreCluster.centroid.eta,newPreCluster.centroid.phi));
+    }
+  }
+}
+
+void JetCluAlgorithm::findStableCones(std::vector<Cluster>& preClusters, std::vector<PhysicsTower>& towers,
+				      std::vector<Cluster>& stableCones)
+{
+  for(std::vector<Cluster>::iterator preClusterIter = preClusters.begin(); preClusterIter != preClusters.end(); preClusterIter++){
+    double startEt  = preClusterIter->centroid.Et;
+    double startEta = preClusterIter->centroid.eta;
+    double startPhi = preClusterIter->centroid.phi;
+    int nIterations = 0;
+    Cluster trialCone;
+    while(nIterations++ < _maxIterations){
+      trialCone.clear();
+      for(std::vector<PhysicsTower>::iterator towerIter = towers.begin(); towerIter != towers.end(); towerIter++){
+	double dEta = fabs(towerIter->eta() - startEta);
+	double dPhi = fabs(towerIter->phi() - startPhi);
+	if(dPhi > M_PI)
+	  dPhi = 2*M_PI - dPhi;
+	double dR = sqrt(dEta*dEta + dPhi*dPhi);
+	if(dR < _coneRadius)
+	  trialCone.addTower(*towerIter);
+      }
+      if(_iratch != 0)
+	for(std::vector<PhysicsTower>::iterator preClusterTowerIter = preClusterIter->towerList.begin();
+	    preClusterTowerIter != preClusterIter->towerList.end();
+	    preClusterTowerIter++){
+	  bool foundInTrialCone = false;
+	  for(std::vector<PhysicsTower>::iterator trialConeTowerIter = trialCone.towerList.begin();
+	      trialConeTowerIter != trialCone.towerList.end() && !foundInTrialCone;
+	      trialConeTowerIter++)
+	    if(trialConeTowerIter->isEqual(*preClusterTowerIter))
+	      foundInTrialCone = true;
+	  if(!foundInTrialCone)
+	    trialCone.addTower(*preClusterTowerIter);
+	}
+      if(nIterations <= _maxIterations){
+	double endEt  = trialCone.centroid.Et;
+	double endEta = trialCone.centroid.eta;
+	double endPhi = trialCone.centroid.phi;
+	if(endEt == startEt && endEta == startEta && endPhi == startPhi)
+	  nIterations = _maxIterations;
+	else{
+	  startEt  = endEt;
+	  startEta = endEta;
+	  startPhi = endPhi;
+	}
+      }
+    }
+//    bool foundIdentical = false;
+//    for(std::vector<Cluster>::iterator stableConeIter = stableCones.begin();
+//	stableConeIter != stableCones.end() && !foundIdentical;
+//	stableConeIter++)
+//      if(trialCone.centroid.isEqual(stableConeIter->centroid))
+//	foundIdentical = true;
+//    if(!foundIdentical)
+      stableCones.push_back(trialCone);
+  }
+  sort(stableCones.begin(),stableCones.end(),ClusterCentroidEtGreater());
+}
+
+void JetCluAlgorithm::splitAndMerge(std::vector<Cluster>& stableCones, std::vector<Cluster>& jets)
+{
+  std::vector<bool> isActive;
+  for(std::vector<Cluster>::iterator stableConeIter = stableCones.begin(); stableConeIter != stableCones.end(); stableConeIter++)
+    isActive.push_back(bool(true));
+  std::vector<bool>::iterator isActiveIter1 = isActive.begin();
+  for(std::vector<Cluster>::iterator stableConeIter1 = stableCones.begin();
+      stableConeIter1 != stableCones.end();
+      stableConeIter1++, isActiveIter1++){
+    std::vector<Cluster>::iterator stableConeIter2 = stableCones.begin();
+    std::vector<bool>::iterator isActiveIter2 = isActive.begin();
+    while(stableConeIter2 != stableConeIter1 && *isActiveIter1){
+      if(*isActiveIter2){
+	Cluster overlap;
+	for(std::vector<PhysicsTower>::iterator towerIter1 = stableConeIter1->towerList.begin();
+	    towerIter1 != stableConeIter1->towerList.end();
+	    towerIter1++)
+	  for(std::vector<PhysicsTower>::iterator towerIter2 = stableConeIter2->towerList.begin();
+	      towerIter2 != stableConeIter2->towerList.end();
+	      towerIter2++)
+	    if(towerIter1->isEqual(*towerIter2)){
+	      overlap.addTower(*towerIter1);
+	      break;
+	    }
+	if(overlap.size()){
+	  if(overlap.size() == stableConeIter2->size())
+	    *isActiveIter2 = false;
+	  else if(overlap.size() == stableConeIter1->size())
+	    *isActiveIter1 = false;
+	  else if(overlap.centroid.Et > _overlapThreshold*stableConeIter1->centroid.Et ||
+		  overlap.centroid.Et > _overlapThreshold*stableConeIter2->centroid.Et){
+	    for(std::vector<PhysicsTower>::iterator stableConeTowerIter2 = stableConeIter2->towerList.begin();
+		stableConeTowerIter2 != stableConeIter2->towerList.end();
+		stableConeTowerIter2++){
+	      bool isInOverlap = false;
+	      for(std::vector<PhysicsTower>::iterator overlapTowerIter = overlap.towerList.begin();
+		  overlapTowerIter != overlap.towerList.end() && !isInOverlap;
+		  overlapTowerIter++)
+		if(stableConeTowerIter2->isEqual(*overlapTowerIter))
+		  isInOverlap = true;
+	      if(!isInOverlap)
+		stableConeIter1->addTower(*stableConeTowerIter2);
+	    }
+	    *isActiveIter2 = false;
+	  }
+	  else{
+	    Cluster removeFromStableCone1,removeFromStableCone2,oldRemoveFromStableCone1,oldRemoveFromStableCone2;
+	    double etaStableCone1 = stableConeIter1->centroid.eta;
+	    double phiStableCone1 = stableConeIter1->centroid.phi;
+	    double etaStableCone2 = stableConeIter2->centroid.eta;
+	    double phiStableCone2 = stableConeIter2->centroid.phi;
+	    double dRstableCone1,dRstableCone2;
+	    int iterCount = 0;
+	    while(iterCount++ <= _maxIterations){
+	      oldRemoveFromStableCone1.clear();
+	      oldRemoveFromStableCone2.clear();
+	      if(iterCount > 1){
+		if(removeFromStableCone1.size()){
+		  Centroid stableConeCentroid1(stableConeIter1->centroid);
+		  Centroid removeCentroid1(removeFromStableCone1.centroid);
+		  stableConeCentroid1.subtract(removeCentroid1);
+		  etaStableCone1 = stableConeCentroid1.eta;
+		  phiStableCone1 = stableConeCentroid1.phi;
+		}
+		else{
+		  etaStableCone1 = stableConeIter1->centroid.eta;
+		  phiStableCone1 = stableConeIter1->centroid.phi;
+		}
+		if(removeFromStableCone2.size()){
+		  Centroid stableConeCentroid2(stableConeIter2->centroid);
+		  Centroid removeCentroid2(removeFromStableCone2.centroid);
+		  stableConeCentroid2.subtract(removeCentroid2);
+		  etaStableCone2 = stableConeCentroid2.eta;
+		  phiStableCone2 = stableConeCentroid2.phi;
+		}
+		else{
+		  etaStableCone2 = stableConeIter2->centroid.eta;
+		  phiStableCone2 = stableConeIter2->centroid.phi;
+		}
+		for(std::vector<PhysicsTower>::iterator removeTowerIter1 = removeFromStableCone1.towerList.begin();
+		    removeTowerIter1 != removeFromStableCone1.towerList.end();
+		    removeTowerIter1++)
+		  oldRemoveFromStableCone1.addTower(*removeTowerIter1);
+		for(std::vector<PhysicsTower>::iterator removeTowerIter2 = removeFromStableCone2.towerList.begin();
+		    removeTowerIter2 != removeFromStableCone2.towerList.end();
+		    removeTowerIter2++)
+		  oldRemoveFromStableCone2.addTower(*removeTowerIter2);
+	      }
+	      removeFromStableCone1.clear();
+	      removeFromStableCone2.clear();
+	      for(std::vector<PhysicsTower>::iterator overlapTowerIter = overlap.towerList.begin();
+		  overlapTowerIter != overlap.towerList.end();
+		  overlapTowerIter++){
+		double dEta1 = fabs(overlapTowerIter->eta() - etaStableCone1);
+		double dPhi1 = fabs(overlapTowerIter->phi() - phiStableCone1);
+		if(dPhi1 > M_PI)
+		  dPhi1 = 2*M_PI - dPhi1;
+		dRstableCone1 = dEta1*dEta1 + dPhi1*dPhi1;
+		double dEta2 = fabs(overlapTowerIter->eta() - etaStableCone2);
+		double dPhi2 = fabs(overlapTowerIter->phi() - phiStableCone2);
+		if(dPhi2 > M_PI)
+		  dPhi2 = 2*M_PI - dPhi2;
+		dRstableCone2 = dEta2*dEta2 + dPhi2*dPhi2;
+		if(dRstableCone1 < dRstableCone2)
+		  removeFromStableCone2.addTower(*overlapTowerIter);
+		else
+		  removeFromStableCone1.addTower(*overlapTowerIter);
+	      }
+	      if(iterCount > 1 &&
+		 removeFromStableCone1.size() == oldRemoveFromStableCone1.size() &&
+		 removeFromStableCone2.size() == oldRemoveFromStableCone2.size() &&
+		 (!removeFromStableCone1.size() || !removeFromStableCone2.size() ||
+		  removeFromStableCone1.centroid.isEqual(oldRemoveFromStableCone1.centroid) &&
+		  removeFromStableCone2.centroid.isEqual(oldRemoveFromStableCone2.centroid)))
+		iterCount = _maxIterations + 1;
+	    }
+	    for(std::vector<PhysicsTower>::iterator removeTowerIter1 = removeFromStableCone1.towerList.begin();
+		removeTowerIter1 != removeFromStableCone1.towerList.end();
+		removeTowerIter1++)
+	      stableConeIter1->removeTower(*removeTowerIter1);
+	    for(std::vector<PhysicsTower>::iterator removeTowerIter2 = removeFromStableCone2.towerList.begin();
+		removeTowerIter2 != removeFromStableCone2.towerList.end();
+		removeTowerIter2++)
+	      stableConeIter2->removeTower(*removeTowerIter2);
+	  }
+	  overlap.clear();
+	}
+      }
+      stableConeIter2++;
+      isActiveIter2++;
+    }
+  }
+  jets.clear();
+  std::vector<bool>::iterator isActiveIter = isActive.begin();
+  for(std::vector<Cluster>::iterator stableConeIter = stableCones.begin();
+      stableConeIter != stableCones.end();
+      stableConeIter++, isActiveIter++)
+    if(*isActiveIter)
+      jets.push_back(*stableConeIter);
+  sort(jets.begin(),jets.end(),ClusterFourVectorEtGreater());
+}
+
+void JetCluAlgorithm::run(std::vector<PhysicsTower>& towers, std::vector<Cluster>& jets)
+{
+  std::vector<Cluster> seedTowers;
+  makeSeedTowers(towers,seedTowers);
+  std::vector<Cluster> preClusters;
+  buildPreClusters(seedTowers,towers,preClusters);
+  std::vector<Cluster> stableCones;
+  findStableCones(preClusters,towers,stableCones);
+  splitAndMerge(stableCones,jets);
+}
Index: /trunk/CDFCones/JetCluAlgorithm.hh
===================================================================
--- /trunk/CDFCones/JetCluAlgorithm.hh	(revision 2)
+++ /trunk/CDFCones/JetCluAlgorithm.hh	(revision 2)
@@ -0,0 +1,42 @@
+#ifndef _JETCLU_ALGORITHM_HH_
+#define _JETCLU_ALGORITHM_HH_
+
+#include "PhysicsTower.hh"
+#include "Cluster.hh"
+#include <vector>
+
+class JetCluAlgorithm
+{
+ private:
+  double _seedThreshold;
+  double _coneRadius;
+  int    _adjacencyCut;
+  int    _maxIterations;
+  int    _iratch;
+  double _overlapThreshold;
+
+ public:
+  JetCluAlgorithm():
+    _seedThreshold(1),
+    _coneRadius(0.7),
+    _adjacencyCut(2),
+    _maxIterations(100),
+    _iratch(1),
+    _overlapThreshold(0.75)
+  {}
+  JetCluAlgorithm(double st, double cr, int ac, int mi, int ir, double ot):
+    _seedThreshold(st),
+    _coneRadius(cr),
+    _adjacencyCut(ac),
+    _maxIterations(mi),
+    _iratch(ir),
+    _overlapThreshold(ot)
+  {}
+  void makeSeedTowers(std::vector<PhysicsTower>& towers, std::vector<Cluster>& seedTowers);
+  void buildPreClusters(std::vector<Cluster>& seedTowers, std::vector<PhysicsTower>& towers, std::vector<Cluster>& preClusters);
+  void findStableCones(std::vector<Cluster>& preClusters, std::vector<PhysicsTower>& towers, std::vector<Cluster>& stableCones);
+  void splitAndMerge(std::vector<Cluster>& stableCones, std::vector<Cluster>& jets);
+  void run(std::vector<PhysicsTower>& towers, std::vector<Cluster>& jets);
+};
+
+#endif
Index: /trunk/CDFCones/LorentzVector.cc
===================================================================
--- /trunk/CDFCones/LorentzVector.cc	(revision 2)
+++ /trunk/CDFCones/LorentzVector.cc	(revision 2)
@@ -0,0 +1,1 @@
+#include "LorentzVector.hh"
Index: /trunk/CDFCones/LorentzVector.hh
===================================================================
--- /trunk/CDFCones/LorentzVector.hh	(revision 2)
+++ /trunk/CDFCones/LorentzVector.hh	(revision 2)
@@ -0,0 +1,47 @@
+#ifndef _LORENTZ_VECTOR_HH_
+#define _LORENTZ_VECTOR_HH_
+
+#include <cmath>
+
+class LorentzVector
+{
+ public:
+
+  double px,py,pz,E;
+
+  LorentzVector(): px(0), py(0), pz(0), E(0) {}
+  LorentzVector(double p1, double p2, double p3, double p0): px(p1), py(p2), pz(p3), E(p0) {}
+  LorentzVector(const LorentzVector& p): px(p.px), py(p.py), pz(p.pz), E(p.E) {}
+  double p()   const {return sqrt(px*px + py*py + pz*pz);}
+  double pt()  const {return sqrt(px*px + py*py);}
+  double y()   const {return 0.5*log((E + pz)/(E - pz));}
+  double Et()  const {return E/p()*pt();}
+  double eta() const {return 0.5*log((p() + pz)/(p() - pz));}
+  double phi() const
+  {
+    double r = atan2(py,px);
+    if(r < 0)
+      r += 2*M_PI;
+    return r;
+  }
+  void add(LorentzVector v)
+  {
+    px += v.px;
+    py += v.py;
+    pz += v.pz;
+    E  += v.E;
+  }
+  void subtract(LorentzVector v)
+  {
+    px -= v.px;
+    py -= v.py;
+    pz -= v.pz;
+    E  -= v.E;
+  }
+  bool isEqual(LorentzVector v)
+  {
+    return px == v.px && py == v.py && pz == v.pz && E == v.E;
+  }
+};
+
+#endif
Index: /trunk/CDFCones/MidPointAlgorithm.cc
===================================================================
--- /trunk/CDFCones/MidPointAlgorithm.cc	(revision 2)
+++ /trunk/CDFCones/MidPointAlgorithm.cc	(revision 2)
@@ -0,0 +1,252 @@
+#include "MidPointAlgorithm.hh"
+#include "ClusterComparisons.hh"
+#include <algorithm>
+#include <cmath>
+
+void MidPointAlgorithm::findStableConesFromSeeds(std::vector<PhysicsTower>& towers, std::vector<Cluster>& stableCones)
+{
+  bool reduceConeSize = true;
+  for(std::vector<PhysicsTower>::iterator towerIter = towers.begin(); towerIter != towers.end(); towerIter++)
+    if(towerIter->fourVector.pt() > _seedThreshold)
+      iterateCone(towerIter->fourVector.y(),towerIter->fourVector.phi(),0,towers,stableCones,reduceConeSize);
+}
+
+void MidPointAlgorithm::findStableConesFromMidPoints(std::vector<PhysicsTower>& towers, std::vector<Cluster>& stableCones)
+{
+  // distanceOK[i-1][j] = Is distance between stableCones i and j (i>j) less than 2*_coneRadius?
+  std::vector< std::vector<bool> > distanceOK;
+if(stableCones.size() > 0){
+  distanceOK.resize(stableCones.size() - 1);
+  for(int nCluster1 = 1; nCluster1 < stableCones.size(); nCluster1++){
+    distanceOK[nCluster1 - 1].resize(nCluster1);
+    double cluster1Rapidity = stableCones[nCluster1].fourVector.y();
+    double cluster1Phi      = stableCones[nCluster1].fourVector.phi();
+    for(int nCluster2 = 0; nCluster2 < nCluster1; nCluster2++){
+      double cluster2Rapidity = stableCones[nCluster2].fourVector.y();
+      double cluster2Phi      = stableCones[nCluster2].fourVector.phi();
+      double dRapidity = fabs(cluster1Rapidity - cluster2Rapidity);
+      double dPhi      = fabs(cluster1Phi      - cluster2Phi);
+      if(dPhi > M_PI)
+        dPhi = 2*M_PI - dPhi;
+      double dR = sqrt(dRapidity*dRapidity + dPhi*dPhi);
+      distanceOK[nCluster1 - 1][nCluster2] = dR < 2*_coneRadius;
+    }
+  }
+}
+  // Find all pairs (triplets, ...) of stableCones which are less than 2*_coneRadius apart from each other.
+  std::vector< std::vector<int> > pairs(0);
+  std::vector<int> testPair(0);
+  int maxClustersInPair = _maxPairSize;
+  if(!maxClustersInPair)
+    maxClustersInPair = stableCones.size();
+  addClustersToPairs(testPair,pairs,distanceOK,maxClustersInPair);
+
+  // Loop over all combinations. Calculate MidPoint. Make midPointClusters.
+  bool reduceConeSize = false;
+  for(int iPair = 0; iPair < pairs.size(); iPair++){
+    // Calculate rapidity, phi and pT of MidPoint.
+    LorentzVector midPoint(0,0,0,0);
+    for(int iPairMember = 0; iPairMember < pairs[iPair].size(); iPairMember++)
+      midPoint.add(stableCones[pairs[iPair][iPairMember]].fourVector);
+    iterateCone(midPoint.y(),midPoint.phi(),midPoint.pt(),towers,stableCones,reduceConeSize);
+  }
+
+  sort(stableCones.begin(),stableCones.end(),ClusterPtGreater());
+}
+
+void MidPointAlgorithm::iterateCone(double startRapidity, double startPhi, double startPt,
+				    std::vector<PhysicsTower>& towers, std::vector<Cluster>& stableCones, bool reduceConeSize)
+{
+  int nIterations = 0;
+  bool keepJet = true;
+  Cluster trialCone;
+  double iterationConeRadius = _coneRadius;
+  if(reduceConeSize)
+    iterationConeRadius *= sqrt(_coneAreaFraction);
+  while(nIterations++ < _maxIterations + 1 && keepJet){
+    trialCone.clear();
+    // Find particles which should go in the cone.
+    if(nIterations == _maxIterations + 1)
+      iterationConeRadius = _coneRadius;
+    for(std::vector<PhysicsTower>::iterator towerIter = towers.begin(); towerIter != towers.end(); towerIter++){
+      double dRapidity = fabs(towerIter->fourVector.y()   - startRapidity);
+      double dPhi      = fabs(towerIter->fourVector.phi() - startPhi);
+      if(dPhi > M_PI)
+	dPhi = 2*M_PI - dPhi;
+      double dR = sqrt(dRapidity*dRapidity + dPhi*dPhi);
+      if(dR < iterationConeRadius)
+	trialCone.addTower(*towerIter);
+    }
+    if(!trialCone.size())   // Empty cone?
+      keepJet = false;
+    else{
+      if(nIterations <= _maxIterations){
+	double endRapidity = trialCone.fourVector.y();
+	double endPhi      = trialCone.fourVector.phi();
+	double endPt       = trialCone.fourVector.pt();
+	// Do we have a stable cone?
+	if(endRapidity == startRapidity && endPhi == startPhi && endPt == startPt){
+	  // If cone size is reduced, then do one more iteration.
+	  nIterations = _maxIterations;
+	  if(!reduceConeSize)
+	    nIterations++;
+	}
+	else{
+	  // Another iteration.
+	  startRapidity = endRapidity;
+	  startPhi      = endPhi;
+	  startPt       = endPt;
+	}
+      }
+    }
+  }
+
+  if(keepJet){
+    // We have a stable cone.
+    bool identical = false;
+    for(std::vector<Cluster>::iterator stableConeIter = stableCones.begin(); stableConeIter != stableCones.end(); stableConeIter++)
+      if(trialCone.fourVector.isEqual(stableConeIter->fourVector))
+	identical = true;
+    if(!identical)
+      stableCones.push_back(trialCone);
+  }
+}
+
+void MidPointAlgorithm::addClustersToPairs(std::vector<int>& testPair, std::vector< std::vector<int> >& pairs,
+					   std::vector< std::vector<bool> >& distanceOK, int maxClustersInPair)
+{
+  // Recursively adds clusters to pairs, triplets, ... whose mid-points are then calculated.
+
+  // Find StableCone number to start with (either 0 at the beginning or last element of testPair + 1).
+  int nextClusterStart = 0;
+  if(testPair.size())
+    nextClusterStart = testPair.back() + 1;
+  for(int nextCluster = nextClusterStart; nextCluster <= distanceOK.size(); nextCluster++){
+    // Is new SeedCone less than 2*_coneRadius apart from all clusters in testPair?
+    bool addCluster = true;
+    for(int iCluster = 0; iCluster < testPair.size() && addCluster; iCluster++)
+      if(!distanceOK[nextCluster - 1][testPair[iCluster]])
+	addCluster = false;
+    if(addCluster){
+      // Add it to the testPair.
+      testPair.push_back(nextCluster);
+      // If testPair is a pair, add it to pairs.
+      if(testPair.size() > 1)
+	pairs.push_back(testPair);
+      // If not bigger than allowed, find more clusters within 2*_coneRadius.
+      if(testPair.size() < maxClustersInPair)
+	addClustersToPairs(testPair,pairs,distanceOK,maxClustersInPair);
+      // All combinations containing testPair found. Remove last element.
+      testPair.pop_back();
+    }
+  }
+}
+
+void MidPointAlgorithm::splitAndMerge(std::vector<Cluster>& stableCones, std::vector<Cluster>& jets)
+{
+  bool mergingNotFinished = true;
+  while(mergingNotFinished){
+    // Sort the stable cones (highest pt first).
+    sort(stableCones.begin(),stableCones.end(),ClusterPtGreater());
+    // Start with the highest pt cone.
+    std::vector<Cluster>::iterator stableConeIter1 = stableCones.begin();
+    if(stableConeIter1 == stableCones.end())   // Stable cone list empty?
+      mergingNotFinished = false;
+    else{
+      bool coneNotModified = true;
+      // Determine whether highest pt cone has an overlap with other stable cones.
+      std::vector<Cluster>::iterator stableConeIter2 = stableConeIter1;
+      stableConeIter2++;   // 2nd highest pt cone.
+      while(coneNotModified && stableConeIter2 != stableCones.end()){
+	// Calculate overlap of the two cones.
+	Cluster overlap;
+	for(std::vector<PhysicsTower>::iterator towerIter1 = stableConeIter1->towerList.begin();
+	    towerIter1 != stableConeIter1->towerList.end();
+	    towerIter1++){
+	  bool isInCone2 = false;
+	  for(std::vector<PhysicsTower>::iterator towerIter2 = stableConeIter2->towerList.begin();
+	      towerIter2 != stableConeIter2->towerList.end();
+	      towerIter2++)
+	    if(towerIter1->isEqual(*towerIter2))
+	      isInCone2 = true;
+	  if(isInCone2)
+	    overlap.addTower(*towerIter1);
+	}
+	if(overlap.size()){   // non-empty overlap
+	  coneNotModified = false;
+	  if(overlap.fourVector.pt() >= _overlapThreshold*stableConeIter2->fourVector.pt()){
+	    // Merge the two cones.
+	    for(std::vector<PhysicsTower>::iterator towerIter2 = stableConeIter2->towerList.begin();
+		towerIter2 != stableConeIter2->towerList.end();
+		towerIter2++){
+	      bool isInOverlap = false;
+	      for(std::vector<PhysicsTower>::iterator overlapTowerIter = overlap.towerList.begin();
+		  overlapTowerIter != overlap.towerList.end();
+		  overlapTowerIter++)
+		if(towerIter2->isEqual(*overlapTowerIter))
+		  isInOverlap = true;
+	      if(!isInOverlap)
+		stableConeIter1->addTower(*towerIter2);
+	    }
+	    // Remove the second cone.
+	    stableCones.erase(stableConeIter2);
+	  }
+	  else{
+	    // Separate the two cones.
+	    // Which particle goes where?
+	    std::vector<PhysicsTower> removeFromCone1,removeFromCone2;
+	    for(std::vector<PhysicsTower>::iterator towerIter = overlap.towerList.begin();
+		towerIter != overlap.towerList.end();
+		towerIter++){
+	      double towerRapidity = towerIter->fourVector.y();
+	      double towerPhi      = towerIter->fourVector.phi();
+	      // Calculate distance from cone 1.
+	      double dRapidity1 = fabs(towerRapidity - stableConeIter1->fourVector.y());
+	      double dPhi1      = fabs(towerPhi      - stableConeIter1->fourVector.phi());
+	      if(dPhi1 > M_PI)
+		dPhi1 = 2*M_PI - dPhi1;
+	      double dRJet1 = sqrt(dRapidity1*dRapidity1 + dPhi1*dPhi1);
+	      // Calculate distance from cone 2.
+	      double dRapidity2 = fabs(towerRapidity - stableConeIter2->fourVector.y());
+	      double dPhi2      = fabs(towerPhi      - stableConeIter2->fourVector.phi());
+	      if(dPhi2 > M_PI)
+		dPhi2 = 2*M_PI - dPhi2;
+	      double dRJet2 = sqrt(dRapidity2*dRapidity2 + dPhi2*dPhi2);
+	      if(dRJet1 < dRJet2)
+		// Particle is closer to cone 1. To be removed from cone 2.
+		removeFromCone2.push_back(*towerIter);
+	      else
+		// Particle is closer to cone 2. To be removed from cone 1.
+		removeFromCone1.push_back(*towerIter);
+	    }
+	    // Remove particles in the overlap region from the cones to which they have the larger distance.
+	    for(std::vector<PhysicsTower>::iterator towerIter = removeFromCone1.begin();
+		towerIter != removeFromCone1.end();
+		towerIter++)
+	      stableConeIter1->removeTower(*towerIter);
+	    for(std::vector<PhysicsTower>::iterator towerIter = removeFromCone2.begin();
+		towerIter != removeFromCone2.end();
+		towerIter++)
+	      stableConeIter2->removeTower(*towerIter);
+	  }
+	}
+	stableConeIter2++;
+      }
+      if(coneNotModified){
+	// Cone 1 has no overlap with any of the other cones and can become a jet.
+	jets.push_back(*stableConeIter1);
+	stableCones.erase(stableConeIter1);
+      }
+    }
+  }
+
+  sort(jets.begin(),jets.end(),ClusterPtGreater());
+}
+
+void MidPointAlgorithm::run(std::vector<PhysicsTower>& towers, std::vector<Cluster>& jets)
+{
+  std::vector<Cluster> stableCones;
+  findStableConesFromSeeds(towers,stableCones);
+  findStableConesFromMidPoints(towers,stableCones);
+  splitAndMerge(stableCones,jets);
+}
Index: /trunk/CDFCones/MidPointAlgorithm.hh
===================================================================
--- /trunk/CDFCones/MidPointAlgorithm.hh	(revision 2)
+++ /trunk/CDFCones/MidPointAlgorithm.hh	(revision 2)
@@ -0,0 +1,45 @@
+#ifndef _MIDPOINT_ALGORITHM_HH_
+#define _MIDPOINT_ALGORITHM_HH_
+
+#include "PhysicsTower.hh"
+#include "Cluster.hh"
+#include <vector>
+
+class MidPointAlgorithm
+{
+ private:
+  double _seedThreshold;
+  double _coneRadius;
+  double _coneAreaFraction;
+  int    _maxPairSize;
+  int    _maxIterations;
+  double _overlapThreshold;
+
+ public:
+  MidPointAlgorithm():
+    _seedThreshold(1),
+    _coneRadius(0.7),
+    _coneAreaFraction(0.25),
+    _maxPairSize(2),
+    _maxIterations(100),
+    _overlapThreshold(0.75)
+  {}
+  MidPointAlgorithm(double st, double cr, double caf, int mps, int mi, double ot):
+    _seedThreshold(st),
+    _coneRadius(cr),
+    _coneAreaFraction(caf),
+    _maxPairSize(mps),
+    _maxIterations(mi),
+    _overlapThreshold(ot)
+  {}
+  void findStableConesFromSeeds(std::vector<PhysicsTower>& particles, std::vector<Cluster>& stableCones);
+  void findStableConesFromMidPoints(std::vector<PhysicsTower>& particles, std::vector<Cluster>& stableCones);
+  void iterateCone(double startRapidity, double startPhi, double startPt, std::vector<PhysicsTower>& particles,
+		   std::vector<Cluster>& stableCones, bool reduceConeSize);
+  void addClustersToPairs(std::vector<int>& testPair, std::vector< std::vector<int> >& pairs,
+			  std::vector< std::vector<bool> >& distanceOK, int maxClustersInPair);
+  void splitAndMerge(std::vector<Cluster>& stableCones, std::vector<Cluster>& jets);
+  void run(std::vector<PhysicsTower>& particles, std::vector<Cluster>& jets);
+};
+
+#endif
Index: /trunk/CDFCones/PhysicsTower.cc
===================================================================
--- /trunk/CDFCones/PhysicsTower.cc	(revision 2)
+++ /trunk/CDFCones/PhysicsTower.cc	(revision 2)
@@ -0,0 +1,1 @@
+#include "PhysicsTower.hh"
Index: /trunk/CDFCones/PhysicsTower.hh
===================================================================
--- /trunk/CDFCones/PhysicsTower.hh	(revision 2)
+++ /trunk/CDFCones/PhysicsTower.hh	(revision 2)
@@ -0,0 +1,31 @@
+#ifndef _PHYSICS_TOWER_HH_
+#define _PHYSICS_TOWER_HH_
+
+#include "LorentzVector.hh"
+#include "CalTower.hh"
+
+class PhysicsTower
+{
+ public:
+
+  LorentzVector fourVector;
+  CalTower calTower;
+
+  PhysicsTower(): fourVector(LorentzVector()), calTower(CalTower()) {}
+  PhysicsTower(LorentzVector v, CalTower c): fourVector(v), calTower(c) {}
+  PhysicsTower(const PhysicsTower& p): fourVector(p.fourVector), calTower(p.calTower) {}
+  PhysicsTower(CalTower c):
+    fourVector(LorentzVector(c.Et*cos(c.phi),c.Et*sin(c.phi),c.Et*sinh(c.eta),c.Et*cosh(c.eta))), calTower(c) {}
+  PhysicsTower(LorentzVector v): fourVector(v), calTower(CalTower(v.Et(),v.eta(),v.phi())) {}
+  double Et()   const {return calTower.Et;}
+  double eta()  const {return calTower.eta;}
+  double phi()  const {return calTower.phi;}
+  int    iEta() const {return calTower.iEta;}
+  int    iPhi() const {return calTower.iPhi;}
+  bool isEqual(PhysicsTower p)
+  {
+    return fourVector.isEqual(p.fourVector) && calTower.isEqual(p.calTower);
+  }
+};
+
+#endif
Index: /trunk/ExRootAnalysis/ExRootAnalysis.h
===================================================================
--- /trunk/ExRootAnalysis/ExRootAnalysis.h	(revision 2)
+++ /trunk/ExRootAnalysis/ExRootAnalysis.h	(revision 2)
@@ -0,0 +1,71 @@
+#ifndef ExRootAnalysis_h
+#define ExRootAnalysis_h
+
+/** \class ExRootAnalysis
+ *
+ *  Analysis steering class.
+ *  Implements events loop and modules management.
+ *
+ *  $Date: 2008-06-04 13:57:23 $
+ *  $Revision: 1.1 $
+ *
+ *
+ *  \author P. Demin - UCL, Louvain-la-Neuve
+ *
+ */
+
+#include "ExRootAnalysis/ExRootTask.h"
+
+class TFile;
+class TFolder;
+class TObjArray;
+
+class ExRootConfReader;
+class ExRootTreeReader;
+class ExRootTreeWriter;
+
+class ExRootFactory;
+
+class ExRootAnalysis: public ExRootTask 
+{
+public:
+
+  ExRootAnalysis();
+  ~ExRootAnalysis();
+
+  void SetTclFileName(const char *name) { fTclFileName = name; }
+  void SetPDGFileName(const char *name) { fPDGFileName = name; }
+
+  Long64_t GetEntries() const;
+  Bool_t ReadEvent(Long64_t entry);
+
+  void Loop();
+
+  virtual void ProcessTask();
+
+  virtual void Init();
+  virtual void Process();
+  virtual void Finish();
+
+  virtual void Clear();
+
+private:
+
+  TFile *fTreeFile, *fInfoFile;
+  
+  Long64_t fAllEntries;
+
+  TString fTclFileName, fPDGFileName;
+
+  TObjArray *fChains;
+
+  ExRootTreeReader *fTreeReader;
+  ExRootTreeWriter *fTreeWriter;
+
+  ExRootFactory *fFactory;
+
+  ClassDef(ExRootAnalysis, 1)
+};
+
+#endif /* ExRootAnalysis_h */
+
Index: /trunk/ExRootAnalysis/ExRootCandList.h
===================================================================
--- /trunk/ExRootAnalysis/ExRootCandList.h	(revision 2)
+++ /trunk/ExRootAnalysis/ExRootCandList.h	(revision 2)
@@ -0,0 +1,160 @@
+#ifndef ExRootCandList_h
+#define ExRootCandList_h
+
+/** \class ExRootCandidate
+ *
+ *  A list of ExRootCandidates with iterators.
+ *
+ *  $Date: 2008-06-04 13:57:23 $
+ *  $Revision: 1.1 $
+ *
+ *
+ *  \author P. Demin - UCL, Louvain-la-Neuve
+ *
+ */
+
+#include "TNamed.h"
+
+#include "ExRootAnalysis/ExRootSortableObject.h"
+
+class TBrowser;
+class TObjArray;
+
+class ExRootCandList;
+class ExRootCandidate;
+class ExRootFactory;
+
+//------------------------------------------------------------------------------
+
+class ExRootCandIter
+{
+  friend class ExRootCandConstIter;
+
+public:
+
+  ExRootCandIter() : fArray(0), fCursor(0) { }
+  ExRootCandIter(TObjArray *array);
+  ExRootCandIter(ExRootCandList *object);
+  ExRootCandIter(const ExRootCandIter &iter);
+  ~ExRootCandIter() { }
+
+  ExRootCandIter &operator=(const ExRootCandIter &rhs);
+
+  ExRootCandidate *Next(Bool_t direction = kIterForward);
+  void Reset(Bool_t direction = kIterForward);
+
+private:
+
+    const TObjArray *fArray; // array being iterated
+  Int_t fCursor; // current position in array
+};
+
+//------------------------------------------------------------------------------
+
+class ExRootCandConstIter
+{
+public:
+
+  ExRootCandConstIter() : fArray(0), fCursor(0) { }
+  ExRootCandConstIter(const TObjArray *array);
+  ExRootCandConstIter(const ExRootCandList *object);
+  ExRootCandConstIter(const ExRootCandIter &iter);
+  ExRootCandConstIter(const ExRootCandConstIter &iter);
+  ~ExRootCandConstIter() { }
+
+  ExRootCandConstIter &operator=(const ExRootCandIter &rhs);
+  ExRootCandConstIter &operator=(const ExRootCandConstIter &rhs);
+
+  const ExRootCandidate *Next(Bool_t direction = kIterForward);
+  void Reset(Bool_t direction = kIterForward);
+
+private:
+
+  const TObjArray *fArray; // array being iterated
+  Int_t fCursor; // current position in array
+};
+
+//------------------------------------------------------------------------------
+
+class ExRootCandList: public TNamed
+{
+  friend class ExRootFactory;
+  friend class ExRootCandIter;
+  friend class ExRootCandConstIter;
+
+public:
+
+  ExRootCandList();
+
+  ExRootCandList(const ExRootCandList &object);
+
+  virtual ~ExRootCandList() {}
+
+  /** Add link to a candidate.
+    @param object -- pointer to ExRootCandidate instance
+    */
+  virtual void Add(ExRootCandidate *object);
+  virtual void Add(const ExRootCandidate *object);
+
+  /** Return number of candidates in this list.
+    @return number of candidates of type int
+    */
+  Int_t Size() const;
+
+  /** Return pointer to the i-th candidate of this candidate.
+    @return pointer to ExRootCandidate
+    */
+  const ExRootCandidate *At(Int_t i) const;
+
+  /** Return iterarator for the list of candidates.
+    @return iterarator of type ExRootCandConstIter
+    */
+  ExRootCandConstIter Iterator() const { return ExRootCandConstIter(fArray); }
+
+  /** Sorts candidates using an instance of a functor class
+    that inherits from ExRootCompare.
+    @param compare -- pointer to ExRootCompare
+    */
+  void Sort(ExRootCompare *compare);
+
+  /** Copy this candidate to object of type ExRootCandList.
+    @param object -- reference to TObject
+    */
+  virtual void Copy(TObject &object) const;
+
+  /** Make a clone of this list.
+    @return pointer to TObject
+    */
+  virtual TObject *Clone(const char *newname = "") const;
+
+  virtual void Clear();
+
+  /** Browse the list of candidates.
+    */
+  virtual void Browse(TBrowser *b);
+
+  /** Returns kTRUE in case candidate contains browsable objects.
+    @return value of type Bool_t
+    */
+  virtual Bool_t IsFolder() const { return kTRUE; }
+
+protected:
+
+  ExRootFactory *fFactory; //!
+
+private:
+
+  void SetFactory(ExRootFactory *factory) { fFactory = factory; }
+
+private:
+
+  /** array of daughters
+    */
+  TObjArray *fArray; //!
+
+  ClassDef(ExRootCandList, 1)
+};
+
+#endif /* ExRootCandList_h */
+
+
Index: /trunk/ExRootAnalysis/ExRootCandidate.h
===================================================================
--- /trunk/ExRootAnalysis/ExRootCandidate.h	(revision 2)
+++ /trunk/ExRootAnalysis/ExRootCandidate.h	(revision 2)
@@ -0,0 +1,246 @@
+#ifndef ExRootCandidate_h
+#define ExRootCandidate_h
+
+/** \class ExRootCandidate
+ *
+ *  Class implementing particle candidate model.
+ *
+ *  $Date: 2008-06-04 13:57:23 $
+ *  $Revision: 1.1 $
+ *
+ *
+ *  \author P. Demin - UCL, Louvain-la-Neuve
+ *
+ */
+
+#include "ExRootAnalysis/ExRootCandList.h"
+
+#include "ExRootAnalysis/ExRootSortableObject.h"
+
+#include "TNamed.h"
+#include "TLorentzVector.h"
+#include "TParticlePDG.h"
+
+#include <map>
+
+class TClass;
+class TBrowser;
+class TObjArray;
+class TParticlePDG;
+
+class ExRootFactory;
+
+//------------------------------------------------------------------------------
+
+class ExRootCandidate: public ExRootCandList
+{
+  friend class ExRootFactory;
+  friend class ExRootCandList;
+
+public:
+
+  ExRootCandidate();
+
+  ExRootCandidate(const ExRootCandidate &object);
+
+  virtual ~ExRootCandidate() {}
+
+  /** Return the charge of the candidate.
+    @return charge of type double
+    */
+  Double_t GetCharge() const { return fCharge; }
+
+  /** Assign charge to the candidate.
+    @param charge of type double
+    */
+  void SetCharge(Double_t charge) { fCharge = charge; }
+
+  /** Assign particle identification code.
+    @param particle -- pointer to TParticlePDG
+    */
+  void SetType(TParticlePDG *particle);
+
+  /** Assign particle identification code.
+    @param name -- particle name
+    */
+  void SetType(const char *name);
+
+  /** Assign particle identification code.
+    @param pdgCode -- particle code
+    */
+  void SetType(Int_t pdgCode);
+
+  /** Return particle identification informationn.
+    @return pointer to TParticlePDG
+    */
+  const TParticlePDG *GetType() const { return GetInfo<TParticlePDG>(); }
+
+  /** Assign mass to the candidate.
+    @param mass of type double
+    */
+  void SetMass(Double_t mass);
+
+  /** Assign momentum to the candidate (at constant mass).
+    @param momentum of type double
+    */
+  void SetMomentum(Double_t momentum);
+
+  /** Return the mass of the candidate.
+    @return mass of type double
+    */
+  Double_t GetMass() const;
+
+  /** Return the momentum 4-vector of the candidate.
+    @return momentum of type TLorentzVector
+    */
+  const TLorentzVector &GetP4() const { return fLorentzVector; }
+
+  /** Assign momentum 4-vector to the candidate.
+    @param momentum of type double
+    */
+
+  void SetP4(const TLorentzVector &p4);
+
+  //
+  // Genealogy
+  //
+
+  /** Return the direct mother of the candidate.
+    @return pointer to ExRootCandidate instance
+    */
+  const ExRootCandidate *Mother() const { return fMother; }
+
+  Bool_t IsComposite() const { return Size() > 0; }
+
+  Bool_t IsResonance() const { return fIsResonance; } // true when c*tau is very small (< 1nm)
+
+  void SetResonance(Bool_t flag = kTRUE) { fIsResonance = flag; }
+
+  //
+  // Check for overlap
+  //
+
+  /** Candidates overlap if they are identical (same pointers),
+    equal (same Base), clones (same UniqueID),
+    representing a same reconstructed object,
+    or having daughters that are overlapping
+    @param object -- pointer to ExRootCandidate
+    @return value of type Bool_t
+    */
+  Bool_t Overlaps(const ExRootCandidate *object) const;
+
+  /** Candidates are equal if they are clones (same UniqueID),
+    and all their daughters are equal
+    @param object -- pointer to ExRootCandidate
+    @return value of type Bool_t
+    */
+  Bool_t Equals(const ExRootCandidate *object) const;
+
+  /** Candidates are clones if they have same UniqueID,
+    same particle identification code and
+    if they are compisite or non-composite in the same time.
+    @param object -- pointer to ExRootCandidate
+    @return value of type Bool_t
+    */
+  Bool_t IsCloneOf(const ExRootCandidate *object, Bool_t checkType = kFALSE) const;
+
+  /** Return pointer to the first clone of a candidate given as parameter
+    found in the decay tree of this candidate.
+    @param object -- pointer to ExRootCandidate
+    @return pointer to ExRootCandidate
+    */
+  const ExRootCandidate *FindCloneInTree(const ExRootCandidate *object) const;
+
+  //
+  // Accessors to specific information (reconstruction, Monte-Carlo, fit parameters)
+  //
+
+  /** Return additional information for this candiate
+    in form of instance of class T.
+    @return pointer to instance of class T
+    */
+  template<typename T>
+  const T *GetInfo() const { return dynamic_cast<const T *>(GetInfo(T::Class())); }
+
+  template<typename T>
+  T *GetInfo() { return dynamic_cast<T *>(GetInfo(T::Class())); }
+
+  /** Return additional information for this candiate
+    in form of instance of a given class.
+    @param cl -- pointer to TClass
+    @return pointer to TObject
+    */
+  const TObject *GetInfo(const TClass *cl) const;
+
+  TObject *GetInfo(const TClass *cl);
+
+  /** Add additional information for this candiate
+    @param info -- pointer to an object with additional information to be attched to this candidate
+    */
+  void SetInfo(TObject *info);
+
+  /** Add link to a daughter of the candidate.
+    @param object -- pointer to ExRootObject instance
+    */
+  virtual void Add(ExRootCandidate *object);
+  virtual void Add(const ExRootCandidate *object);
+
+  void AddDaughter(ExRootCandidate *object);
+  void AddDaughter(const ExRootCandidate *object);
+
+  /** Copy this candidate to object of type ExRootCandidate.
+    @param object -- reference to TObject
+    */
+  virtual void Copy(TObject &object) const;
+
+  /** Make a clone of this candidate.
+    @return pointer to TObject
+    */
+  virtual TObject *Clone(const char *newname = "") const;
+
+  virtual void Clear();
+
+  /** Browse candidate.
+    */
+  virtual void Browse(TBrowser *b);
+
+  /** Returns kTRUE in case candidate contains browsable objects.
+    @return value of type Bool_t
+    */
+  virtual Bool_t IsFolder() const { return kTRUE; }
+
+  /** Returns kTRUE in case this candidate is sortable.
+    @return value of type Bool_t
+    */
+  virtual Bool_t IsSortable() const { return fgCompare ? fgCompare->IsSortable(this) : kFALSE; }
+
+  /** Calls Compare method of an instance of a functor class that inherits from ExRootCompare.
+    @return -1 if this is smaller than obj, 0 if candidates are equal and 1 if this is larger than obj.
+    */
+  virtual Int_t Compare(const TObject *obj) const { return fgCompare->Compare(this, obj); }
+
+private:
+
+  /**  resonance flag
+    */
+  Bool_t fIsResonance; //
+
+  /** electrical charge
+    */
+  Double_t fCharge; //
+
+  TLorentzVector fLorentzVector; //
+
+  /** pointer to mother candidate
+    */
+  ExRootCandidate *fMother; //!
+
+  static ExRootCompare *fgCompare; //!
+
+  std::map<const TClass *, TObject *> fInfo;
+
+  ClassDef(ExRootCandidate, 1)
+};
+
+#endif /* ExRootCandidate_h */
+
Index: /trunk/ExRootAnalysis/ExRootClasses.h
===================================================================
--- /trunk/ExRootAnalysis/ExRootClasses.h	(revision 2)
+++ /trunk/ExRootAnalysis/ExRootClasses.h	(revision 2)
@@ -0,0 +1,378 @@
+#ifndef ExRootClasses_h
+#define ExRootClasses_h
+
+/** \class ExRootClasses
+ *
+ *  Definition of classes to be stored in the root tree.
+ *  Function ExRootCompareXYZ sorts objects by the variable XYZ that MUST be
+ *  present in the data members of the root tree class of the branch.
+ *
+ *  $Date: 2008-06-04 13:57:24 $
+ *  $Revision: 1.1 $
+ *
+ *
+ *  \author P. Demin - UCL, Louvain-la-Neuve
+ *
+ */
+
+// Dependencies (#includes)
+
+#include "TRef.h"
+#include "TObject.h"
+#include "TRefArray.h"
+
+#include "ExRootAnalysis/ExRootSortableObject.h"
+
+//---------------------------------------------------------------------------
+
+class ExRootLHEFEvent: public TObject
+{
+public:
+
+  Long64_t Number; // event number
+
+  Int_t Nparticles; // number of particles in the event | hepup.NUP
+  Int_t ProcessID; // subprocess code for the event | hepup.IDPRUP
+
+  Double_t Weight; // weight for the event | hepup.XWGTUP
+  Double_t ScalePDF; // scale in GeV used in the calculation of the PDFs in the event | hepup.SCALUP
+  Double_t CouplingQED; // value of the QED coupling used in the event | hepup.AQEDUP
+  Double_t CouplingQCD; // value of the QCD coupling used in the event | hepup.AQCDUP
+
+  ClassDef(ExRootLHEFEvent, 2)
+};
+
+//---------------------------------------------------------------------------
+
+class ExRootLHEFParticle: public ExRootSortableObject
+{
+public:
+
+  Int_t PID; // particle HEP ID number | hepup.IDUP[number]
+  Int_t Status; // particle status code | hepup.ISTUP[number]
+  Int_t Mother1; // index for the particle first mother | hepup.MOTHUP[number][0]
+  Int_t Mother2; // index for the particle last mother | hepup.MOTHUP[number][1]
+  Int_t ColorLine1; // index for the particle color-line | hepup.ICOLUP[number][0]
+  Int_t ColorLine2; // index for the particle anti-color-line | hepup.ICOLUP[number][1]
+
+  Double_t Px; // particle momentum vector (x component) | hepup.PUP[number][0]
+  Double_t Py; // particle momentum vector (y component) | hepup.PUP[number][1]
+  Double_t Pz; // particle momentum vector (z component) | hepup.PUP[number][2]
+  Double_t E; // particle energy | hepup.PUP[number][3]
+  Double_t M; // particle mass | hepup.PUP[number][4]
+
+  Double_t PT; // particle transverse momentum
+  Double_t Eta; // particle pseudorapidity
+  Double_t Phi; // particle azimuthal angle
+
+  Double_t Rapidity; // particle rapidity
+
+  Double_t LifeTime; // particle invariant lifetime
+                     // (c*tau, distance from production to decay in mm)
+                     // | hepup.VTIMUP[number]
+
+  Double_t Spin; // cosine of the angle between the particle spin vector
+                 // and the decaying particle 3-momentum,
+                 // specified in the lab frame. | hepup.SPINUP[number]
+
+  static ExRootCompare *fgCompare; //!
+  const ExRootCompare *GetCompare() const { return fgCompare; }
+
+  ClassDef(ExRootLHEFParticle, 2)
+};
+
+//---------------------------------------------------------------------------
+
+class ExRootGenEvent: public TObject
+{
+public:
+
+  Long64_t Number; // event number | hepevt.nevhep
+
+  ClassDef(ExRootGenEvent, 1)
+};
+
+//---------------------------------------------------------------------------
+
+class ExRootGenParticle: public ExRootSortableObject
+{
+public:
+  Int_t PID; // particle HEP ID number | hepevt.idhep[number]
+  Int_t Status; // particle status | hepevt.isthep[number]
+  Int_t M1; // particle 1st mother | hepevt.jmohep[number][0] - 1
+  Int_t M2; // particle 2nd mother | hepevt.jmohep[number][1] - 1
+  Int_t D1; // particle 1st daughter | hepevt.jdahep[number][0] - 1
+  Int_t D2; // particle 2nd daughter | hepevt.jdahep[number][1] - 1
+
+  Double_t E; // particle energy | hepevt.phep[number][3]
+  Double_t Px; // particle momentum vector (x component) | hepevt.phep[number][0]
+  Double_t Py; // particle momentum vector (y component) | hepevt.phep[number][1]
+  Double_t Pz; // particle momentum vector (z component) | hepevt.phep[number][2]
+
+  Double_t PT; // particle transverse momentum
+  Double_t Eta; // particle pseudorapidity
+  Double_t Phi; // particle azimuthal angle
+
+  Double_t Rapidity; // particle rapidity
+
+  Double_t T; // particle vertex position (t component) | hepevt.vhep[number][3]
+  Double_t X; // particle vertex position (x component) | hepevt.vhep[number][0]
+  Double_t Y; // particle vertex position (y component) | hepevt.vhep[number][1]
+  Double_t Z; // particle vertex position (z component) | hepevt.vhep[number][2]
+
+  static ExRootCompare *fgCompare; //!
+  const ExRootCompare *GetCompare() const { return fgCompare; }
+
+  ClassDef(ExRootGenParticle, 1)
+};
+
+//---------------------------------------------------------------------------
+
+class ExRootGenJet: public ExRootSortableObject
+{
+public:
+
+  Double_t E; // jet energy
+  Double_t Px; // jet momentum vector (x component)
+  Double_t Py; // jet momentum vector (y component)
+  Double_t Pz; // jet momentum vector (z component)
+
+  Double_t PT; // jet transverse momentum
+  Double_t Eta; // jet pseudorapidity
+  Double_t Phi; // jet azimuthal angle
+
+  Double_t Rapidity; // jet rapidity
+
+  Double_t Mass; // jet invariant mass
+
+  static ExRootCompare *fgCompare; //!
+  const ExRootCompare *GetCompare() const { return fgCompare; }
+
+  ClassDef(ExRootGenJet, 1)
+};
+
+//---------------------------------------------------------------------------
+
+class ExRootMatching: public TObject
+{
+public:
+  Double_t DMerge;
+  Double_t YMerge;
+
+  ClassDef(ExRootMatching, 1)
+};
+
+//---------------------------------------------------------------------------
+
+class ExRootGenMatch: public TObject
+{
+public:
+
+  Double_t Npart;
+  Double_t Qjet1;
+  Double_t Qjet2;
+  Double_t Qjet3;
+  Double_t Qjet4;
+  Double_t Ptcjet1;
+  Double_t Ptcjet2;
+  Double_t Ptcjet3;
+  Double_t Ptcjet4;
+  Double_t Etacjet1;
+  Double_t Etacjet2;
+  Double_t Etacjet3;
+  Double_t Etacjet4;
+  Double_t Phicjet1;
+  Double_t Phicjet2;
+  Double_t Phicjet3;
+  Double_t Phicjet4;
+  Double_t Ptjet1;
+  Double_t Ptjet2;
+  Double_t Ptjet3;
+  Double_t Ptjet4;
+  Double_t Etajet1;
+  Double_t Etajet2;
+  Double_t Etajet3;
+  Double_t Etajet4;
+  Double_t Phijet1;
+  Double_t Phijet2;
+  Double_t Phijet3;
+  Double_t Phijet4;
+  Double_t Idres1;
+  Double_t Ptres1;
+  Double_t Etares1;
+  Double_t Phires1;
+  Double_t Idres2;
+  Double_t Ptres2;
+  Double_t Etares2;
+  Double_t Phires2;
+  Double_t Ptlep1;
+  Double_t Etmiss;
+  Double_t Htjets;
+  Double_t Ptb;
+  Double_t Etab;
+  Double_t Ptbbar;
+  Double_t Etabbar;
+  Double_t Ptbj;
+  Double_t Etabj;
+  Double_t Qpar1;
+  Double_t Qpar2;
+  Double_t Qpar3;
+  Double_t Qpar4;
+  Double_t Ptpar1;
+  Double_t Ptpar2;
+  Double_t Ptpar3;
+  Double_t Ptpar4;
+  Double_t Ncjets;
+  Double_t Njets;
+  Double_t Nfile;
+  Double_t Nclus;
+
+  ClassDef(ExRootGenMatch, 1)
+};
+
+//---------------------------------------------------------------------------
+
+class ExRootEvent: public TObject
+{
+public:
+
+  Long64_t Number; // event number
+  Int_t Trigger; // trigger word
+
+  ClassDef(ExRootEvent, 1)
+};
+
+//---------------------------------------------------------------------------
+
+class ExRootMissingET: public TObject
+{
+public:
+  Double_t MET; // mising transverse energy
+  Double_t Phi; // mising energy azimuthal angle
+
+  ClassDef(ExRootMissingET, 1)
+};
+
+//---------------------------------------------------------------------------
+
+class ExRootPhoton: public ExRootSortableObject
+{
+public:
+
+  Double_t PT; // photon transverse momentum
+  Double_t Eta; // photon pseudorapidity
+  Double_t Phi; // photon azimuthal angle
+
+  Double_t EhadOverEem; // ratio of the hadronic versus electromagnetic energy
+                        // deposited in the calorimeter
+
+  static ExRootCompare *fgCompare; //!
+  const ExRootCompare *GetCompare() const { return fgCompare; }
+
+  ClassDef(ExRootPhoton, 2)
+};
+
+//---------------------------------------------------------------------------
+
+class ExRootElectron: public ExRootSortableObject
+{
+public:
+
+  Double_t PT; // electron transverse momentum
+  Double_t Eta; // electron pseudorapidity
+  Double_t Phi; // electron azimuthal angle
+
+  Double_t Charge; // electron charge
+
+  Double_t Ntrk; // number of tracks associated with the electron
+
+  Double_t EhadOverEem; // ratio of the hadronic versus electromagnetic energy
+                        // deposited in the calorimeter
+
+  static ExRootCompare *fgCompare; //!
+  const ExRootCompare *GetCompare() const { return fgCompare; }
+
+  ClassDef(ExRootElectron, 2)
+};
+
+//---------------------------------------------------------------------------
+
+class ExRootMuon: public ExRootSortableObject
+{
+public:
+
+  Double_t PT; // muon transverse momentum
+  Double_t Eta; // muon pseudorapidity
+  Double_t Phi; // muon azimuthal angle
+
+  Double_t Charge; // muon charge
+
+  Double_t Ntrk; // number of tracks associated with the muon
+
+  Double_t PTiso; // sum of tracks transverse momentum within a cone of radius R=0.4
+                  // centered on the muon (excluding the muon itself)
+
+  Double_t ETiso; // ratio of ET in a 3x3 calorimeter cells array around the muon
+                  // (including the muon's cell) to the muon PT
+
+  Int_t JetIndex; // index of the closest jet
+
+  static ExRootCompare *fgCompare; //!
+  const ExRootCompare *GetCompare() const { return fgCompare; }
+
+  ClassDef(ExRootMuon, 2)
+};
+
+//---------------------------------------------------------------------------
+
+class ExRootTau: public ExRootSortableObject
+{
+public:
+
+  Double_t PT; // tau transverse momentum
+  Double_t Eta; // tau pseudorapidity
+  Double_t Phi; // tau azimuthal angle
+
+  Double_t Charge; // tau charge
+
+  Double_t Ntrk; // number of charged tracks associated with the tau
+
+  Double_t EhadOverEem; // ratio of the hadronic versus electromagnetic energy
+                        // deposited in the calorimeter
+
+  static ExRootCompare *fgCompare; //!
+  const ExRootCompare *GetCompare() const { return fgCompare; }
+
+  ClassDef(ExRootTau, 2)
+};
+
+//---------------------------------------------------------------------------
+
+class ExRootJet: public ExRootSortableObject
+{
+public:
+
+  Double_t PT; // jet transverse momentum
+  Double_t Eta; // jet pseudorapidity
+  Double_t Phi; // jet azimuthal angle
+
+  Double_t Mass; // jet invariant mass
+
+  Double_t Ntrk; // number of tracks associated with the jet
+
+  Double_t BTag; // 1 or 2 for a jet that has been tagged as containing a heavy quark
+
+  Double_t EhadOverEem; // ratio of the hadronic versus electromagnetic energy
+                        // deposited in the calorimeter
+
+  Int_t Index; // jet index in the LHC Olympics file
+
+  static ExRootCompare *fgCompare; //!
+  const ExRootCompare *GetCompare() const { return fgCompare; }
+
+  ClassDef(ExRootJet, 2)
+};
+
+#endif // ExRootClasses_h
+
+
Index: /trunk/ExRootAnalysis/ExRootClassifier.h
===================================================================
--- /trunk/ExRootAnalysis/ExRootClassifier.h	(revision 2)
+++ /trunk/ExRootAnalysis/ExRootClassifier.h	(revision 2)
@@ -0,0 +1,17 @@
+#ifndef ExRootClassifier_h
+#define ExRootClassifier_h
+
+#include <Rtypes.h>
+
+class TObject;
+
+class ExRootClassifier
+{
+public:
+  virtual ~ExRootClassifier() {}
+  virtual Int_t GetCategory(TObject *object) = 0;
+
+};
+
+#endif /* ExRootClassifier */
+
Index: /trunk/ExRootAnalysis/ExRootConfReader.h
===================================================================
--- /trunk/ExRootAnalysis/ExRootConfReader.h	(revision 2)
+++ /trunk/ExRootAnalysis/ExRootConfReader.h	(revision 2)
@@ -0,0 +1,79 @@
+#ifndef ExRootConfReader_h
+#define ExRootConfReader_h
+
+/** \class ExRootConfReader
+ *
+ *  Class handling output ROOT tree
+ *
+ *  $Date: 2008-06-04 13:57:24 $
+ *  $Revision: 1.1 $
+ *
+ *
+ *  \author P. Demin - UCL, Louvain-la-Neuve
+ *
+ */
+
+#include "TNamed.h"
+
+#include <map>
+#include <utility>
+
+struct Tcl_Obj;
+struct Tcl_Interp;
+
+class ExRootConfParam
+{
+public:
+
+  ExRootConfParam(const char *name = 0, Tcl_Obj *object = 0, Tcl_Interp *interp = 0);
+
+  int GetInt(int defaultValue = 0);
+  long GetLong(long defaultValue = 0);
+  double GetDouble(double defaultValue = 0.0);
+  bool GetBool(bool defaultValue = false);
+  const char *GetString(const char *defaultValue = "");
+
+  int GetSize();
+  ExRootConfParam operator[](int index);
+
+private:
+
+  const char *fName;
+  Tcl_Obj *fObject;
+  Tcl_Interp *fTclInterp;
+};
+
+//------------------------------------------------------------------------------
+
+class ExRootConfReader : public TNamed
+{
+public:
+  typedef std::map<TString, TString> ExRootTaskMap;
+
+  ExRootConfReader();
+  ~ExRootConfReader();
+
+  void ReadFile(const char *fileName);
+
+  int GetInt(const char *name, int defaultValue, int index = -1);
+  long GetLong(const char *name, long defaultValue, int index = -1);
+  double GetDouble(const char *name, double defaultValue, int index = -1);
+  bool GetBool(const char *name, bool defaultValue, int index = -1);
+  const char *GetString(const char *name, const char *defaultValue, int index = -1);
+  ExRootConfParam GetParam(const char *name);
+
+  const ExRootTaskMap *GetModules() const { return &fModules; }
+
+  void AddModule(const char *className, const char *moduleName);
+
+private:
+
+  Tcl_Interp *fTclInterp;
+
+  ExRootTaskMap fModules;
+
+  ClassDef(ExRootConfReader, 1)
+};
+
+#endif
+
Index: /trunk/ExRootAnalysis/ExRootEventLoop.h
===================================================================
--- /trunk/ExRootAnalysis/ExRootEventLoop.h	(revision 2)
+++ /trunk/ExRootAnalysis/ExRootEventLoop.h	(revision 2)
@@ -0,0 +1,54 @@
+#ifndef ExRootEventLoop_h
+#define ExRootEventLoop_h
+
+/** \class ExRootEventLoop
+ *
+ *  Analysis steering class.
+ *  Implements events loop and modules management.
+ *
+ *  $Date: 2008-06-04 13:57:24 $
+ *  $Revision: 1.1 $
+ *
+ *
+ *  \author P. Demin - UCL, Louvain-la-Neuve
+ *
+ */
+
+#include "ExRootAnalysis/ExRootModule.h"
+
+class TTask;
+class TFile;
+class TFolder;
+class TObjArray;
+
+class ExRootTreeReader;
+
+class ExRootEventLoop: public ExRootModule
+{
+public:
+
+  ExRootEventLoop();
+  ~ExRootEventLoop();
+
+  Long64_t GetEntries();
+  Bool_t ReadEvent(Long64_t entry);
+
+  virtual void Init();
+  virtual void Process();
+  virtual void Finish();
+
+  virtual void Clear();
+
+private:
+
+  Long64_t fAllEntries;
+
+  ExRootTask *fEventLoop;
+
+  TObjArray *fChains;
+
+  ClassDef(ExRootEventLoop, 1)
+};
+
+#endif /* ExRootEventLoop_h */
+
Index: /trunk/ExRootAnalysis/ExRootFactory.h
===================================================================
--- /trunk/ExRootAnalysis/ExRootFactory.h	(revision 2)
+++ /trunk/ExRootAnalysis/ExRootFactory.h	(revision 2)
@@ -0,0 +1,72 @@
+#ifndef ExRootFactory_h
+#define ExRootFactory_h
+
+/** \class ExRootFactory
+ *
+ *  Class handling creation of ExRootCandidate,
+ *  ExRootCandList and all other objects.
+ *
+ *  $Date: 2008-06-04 13:57:25 $
+ *  $Revision: 1.1 $
+ *
+ *
+ *  \author P. Demin - UCL, Louvain-la-Neuve
+ *
+ */
+
+#include "TNamed.h"
+
+#include <map>
+#include <set>
+
+class TObjArray;
+
+class ExRootTreeBranch;
+class ExRootTreeWriter;
+
+class ExRootCandList;
+class ExRootCandidate;
+
+class ExRootFactory: public TNamed
+{
+public:
+  
+  ExRootFactory();
+  ~ExRootFactory();
+
+  void Clear();
+
+  TObjArray *NewArray();
+
+  TObjArray *NewPermanentArray();
+
+  ExRootCandList *NewCandList();
+  ExRootCandidate *NewCandidate();
+
+  ExRootCandList *NewPermanentCandList();
+  ExRootCandidate *NewPermanentCandidate();
+
+  TObject *New(TClass *cl);
+
+  template<typename T>
+  T *New() { return static_cast<T *>(New(T::Class())); }
+
+
+private:
+
+  ExRootTreeWriter *fTreeWriter; //!
+
+  ExRootTreeBranch *fPermanentObjArrays; //!
+
+  ExRootTreeBranch *fPermanentCandLists; //!
+
+  ExRootTreeBranch *fPermanentCandidates; //!
+
+  std::map<const TClass *, ExRootTreeBranch *> fMakers; //!
+  std::set<TObject *> fPool; //!
+
+  ClassDef(ExRootFactory, 1)
+};
+
+#endif /* ExRootFactory */
+
Index: /trunk/ExRootAnalysis/ExRootFilter.h
===================================================================
--- /trunk/ExRootAnalysis/ExRootFilter.h	(revision 2)
+++ /trunk/ExRootAnalysis/ExRootFilter.h	(revision 2)
@@ -0,0 +1,38 @@
+#ifndef ExRootFilter_h
+#define ExRootFilter_h
+
+#include "Rtypes.h"
+
+#include <map>
+
+class ExRootClassifier;
+class TSeqCollection;
+class TObjArray;
+class TIterator;
+
+class ExRootFilter
+{
+public:
+  class FilterExeption{};
+
+  ExRootFilter(const TSeqCollection *collection);
+  ~ExRootFilter();
+
+  void Reset(ExRootClassifier *classifier = 0);
+
+  TObjArray *GetSubArray(ExRootClassifier *classifier, Int_t category);
+
+private:
+
+  typedef std::map<Int_t, TObjArray*> TCategoryMap;
+  typedef std::map<ExRootClassifier*, std::pair<Bool_t, TCategoryMap> > TClassifierMap;
+
+  const TSeqCollection *fCollection;
+  TIterator *fIter;
+
+  TClassifierMap fMap;
+
+};
+
+#endif /* ExRootFilter */
+
Index: /trunk/ExRootAnalysis/ExRootModule.h
===================================================================
--- /trunk/ExRootAnalysis/ExRootModule.h	(revision 2)
+++ /trunk/ExRootAnalysis/ExRootModule.h	(revision 2)
@@ -0,0 +1,73 @@
+#ifndef ExRootModule_h
+#define ExRootModule_h
+
+/** \class ExRootModule
+ *
+ *  Base class for analysis modules
+ *
+ *  $Date: 2008-06-04 13:57:25 $
+ *  $Revision: 1.1 $
+ *
+ *
+ *  \author P. Demin - UCL, Louvain-la-Neuve
+ *
+ */
+
+#include "ExRootAnalysis/ExRootTask.h"
+
+class TClass;
+class TObject;
+class TFolder;
+class TClonesArray;
+
+class ExRootResult;
+class ExRootTreeBranch;
+class ExRootTreeReader;
+class ExRootTreeWriter;
+
+class ExRootFactory;
+
+class ExRootModule: public ExRootTask 
+{
+public:
+
+  ExRootModule();
+  ~ExRootModule();
+
+  virtual void Init();
+  virtual void Process();
+  virtual void Finish();
+
+  const TObjArray *ImportArray(const char *name);
+  TObjArray *ExportArray(const char *name);
+
+  TClonesArray *UseBranch(const char *name);
+
+  ExRootTreeBranch *NewBranch(const char *name, TClass *cl);
+
+  ExRootResult *GetPlots();
+  ExRootFactory *GetFactory();
+  ExRootTreeReader *GetTreeReader();
+
+
+protected:
+
+  ExRootTreeReader *fTreeReader;
+  ExRootTreeWriter *fTreeWriter;
+
+  ExRootFactory *fFactory;
+
+private:
+
+  TFolder *NewFolder(const char *name);
+  TObject *GetObject(const char *name, TClass *cl);
+
+  ExRootResult *fPlots;
+
+  TFolder *fPlotFolder, *fExportFolder;
+
+  ClassDef(ExRootModule, 1)
+};
+
+#endif /* ExRootModule_h */
+
Index: /trunk/ExRootAnalysis/ExRootProgressBar.h
===================================================================
--- /trunk/ExRootAnalysis/ExRootProgressBar.h	(revision 2)
+++ /trunk/ExRootAnalysis/ExRootProgressBar.h	(revision 2)
@@ -0,0 +1,29 @@
+#ifndef ExRootProgressBar_h
+#define ExRootProgressBar_h
+
+#include "Rtypes.h"
+
+class ExRootProgressBar
+{
+public:
+
+  ExRootProgressBar(Long64_t entries, Int_t width = 25);
+  ~ExRootProgressBar();
+
+  void Update(Long64_t entry);
+  void Finish();
+
+private:
+
+  Long64_t fEntries;
+  Int_t fWidth;
+
+  ULong_t fTime;
+  Int_t fHashes;
+
+  char *fBar;
+
+};
+
+#endif /* ExRootProgressBar */
+
Index: /trunk/ExRootAnalysis/ExRootResult.h
===================================================================
--- /trunk/ExRootAnalysis/ExRootResult.h	(revision 2)
+++ /trunk/ExRootAnalysis/ExRootResult.h	(revision 2)
@@ -0,0 +1,91 @@
+#ifndef ExRootResult_h
+#define ExRootResult_h
+
+#include "Rtypes.h"
+#include "Gtypes.h"
+#include "TMath.h"
+
+#include <set>
+#include <map>
+
+class TH1;
+class TH2;
+class THStack;
+class TCanvas;
+class TLegend;
+class TProfile;
+class TPaveText;
+class TObjArray;
+class TFolder;
+
+class ExRootResult
+{
+
+public:
+
+  ExRootResult();
+  ~ExRootResult();
+
+  void Reset();
+  void Write(const char *fileName = "results.root");
+  void Print(const char *format = "eps");
+
+  TH1 *AddHist1D(const char *name, const char *title,
+                 const char *xlabel, const char *ylabel,
+                 Int_t nxbins, Axis_t xmin, Axis_t xmax,
+                 Int_t logx = 0, Int_t logy = 0);
+
+  TH1 *AddHist1D(const char *name, const char *title,
+                 const char *xlabel, const char *ylabel,
+                 Int_t nxbins, const Float_t *bins,
+                 Int_t logx = 0, Int_t logy = 0);
+
+  TProfile *AddProfile(const char *name, const char *title,
+                       const char *xlabel, const char *ylabel,
+                       Int_t nxbins, Axis_t xmin, Axis_t xmax,
+                       Int_t logx = 0, Int_t logy = 0);
+
+  TH2 *AddHist2D(const char *name, const char *title,
+                 const char *xlabel, const char *ylabel,
+                 Int_t nxbins, Axis_t xmin, Axis_t xmax,
+                 Int_t nybins, Axis_t ymin, Axis_t ymax,
+                 Int_t logx = 0, Int_t logy = 0);
+
+  THStack *AddHistStack(const char *name, const char *title);
+
+  TLegend *AddLegend(Double_t x1, Double_t y1, Double_t x2, Double_t y2);
+
+  TPaveText *AddComment(Double_t x1, Double_t y1, Double_t x2, Double_t y2);
+
+  void Attach(TObject *plot, TObject *object);
+
+  TCanvas *GetCanvas();
+
+  void PrintPlot(TObject *plot, const char *sufix = "",  const char *format = "eps");
+
+  void SetFolder(TFolder *folder) { fFolder = folder; }
+
+private:
+
+  struct PlotSettings
+  {
+    Int_t logx;
+    Int_t logy;
+  };
+
+  void CreateCanvas();
+
+  TCanvas *fCanvas; //!
+
+  std::set<TObject*> fPool; //!
+  
+  std::map<TObject*, TObjArray*> fPlots; //!
+
+  std::map<TObject*, ExRootResult::PlotSettings> fSettings; //!
+
+  TFolder *fFolder; //!
+
+};
+
+#endif /* ExRootResult_h */
+
Index: /trunk/ExRootAnalysis/ExRootSortableObject.h
===================================================================
--- /trunk/ExRootAnalysis/ExRootSortableObject.h	(revision 2)
+++ /trunk/ExRootAnalysis/ExRootSortableObject.h	(revision 2)
@@ -0,0 +1,189 @@
+#ifndef ExRootSortableObject_h
+#define ExRootSortableObject_h
+
+/** \class ExRootSortableObject
+ *
+ *
+ *  $Date: 2008-06-04 13:57:26 $
+ *  $Revision: 1.1 $
+ *
+ *
+ *  \author P. Demin - UCL, Louvain-la-Neuve
+ *
+ */
+
+// Dependencies (#GetCompare)
+
+#include "TRef.h"
+#include "TObject.h"
+#include "TRefArray.h"
+
+#include "TMath.h"
+
+//---------------------------------------------------------------------------
+
+class ExRootCompare
+{
+public:
+  virtual Bool_t IsSortable(const TObject *obj) const { return kTRUE; }
+  virtual Int_t Compare(const TObject *obj1, const TObject *obj2) const = 0;
+};
+
+//---------------------------------------------------------------------------
+
+class ExRootSortableObject: public TObject
+{
+public:
+
+  Bool_t IsSortable() const { return GetCompare() ? GetCompare()->IsSortable(this) : kFALSE; }
+  Int_t Compare(const TObject *obj) const { return GetCompare()->Compare(this, obj); }
+
+  virtual const ExRootCompare *GetCompare() const = 0;
+
+  ClassDef(ExRootSortableObject, 1)
+};
+
+//---------------------------------------------------------------------------
+// Standard Comparison Criteria: E, ET, PT, DeltaR
+//---------------------------------------------------------------------------
+
+template <typename T>
+class ExRootCompareE: public ExRootCompare
+{
+  ExRootCompareE() {}
+public:
+  static ExRootCompareE *Instance()
+  {
+    static ExRootCompareE single;
+    return &single;
+  }
+
+  Int_t Compare(const TObject *obj1, const TObject *obj2) const
+  {
+    const T *t1 = static_cast<const T*>(obj1);
+    const T *t2 = static_cast<const T*>(obj2);
+    if(t1->E > t2->E)
+      return -1;
+    else if(t1->E < t2->E)
+      return 1;
+    else
+      return 0;
+  }
+};
+
+//---------------------------------------------------------------------------
+
+template <typename T>
+class ExRootComparePT: public ExRootCompare
+{
+  ExRootComparePT() {}
+public:
+  static ExRootComparePT *Instance()
+  {
+    static ExRootComparePT single;
+    return &single;
+  }
+
+  Int_t Compare(const TObject *obj1, const TObject *obj2) const
+  {
+    const T *t1 = static_cast<const T*>(obj1);
+    const T *t2 = static_cast<const T*>(obj2);
+    if(t1->PT > t2->PT)
+      return -1;
+    else if(t1->PT < t2->PT)
+      return 1;
+    else
+      return 0;
+  }
+};
+
+//---------------------------------------------------------------------------
+
+template <typename T>
+class ExRootCompareET: public ExRootCompare
+{
+  ExRootCompareET() {}
+public:
+  static ExRootCompareET *Instance()
+  {
+    static ExRootCompareET single;
+    return &single;
+  }
+
+  Int_t Compare(const TObject *obj1, const TObject *obj2) const
+  {
+    const T *t1 = static_cast<const T*>(obj1);
+    const T *t2 = static_cast<const T*>(obj2);
+    if(t1->ET > t2->ET)
+      return -1;
+    else if(t1->ET < t2->ET)
+      return 1;
+    else
+      return 0;
+  }
+};
+
+//---------------------------------------------------------------------------
+
+template <typename T1, typename T2>
+class ExRootCompareDeltaR: public ExRootCompare
+{
+  ExRootCompareDeltaR(const T2 *obj = 0) : fObj(obj) {}
+
+  Double_t DeltaPhi(Double_t phi1, Double_t phi2)
+  {
+    Double_t phi = TMath::Abs(phi1 - phi2);
+    return (phi <= TMath::Pi()) ? phi : (2.0*TMath::Pi()) - phi;
+  }
+
+  Double_t Sqr(Double_t x) { return x*x; }
+
+  Double_t SumSqr(Double_t a, Double_t b)
+  {
+    Double_t aAbs = TMath::Abs(a);
+    Double_t bAbs = TMath::Abs(b);
+    if(aAbs > bAbs) return aAbs * TMath::Sqrt(1.0 + Sqr(bAbs / aAbs));
+    else return (bAbs == 0) ? 0.0 : bAbs * TMath::Sqrt(1.0 + Sqr(aAbs / bAbs));
+  };
+
+  const T2 *fObj;
+
+public:
+    static ExRootCompareDeltaR *Instance(const T2 *obj = 0)
+  {
+      static ExRootCompareDeltaR single(obj);
+      return &single;
+  }
+
+  void SetObject(const T2 *obj) { fObj = obj; }
+
+  Int_t Compare(const TObject *obj1, const TObject *obj2) const
+  {
+    Double_t eta[3], phi[3], deltaR[2];
+    const T1 *t1 = static_cast<const T1*>(obj1);
+    const T1 *t2 = static_cast<const T1*>(obj2);
+
+    eta[0] = fObj->Eta;
+    phi[0] = fObj->Phi;
+
+    eta[1] = t1->Eta;
+    phi[1] = t1->Phi;
+
+    eta[2] = t2->Eta;
+    phi[2] = t2->Phi;
+
+    deltaR[0] = SumSqr(TMath::Abs(eta[0] - eta[1]), DeltaPhi(phi[0], phi[1]));
+    deltaR[1] = SumSqr(TMath::Abs(eta[0] - eta[2]), DeltaPhi(phi[0], phi[2]));
+
+    if(deltaR[0] < deltaR[1])
+      return -1;
+    else if(deltaR[0] > deltaR[1])
+      return 1;
+    else
+      return 0;
+  }
+};
+
+#endif // ExRootSortableObject_h
+
+
Index: /trunk/ExRootAnalysis/ExRootTask.h
===================================================================
--- /trunk/ExRootAnalysis/ExRootTask.h	(revision 2)
+++ /trunk/ExRootAnalysis/ExRootTask.h	(revision 2)
@@ -0,0 +1,74 @@
+#ifndef ExRootTask_h
+#define ExRootTask_h
+
+/** \class ExRootTask
+ *
+ *  Class handling output ROOT tree
+ *
+ *  $Date: 2008-06-04 13:57:26 $
+ *  $Revision: 1.1 $
+ *
+ *
+ *  \author P. Demin - UCL, Louvain-la-Neuve
+ *
+ */
+
+#include "TTask.h"
+
+#include "ExRootAnalysis/ExRootConfReader.h"
+
+class TClass;
+class TFolder;
+
+class ExRootTask : public TTask
+{
+public:
+
+  ExRootTask();
+  virtual ~ExRootTask();
+
+  virtual void Init();
+  virtual void Process();
+  virtual void Finish();
+
+  virtual void InitTask();
+  virtual void ProcessTask();
+  virtual void FinishTask();
+
+  virtual void InitSubTasks();
+  virtual void ProcessSubTasks();
+  virtual void FinishSubTasks();
+
+  void Add(TTask *task);
+
+  ExRootTask *NewTask(TClass *cl, const char *name);
+  ExRootTask *NewTask(const char *className, const char *taskName);
+
+  void Exec(Option_t* option);
+
+  int GetInt(const char *name, int defaultValue, int index = -1);
+  long GetLong(const char *name, long defaultValue, int index = -1);
+  double GetDouble(const char *name, double defaultValue, int index = -1);
+  bool GetBool(const char *name, bool defaultValue, int index = -1);
+  const char *GetString(const char *name, const char *defaultValue, int index = -1);
+  ExRootConfParam GetParam(const char *name);
+  const ExRootConfReader::ExRootTaskMap *GetModules();
+
+  void SetFolder(TFolder *folder) { fFolder = folder; }
+  void SetConfReader(ExRootConfReader *conf) { fConfReader = conf; }
+
+protected:
+
+    TFolder *GetFolder() const { return fFolder; }
+    ExRootConfReader *GetConfReader() const { return fConfReader; }
+
+private:
+
+  TFolder *fFolder;
+  ExRootConfReader *fConfReader;
+
+  ClassDef(ExRootTask, 1)
+};
+
+#endif /* ExRootTask */
+
Index: /trunk/ExRootAnalysis/ExRootTreeBranch.h
===================================================================
--- /trunk/ExRootAnalysis/ExRootTreeBranch.h	(revision 2)
+++ /trunk/ExRootAnalysis/ExRootTreeBranch.h	(revision 2)
@@ -0,0 +1,41 @@
+#ifndef ExRootTreeBranch_h
+#define ExRootTreeBranch_h
+
+/** \class ExRootTreeBranch
+ *
+ *  Class handling object creation.
+ *  It is also used for output ROOT tree branches
+ *
+ *  $Date: 2008-06-04 13:57:27 $
+ *  $Revision: 1.1 $
+ *
+ *
+ *  \author P. Demin - UCL, Louvain-la-Neuve
+ *
+ */
+
+#include "Rtypes.h"
+
+class TTree;
+class TClonesArray;
+
+class ExRootTreeBranch
+{
+public:
+
+  class MemoryAllocationExeption{};
+  
+  ExRootTreeBranch(const char *name, TClass *cl, TTree *tree = 0);
+  ~ExRootTreeBranch();
+
+  TObject *NewEntry();
+  void Clear();
+
+private:
+
+  Int_t fSize, fCapacity;
+  TClonesArray *fData;  
+};
+
+#endif /* ExRootTreeBranch */
+
Index: /trunk/ExRootAnalysis/ExRootTreeReader.h
===================================================================
--- /trunk/ExRootAnalysis/ExRootTreeReader.h	(revision 2)
+++ /trunk/ExRootAnalysis/ExRootTreeReader.h	(revision 2)
@@ -0,0 +1,59 @@
+#ifndef ExRootTreeReader_h
+#define ExRootTreeReader_h
+
+/** \class ExRootTreeReader
+ *
+ *  Class simplifying access to ROOT tree branches
+ *
+ *  $Date: 2008-06-04 13:57:27 $
+ *  $Revision: 1.1 $
+ *
+ *
+ *  \author P. Demin - UCL, Louvain-la-Neuve
+ *
+ */
+
+#include "TROOT.h"
+#include "TNamed.h"
+#include "TChain.h"
+#include "TFile.h"
+
+#include <map>
+
+class TFolder;
+class TBrowser;
+
+class ExRootTreeReader : public TNamed
+{
+public :
+
+  ExRootTreeReader(TTree *tree = 0);
+  ~ExRootTreeReader();
+
+  void SetTree(TTree *tree) { fChain = tree; }
+
+  Long64_t GetEntries() const { return fChain ? static_cast<Long64_t>(fChain->GetEntries()) : 0; }
+  Bool_t ReadEntry(Long64_t entry);
+
+  TClonesArray *UseBranch(const char *branchName);
+
+  virtual void Browse(TBrowser *b);
+  virtual Bool_t IsFolder() const { return kTRUE; }
+
+private:
+
+  Bool_t Notify();
+
+  TTree *fChain;  // pointer to the analyzed TTree or TChain
+  Int_t fCurrentTree; // current Tree number in a TChain
+
+  TFolder *fFolder;
+
+  typedef std::map<TString, std::pair<TBranch*, TClonesArray*> > TBranchMap;
+
+  TBranchMap fBranchMap;
+
+  ClassDef(ExRootTreeReader, 1)
+};
+
+#endif // ExRootTreeReader_h
Index: /trunk/ExRootAnalysis/ExRootTreeWriter.h
===================================================================
--- /trunk/ExRootAnalysis/ExRootTreeWriter.h	(revision 2)
+++ /trunk/ExRootAnalysis/ExRootTreeWriter.h	(revision 2)
@@ -0,0 +1,57 @@
+#ifndef ExRootTreeWriter_h
+#define ExRootTreeWriter_h
+
+/** \class ExRootTreeWriter
+ *
+ *  Class handling output ROOT tree
+ *
+ *  $Date: 2008-06-04 13:57:27 $
+ *  $Revision: 1.1 $
+ *
+ *
+ *  \author P. Demin - UCL, Louvain-la-Neuve
+ *
+ */
+
+#include "TNamed.h"
+ 
+#include <set>
+
+class TFile;
+class TTree;
+class TClass;
+class ExRootTreeBranch;
+
+class ExRootTreeWriter : public TNamed
+{
+public:
+
+  ExRootTreeWriter(TFile *file = 0, const char *treeName = "Analysis");
+  ~ExRootTreeWriter();
+
+  void SetTreeFile(TFile *file) { fFile = file; }
+  void SetTreeName(const char *name) { fTreeName = name; }
+
+  ExRootTreeBranch *NewBranch(const char *name, TClass *cl);
+  ExRootTreeBranch *NewFactory(const char *name, TClass *cl);
+
+  void Clear();
+  void Fill();
+  void Write();
+
+private:
+
+  TTree *NewTree();
+
+  TFile *fFile;
+  TTree *fTree;
+
+  TString fTreeName;
+  
+  std::set<ExRootTreeBranch*> fBranches;
+
+  ClassDef(ExRootTreeWriter, 1)
+};
+
+#endif /* ExRootTreeWriter */
+
Index: /trunk/ExRootAnalysis/ExRootUtilities.h
===================================================================
--- /trunk/ExRootAnalysis/ExRootUtilities.h	(revision 2)
+++ /trunk/ExRootAnalysis/ExRootUtilities.h	(revision 2)
@@ -0,0 +1,25 @@
+#ifndef ExRootUtilities_h
+#define ExRootUtilities_h
+
+/** \class ExRootUtilities
+ *
+ *  Functions simplifying ROOT tree analysis
+ *
+ *  $Date: 2008-06-04 13:57:28 $
+ *  $Revision: 1.1 $
+ *
+ *
+ *  \author P. Demin - UCL, Louvain-la-Neuve
+ *
+ */
+
+#include "Rtypes.h"
+
+class TH1;
+class TChain;
+
+void HistStyle(TH1 *hist, Bool_t stats = kTRUE);
+
+Bool_t FillChain(TChain *chain, const char *inputFileList);
+
+#endif // ExRootUtilities_h
Index: /trunk/KtJet/KtDistance.cc
===================================================================
--- /trunk/KtJet/KtDistance.cc	(revision 2)
+++ /trunk/KtJet/KtDistance.cc	(revision 2)
@@ -0,0 +1,97 @@
+#include "KtJet/KtDistance.h"
+#include "KtJet/KtUtil.h"
+#include "KtJet/KtDistanceInterface.h"
+#include <cmath>
+#include <vector>
+#include <string>
+#include <iostream>
+namespace KtJet {
+
+
+KtDistance* getDistanceScheme(int angle, int collision_type) {
+  if (angle == 1)      return new KtDistanceAngle(collision_type);
+  else if( angle == 2) return new KtDistanceDeltaR(collision_type);
+  else if (angle == 3) return new KtDistanceQCD(collision_type);
+  else{
+    std::cout << "WARNING, unreconised distance scheme specified!" << std::endl;
+    std::cout << "Distance Scheme set to KtDistanceAngle" << std::endl;
+    return new KtDistanceAngle(collision_type);
+  }
+}
+
+KtDistanceAngle::KtDistanceAngle(int collision_type) : m_type(collision_type), m_name("angle") {}
+  //KtDistanceAngle::~KtDistanceAngle() {}
+std::string KtDistanceAngle::name() const {return m_name;}
+
+KtFloat KtDistanceAngle::operator()(const KtLorentzVector & a) const {
+  KtFloat kt, r, costh;
+  const KtFloat small = 0.0001;     // ??? Should be defined somewhere else?
+  switch (m_type) {            // direction of beam depends on collision type
+  case 1:
+    return -1;               // e+e- : no beam remnant, so result will be ignored anyway
+    break;
+  case 2:                    // ep (p beam -z direction)
+    costh = -(a.cosTheta());
+    break;
+  case 3:                    // pe (p beam +z direction)
+    costh = a.cosTheta();
+    break;
+  case 4:                    // pp (p beams in both directions)
+    costh = fabs(a.cosTheta());
+    break;
+  default:                   // type out of range - WARNING ???
+    costh = 0.;
+    break;
+  }
+  r = 2*(1-costh);
+  if (r<small) r = a.perp2()/a.vect().mag2();  // Use approx if close to beam
+  kt = a.e()*a.e() * r;
+  return kt;
+}
+
+KtFloat KtDistanceAngle::operator()(const KtLorentzVector & a, const KtLorentzVector & b) const {
+  KtFloat emin = std::min(a.e(),b.e());
+  KtFloat esq = emin*emin;
+  KtFloat costh = a.vect().cosTheta(b.vect());
+  return 2 * esq * (1 - costh);
+}
+
+
+KtDistanceDeltaR::KtDistanceDeltaR(int collision_type) : m_type(collision_type), m_name("DeltaR") {}
+  //KtDistanceDeltaR::~KtDistanceDeltaR() {}
+std::string KtDistanceDeltaR::name() const {return m_name;}
+
+KtFloat KtDistanceDeltaR::operator()(const KtLorentzVector & a) const {
+  return (m_type==1) ? -1 : a.perp2(); // If e+e-, no beam remnant, so result will be ignored anyway
+}
+
+KtFloat KtDistanceDeltaR::operator()(const KtLorentzVector & a, const KtLorentzVector & b) const {
+  KtFloat rsq,esq,kt,deltaEta,deltaPhi;
+  deltaEta = a.crapidity()-b.crapidity();
+  deltaPhi = phiAngle(a.phi()-b.phi());
+  rsq = deltaEta*deltaEta + deltaPhi*deltaPhi;
+  esq = std::min(a.perp2(),b.perp2());
+  kt = esq*rsq;
+  return kt;
+}
+
+
+KtDistanceQCD::KtDistanceQCD(int collision_type) : m_type(collision_type), m_name("QCD") {}
+  //KtDistanceQCD::~KtDistanceQCD() {}
+std::string KtDistanceQCD::name() const {return m_name;}
+
+KtFloat KtDistanceQCD::operator()(const KtLorentzVector & a) const {
+  return (m_type==1) ? -1 : a.perp2(); // If e+e-, no beam remnant, so result will be ignored anyway
+}
+
+KtFloat KtDistanceQCD::operator()(const KtLorentzVector & a, const KtLorentzVector & b) const {
+  KtFloat rsq,esq,kt,deltaEta,deltaPhi;
+  deltaEta = a.crapidity()-b.crapidity();
+  deltaPhi = phiAngle(a.phi()-b.phi());
+  rsq = 2 * (cosh(deltaEta)-cos(deltaPhi));
+  esq = std::min(a.perp2(),b.perp2());
+  kt = esq*rsq;
+  return kt;
+}
+
+}//end of namespace
Index: /trunk/KtJet/KtDistance.h
===================================================================
--- /trunk/KtJet/KtDistance.h	(revision 2)
+++ /trunk/KtJet/KtDistance.h	(revision 2)
@@ -0,0 +1,70 @@
+#ifndef KTJET_KTDISTANCE_H
+#define KTJET_KTDISTANCE_H
+
+#include "KtJet/KtDistanceInterface.h"
+#include <string>
+#include "KtJet/KtUtil.h"
+#include "KtJet/KtLorentzVector.h"
+
+
+namespace KtJet {
+  /**
+   *  Function object to calculate Kt for jets and pairs.
+
+   @author J.Butterworth J.Couchman B.Cox B.Waugh
+  */
+
+  /** Get required KtDistance object given integer argument
+   */
+  KtDistance* getDistanceScheme(int dist, int collision_type);
+
+  class KtDistanceAngle : public KtDistance {
+  public:
+    KtDistanceAngle(int collision_type=1);
+    virtual ~KtDistanceAngle(){}
+    /** Jet Kt */
+    KtFloat operator()(const KtLorentzVector &) const;
+    /** Pair Kt */
+    KtFloat operator()(const KtLorentzVector &, const KtLorentzVector &) const;
+    /** Name of scheme */
+    std::string name() const;
+  private:
+    int m_type;
+    std::string m_name;
+  };
+
+
+  class KtDistanceDeltaR : public KtDistance {
+  public:
+    KtDistanceDeltaR(int collision_type=1);
+    virtual ~KtDistanceDeltaR(){};
+    /** Jet Kt */
+    KtFloat operator()(const KtLorentzVector &) const;
+    /** Pair Kt */
+    KtFloat operator()(const KtLorentzVector &, const KtLorentzVector &) const;
+    /** Name of scheme */
+    std::string name() const;
+  private:
+    int m_type;
+    std::string m_name;
+  };
+
+
+  class KtDistanceQCD : public KtDistance {
+  public:
+    KtDistanceQCD(int collision_type=1);
+    virtual ~KtDistanceQCD(){};
+    /** Jet Kt */
+    KtFloat operator()(const KtLorentzVector &) const;
+    /** Pair Kt */
+    KtFloat operator()(const KtLorentzVector &, const KtLorentzVector &) const;
+    /** Name of scheme */
+    std::string name() const;
+  private:
+    int m_type;
+    std::string m_name;
+  };
+
+}//end of namespace
+
+#endif
Index: /trunk/KtJet/KtDistanceInterface.h
===================================================================
--- /trunk/KtJet/KtDistanceInterface.h	(revision 2)
+++ /trunk/KtJet/KtDistanceInterface.h	(revision 2)
@@ -0,0 +1,28 @@
+#ifndef KTJET_KTDISTANCEINTERFACE_H
+#define KTJET_KTDISTANCEINTERFACE_H
+
+#include <string>
+#include "KtJet/KtUtil.h"
+
+namespace KtJet {
+  /**
+   *  Interface class to calculate Kt for jets and pairs.  
+   
+   @author J.Butterworth J.Couchman B.Cox B.Waugh
+  */
+  class KtLorentzVector;
+  class KtDistance {
+  public:
+    /** virtual destructor needed */
+    virtual ~KtDistance() {}
+    /** Jet Kt */
+    virtual KtFloat operator()(const KtLorentzVector &) const = 0;
+    /** Pair Kt */
+    virtual KtFloat operator()(const KtLorentzVector &, const KtLorentzVector &) const = 0;
+    /** Name of scheme */
+    virtual std::string name() const = 0;
+  };
+  
+}// end of namespace
+
+#endif
Index: /trunk/KtJet/KtEvent.cc
===================================================================
--- /trunk/KtJet/KtEvent.cc	(revision 2)
+++ /trunk/KtJet/KtEvent.cc	(revision 2)
@@ -0,0 +1,401 @@
+#include "KtJet/KtEvent.h"
+#include "KtJet/KtLorentzVector.h"
+#include "KtJet/KtJetTable.h"
+#include "KtJet/KtDistance.h"
+#include "KtJet/KtDistanceInterface.h"
+#include "KtJet/KtRecom.h"
+#include "KtJet/KtRecomInterface.h"
+#include <vector>
+#include <utility>
+#include <iostream>
+#include <string>
+#include <algorithm>
+#include <cmath>
+
+namespace KtJet {
+  //using CLHEP::HepLorentzVector;
+  using namespace CLHEP;
+
+  /** Constructor for inclusive method */
+  KtEvent::KtEvent(const std::vector<KtLorentzVector> & constituents,
+                   int type, int angle, int recom,
+                   KtFloat rParameter)
+    : m_type(type),
+      m_rParameterSq(rParameter*rParameter), m_inclusive(true),
+      m_jets() {
+    init(constituents,0,angle,0,recom);
+  }
+
+  KtEvent::KtEvent(const std::vector<KtLorentzVector> & constituents,
+                   int type, KtDistance *angle, KtRecom *recom,
+                   KtFloat rParameter)
+    : m_type(type),
+      m_rParameterSq(rParameter*rParameter), m_inclusive(true),
+      m_jets() {
+    init(constituents,angle,0,recom,0);
+  }
+
+  KtEvent::KtEvent(const std::vector<KtLorentzVector> & constituents,
+                   int type, KtDistance *angle, int recom,
+                   KtFloat rParameter)
+    : m_type(type),
+      m_rParameterSq(rParameter*rParameter), m_inclusive(true),
+      m_jets() {
+    init(constituents,angle,0,0,recom);
+  }
+
+  KtEvent::KtEvent(const std::vector<KtLorentzVector> & constituents,
+                   int type, int angle, KtRecom *recom,
+                   KtFloat rParameter)
+    : m_type(type),
+      m_rParameterSq(rParameter*rParameter), m_inclusive(true),
+      m_jets() {
+    init(constituents,0,angle,recom,0);
+  }
+
+  KtEvent::KtEvent(const std::vector<HepLorentzVector> & constituents,
+                   int type, int angle, int recom,
+                   KtFloat rParameter)
+    : m_type(type),
+      m_rParameterSq(rParameter*rParameter), m_inclusive(true),
+      m_jets() {
+    std::vector<KtLorentzVector> konstituents;
+    makeKtFromHepLV(konstituents,constituents);
+    init(konstituents,0,angle,0,recom);
+  }
+
+  /** Constructor for exclusive method */
+  KtEvent::KtEvent(const std::vector<KtLorentzVector> & constituents,
+                   int type, int angle, int recom)
+    : m_type(type),
+      m_rParameterSq(1), m_inclusive(false),
+      m_jets() {
+    init(constituents,0,angle,0,recom);
+  }
+
+  KtEvent::KtEvent(const std::vector<KtLorentzVector> & constituents,
+                   int type, KtDistance *angle, KtRecom *recom)
+    : m_type(type),
+      m_rParameterSq(1), m_inclusive(false),
+      m_jets() {
+    init(constituents,angle,0,recom,0);
+  }
+
+  KtEvent::KtEvent(const std::vector<KtLorentzVector> & constituents,
+                   int type, KtDistance *angle, int recom)
+    : m_type(type),
+      m_rParameterSq(1), m_inclusive(false),
+      m_jets() {
+    init(constituents,angle,0,0,recom);
+  }
+
+  KtEvent::KtEvent(const std::vector<KtLorentzVector> & constituents,
+                   int type, int angle, KtRecom *recom)
+    : m_type(type),
+      m_rParameterSq(1), m_inclusive(false),
+      m_jets() {
+    init(constituents,0,angle,recom,0);
+  }
+
+  KtEvent::KtEvent(const std::vector<HepLorentzVector> & constituents,
+                   int type, int angle, int recom)
+    : m_type(type),
+      m_rParameterSq(1), m_inclusive(false),
+      m_jets() {
+    std::vector<KtLorentzVector> konstituents;
+    makeKtFromHepLV(konstituents,constituents);
+    init(konstituents,0,angle,0,recom);
+  }
+
+  /** Constructor for (exclusive) subjet method */
+  KtEvent::KtEvent(const KtLorentzVector & jet, int angle, int recom)
+    : m_type(1),
+      m_rParameterSq(1), m_inclusive(false),
+      m_jets() {
+    init(jet,0,angle,0,recom);
+  }
+
+  KtEvent::KtEvent(const KtLorentzVector & jet, KtDistance *angle, KtRecom *recom)
+    : m_type(1),
+      m_rParameterSq(1), m_inclusive(false),
+      m_jets() {
+    init(jet,angle,0,recom,0);
+  }
+
+  KtEvent::KtEvent(const KtLorentzVector & jet, KtDistance *angle, int recom)
+    : m_type(1),
+      m_rParameterSq(1), m_inclusive(false),
+      m_jets() {
+    init(jet,angle,0,0,recom);
+  }
+
+  KtEvent::KtEvent(const KtLorentzVector & jet, int angle, KtRecom *recom)
+    : m_type(1),
+      m_rParameterSq(1), m_inclusive(false),
+      m_jets() {
+    init(jet,0,angle,recom,0);
+  }
+
+  KtEvent::~KtEvent() {
+    delete m_ktDist;
+    delete m_ktRecom;
+  }
+
+  void KtEvent::findJetsN(int nJets) {
+    // Uses merging history created by makeJets
+    if (m_inclusive) {
+      std::cout << "WARNING in KtEvent::findJetsN : Trying to find exclusive jets in inclusive event\n";
+    }
+    m_jets.clear();
+    KtJetTable jt(m_constituents,m_ktDist,m_ktRecom);
+    int nParticles = m_constituents.size();
+    int njet = m_constituents.size();
+    while (njet>nJets) {
+      int hist = m_hist[njet-1];
+      if (hist>=0) {
+        jt.killJet(hist);
+      } else {
+        // Merge two jets
+        hist = -hist;
+        int iPair = hist % nParticles;
+        int jPair = hist / nParticles;
+        jt.mergeJets(iPair,jPair);
+      }
+      --njet;
+    }
+    // Now jets remaining in jt should be required jets: copy to m_jets
+    for (int i=0; i<jt.getNJets(); ++i) { m_jets.push_back(jt.getJet(i)); }
+  }
+
+  /** Do exclusive jet-finding to scale dCut */
+  void KtEvent::findJetsD(KtFloat dCut) {
+    // Find number of jets at scale dCut, then call findJetsN to do merging
+    int njets = 1;
+    for (int iloop = m_constituents.size(); iloop>1; --iloop) {
+      if (m_dMerge[iloop-1]>=dCut) {
+        njets = iloop;
+        break;
+      }
+    }
+    findJetsN(njets);
+  }
+
+  /** Do exclusive jet-finding to scale yCut */
+  void KtEvent::findJetsY(KtFloat yCut) {
+    // Find jets at scale yCut by rescaling to give dCut, then calling findJetsD
+    KtFloat dCut = yCut * m_eCut * m_eCut;
+    findJetsD(dCut);
+  }
+
+  /** Get jets */
+  std::vector<KtLorentzVector> KtEvent::getJets() {
+    return m_jets;
+  }
+
+  std::vector<KtLorentzVector> KtEvent::getJetsE() {
+    std::vector<KtLorentzVector> a(m_jets);
+    std::sort(a.begin(),a.end(),greaterE);
+    return a;
+  }
+
+  std::vector<KtLorentzVector> KtEvent::getJetsEt() {
+    std::vector<KtLorentzVector> a(m_jets);
+    std::sort(a.begin(),a.end(),greaterEt);
+    return a;
+  }
+
+  std::vector<KtLorentzVector> KtEvent::getJetsPt() {
+    std::vector<KtLorentzVector> a(m_jets);
+    std::sort(a.begin(),a.end(),greaterPt);
+    return a;
+  }
+
+  std::vector<KtLorentzVector> KtEvent::getJetsRapidity() {
+    std::vector<KtLorentzVector> a(m_jets);
+    std::sort(a.begin(),a.end(),greaterRapidity);
+    return a;
+  }
+
+  std::vector<KtLorentzVector> KtEvent::getJetsEta() {
+    std::vector<KtLorentzVector> a(m_jets);
+    std::sort(a.begin(),a.end(),greaterEta);
+    return a;
+  }
+
+  std::vector<const KtLorentzVector *> KtEvent::getConstituents() const {
+    std::vector<const KtLorentzVector *> a;
+    std::vector<KtLorentzVector>::const_iterator itr = m_constituents.begin();
+    for (; itr != m_constituents.end(); ++itr) {
+      a.push_back(&*itr);   // ??? Converted to pointer?
+    }
+    return a;
+  }
+
+  std::vector<KtLorentzVector> KtEvent::copyConstituents() const {
+    std::vector<KtLorentzVector> a(m_constituents);
+    return a;
+  }
+
+  KtLorentzVector KtEvent::getJet(const KtLorentzVector & a) const {
+    std::vector<KtLorentzVector>::const_iterator itr = m_jets.begin();
+    for (; itr != m_jets.end(); ++itr) {
+      if (a == *itr || itr->contains(a)) return *itr;
+    }
+    std::cout << "ERROR in KtEvent::getJet : particle not in event" << std::endl;
+    return a; // ??? Do something more sensible here?
+  }
+
+
+  /*********************
+   *  Private methods  *
+   *********************/
+
+  /** Initialization for event jet analysis */
+  void KtEvent::init(const std::vector<KtLorentzVector> & constituents,
+                     KtDistance* dist, int idist, KtRecom* recom, int irecom) {
+    static bool first_inclusive = true, first_exclusive = true;
+    listAuthors();
+    setSchemes(dist,idist,recom,irecom);
+    m_constituents.clear();
+    std::vector<KtLorentzVector>::const_iterator itr;
+    for (itr=constituents.begin(); itr!=constituents.end(); ++itr) {
+      KtLorentzVector v = (*m_ktRecom)(*itr);
+      m_constituents.push_back(v);
+    }
+    addEnergy();
+    setECut(getETot());
+    if (first_inclusive && m_inclusive) {
+      first_inclusive = false;
+      printSteering("inclusive");
+    }
+    if (first_exclusive && !m_inclusive) {
+      first_exclusive = false;
+      printSteering("exclusive");
+    }
+    makeJets();
+    if (!isInclusive()) m_jets.clear(); // Only need merging history in exclusive case.
+    // Jets reconstructed later with fixed d cut or njets.
+  }
+
+  /** Initialization for subjet analysis */
+  void KtEvent::init(const KtLorentzVector & jet, KtDistance* dist, int idist, KtRecom* recom, int irecom) {
+    static bool first_subjet = true;
+    listAuthors();
+    setSchemes(dist,idist,recom,irecom);
+    std::vector<const KtLorentzVector*> constituents = jet.getConstituents();
+    m_constituents.clear();
+    std::vector<const KtLorentzVector *>::const_iterator itr;
+    for (itr=constituents.begin(); itr!=constituents.end(); ++itr) {
+      KtLorentzVector v = (*m_ktRecom)(**itr);
+      m_constituents.push_back(v);
+    }
+    addEnergy();
+    setECut(jet.perp());
+    if (first_subjet) {
+      first_subjet = false;
+      printSteering("subjet");
+    }
+    makeJets();
+    m_jets.clear();  // Only need merging history. Jets reconstructed later with fixed d cut or njets.
+  }
+
+  void KtEvent::addEnergy() {
+    m_eTot = 0;
+    std::vector<KtLorentzVector>::const_iterator itr;
+    for (itr = m_constituents.begin(); itr != m_constituents.end(); ++itr) {
+      m_eTot += itr->e();          // Add up energy in event
+    }
+  }
+
+  void KtEvent::makeJets() {
+    int nParticles = m_constituents.size();
+    if (nParticles==0) return;                // Do nothing if no input particles
+
+    m_dMerge.resize(nParticles);              // Reserve space for D-cut vector
+    m_hist.resize(nParticles);                // Reserve space for merging history vector
+    KtJetTable jt(m_constituents,m_ktDist,m_ktRecom);
+
+    int njet;
+    //  KtFloat dMax = 0;
+    while ((njet=jt.getNJets())>1) {          // Keep merging until only one jet left
+      int iPairMin, jPairMin, iJetMin;
+      KtFloat dPairMin, dJetMin, dMin;
+      std::pair<int,int> pPairMin = jt.getMinDPair(); // Find jet pair with minimum D
+      iPairMin = pPairMin.first;
+      jPairMin = pPairMin.second;
+      dPairMin = jt.getD(iPairMin,jPairMin);
+      iJetMin = jt.getMinDJet();                      // Find jet with minimum D to beam
+      dJetMin = jt.getD(iJetMin);
+      dJetMin *= m_rParameterSq;                      // Scale D to beam by rParameter
+      bool mergeWithBeam = ((m_type != 1 && (dJetMin<=dPairMin)) || njet==1); // Merge with beam remnant?
+      dMin = mergeWithBeam ? dJetMin : dPairMin;
+
+      if (mergeWithBeam) {                        // Merge jet with beam remnant
+        m_jets.push_back(jt.getJet(iJetMin));     //   Add jet to inclusive list
+        m_hist[njet-1] = iJetMin;                 //   Record which jet killed (+ve to indicate merge with beam)
+        jt.killJet(iJetMin);                      //   Chuck out jet
+      } else {                                    // Merge pair of jets
+        m_hist[njet-1] = -(jPairMin*nParticles+iPairMin); //  Record which jet pair merged (-ve to indicate pair)
+        jt.mergeJets(iPairMin,jPairMin);                  //  Merge jets
+      }
+      m_dMerge[njet-1] = dMin;                    // Store D where jets merged
+    }
+    // End of loop: now should have njet = 1
+    m_jets.push_back(jt.getJet(0));                           // Add last jet to list
+    m_dMerge[0] = jt.getD(0);                                    // Put last jet kt in vectors ???
+  }
+
+  void KtEvent::makeKtFromHepLV(std::vector<KtLorentzVector> & kt,
+                                const std::vector<HepLorentzVector> & hep) {
+    std::vector<HepLorentzVector>::const_iterator itr = hep.begin();
+    for (; itr != hep.end(); ++itr) {
+      KtLorentzVector ktvec(*itr);
+      kt.push_back(ktvec);
+    }
+  }
+
+  void KtEvent::setSchemes(KtDistance* dist, int idist, KtRecom* recom, int irecom) {
+    m_angle = idist;
+    m_ktDist = (dist) ? dist : getDistanceScheme(idist,m_type);
+    m_recom = irecom;
+    m_ktRecom = (recom) ? recom : getRecomScheme(irecom);
+  }
+
+  void KtEvent::printSteering(std::string mode) const {
+    static std::string collisionType[4] = {"e+e-","ep","pe","pp"};
+    std::string type = (m_type>=1 && m_type <= 4)  ? collisionType[m_type-1]  : "unknown";
+    std::string angle = m_ktDist->name();
+    std::string recom = m_ktRecom->name();
+    mode.resize(10,' ');
+    type.resize(16,' ');
+    angle.resize(16,' ');
+    recom.resize(16,' ');
+    std::cout << "******************************************\n";
+    std::cout << "* KtEvent constructor called: " << mode << " *\n";
+    std::cout << "* Collision type:       " << type  << " *\n";
+    std::cout << "* Kt scheme:            " << angle << " *\n";
+    std::cout << "* Recombination scheme: " << recom << " *\n";
+#ifdef KTDOUBLEPRECISION
+    std::cout << "* Compiled to use double precision.      *\n";
+#else
+    std::cout << "* Compiled to use single precision.      *\n";
+#endif
+    std::cout << "******************************************\n";
+  }
+
+  void KtEvent::listAuthors() const {
+    static bool first = true;
+    if (first) {
+      first = false;
+      std::cout << "***********************************************\n";
+      std::cout << "* Package KtJet written by:                   *\n";
+      std::cout << "*   Jon Butterworth                           *\n";
+      std::cout << "*   Jon Couchman                              *\n";
+      std::cout << "*   Brian Cox                                 *\n";
+      std::cout << "*   Ben Waugh                                 *\n";
+      std::cout << "* See documentation at <http://www.ktjet.org> *\n";
+      std::cout << "***********************************************\n";
+    }
+  }
+
+}//end of namespace
Index: /trunk/KtJet/KtEvent.h
===================================================================
--- /trunk/KtJet/KtEvent.h	(revision 2)
+++ /trunk/KtJet/KtEvent.h	(revision 2)
@@ -0,0 +1,158 @@
+#ifndef KTJET_KTEVENT_H
+#define KTJET_KTEVENT_H
+
+#include "KtJet/KtUtil.h"
+#include "KtJet/KtDistanceInterface.h"
+#include "KtJet/KtJetTable.h"
+#include "KtJet/KtRecomInterface.h"
+#include <vector>
+#include <string>
+#include "CLHEP/Vector/LorentzVector.h"
+
+
+namespace KtJet {
+
+  class KtLorentzVector;
+
+  /**
+   * The KtEvent class represents a whole system
+   * of KtLorentzVectors constructed using
+   * the defined KT clustering algorithm.
+
+   @author J.Butterworth J.Couchman B.Cox B.Waugh
+  */
+
+  class KtEvent {
+  public:
+    /** Inclusive method constructors */
+    KtEvent(const std::vector<KtLorentzVector> &, int type, int angle, int recom,
+            KtFloat rparameter);
+    KtEvent(const std::vector<KtLorentzVector> &, int type, KtDistance *, KtRecom *,
+            KtFloat rparameter);
+    KtEvent(const std::vector<KtLorentzVector> &, int type, KtDistance *, int recom,
+            KtFloat rparameter);
+    KtEvent(const std::vector<KtLorentzVector> &, int type, int angle, KtRecom *,
+            KtFloat rparameter);
+    KtEvent(const std::vector<CLHEP::HepLorentzVector> &, int type, int angle, int recom,
+            KtFloat rparameter);
+    /** Exclusive method constructors */
+    KtEvent(const std::vector<KtLorentzVector> &, int type, int angle, int recom);
+    KtEvent(const std::vector<KtLorentzVector> &, int type, KtDistance *, KtRecom *);
+    KtEvent(const std::vector<KtLorentzVector> &, int type, KtDistance *, int recom);
+    KtEvent(const std::vector<KtLorentzVector> &, int type, int angle, KtRecom *);
+    KtEvent(const std::vector<CLHEP::HepLorentzVector> &, int type, int angle, int recom);
+    /** Subjets method constructors */
+    KtEvent(const KtLorentzVector & jet, int angle, int recom);
+    KtEvent(const KtLorentzVector & jet, KtDistance *, KtRecom *);
+    KtEvent(const KtLorentzVector & jet, KtDistance *, int recom);
+    KtEvent(const KtLorentzVector & jet, int angle, KtRecom *);
+    /** Destructor */
+    ~KtEvent();
+
+    /** Do exclusive jet-finding for nJets jets */
+    void findJetsN(int nJets);
+    /** Do exclusive jet-finding up to scale dCut */
+    void findJetsD(KtFloat dCut);
+    /** Do exclusive jet-finding up to parameter yCut */
+    void findJetsY(KtFloat yCut);
+
+    /** Returns the number of final state jets */
+    inline int getNJets() const;
+    /** Return final state jets without sorting */
+    std::vector<KtLorentzVector> getJets();
+    /** Return jets in order of decreasing E */
+    std::vector<KtLorentzVector> getJetsE();
+    /** Return final state jets in order of decreasing Et */
+    std::vector<KtLorentzVector> getJetsEt();
+    /** Return final state jets in order of decreasing Pt */
+    std::vector<KtLorentzVector> getJetsPt();
+    /** Return final state jets in order of decreasing rapidity */
+    std::vector<KtLorentzVector> getJetsRapidity();
+    /** Return final state jets in order of decreasing pseudorapidity (eta) */
+    std::vector<KtLorentzVector> getJetsEta();
+
+    /** d-cut where n+1 jets merged to n */
+    inline KtFloat getDMerge(int nJets) const;
+    /** y-cut where n+1 jets merged to n */
+    inline KtFloat getYMerge(int nJets) const;
+
+    /** Get number of objects input to KtEvent */
+    inline int getNConstituents() const;
+    /** Get pointers to input particles */
+    std::vector<const KtLorentzVector *> getConstituents() const;
+    /** Get copies of input particles */
+    std::vector<KtLorentzVector> copyConstituents() const;
+
+    /** Jet containing given particle
+     *  If passed jet in this event, return same jet. If passed particle or jet not in this
+     *  event, error. */
+    KtLorentzVector getJet(const KtLorentzVector &) const;
+
+    /** Set ECut value used in calculating YCut. Default is total transverse energy of the event */
+    inline void setECut(KtFloat eCut);
+    /** Get ECut value used in calculating YCut */
+    inline KtFloat getECut() const;
+    /** Get total energy in event */
+    inline KtFloat getETot() const;
+    /** Get collision type */
+    inline int getType() const;
+    /** Get distance ("angle") scheme */
+    inline int getAngle() const;
+    /** Get recombination scheme */
+    inline int getRecom() const;
+    /** Get inclusive flag: true if inclusive method constructor was used */
+    inline bool isInclusive() const;
+
+  private:
+
+    /** Copy of original input particles */
+    std::vector<KtLorentzVector> m_constituents;
+    /** Collision type */
+    int m_type;
+    /** Kt distance scheme */
+    int m_angle;
+    /** Recombination scheme */
+    int m_recom;
+    KtRecom *m_ktRecom;
+    /** R parameter squared */
+    KtFloat m_rParameterSq;
+    /** Flag for inclusive jets (false = exclusive) */
+    bool m_inclusive;
+    /** Energy scale for calculating y */
+    KtFloat m_eCut;
+    /** 1 / (eCut^2) */
+    KtFloat m_etsq;
+    /** Total energy in event */
+    KtFloat m_eTot;
+    /** d at each merge */
+    std::vector<KtFloat> m_dMerge;
+    /** Jets found */
+    std::vector<KtLorentzVector> m_jets;
+    /** merging history - jet/pair merged at each step */
+    std::vector<int> m_hist;
+    /** Function object to calculate jet resolution parameters */
+    KtDistance *m_ktDist;
+
+    /** Initialize event jet analysis */
+    void init(const std::vector<KtLorentzVector> &, KtDistance* dist, int idist, KtRecom* recom, int irecom);
+    /** Initialize subjet analysis */
+    void init(const KtLorentzVector & jet, KtDistance* dist, int idist, KtRecom* recom, int irecom);
+    /** Add up E and Et in event */
+    void addEnergy();
+    /** Make jets */
+    void makeJets();
+    /** Make KtLorentzVectors from CLHEP HepLorentzVectors */
+    void makeKtFromHepLV(std::vector<KtLorentzVector> &, const std::vector<CLHEP::HepLorentzVector> &);
+    /** Get right distance and recombinatoin schemes based on integer flags as necessary */
+    void setSchemes(KtDistance* dist, int idist, KtRecom* recom, int irecom);
+    /** Print steering parameters to stdout */
+    void printSteering(std::string mode="") const;
+    /** Print list of authors, URL of documentation etc. */
+    void listAuthors() const;
+  };
+
+#include "KtJet/KtEvent.icc"
+
+}//end of namespace
+
+#endif
Index: /trunk/KtJet/KtEvent.icc
===================================================================
--- /trunk/KtJet/KtEvent.icc	(revision 2)
+++ /trunk/KtJet/KtEvent.icc	(revision 2)
@@ -0,0 +1,14 @@
+inline int KtEvent::getNJets() const {return m_jets.size();}
+inline KtFloat KtEvent::getDMerge(int nJets) const {return m_dMerge[nJets];}
+inline KtFloat KtEvent::getYMerge(int nJets) const {return m_dMerge[nJets] * m_etsq;}
+inline int KtEvent::getNConstituents() const {return m_constituents.size();}
+inline  void KtEvent::setECut(KtFloat eCut) {
+  m_eCut = eCut;
+  m_etsq = 1/(eCut*eCut);
+}
+inline KtFloat KtEvent::getECut() const {return m_eCut;}
+inline KtFloat KtEvent::getETot() const {return m_eTot;}
+inline int KtEvent::getType() const {return m_type;}
+inline int KtEvent::getAngle() const {return m_angle;}
+inline int KtEvent::getRecom() const {return m_recom;}
+inline bool KtEvent::isInclusive() const {return m_inclusive;}
Index: /trunk/KtJet/KtJet.h
===================================================================
--- /trunk/KtJet/KtJet.h	(revision 2)
+++ /trunk/KtJet/KtJet.h	(revision 2)
@@ -0,0 +1,13 @@
+#ifndef KTJET_KTJET_H
+#define KTJET_KTJET_H
+
+#include "KtJet/KtUtil.h"
+#include "KtJet/KtEvent.h"
+#include "KtJet/KtDistance.h"
+#include "KtJet/KtDistanceInterface.h"
+#include "KtJet/KtLorentzVector.h"
+#include "KtJet/KtJetTable.h"
+#include "KtJet/KtRecom.h"
+#include "KtJet/KtRecomInterface.h"
+
+#endif
Index: /trunk/KtJet/KtJetTable.cc
===================================================================
--- /trunk/KtJet/KtJetTable.cc	(revision 2)
+++ /trunk/KtJet/KtJetTable.cc	(revision 2)
@@ -0,0 +1,188 @@
+#include "KtJet/KtJetTable.h"
+#include "KtJet/KtLorentzVector.h"
+#include "KtJet/KtDistanceInterface.h"
+#include "KtJet/KtRecomInterface.h"
+#include <vector>
+#include <utility>
+#include <algorithm>
+#include <iostream>
+
+namespace KtJet{
+
+KtJetTable::KtJetTable(const std::vector<KtLorentzVector> & p, KtDistance *ktdist, KtRecom *recom)
+  : m_fKtDist(ktdist), m_ktRecom(recom) {
+  m_nRows = p.size();
+  m_jets.reserve(m_nRows);          // Reserve space for jet array
+  m_ddi.reserve(m_nRows);           // Reserve space for di array
+  m_dPairs.resize(m_nRows);         // Make space for dij table
+
+  std::vector<KtLorentzVector>::const_iterator pitr = p.begin();
+  for (; pitr != p.end(); ++pitr) { // Initialize jets with one particle each
+    KtLorentzVector j;              //   create new jet
+    j.add(*pitr);                   //   add single particle to jet
+    m_jets.push_back(j);
+  }
+  for (int i = 0; i < m_nRows-1; ++i) {     // Fill array of pair kt's
+    for (int j = i+1 ; j < m_nRows; ++j) {
+      KtFloat D = (*m_fKtDist)(m_jets[i],m_jets[j]);
+      m_dPairs(i,j) = D;
+    }
+  }
+  for (int i = 0; i < m_nRows; ++i){        // Fill vector of particle kt's
+    m_ddi.push_back((*m_fKtDist)(m_jets[i]));
+  }
+}
+
+KtJetTable::~KtJetTable() {}
+
+const KtLorentzVector & KtJetTable::getJet(int i) const {
+  return m_jets[i];
+}
+
+KtFloat KtJetTable::getD(int i, int j) const {
+  return m_dPairs(i,j);
+}
+
+KtFloat KtJetTable::getD(int i) const {
+  if (i<0 || i>=static_cast<int>(m_ddi.size())) {
+    std::cout << "ERROR in KtJetTable::getD(int)" << std::endl;
+    std::cout << "  i, m_ddi.size() = " << i << ", " << m_ddi.size() << std::endl;
+  }
+  return m_ddi[i];
+}
+
+/***************************************************************
+ *  Merge jets i and j, updating four-momentum and kt vectors  *
+ ***************************************************************/
+void KtJetTable::mergeJets(int i, int j) {
+  int njet = getNJets();
+  if (i<0 || i>=njet || j<0 || j>=njet || i>=j) {
+    std::cout << "ERROR in KtJetTable::mergeJets" << std::endl;
+    std::cout << "  Attempt to merge jets " << i << ", " << j << " in event with " << njet << " jets" << std::endl;
+  }
+  m_jets[i].add(m_jets[j],m_ktRecom); // Add constituents and merge 4-momenta using required scheme
+  for (int ii=0; ii<i; ++ii) {      // Calculate pair kt's involving merged particles
+    KtFloat D = (*m_fKtDist)(m_jets[ii],m_jets[i]);
+    m_dPairs(ii,i) = D;
+  }
+  for (int jj=i+1; jj<njet; ++jj) {
+    KtFloat D = (*m_fKtDist)(m_jets[i],m_jets[jj]);
+    m_dPairs(i,jj) = D;
+  }
+  m_ddi[i] = (*m_fKtDist)(m_jets[i]);  // Calculate kt of merged particles
+  killJet(j);                       // Now delete particle j
+}
+
+/***************************************************
+ *  Delete jet i by moving last jet on top of it,  *
+ *   updating four momentum and kt vectors         *
+ ***************************************************/
+void KtJetTable::killJet(int i) {
+  //  std::cout << " KtJetTable::killJet, i = " << i << std::endl;
+  int njet = getNJets();
+  if (i<0 || i>=njet) {
+    std::cout << "ERROR in KtEvent::killJet" << std::endl;
+    std::cout << "  Attempt to delete jet " << i << " in event with " << njet << " jets" << std::endl;
+  }
+  //  std::cout << " njet = " << njet << std::endl;
+  m_jets[i] = m_jets[njet-1];      // move last jet into space left by jet i
+  for (int j=0; j<i; ++j) {    // move pair kt's
+    m_dPairs(j,i) = m_dPairs(j,njet-1);
+  }
+  for (int j=i+1; j<njet-1; ++j) {
+    m_dPairs(i,j) = m_dPairs(j,njet-1);
+  }
+  m_ddi[i] = m_ddi[njet-1];          // move jet kt
+  m_dPairs.killJet();           // reduce size of kt array
+  m_jets.pop_back();             // delete last jet from vector
+  m_ddi.pop_back();               // delete last jet kt
+  //  std::cout << " Finished in KtJetTable::killJet" << std::endl;
+}
+
+std::pair<int,int> KtJetTable::getMinDPair() const {
+  return m_dPairs.getMin();
+}
+
+int KtJetTable::getMinDJet() const {
+  return std::distance(m_ddi.begin(),std::min_element(m_ddi.begin(),m_ddi.end()));
+}
+
+/*************************************************************
+ *  Now the functions for nested class KtJetTable::DijTable  *
+ *************************************************************/
+
+KtJetTable::DijTable::DijTable(int nParticles) : m_nRows(nParticles), m_nJets(nParticles) {
+  m_table.resize(m_nRows*m_nRows);
+}
+
+KtJetTable::DijTable::~DijTable() {}
+
+void KtJetTable::DijTable::resize(int nParticles) {
+  /*************************************************************
+   *  Reserve space for kt of pairs with nParticles particles  *
+   *************************************************************/
+  m_nRows = nParticles;
+  m_nJets = nParticles;
+  m_table.resize(m_nRows*m_nRows);
+}
+
+std::pair<int,int> KtJetTable::DijTable::getMin() const {
+  /********************************************************
+   *  Find position of smallest entry in table  *
+   ********************************************************/
+  KtFloat d = m_table[1];
+  int k=0; int i=0; int j=1;                    // Initialize to first used element
+  for (int ii=0; ii<m_nJets-1; ++ii) {
+    for (int jj=ii+1; jj<m_nJets; ++jj) {
+      ++k;
+      if (m_table[k]<d) {
+	i = ii; j = jj; d = m_table[k];
+      }
+    }
+    k += 2 + ii + m_nRows - m_nJets;
+  }
+  return std::pair<int,int>(i,j);
+}
+
+void KtJetTable::DijTable::print() const {
+  /*****************************************
+   *  Write out contents of table to cout  *
+   *****************************************/
+  for (int i = 0; i<m_nRows-1; ++i){
+    for (int j = i+1; j<m_nRows; ++j){
+      KtFloat D = (*this)(i,j);
+      std::cout << i+1 << " " << j+1 << " " << D << '\n';
+    }
+  }
+  std::cout << std::endl;
+}
+
+KtFloat & KtJetTable::DijTable::operator() (int ii, int jj) {
+  int i = std::min(ii,jj);
+  int j = std::max(ii,jj);
+  if (i<0 || j<0 || i>=m_nJets || j>=m_nJets || i>=j) {
+    std::cout << "ERROR in KtJetTable::DijTable::operator()" << std::endl;
+    std::cout << "  Attempt to access element (" << i << "," << j << ") in table with nJets, nRows = "
+	 << m_nJets << ", " << m_nRows << std::endl;
+  }
+  return *(m_table.begin() + i*m_nRows + j);
+}
+
+
+KtFloat KtJetTable::DijTable::operator() (int i, int j) const {
+  if (i<0 || j<0 || i>=m_nJets || j>=m_nJets) {
+    std::cout << "ERROR in KtJetTable::DijTable::operator() const";
+    std::cout << "  Attempt to access element (" << i << "," << j << ") in table with nJets, nRows = "
+	 << m_nJets << ", " << m_nRows << std::endl;
+  }
+  return *(m_table.begin() + i*m_nRows + j);
+}
+
+void KtJetTable::DijTable::killJet() {
+  if (m_nJets<=0) {
+    std::cout << "ERROR in KtJetTable::DijTable::killJet()" << std::endl;
+    std::cout << "  Called when m_nJets = " << m_nJets << std::endl;
+  }
+  --m_nJets;
+}
+}//end of namespace
Index: /trunk/KtJet/KtJetTable.h
===================================================================
--- /trunk/KtJet/KtJetTable.h	(revision 2)
+++ /trunk/KtJet/KtJetTable.h	(revision 2)
@@ -0,0 +1,92 @@
+#ifndef KTJET_KTJETTABLE_H
+#define KTJET_KTJETTABLE_H
+
+#include "KtJet/KtLorentzVector.h"
+#include "KtJet/KtDistanceInterface.h"
+#include "KtJet/KtRecomInterface.h"
+#include <vector>
+#include <string>
+
+
+namespace KtJet{
+
+  /**
+   *  Class KtJetTable encapsulates the jet four-momenta and Kt's in one object.
+   *  Does merging and deletion of jets and returns jets, Kt's etc.
+   *  Uses a KtDistance object to calculate Kt's.
+   *
+   *  Usage example:
+   *    CLHEP::HepLorentzVector eScheme(const CLHEP::HepLorentzVector &,
+   const CLHEP::HepLorentzVector &); // function to merge jets
+   *    std::vector<KtLorentzVector> jets;
+   *                                //  [Put some particles in "jets".]
+   *    KtDistanceDeltaR ktPP(4);   //  4 = pp collision
+   *    KtJetTable jt(jets, ktPP, eScheme);
+
+   @author J.Butterworth J.Couchman B.Cox B.Waugh
+  */
+  class KtJetTable {
+  public:
+    KtJetTable(const std::vector<KtLorentzVector> &, KtDistance *, KtRecom *recom);
+    ~KtJetTable();
+    /* Number of jets */
+    inline int getNJets() const;
+    /** Get jet from table */
+    const KtLorentzVector & getJet(int i) const;
+    /** Kt for jet pair (i,j) */
+    KtFloat getD(int i, int j) const;
+    /** Kt of jet (i) with respect to beam */
+    KtFloat getD(int i) const;
+    /** Get indices of jet pair with min Kt */
+    std::pair<int,int> getMinDPair() const;
+    /** Get index of jet with min Kt with respect to beam */
+    int getMinDJet() const;
+    /** Combine jets (i,j) (E-scheme only so far) */
+    void mergeJets(int i, int j);
+    /** Delete jet (i) from table */
+    void killJet(int i);
+  private:
+    /** Initial number of jets/particles */
+    int m_nRows;
+    /** Jet 4-momenta */
+    std::vector<KtLorentzVector> m_jets;
+    /** Function object to define Kt distance scheme */
+    KtDistance *m_fKtDist;
+    /** Recombination scheme */
+    KtRecom *m_ktRecom;
+    //  CLHEP::HepLorentzVector (*m_frecom)(const CLHEP::HepLorentzVector &, const CLHEP::HepLorentzVector &);
+    /** Kt with respect to beam */
+    std::vector<KtFloat> m_ddi;
+    /** Class to deal with pair Kt's */
+    class DijTable {
+    private:
+      /** No. of initial jets/particles */
+      int m_nRows;
+      /** No. of jets after merging etc. */
+      int m_nJets;
+      /** Vector of Kt values */
+      std::vector<KtFloat> m_table;
+    public:
+      DijTable(int nParticles=0);
+      ~DijTable();
+      /** Set size to hold nParticles particles */
+      void resize(int nParticles);
+      /** Return reference to allow Kt value to be set */
+      KtFloat & operator() (int i, int j);
+      /** Return Kt by value */
+      KtFloat operator() (int i, int j) const;
+      /** Find position of minimum Kt in table */
+      std::pair<int,int> getMin() const;
+      /** Decrement number of jets */
+      void killJet();
+      /** ??? debug only? Print contents of table */
+      void print() const;
+    };
+    /** 2D table of all pair kt's */
+    DijTable m_dPairs;
+  };
+
+#include "KtJet/KtJetTable.icc"
+
+}//end of namespace
+#endif
Index: /trunk/KtJet/KtJetTable.icc
===================================================================
--- /trunk/KtJet/KtJetTable.icc	(revision 2)
+++ /trunk/KtJet/KtJetTable.icc	(revision 2)
@@ -0,0 +1,4 @@
+inline int KtJetTable::getNJets() const {
+  return m_jets.size();
+}
+
Index: /trunk/KtJet/KtLorentzVector.cc
===================================================================
--- /trunk/KtJet/KtLorentzVector.cc	(revision 2)
+++ /trunk/KtJet/KtLorentzVector.cc	(revision 2)
@@ -0,0 +1,126 @@
+#include "KtJet/KtLorentzVector.h"
+#include "KtJet/KtUtil.h"
+#include "KtJet/KtRecomInterface.h"
+#include <iostream>
+#include <climits>
+
+namespace KtJet {
+  unsigned int KtLorentzVector::m_num = 0;
+  //using CLHEP::HepLorentzVector;
+  using namespace CLHEP;
+
+  /*************************************************
+   *  Default constructor, used to create new jet  *
+   *************************************************/
+  KtLorentzVector::KtLorentzVector() :
+    HepLorentzVector(), m_constituents(), m_isAtomic(false) {
+    if (m_num < UINT_MAX) {
+      ++m_num;
+    } else {
+      m_num = 0;
+      std::cout << "Warning: Number of KtLorentzVectors exceeds capacity of unsigned int" << std::endl;
+    }
+    m_id = m_num;
+  }
+
+  /*****************************************************************
+   *  Constructor for new "atomic" particle from HepLorentzVector  *
+   *****************************************************************/
+  KtLorentzVector::KtLorentzVector(const HepLorentzVector &p) :
+    HepLorentzVector(p), m_id(m_num++), m_constituents(), m_isAtomic(true) {
+  }
+
+  /***********************************************************
+   *  Constructor for new "atomic" particle from 4-momentum  *
+   ***********************************************************/
+  KtLorentzVector::KtLorentzVector(KtFloat px, KtFloat py, KtFloat pz, KtFloat e) :
+    HepLorentzVector(px,py,pz,e), m_id(m_num++), m_constituents(), m_isAtomic(true) {
+  }
+
+  /**********************************************************/
+
+  KtLorentzVector::~KtLorentzVector() {}
+
+  /**********************************************************/
+
+  std::vector<KtLorentzVector> KtLorentzVector::copyConstituents() const {
+    std::vector<KtLorentzVector> a;
+    std::vector<const KtLorentzVector*>::const_iterator itr = m_constituents.begin();
+    for (; itr != m_constituents.end(); ++itr) {
+      a.push_back(**itr);
+    }
+    return a;
+  }
+
+  void KtLorentzVector::addConstituents(const KtLorentzVector* ktvec) {
+    if(!ktvec->isJet()) {
+      m_constituents.push_back((ktvec));
+      return;
+    }else{
+      std::vector<const KtLorentzVector*>::const_iterator itr = ktvec->getConstituents().begin();
+      for (; itr != ktvec->getConstituents().end() ; ++itr) this->addConstituents(*itr);
+      return;
+    }
+  }
+
+  bool KtLorentzVector::contains(const KtLorentzVector & a) const {
+    if (a == *this) return true;
+    if (m_isAtomic) return false;
+    std::vector<const KtLorentzVector*>::const_iterator itr = m_constituents.begin();
+    for (; itr != m_constituents.end() ; ++itr) {
+      if (a == **itr) return true;
+    }
+    return false;
+  }
+
+  void KtLorentzVector::add(const KtLorentzVector &p, KtRecom *recom) {
+    if (m_isAtomic) { // ???
+      std::cout << "Tried to add to atomic KtLorentzVector. You shouldn't do that!" << std::endl;
+      //    exit(1);
+    }
+    this->addConstituents(&p);
+    HepLorentzVector::operator=((*recom)((*this),p));
+    calcRapidity();
+  }
+
+  void KtLorentzVector::add(const KtLorentzVector &p) {
+    this->operator+=(p);
+  }
+
+  KtLorentzVector & KtLorentzVector::operator+= (const KtLorentzVector &p){
+    if (m_isAtomic) { // ???
+      std::cout << "Tried to add to atomic KtLorentzVector. You shouldn't do that!" << std::endl;
+      //    exit(1);
+    }
+    this->addConstituents(&p);
+    HepLorentzVector::operator+=(p);
+    calcRapidity();
+    return *this;
+  }
+
+  // KtLorentzVector::KtLorentzVector(const KtLorentzVector & p) {} // Use default copy
+
+  /**************************************
+   *  Comparison functions for sorting  *
+   **************************************/
+  bool greaterE(const HepLorentzVector & a, const HepLorentzVector & b) {
+    return (a.e()>b.e());
+  }
+
+  bool greaterEt(const HepLorentzVector & a, const HepLorentzVector & b) {
+    return (a.et()>b.et());
+  }
+
+  bool greaterPt(const HepLorentzVector & a, const HepLorentzVector & b) {
+    return (a.perp2()>b.perp2());
+  }
+
+  bool greaterRapidity(const HepLorentzVector & a, const HepLorentzVector & b) {
+    return (a.rapidity()>b.rapidity());
+  }
+
+  bool greaterEta(const HepLorentzVector & a, const HepLorentzVector & b) {
+    return (a.pseudoRapidity()>b.pseudoRapidity());
+  }
+
+}//end of namespace
Index: /trunk/KtJet/KtLorentzVector.h
===================================================================
--- /trunk/KtJet/KtLorentzVector.h	(revision 2)
+++ /trunk/KtJet/KtLorentzVector.h	(revision 2)
@@ -0,0 +1,85 @@
+#ifndef KTJET_KTLORENTZVECTOR_H
+#define KTJET_KTLORENTZVECTOR_H
+
+#include <vector>
+#include <cmath>
+#include "KtJet/KtUtil.h"
+
+
+namespace KtJet {
+  /**
+   * This Class represents a KtCluster Object.
+   * It is just a CLHEP HepLorentzVector and also contains
+   * a std::vector of all its constituent KtLorentzVectors
+   * and an id number
+
+   @author J.Butterworth J.Couchman B.Cox B.Waugh
+  */
+  class KtRecom;
+
+  class KtLorentzVector : public CLHEP::HepLorentzVector {
+  public:
+    /** Default Constructor: create jet with no constituents */
+    KtLorentzVector();
+    /** Constructor: create particle with given 4-momentum */
+    KtLorentzVector(const CLHEP::HepLorentzVector &);
+    /** Constructor: create particle with given 4-momentum */
+    KtLorentzVector(KtFloat px, KtFloat py, KtFloat pz, KtFloat e);
+
+    /** Destructor */
+    ~KtLorentzVector();
+
+    /** return a reference to the vector of pointers of the KtLorentzVectors constituents */
+    inline const std::vector<const KtLorentzVector*> & getConstituents() const;
+    /** copy constituents */
+    std::vector<KtLorentzVector> copyConstituents() const;
+    /** returns the number of constituents KtLorentzVector is made up of */
+    inline int getNConstituents() const;
+    /** Check if a KtLorentzVector is a constituent */
+    bool contains(const KtLorentzVector &) const;
+    /** Add particle to jet using required recombination scheme to merge 4-momenta */
+    void add(const KtLorentzVector &, KtRecom *recom);
+    /** Add particle to jet using E scheme (4-vector addition) to merge 4-momenta */
+    void add(const KtLorentzVector &);
+    inline unsigned int getID() const {return m_id;}     // ??? Temporary, for debugging only
+    /**  is it a Jet, not single particle */
+    inline bool isJet() const;
+    /** Add particle to jet using E scheme (4-vector addition) to merge 4-momenta */
+    KtLorentzVector & operator+= (const KtLorentzVector &);
+    /** Compare IDs of objects */
+    inline bool operator== (const KtLorentzVector &) const;
+    inline bool operator!= (const KtLorentzVector &) const;
+    inline bool operator< (const KtLorentzVector &) const;
+    inline bool operator> (const KtLorentzVector &) const;
+  private:
+    /** rapidity, only valid if haven't called other methods since last call to add() */
+    inline KtFloat crapidity() const;
+    /** rapidity, only valid if haven't called other methods since last call to add() */
+    KtFloat m_crapidity;
+    /** calculate rapidity */
+    inline void calcRapidity();
+    /** private method to help add constituents to vector */
+    void addConstituents(const KtLorentzVector*) ;
+    /** KtLorentzVectors id number */
+    unsigned int m_id;
+    /** Pointers to constituents */
+    std::vector<const KtLorentzVector*> m_constituents;
+    /** Particle rather than jet */
+    bool m_isAtomic;
+    /** Number of instances so far */
+    static unsigned int m_num;
+    /** Some classes need access to crapidity for efficiency reasons */
+    friend class KtDistanceDeltaR;
+    friend class KtDistanceQCD;
+  };
+
+  bool greaterE(const CLHEP::HepLorentzVector &, const CLHEP::HepLorentzVector &);
+  bool greaterEt(const CLHEP::HepLorentzVector &, const CLHEP::HepLorentzVector &);
+  bool greaterPt(const CLHEP::HepLorentzVector &, const CLHEP::HepLorentzVector &);
+  bool greaterRapidity(const CLHEP::HepLorentzVector &, const CLHEP::HepLorentzVector &);
+  bool greaterEta(const CLHEP::HepLorentzVector &, const CLHEP::HepLorentzVector &);
+
+#include "KtJet/KtLorentzVector.icc"
+
+}//end of namespace
+#endif
Index: /trunk/KtJet/KtLorentzVector.icc
===================================================================
--- /trunk/KtJet/KtLorentzVector.icc	(revision 2)
+++ /trunk/KtJet/KtLorentzVector.icc	(revision 2)
@@ -0,0 +1,36 @@
+inline KtFloat KtLorentzVector::crapidity() const {
+  return m_crapidity;
+}
+
+inline int KtLorentzVector::getNConstituents() const {
+  return m_constituents.size();
+}
+
+inline const std::vector<const KtLorentzVector*> & KtLorentzVector::getConstituents() const {return m_constituents;}
+
+inline bool KtLorentzVector::isJet() const {return !m_isAtomic;} 
+
+inline bool KtLorentzVector::operator== (const KtLorentzVector& v2) const {
+  return (m_id == v2.m_id);
+}
+
+inline bool KtLorentzVector::operator!= (const KtLorentzVector& v2) const {
+  return (m_id != v2.m_id);
+}
+
+inline bool KtLorentzVector::operator< (const KtLorentzVector& v2) const {
+  return (m_id < v2.m_id);
+}
+
+inline bool KtLorentzVector::operator> (const KtLorentzVector& v2) const {
+  return (m_id > v2.m_id);
+}
+
+inline void KtLorentzVector::calcRapidity() {
+  const KtFloat etamax = 10;
+  if (fabs(this->pz())==this->e()) {
+    m_crapidity = (this->pz() > 0) ? (etamax+2) : -(etamax+2);
+  } else {
+    m_crapidity = HepLorentzVector::rapidity();
+  }
+}
Index: /trunk/KtJet/KtRecom.cc
===================================================================
--- /trunk/KtJet/KtRecom.cc	(revision 2)
+++ /trunk/KtJet/KtRecom.cc	(revision 2)
@@ -0,0 +1,137 @@
+#include "KtJet/KtRecom.h"
+#include "KtJet/KtUtil.h"
+#include "KtJet/KtRecomInterface.h"
+#include <string>
+
+namespace KtJet {
+  //using CLHEP::HepLorentzVector;
+  using namespace CLHEP;
+
+  KtRecom* getRecomScheme(int recom) {
+    if (recom == 1)   return new KtRecomE();
+    else if (recom == 2)   return new KtRecomPt();
+    else if (recom == 3)   return new KtRecomPt2();
+    else if (recom == 4)   return new KtRecomEt();
+    else if (recom == 5)   return new KtRecomEt2();
+    else{
+      std::cout << "WARNING, unreconised recombination scheme specified!" << std::endl;
+      std::cout << "Recombination Scheme set to KtRecomE" << std::endl;
+      return new KtRecomE();
+    }
+  }
+
+
+  KtRecomE::KtRecomE() : m_name("E") {}
+  //KtRecomE::~KtRecomE() {}
+  std::string KtRecomE::name() const {return m_name;}
+
+  HepLorentzVector KtRecomE::operator()(const HepLorentzVector &a, const HepLorentzVector &b) const {
+    return a+b;
+  }
+
+  KtLorentzVector KtRecomE::operator()(const KtLorentzVector &a) const {
+    return a;
+  }
+
+  KtRecomPt::KtRecomPt() : m_name("Pt") {}
+  //KtRecomPt::~KtRecomPt() {}
+  std::string KtRecomPt::name() const {return m_name;}
+
+  HepLorentzVector KtRecomPt::operator()(const HepLorentzVector &a, const HepLorentzVector &b) const {
+    KtFloat pti, ptj, newPt, newEta, newPhi, deltaPhi;
+    pti = a.perp();
+    ptj = b.perp();
+    newPt = pti + ptj;
+    newEta = (pti * a.eta() + ptj * b.eta()) / newPt;
+    deltaPhi = phiAngle(b.phi() - a.phi());
+    newPhi = a.phi() + deltaPhi * ptj / newPt;
+    newPhi = phiAngle(newPhi);
+    return HepLorentzVector(newPt*cos(newPhi),newPt*sin(newPhi),newPt*sinh(newEta),newPt*cosh(newEta));
+  }
+
+  /** Make 4-vector massless by setting E = p */
+  KtLorentzVector KtRecomPt::operator()(const KtLorentzVector &a) const {
+    KtLorentzVector v = a;
+    v.setE(a.vect().mag());
+    return v;
+  }
+
+
+  KtRecomPt2::KtRecomPt2() : m_name("Pt^2") {}
+  //KtRecomPt2::~KtRecomPt2() {}
+  std::string KtRecomPt2::name() const {return m_name;}
+
+  HepLorentzVector KtRecomPt2::operator()(const HepLorentzVector &a, const HepLorentzVector &b) const {
+    KtFloat pti, ptj, ptisq, ptjsq, newPt, newEta, newPhi, deltaPhi;
+    pti = a.perp();
+    ptj = b.perp();
+    ptisq = a.perp2();
+    ptjsq = b.perp2();
+    newPt = pti + ptj;
+    newEta = (ptisq * a.eta() + ptjsq * b.eta()) / (ptisq + ptjsq);
+    deltaPhi = phiAngle(b.phi() - a.phi());
+    newPhi = a.phi() + deltaPhi * ptjsq / (ptisq + ptjsq);
+    newPhi = phiAngle(newPhi);
+    return HepLorentzVector(newPt*cos(newPhi),newPt*sin(newPhi),newPt*sinh(newEta),newPt*cosh(newEta));
+  }
+
+  /** Make 4-vector massless by setting E = p */
+  KtLorentzVector KtRecomPt2::operator()(const KtLorentzVector &a) const {
+    KtLorentzVector v = a;
+    v.setE(a.vect().mag());
+    return v;
+  }
+
+
+  KtRecomEt::KtRecomEt() : m_name("Et") {}
+  //KtRecomEt::~KtRecomEt() {}
+  std::string KtRecomEt::name() const {return m_name;}
+
+  HepLorentzVector KtRecomEt::operator()(const HepLorentzVector &a, const HepLorentzVector &b) const {
+    KtFloat pti, ptj, newPt, newEta, newPhi, deltaPhi;
+    pti = a.et();
+    ptj = b.et();
+    newPt = pti + ptj;
+    newEta = (pti * a.eta() + ptj * b.eta()) / newPt;
+    deltaPhi = phiAngle(b.phi() - a.phi());
+    newPhi = a.phi() + deltaPhi * ptj / newPt;
+    newPhi = phiAngle(newPhi);
+    return HepLorentzVector(newPt*cos(newPhi),newPt*sin(newPhi),newPt*sinh(newEta),newPt*cosh(newEta));
+  }
+
+  /** Make 4-vector massless by scaling momentum to equal E */
+  KtLorentzVector KtRecomEt::operator()(const KtLorentzVector &a) const {
+    KtLorentzVector v = a;
+    KtFloat scale = a.e() / a.vect().mag();
+    v.setVect(a.vect() * scale);
+    return v;
+  }
+
+
+  KtRecomEt2::KtRecomEt2() : m_name("Et^2") {}
+  //KtRecomEt2::~KtRecomEt2() {}
+  std::string KtRecomEt2::name() const {return m_name;}
+
+  HepLorentzVector KtRecomEt2::operator()(const HepLorentzVector &a, const HepLorentzVector &b) const {
+    KtFloat pti, ptj, ptisq, ptjsq, newPt, newEta, newPhi, deltaPhi;
+    pti = a.et();
+    ptj = b.et();
+    ptisq = pti*pti;
+    ptjsq = ptj*ptj;
+    newPt = pti + ptj;
+    newEta = (ptisq * a.eta() + ptjsq * b.eta()) / (ptisq + ptjsq);
+    deltaPhi = phiAngle(b.phi() - a.phi());
+    newPhi = a.phi() + deltaPhi * ptjsq / (ptisq + ptjsq);
+    newPhi = phiAngle(newPhi);
+    return HepLorentzVector(newPt*cos(newPhi),newPt*sin(newPhi),newPt*sinh(newEta),newPt*cosh(newEta));
+  }
+
+  /** Make 4-vector massless by scaling momentum to equal E */
+  KtLorentzVector KtRecomEt2::operator()(const KtLorentzVector &a) const {
+    KtLorentzVector v = a;
+    KtFloat scale = a.e() / a.vect().mag();
+    v.setVect(a.vect() * scale);
+    return v;
+  }
+
+}//end of namespace
Index: /trunk/KtJet/KtRecom.h
===================================================================
--- /trunk/KtJet/KtRecom.h	(revision 2)
+++ /trunk/KtJet/KtRecom.h	(revision 2)
@@ -0,0 +1,96 @@
+#ifndef KTJET_KTRECOM_H
+#define KTJET_KTRECOM_H
+
+#include <string>
+#include "KtJet/KtUtil.h"
+#include "KtJet/KtLorentzVector.h"
+#include "KtJet/KtRecomInterface.h"
+
+
+namespace KtJet {
+  /**
+   *  Function object to combine 4-momenta
+   *  @author J.Butterworth J.Couchman B.Cox B.Waugh
+  */
+
+  /** Get required KtRecom object given integer argument
+   */
+  KtRecom* getRecomScheme(int recom);
+
+  class KtRecomE : public KtRecom {
+  public:
+    KtRecomE();
+    virtual ~KtRecomE(){};
+    /** Return merged 4-momentum */
+    CLHEP::HepLorentzVector operator()(const CLHEP::HepLorentzVector &, const CLHEP::HepLorentzVector &) const;
+    /** Process input 4-momentum */
+    KtLorentzVector operator()(const KtLorentzVector &) const;
+    /** Name of scheme */
+    std::string name() const;
+  private:
+    std::string m_name;
+  };
+
+
+  class KtRecomPt : public KtRecom {
+  public:
+    KtRecomPt();
+    virtual ~KtRecomPt(){};
+    /** Return merged 4-momentum */
+    CLHEP::HepLorentzVector operator()(const CLHEP::HepLorentzVector &, const CLHEP::HepLorentzVector &) const;
+    /** Process input 4-momentum */
+    KtLorentzVector operator()(const KtLorentzVector &) const;
+    /** Name of scheme */
+    std::string name() const;
+  private:
+    std::string m_name;
+  };
+
+
+  class KtRecomPt2 : public KtRecom {
+  public:
+    KtRecomPt2();
+    virtual ~KtRecomPt2(){};
+    /** Return merged 4-momentum */
+    CLHEP::HepLorentzVector operator()(const CLHEP::HepLorentzVector &, const CLHEP::HepLorentzVector &) const;
+    /** Process input 4-momentum */
+    KtLorentzVector operator()(const KtLorentzVector &) const;
+    /** Name of scheme */
+    std::string name() const;
+  private:
+    std::string m_name;
+  };
+
+
+  class KtRecomEt : public KtRecom {
+  public:
+    KtRecomEt();
+    virtual ~KtRecomEt(){};
+    /** Return merged 4-momentum */
+    CLHEP::HepLorentzVector operator()(const CLHEP::HepLorentzVector &, const CLHEP::HepLorentzVector &) const;
+    /** Process input 4-momentum */
+    KtLorentzVector operator()(const KtLorentzVector &) const;
+    /** Name of scheme */
+    std::string name() const;
+  private:
+    std::string m_name;
+  };
+
+
+  class KtRecomEt2 : public KtRecom {
+  public:
+    KtRecomEt2();
+    virtual ~KtRecomEt2(){};
+    /** Return merged 4-momentum */
+    CLHEP::HepLorentzVector operator()(const CLHEP::HepLorentzVector &, const CLHEP::HepLorentzVector &) const;
+    /** Process input 4-momentum */
+    KtLorentzVector operator()(const KtLorentzVector &) const;
+    /** Name of scheme */
+    std::string name() const;
+  private:
+    std::string m_name;
+  };
+
+}//end of namespace
+
+#endif
Index: /trunk/KtJet/KtRecomInterface.h
===================================================================
--- /trunk/KtJet/KtRecomInterface.h	(revision 2)
+++ /trunk/KtJet/KtRecomInterface.h	(revision 2)
@@ -0,0 +1,28 @@
+#ifndef KTJET_KTRECOMINTERFACE_H
+#define KTJET_KTRECOMINTERFACE_H
+
+#include <string>
+#include "KtJet/KtUtil.h"
+
+
+namespace KtJet {
+  class KtLorentzVector;
+  /**
+   *  Interface class to combine 4-momenta
+   *  @author J.Butterworth J.Couchman B.Cox B.Waugh
+  */
+  class KtRecom {
+  public:
+    /** virtual destructor needed */
+    virtual ~KtRecom() {}
+    /** Return merged 4-momentum */
+    virtual CLHEP::HepLorentzVector operator()(const CLHEP::HepLorentzVector &, const CLHEP::HepLorentzVector &) const = 0;
+    /** Process input 4-momentum */
+    virtual KtLorentzVector operator()(const KtLorentzVector &) const = 0;
+    /** Name of scheme */
+    virtual std::string name() const = 0;
+  };
+  
+}
+
+#endif //end of namespace
Index: /trunk/KtJet/KtUtil.cc
===================================================================
--- /trunk/KtJet/KtUtil.cc	(revision 2)
+++ /trunk/KtJet/KtUtil.cc	(revision 2)
@@ -0,0 +1,15 @@
+#include "KtJet/KtUtil.h"
+#include "KtJet/KtLorentzVector.h"
+#include <cmath>
+
+namespace KtJet {
+  /** Put phi in range [-pi,+pi]. No such function in CLHEP 1.7. (But is in 1.8.)
+   */
+KtFloat phiAngle(KtFloat testphi) {
+  KtFloat phi = testphi;
+  while (phi>M_PI) phi -= (2*M_PI);
+  while (phi<-M_PI) phi += (2*M_PI);
+  return phi;
+}
+
+}//end of namespace
Index: /trunk/KtJet/KtUtil.h
===================================================================
--- /trunk/KtJet/KtUtil.h	(revision 2)
+++ /trunk/KtJet/KtUtil.h	(revision 2)
@@ -0,0 +1,24 @@
+#ifndef KTJET_KTUTIL_H
+#define KTJET_KTUTIL_H
+
+// Includes
+#include "CLHEP/Vector/ThreeVector.h"
+#include "CLHEP/Vector/LorentzVector.h"
+
+
+namespace KtJet{
+  
+#ifdef KTDOUBLEPRECISION
+  typedef double KtFloat;
+#else
+  typedef float KtFloat;
+#endif
+  
+  class KtLorentzVector;
+  
+  /** Phi angle forced into range -pi to +pi */
+  KtFloat phiAngle(KtFloat testphi);
+  
+} //end of namespace
+
+#endif
Index: /trunk/KtJet/modify_all.sh
===================================================================
--- /trunk/KtJet/modify_all.sh	(revision 2)
+++ /trunk/KtJet/modify_all.sh	(revision 2)
@@ -0,0 +1,8 @@
+#! /bin/sh
+
+for file in *.h *.cc
+do
+  echo $file
+  sed 's|CLHEPNAMESPACE HepLorentzVector|CLHEP::HepLorentzVector|g' $file > ${file}.tmp
+  mv ${file}.tmp ${file}
+done
Index: /trunk/doc/RootTreeDescription.html
===================================================================
--- /trunk/doc/RootTreeDescription.html	(revision 2)
+++ /trunk/doc/RootTreeDescription.html	(revision 2)
@@ -0,0 +1,639 @@
+<html>
+<head>
+  <meta HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso-8859-1">
+  <meta NAME="keywords" CONTENT="root, tree, ntuple, format, description">
+  <title>root tree description</title>
+</head>
+<body>
+<H1>root tree description</H1>
+<hr>
+<H2>Branches</H2>
+<hr>
+<table style="border: 1px dotted;" align="center" border="0" cellpadding="7" cellspacing="3" widt="95%">
+<tr><td><b>Branch</b></td>
+<td><b>Definition</b></td>
+<td><b>Class</b></td></tr>
+<tr bgcolor="#eeeeee">
+  <td>Event</td>
+  <td>generated event from LHEF
+</td>
+  <td><a href="#ExRootLHEFEvent">ExRootLHEFEvent</a></td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>Particle</td>
+  <td>generated partons from LHEF
+</td>
+  <td><a href="#ExRootLHEFParticle">ExRootLHEFParticle</a></td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>Event</td>
+  <td>information about generated event</td>
+  <td><a href="#ExRootGenEvent">ExRootGenEvent</a></td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>GenParticle</td>
+  <td>generated particles from HEPEVT</td>
+  <td><a href="#ExRootGenParticle">ExRootGenParticle</a></td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>Event</td>
+  <td>information about reconstructed event
+</td>
+  <td><a href="#ExRootEvent">ExRootEvent</a></td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>Photon</td>
+  <td>reconstructed photons
+</td>
+  <td><a href="#ExRootPhoton">ExRootPhoton</a></td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>Electron</td>
+  <td>reconstructed electrons
+</td>
+  <td><a href="#ExRootElectron">ExRootElectron</a></td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>Muon</td>
+  <td>reconstructed muons
+</td>
+  <td><a href="#ExRootMuon">ExRootMuon</a></td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>Tau</td>
+  <td>reconstructed hadronically-decaying tau leptons
+</td>
+  <td><a href="#ExRootTau">ExRootTau</a></td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>Jet</td>
+  <td>reconstructed jets
+</td>
+  <td><a href="#ExRootJet">ExRootJet</a></td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>MissingET</td>
+  <td>missing transverse energy
+</td>
+  <td><a href="#ExRootMissingET">ExRootMissingET</a></td>
+</tr>
+</table>
+<hr>
+<H2>Classes</H2>
+<hr>
+<table style="border: 1px dotted;" align="center" border="0" cellpadding="7" cellspacing="3" widt="95%">
+<tr><td><b>Parameter</b></td>
+<td><b>Definition</b></td>
+<td><b>How it was calculated</b></td></tr>
+<tr bgcolor="#ffffff"><td colspan=3><hr><a name="ExRootLHEFEvent"><H3>ExRootLHEFEvent</H3><hr></td></tr>
+<tr bgcolor="#ffffff">
+  <td>Number</td>
+  <td>event number
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>Nparticles</td>
+  <td>number of particles in the event </td>
+  <td> hepup.NUP
+</td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>ProcessID</td>
+  <td>subprocess code for the event </td>
+  <td> hepup.IDPRUP
+</td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>Weight</td>
+  <td>weight for the event </td>
+  <td> hepup.XWGTUP
+</td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>ScalePDF</td>
+  <td>scale in GeV used in the calculation of the PDFs in the event </td>
+  <td> hepup.SCALUP
+</td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>CouplingQED</td>
+  <td>value of the QED coupling used in the event </td>
+  <td> hepup.AQEDUP
+</td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>CouplingQCD</td>
+  <td>value of the QCD coupling used in the event </td>
+  <td> hepup.AQCDUP
+</td>
+</tr>
+<tr bgcolor="#ffffff"><td colspan=3><hr><a name="ExRootLHEFParticle"><H3>ExRootLHEFParticle</H3><hr></td></tr>
+<tr bgcolor="#ffffff">
+  <td>PID</td>
+  <td>particle HEP ID number </td>
+  <td> hepup.IDUP[number]
+</td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>Status</td>
+  <td>particle status code </td>
+  <td> hepup.ISTUP[number]
+</td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>Mother1</td>
+  <td>index for the particle first mother </td>
+  <td> hepup.MOTHUP[number][0]
+</td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>Mother2</td>
+  <td>index for the particle last mother </td>
+  <td> hepup.MOTHUP[number][1]
+</td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>ColorLine1</td>
+  <td>index for the particle color-line </td>
+  <td> hepup.ICOLUP[number][0]
+</td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>ColorLine2</td>
+  <td>index for the particle anti-color-line </td>
+  <td> hepup.ICOLUP[number][1]
+</td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>Px</td>
+  <td>particle momentum vector (x component) </td>
+  <td> hepup.PUP[number][0]
+</td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>Py</td>
+  <td>particle momentum vector (y component) </td>
+  <td> hepup.PUP[number][1]
+</td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>Pz</td>
+  <td>particle momentum vector (z component) </td>
+  <td> hepup.PUP[number][2]
+</td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>E</td>
+  <td>particle energy </td>
+  <td> hepup.PUP[number][3]
+</td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>M</td>
+  <td>particle mass </td>
+  <td> hepup.PUP[number][4]
+</td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>PT</td>
+  <td>particle transverse momentum
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>Eta</td>
+  <td>particle pseudorapidity
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>Phi</td>
+  <td>particle azimuthal angle
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>Rapidity</td>
+  <td>particle rapidity
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>LifeTime</td>
+  <td>particle invariant lifetime
+ (c*tau, distance from production to decay in mm)
+ </td>
+  <td> hepup.VTIMUP[number]
+</td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>Spin</td>
+  <td>cosine of the angle between the particle spin vector
+ and the decaying particle 3-momentum,
+ specified in the lab frame. </td>
+  <td> hepup.SPINUP[number]
+</td>
+</tr>
+<tr bgcolor="#ffffff"><td colspan=3><hr><a name="ExRootGenEvent"><H3>ExRootGenEvent</H3><hr></td></tr>
+<tr bgcolor="#ffffff">
+  <td>Number</td>
+  <td>event number </td>
+  <td> hepevt.nevhep
+</td>
+</tr>
+<tr bgcolor="#ffffff"><td colspan=3><hr><a name="ExRootGenParticle"><H3>ExRootGenParticle</H3><hr></td></tr>
+<tr bgcolor="#ffffff">
+  <td>PID</td>
+  <td>particle HEP ID number </td>
+  <td> hepevt.idhep[number]
+</td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>Status</td>
+  <td>particle status </td>
+  <td> hepevt.isthep[number]
+</td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>M1</td>
+  <td>particle 1st mother </td>
+  <td> hepevt.jmohep[number][0] - 1
+</td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>M2</td>
+  <td>particle 2nd mother </td>
+  <td> hepevt.jmohep[number][1] - 1
+</td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>D1</td>
+  <td>particle 1st daughter </td>
+  <td> hepevt.jdahep[number][0] - 1
+</td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>D2</td>
+  <td>particle 2nd daughter </td>
+  <td> hepevt.jdahep[number][1] - 1
+</td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>E</td>
+  <td>particle energy </td>
+  <td> hepevt.phep[number][3]
+</td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>Px</td>
+  <td>particle momentum vector (x component) </td>
+  <td> hepevt.phep[number][0]
+</td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>Py</td>
+  <td>particle momentum vector (y component) </td>
+  <td> hepevt.phep[number][1]
+</td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>Pz</td>
+  <td>particle momentum vector (z component) </td>
+  <td> hepevt.phep[number][2]
+</td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>PT</td>
+  <td>particle transverse momentum
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>Eta</td>
+  <td>particle pseudorapidity
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>Phi</td>
+  <td>particle azimuthal angle
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>Rapidity</td>
+  <td>particle rapidity
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>T</td>
+  <td>particle vertex position (t component) </td>
+  <td> hepevt.vhep[number][3]
+</td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>X</td>
+  <td>particle vertex position (x component) </td>
+  <td> hepevt.vhep[number][0]
+</td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>Y</td>
+  <td>particle vertex position (y component) </td>
+  <td> hepevt.vhep[number][1]
+</td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>Z</td>
+  <td>particle vertex position (z component) </td>
+  <td> hepevt.vhep[number][2]
+</td>
+</tr>
+<tr bgcolor="#ffffff"><td colspan=3><hr><a name="ExRootGenJet"><H3>ExRootGenJet</H3><hr></td></tr>
+<tr bgcolor="#ffffff">
+  <td>E</td>
+  <td>jet energy
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>Px</td>
+  <td>jet momentum vector (x component)
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>Py</td>
+  <td>jet momentum vector (y component)
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>Pz</td>
+  <td>jet momentum vector (z component)
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>PT</td>
+  <td>jet transverse momentum
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>Eta</td>
+  <td>jet pseudorapidity
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>Phi</td>
+  <td>jet azimuthal angle
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>Rapidity</td>
+  <td>jet rapidity
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>Mass</td>
+  <td>jet invariant mass
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#ffffff"><td colspan=3><hr><a name="ExRootEvent"><H3>ExRootEvent</H3><hr></td></tr>
+<tr bgcolor="#ffffff">
+  <td>Number</td>
+  <td>event number
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>Trigger</td>
+  <td>trigger word
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#ffffff"><td colspan=3><hr><a name="ExRootMissingET"><H3>ExRootMissingET</H3><hr></td></tr>
+<tr bgcolor="#ffffff">
+  <td>MET</td>
+  <td>mising transverse energy
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>Phi</td>
+  <td>mising energy azimuthal angle
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#ffffff"><td colspan=3><hr><a name="ExRootPhoton"><H3>ExRootPhoton</H3><hr></td></tr>
+<tr bgcolor="#ffffff">
+  <td>PT</td>
+  <td>photon transverse momentum
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>Eta</td>
+  <td>photon pseudorapidity
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>Phi</td>
+  <td>photon azimuthal angle
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>EhadOverEem</td>
+  <td>ratio of the hadronic versus electromagnetic energy
+ deposited in the calorimeter
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#ffffff"><td colspan=3><hr><a name="ExRootElectron"><H3>ExRootElectron</H3><hr></td></tr>
+<tr bgcolor="#ffffff">
+  <td>PT</td>
+  <td>electron transverse momentum
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>Eta</td>
+  <td>electron pseudorapidity
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>Phi</td>
+  <td>electron azimuthal angle
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>Charge</td>
+  <td>electron charge
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>Ntrk</td>
+  <td>number of tracks associated with the electron
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>EhadOverEem</td>
+  <td>ratio of the hadronic versus electromagnetic energy
+ deposited in the calorimeter
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#ffffff"><td colspan=3><hr><a name="ExRootMuon"><H3>ExRootMuon</H3><hr></td></tr>
+<tr bgcolor="#ffffff">
+  <td>PT</td>
+  <td>muon transverse momentum
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>Eta</td>
+  <td>muon pseudorapidity
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>Phi</td>
+  <td>muon azimuthal angle
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>Charge</td>
+  <td>muon charge
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>Ntrk</td>
+  <td>number of tracks associated with the muon
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>PTiso</td>
+  <td>sum of tracks transverse momentum within a cone of radius R=0.4
+ centered on the muon (excluding the muon itself)
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>ETiso</td>
+  <td>ratio of ET in a 3x3 calorimeter cells array around the muon
+ (including the muon's cell) to the muon PT
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>JetIndex</td>
+  <td>index of the closest jet
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#ffffff"><td colspan=3><hr><a name="ExRootTau"><H3>ExRootTau</H3><hr></td></tr>
+<tr bgcolor="#ffffff">
+  <td>PT</td>
+  <td>tau transverse momentum
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>Eta</td>
+  <td>tau pseudorapidity
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>Phi</td>
+  <td>tau azimuthal angle
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>Charge</td>
+  <td>tau charge
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>Ntrk</td>
+  <td>number of charged tracks associated with the tau
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>EhadOverEem</td>
+  <td>ratio of the hadronic versus electromagnetic energy
+ deposited in the calorimeter
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#ffffff"><td colspan=3><hr><a name="ExRootJet"><H3>ExRootJet</H3><hr></td></tr>
+<tr bgcolor="#ffffff">
+  <td>PT</td>
+  <td>jet transverse momentum
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>Eta</td>
+  <td>jet pseudorapidity
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>Phi</td>
+  <td>jet azimuthal angle
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>Mass</td>
+  <td>jet invariant mass
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>Ntrk</td>
+  <td>number of tracks associated with the jet
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>BTag</td>
+  <td>1 or 2 for a jet that has been tagged as containing a heavy quark
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#ffffff">
+  <td>EhadOverEem</td>
+  <td>ratio of the hadronic versus electromagnetic energy
+ deposited in the calorimeter
+</td>
+  <td></td>
+</tr>
+<tr bgcolor="#eeeeee">
+  <td>Index</td>
+  <td>jet index in the LHC Olympics file
+</td>
+  <td></td>
+</tr>
+</table>
+</body></html>
Index: /trunk/doc/convert_all_eps_to_jpg.sh
===================================================================
--- /trunk/doc/convert_all_eps_to_jpg.sh	(revision 2)
+++ /trunk/doc/convert_all_eps_to_jpg.sh	(revision 2)
@@ -0,0 +1,7 @@
+#! /bin/sh
+
+for file in *.eps
+do
+  echo ">> Converting file $file"
+  ./doc/epstosmth --gsopt='-r60x60 -dGraphicsAlphaBits=4' --gsdev=jpeg $file
+done
Index: /trunk/doc/convert_all_eps_to_pdf.sh
===================================================================
--- /trunk/doc/convert_all_eps_to_pdf.sh	(revision 2)
+++ /trunk/doc/convert_all_eps_to_pdf.sh	(revision 2)
@@ -0,0 +1,7 @@
+#! /bin/sh
+
+for file in *.eps
+do
+  echo ">> Converting file $file" 
+  ./doc/epstosmth --gsdev=pdfwrite $file
+done
Index: /trunk/doc/convert_all_eps_to_png.sh
===================================================================
--- /trunk/doc/convert_all_eps_to_png.sh	(revision 2)
+++ /trunk/doc/convert_all_eps_to_png.sh	(revision 2)
@@ -0,0 +1,7 @@
+#! /bin/sh
+
+for file in *.eps
+do
+  echo ">> Converting file $file" 
+  ./doc/epstosmth --gsopt='-r60x60 -dGraphicsAlphaBits=4' --gsdev=png16m $file
+done
Index: /trunk/doc/genMakefile.tcl
===================================================================
--- /trunk/doc/genMakefile.tcl	(revision 2)
+++ /trunk/doc/genMakefile.tcl	(revision 2)
@@ -0,0 +1,921 @@
+#!/usr/bin/env tclsh
+
+set prefix "tmp/"
+set suffix " \\\n\t"
+
+set srcSuf {.$(SrcSuf)}
+set objSuf {.$(ObjSuf)}
+set exeSuf {$(ExeSuf)}
+
+proc dependencies {fileName firstLine {force 1} {command {}}} {
+  global suffix headerFiles sourceFiles
+
+  if {[info exists sourceFiles($fileName)]} return
+
+  set sourceFiles($fileName) 1
+
+  set list {}
+  set fid [open $fileName]
+  while {! [eof $fid]} {
+    set line [gets $fid]
+    if [regexp -- {^\s*#include\s*"((\w+/)+\w+\.(h|hh))"} $line] {
+      set elements [split $line {"}]
+      set file [lindex $elements 1]
+      if [file exists $file] {
+        lappend list $file
+        set headerFiles($file) 1
+      }
+    }
+  }
+  
+  if {[llength $list] > 0} {
+    puts -nonewline $firstLine
+    foreach file $list {puts -nonewline $suffix$file}
+    if {$command != {}} {
+      puts ""
+      puts $command
+    }
+    puts ""
+  } elseif {$force} {
+    puts -nonewline $firstLine
+    if {$command != {}} {
+      puts ""
+      puts $command
+    }
+    puts ""
+  }
+
+  close $fid  
+}
+
+proc dictDeps {dictVar args} {
+
+  global prefix suffix srcSuf objSuf
+
+  set dict [eval glob -nocomplain $args]
+  
+  set dictSrcFiles {}
+  set dictObjFiles {}
+
+  foreach fileName $dict {
+    regsub {LinkDef\.h} $fileName {Dict} dictName
+    set dictName $prefix$dictName
+  
+    lappend dictSrcFiles $dictName$srcSuf
+    lappend dictObjFiles $dictName$objSuf
+  
+    dependencies $fileName "$dictName$srcSuf:$suffix$fileName"
+  }
+  
+  puts -nonewline "${dictVar} = $suffix"
+  puts [join $dictSrcFiles $suffix]
+  puts ""
+
+  puts -nonewline "${dictVar}_OBJ = $suffix"
+  puts [join $dictObjFiles $suffix]
+  puts ""
+
+}
+
+proc sourceDeps {srcPrefix args} {
+
+  global prefix suffix srcSuf objSuf
+  
+  set source [eval glob -nocomplain $args]
+    
+  set srcObjFiles {}
+  
+  foreach fileName $source {
+    regsub {\.cc} $fileName {} srcName
+    set srcObjName $prefix$srcName
+  
+    lappend srcObjFiles $srcObjName$objSuf
+  
+    dependencies $fileName "$srcObjName$objSuf:$suffix$srcName$srcSuf"
+  }
+
+  puts -nonewline "${srcPrefix}_OBJ = $suffix"
+  puts [join $srcObjFiles $suffix]
+  puts ""
+}
+
+proc tclDeps {} {
+
+  global prefix suffix srcSuf objSuf
+   
+  set source [glob -nocomplain {tcl/*.c}]
+  
+  set srcObjFiles {}
+  
+  foreach fileName $source {
+    if {$fileName == "tcl/tclc.c" || $fileName == "tcl/tcl.c"} continue
+ 
+    regsub {\.c} $fileName {} srcName
+    set srcObjName $prefix$srcName
+  
+    lappend srcObjFiles $srcObjName$objSuf
+  
+    dependencies $fileName "$srcObjName$objSuf:$suffix$fileName"
+  }
+  
+  puts -nonewline "TCL_OBJ = $suffix"
+  puts [join $srcObjFiles $suffix]
+  puts ""
+}
+
+proc stdhepDeps {} {
+
+  global prefix suffix srcSuf objSuf
+   
+  set source [glob -nocomplain {mcfio/*.c} {stdhep/*.c}]
+  
+  set srcObjFiles {}
+
+  foreach fileName $source {
+    regsub {\.c} $fileName {} srcName
+    set srcObjName $prefix$srcName
+  
+    lappend srcObjFiles $srcObjName$objSuf
+  
+    dependencies $fileName "$srcObjName$objSuf:$suffix$fileName"
+  }
+  
+  puts -nonewline "STDHEP_OBJ = $suffix"
+  puts [join $srcObjFiles $suffix]
+  puts ""
+}
+
+proc stdhepExecutableDeps {} {
+
+  global prefix suffix objSuf exeSuf
+   
+  set executable [glob -nocomplain {test/ExRootSTDHEPConverter.cpp} \
+                                   {test/MatchingSTDHEPConverter.cpp}]
+
+  set exeFiles {}
+  
+  foreach fileName $executable {
+    regsub {\.cpp} $fileName {} exeObjName
+    set exeObjName $prefix$exeObjName
+    set exeName [file tail $exeObjName]
+
+    lappend exeFiles $exeName$exeSuf
+    lappend exeObjFiles $exeObjName$objSuf
+    
+    puts "$exeName$exeSuf:$suffix$exeObjName$objSuf"
+    puts ""
+  
+    dependencies $fileName "$exeObjName$objSuf:$suffix$fileName"
+  }
+  
+  if [info exists exeFiles] {
+    puts -nonewline "STDHEP_EXECUTABLE = $suffix"
+    puts [join $exeFiles $suffix]
+    puts ""
+  }
+  if [info exists exeObjFiles] {
+    puts -nonewline "STDHEP_EXECUTABLE_OBJ = $suffix"
+    puts [join $exeObjFiles $suffix]
+    puts ""
+  }
+
+}
+
+proc executableDeps {} {
+
+  global prefix suffix objSuf exeSuf
+   
+  set executable [glob -nocomplain {test/*.cpp}]
+  
+  set exeFiles {}
+  
+  foreach fileName $executable {
+    if {$fileName == "test/ExRootSTDHEPConverter.cpp"} continue
+    if {$fileName == "test/MatchingSTDHEPConverter.cpp"} continue
+    regsub {\.cpp} $fileName {} exeObjName
+    set exeObjName $prefix$exeObjName
+    set exeName [file tail $exeObjName]
+
+    lappend exeFiles $exeName$exeSuf
+    lappend exeObjFiles $exeObjName$objSuf
+    
+    puts "$exeName$exeSuf:$suffix$exeObjName$objSuf"
+    puts ""
+  
+    dependencies $fileName "$exeObjName$objSuf:$suffix$fileName"
+  }
+  
+  if [info exists exeFiles] {
+    puts -nonewline "EXECUTABLE = $suffix"
+    puts [join $exeFiles $suffix]
+    puts ""
+  }
+  if [info exists exeObjFiles] {
+    puts -nonewline "EXECUTABLE_OBJ = $suffix"
+    puts [join $exeObjFiles $suffix]
+    puts ""
+  }
+
+}
+
+proc headerDeps {} {
+  global suffix headerFiles
+    
+  foreach fileName [array names headerFiles] {  
+    dependencies $fileName "$fileName:" 0 "\t@touch \$@"
+  }
+}
+
+puts {
+#
+# Makefile for ExRootAnalysis
+#
+# Author: P. Demin - UCL, Louvain-la-Neuve
+#
+# multi-platform configuration is taken from ROOT (root/test/Makefile)
+#
+
+ARCH   = $(shell root-config --arch)
+
+CXX    =
+ObjSuf = o
+SrcSuf = cc
+ExeSuf =
+DllSuf = so
+LibSuf = a
+OutPutOpt     = -o # keep whitespace after "-o"
+
+ROOTCFLAGS   := $(shell root-config --cflags)
+ROOTLIBS     := $(shell root-config --libs)
+ROOTGLIBS    := $(shell root-config --glibs)
+
+ifeq ($(ARCH),win32)
+PLATFORM      = win32
+endif
+ifeq ($(ARCH),win32gdk)
+PLATFORM      = win32
+endif
+
+ifeq ($(ARCH),hpux)
+# HP-UX with CC
+CXX    = CC
+CXXFLAGS      = -O +Z
+LD     = CC
+LDFLAGS= -O +a1 -z
+SOFLAGS= -b
+DllSuf = sl
+endif
+
+ifeq ($(ARCH),hpuxacc)
+# HP-UX 10.x with aCC
+CXX    = aCC
+CXXFLAGS      = -O +Z
+LD     = aCC
+LDFLAGS= -O -z
+SOFLAGS= -b
+endif
+
+ifeq ($(ARCH),hpuxia64acc)
+# HP-UX 11i 1.5 (IA-64) with aCC
+CXX    = aCC
+CXXFLAGS      = +DD64 -O +Z
+LD     = aCC
+LDFLAGS= +DD64 -O -z
+SOFLAGS= -b
+endif
+
+ifeq ($(ARCH),hpuxegcs)
+# HP-UX 10.x with g++
+CXXFLAGS      = -O -fPIC
+CXX    = g++
+LD     = g++
+LDFLAGS= -O
+SOFLAGS= -fPIC -shared
+endif
+
+
+ifeq ($(ARCH),hurddeb)
+# GNU/Hurd
+CXX    = g++
+CXXFLAGS      = -O -Wall -fPIC
+LD     = g++
+LDFLAGS= -O
+SOFLAGS= -shared
+endif
+
+ifeq ($(ARCH),aix)
+# IBM AIX xlC 4.x
+CXX    = xlC
+CXXFLAGS      = -O
+LD     = xlC
+LDFLAGS= -O
+SOFLAGS=
+ROOTLIBS     := $(shell root-config --nonew --libs)
+ROOTGLIBS    := $(shell root-config --nonew --glibs)
+endif
+
+ifeq ($(ARCH),aix5)
+# IBM AIX xlC 5.x
+CXX    = xlC
+CXXFLAGS      = -O
+LD     = xlC
+LDFLAGS= -O
+SOFLAGS=
+ROOTLIBS     := $(shell root-config --nonew --libs)
+ROOTGLIBS    := $(shell root-config --nonew --glibs)
+endif
+
+ifeq ($(ARCH),aixegcs)
+# IBM AIX with GCC
+CXX    = g++
+CXXFLAGS      = -O
+LD     = g++
+LDFLAGS= -O
+SOFLAGS= -shared
+endif
+
+ifeq ($(ARCH),solaris)
+# Solaris CC
+CXX    = /opt/SUNWspro/bin/CC
+CXXFLAGS      = -O -KPIC
+LD     = /opt/SUNWspro/bin/CC
+LDFLAGS= -O
+SOFLAGS= -G
+endif
+
+ifeq ($(ARCH),solarisCC5)
+# Solaris CC 5.0
+CXX    = CC
+CXXFLAGS      = -O -KPIC
+LD     = CC
+LDFLAGS= -O
+SOFLAGS= -G
+endif
+
+ifeq ($(ARCH),solarisegcs)
+# Solaris egcs
+CXX    = g++
+CXXFLAGS      = -O -fPIC
+LD     = CC
+LDFLAGS= -O
+SOFLAGS= -shared
+endif
+
+ifeq ($(ARCH),solarisgcc)
+# Solaris gcc
+CXX    = g++
+CXXFLAGS      = -O -fPIC
+LD     = g++
+LDFLAGS= -O
+SOFLAGS= -shared
+endif
+
+ifeq ($(ARCH),solariskcc)
+# Solaris kcc
+CXX    = KCC --one_instantiation_per_object
+CXXFLAGS      = -O4 -KPIC
+LD     = KCC
+LDFLAGS= -O4
+SOFLAGS=
+endif
+
+ifeq ($(ARCH),solarisx86)
+# Solaris CC on Intel
+CXX    = CC
+CXXFLAGS      = -O -KPIC
+LD     = CC
+LDFLAGS= -O
+SOFLAGS= -G
+endif
+
+ifeq ($(ARCH),sgicc)
+# SGI
+CXX    = CC -n32  -I/usr/include/CC.sgi
+CXXFLAGS      = -O
+LD     = CC -n32  -I/usr/include/CC.sgi
+LDFLAGS= -O
+SOFLAGS= -shared
+endif
+
+ifeq ($(ARCH),sgiegcs)
+# SGI 6.x with EGCS
+CXX    = g++
+CXXFLAGS      = -O -Wall -fPIC
+LD     = g++
+LDFLAGS= -O -Wl,-u,__builtin_new -Wl,-u,__builtin_delete -Wl,-u,__nw__FUiPv
+SOFLAGS= -shared
+endif
+
+ifeq ($(ARCH),sgin32egcs)
+# SGI 6.x with EGCS for n32 ABI
+CXX    = g++
+CXXFLAGS      = -O -Wall -fPIC
+LD     = g++
+LDFLAGS= -O -L/usr/lib32 -Wl,-woff,134
+SOFLAGS= -shared
+endif
+
+ifeq ($(ARCH),sgigcc)
+# SGI with GCC
+CXX    = g++
+CXXFLAGS      = -O -Wall -fPIC
+LD     = g++
+LDFLAGS= -O -Wl,-u,__builtin_new -Wl,-u,__builtin_delete -Wl,-u,__nw__FUiPv
+SOFLAGS= -shared
+endif
+
+ifeq ($(ARCH),sgikcc)
+# SGI with KCC
+CXX    = KCC -n32 --one_instantiation_per_object
+CXXFLAGS      = -O
+LD     = KCC -n32
+LDFLAGS= -O
+SOFLAGS=
+endif
+
+ifeq ($(ARCH),alphagcc)
+# Alpha/OSF with g++
+CXX    = g++
+CXXFLAGS      = -O -Wall -fPIC
+LD     = g++
+LDFLAGS= -O
+SOFLAGS= -Wl,-expect_unresolved,* -shared
+endif
+
+ifeq ($(ARCH),alphaegcs)
+# Alpha/OSF with egcs
+CXX    = g++
+CXXFLAGS      = -O -Wall -fPIC
+LD     = g++
+LDFLAGS= -O
+SOFLAGS= -Wl,-expect_unresolved,* -shared
+endif
+
+ifeq ($(ARCH),alphakcc)
+# Alpha/OSF with kai compiler (not yet valid)
+CXX    = KCC --one_instantiation_per_object
+CXXFLAGS      = -O -fPIC
+LD     = KCC
+LDFLAGS= -O
+SOFLAGS= -Wl,-expect_unresolved,* -shared
+endif
+
+ifeq ($(ARCH),alphacxx6)
+# Alpha/OSF with cxx6
+CXX    = cxx
+CXXFLAGS      = -O
+LD     = cxx
+LDFLAGS= -O
+SOFLAGS= -shared -nocxxstd -Wl,-expect_unresolved,*,-msym
+endif
+
+ifeq ($(ARCH),alphacxx)
+# Alpha/OSF with cxx5
+CXX    = cxx
+CXXFLAGS      = -O
+LD     = cxx
+LDFLAGS= -O
+SOFLAGS= -Wl,-expect_unresolved,* -call_shared
+endif
+
+ifeq ($(ARCH),linuxrh51)
+# Linux with gcc 2.7.2.x
+CXX    = g++
+CXXFLAGS      = -O -Wall -fPIC
+LD     = g++
+LDFLAGS= -O
+SOFLAGS= -shared
+AR = ar
+ARFLAGS = cru
+RANLIB = ranlib
+endif
+
+ifeq ($(ARCH),linuxrh42)
+# Linux with gcc 2.7.2.x (RedHat 4.2)
+CXX    = g++
+CXXFLAGS      = -O -Wall -fPIC
+LD     = g++
+LDFLAGS= -O
+SOFLAGS= -shared
+AR = ar
+ARFLAGS = cru
+RANLIB = ranlib
+endif
+
+ifeq ($(ARCH),linuxdeb)
+# Linux with gcc 2.7.2.x
+CXX    = g++
+CXXFLAGS      = -O -Wall -fPIC
+LD     = g++
+LDFLAGS= -O
+SOFLAGS= -shared
+AR = ar
+ARFLAGS = cru
+RANLIB = ranlib
+endif
+
+ifeq ($(ARCH),linuxdeb2)
+# Linux with gcc 2.7.2.x
+CXX    = g++
+CXXFLAGS      = -O -Wall -fPIC
+LD     = g++
+LDFLAGS= -O
+SOFLAGS= -shared
+AR = ar
+ARFLAGS = cru
+RANLIB = ranlib
+endif
+
+ifeq ($(ARCH),linuxdeb2ppc)
+# Debian/Linux on the PowerPC
+CXX    = g++
+CXXFLAGS      = -O -Wall -fPIC
+LD     = g++
+LDFLAGS= -O
+SOFLAGS= -shared
+AR = ar
+ARFLAGS = cru
+RANLIB = ranlib
+endif
+
+
+ifeq ($(ARCH),linuxsuse6)
+# Linux with gcc 2.7.2.x
+CXX    = g++
+CXXFLAGS      = -O -Wall -fPIC
+LD     = g++
+LDFLAGS= -O
+SOFLAGS= -shared
+AR = ar
+ARFLAGS = cru
+RANLIB = ranlib
+endif
+
+ifeq ($(ARCH),linux)
+# Linux with egcs, gcc 2.9x, gcc 3.x (>= RedHat 5.2)
+CXX    = g++
+CXXFLAGS      = -O -Wall -fPIC
+LD     = g++
+LDFLAGS= -O
+SOFLAGS= -shared
+AR = ar
+ARFLAGS = cru
+RANLIB = ranlib
+endif
+
+ifeq ($(ARCH),linuxkcc)
+# Linux with the KAI compiler
+CXX    = KCC --one_instantiation_per_object
+CXXFLAGS      = -fPIC +K0
+LD     = KCC
+LDFLAGS= -O $(shell root-config --cflags)
+SOFLAGS=
+AR = ar
+ARFLAGS = cru
+RANLIB = ranlib
+endif
+
+ifeq ($(ARCH),linuxicc)
+# Linux with Intel icc compiler
+CXX    = icc
+CXXFLAGS      = -O
+LD     = icc
+LDFLAGS= -O
+SOFLAGS= -shared
+AR = ar
+ARFLAGS = cru
+RANLIB = ranlib
+endif
+
+ifeq ($(ARCH),linuxppcegcs)
+# MkLinux with egcs/glibc
+CXX    = g++
+CXXFLAGS      = -O -Wall -fPIC
+LD     = g++
+LDFLAGS= -O
+SOFLAGS= -shared
+AR = ar
+ARFLAGS = cru
+RANLIB = ranlib
+endif
+
+ifeq ($(ARCH),linuxia64gcc)
+# Itanium Linux with gcc 2.9x
+CXX    = g++
+CXXFLAGS      = -O -Wall -fPIC
+LD     = g++
+LDFLAGS= -O
+SOFLAGS= -shared
+AR = ar
+ARFLAGS = cru
+RANLIB = ranlib
+endif
+
+ifeq ($(ARCH),linuxia64sgi)
+# Itanium Linux with sgiCC
+CXX    = sgiCC
+CXXFLAGS      = -O -Wall -fPIC
+LD     = gsgiCC
+LDFLAGS= -O
+SOFLAGS= -shared
+AR = ar
+ARFLAGS = cru
+RANLIB = ranlib
+endif
+
+ifeq ($(ARCH),linuxia64ecc)
+# Itanium Linux with Intel ecc
+CXX    = ecc
+CXXFLAGS      = -O
+LD     = ecc
+LDFLAGS= -O -i_dynamic
+SOFLAGS= -shared
+AR = ar
+ARFLAGS = cru
+RANLIB = ranlib
+endif
+
+ifeq ($(ARCH),linuxx8664gcc)
+# AMD Opteron (64 bit mode) Linux with gcc 3.x
+CXX    = g++
+CXXFLAGS      = -O -Wall -fPIC
+LD     = g++
+LDFLAGS= -O
+SOFLAGS= -shared
+AR = ar
+ARFLAGS = cru
+RANLIB = ranlib
+endif
+
+ifeq ($(ARCH),linuxalphaegcs)
+# Alpha Linux with egcs
+CXX    = g++
+CXXFLAGS      = -O -Wall -fPIC
+LD     = g++
+LDFLAGS= -O
+SOFLAGS= -shared
+AR = ar
+ARFLAGS = cru
+RANLIB = ranlib
+endif
+
+ifeq ($(ARCH),linuxarm)
+# ARM Linux with egcs
+CXX    = g++
+CXXFLAGS      = -O -Wall -fPIC
+LD     = g++
+LDFLAGS= -O
+SOFLAGS= -shared
+AR = ar
+ARFLAGS = cru
+RANLIB = ranlib
+endif
+
+ifeq ($(ARCH),mklinux)
+# MkLinux with libc5
+CXX    = g++
+CXXFLAGS      = -O -Wall -fPIC
+LD     = g++
+LDFLAGS= -O
+SOFLAGS= -shared
+AR = ar
+ARFLAGS = cru
+RANLIB = ranlib
+endif
+
+ifeq ($(ARCH),freebsd)
+# FreeBSD with libc5
+CXX    = g++
+CXXFLAGS      = -O -pipe -W -Wall -fPIC
+LD     = g++
+LDFLAGS= -O
+SOFLAGS= -shared -Wl,-x
+AR = ar
+ARFLAGS = cru -crv
+RANLIB = ranlib
+endif
+
+ifeq ($(ARCH),freebsd4)
+# FreeBSD with glibc
+CXX    = g++
+CXXFLAGS      = -O -pipe -W -Wall -fPIC
+LD     = g++
+LDFLAGS= -O
+SOFLAGS= -shared -Wl,-x
+AR = ar
+ARFLAGS = cru -crv
+RANLIB = ranlib
+endif
+
+ifeq ($(ARCH),macosx)
+# MacOS X with cc (GNU cc 2.95.2)
+CXX    = c++
+CXXFLAGS      = -O -pipe -Wall
+LD     = c++
+LDFLAGS= -O -Xlinker -bind_at_load -flat_namespace
+# The SOFLAGS will be used to create the .dylib; the .so will
+# be created separately
+DllSuf = dylib
+SOFLAGS= -dynamiclib -flat_namespace -undefined suppress
+AR = ar
+ARFLAGS = cru -crv
+RANLIB = ranlib
+endif
+
+ifeq ($(ARCH),hiux)
+# Hitachi HIUX
+CXX    = g++
+CXXFLAGS      = -O2 -fPIC
+LD     = g++
+LDFLAGS= -Wl,+s
+SOFLAGS= -Wl,-b,-E -nostdlib -nostartfiles
+DllSuf = sl
+endif
+
+ifeq ($(PLATFORM),win32)
+# Windows with the VC++ compiler
+ObjSuf = obj
+SrcSuf = cxx
+ExeSuf = .exe
+DllSuf = dll
+OutPutOpt     = -out:
+CXX    = cl
+CXXOPT = -O2
+#CXXOPT = -Z7
+CXXFLAGS      = $(CXXOPT) -G5 -GR -GX -MD -DWIN32 -D_WINDOWS -nologo \
+  -DVISUAL_CPLUSPLUS -D_X86_=1 -D_DLL
+LD     = link
+LDOPT  = -opt:ref
+#LDOPT  = -debug
+LDFLAGS= $(LDOPT) -pdb:none -nologo
+SOFLAGS= -DLL
+
+ROOTLIBS     := $(shell root-config --nonew --libs)
+ROOTGLIBS    := $(shell root-config --nonew --glibs)
+EXPLLINKLIBS  = $(ROOTLIBS) $(ROOTGLIBS)
+endif
+
+ifeq ($(ARCH),win32gcc)
+# Windows with gcc
+DllSuf = dll
+ExeSuf = .exe
+CXX    = g++
+CXXFLAGS      = -O -Wall -Woverloaded-virtual -I/usr/X11R6/include
+LD     = g++
+LDFLAGS= -O -Wl,--enable-auto-import
+SOFLAGS= -shared -D_DLL -Wl,--export-all-symbols
+EXPLLINKLIBS  = $(ROOTLIBS) $(ROOTGLIBS)
+AR = ar
+ARFLAGS = cru
+RANLIB = ranlib
+endif
+
+ifeq ($(CXX),)
+$(error $(ARCH) invalid architecture)
+endif
+
+CXXFLAGS += $(ROOTCFLAGS) -DDROP_CGAL -I. -Itcl -Imcfio -Istdhep -ICDFCones -ICDFCones/CDFcode
+LIBS = $(ROOTLIBS) -lEG $(SYSLIBS)
+GLIBS = $(ROOTGLIBS) $(SYSLIBS)
+	
+###
+
+STATIC = lib/libExRootAnalysisPGS.$(LibSuf)
+SHARED = lib/libExRootAnalysis.$(DllSuf)
+
+all:
+
+}
+
+stdhepExecutableDeps
+
+executableDeps
+
+dictDeps {DICT} {src/*LinkDef.h} {modules/*LinkDef.h}
+
+dictDeps {PGS_DICT} {pgs/*LinkDef.h}
+
+sourceDeps {SOURCE} {src/*.cc} {modules/*.cc} {CDFCones/*.cc} {KtJet/*.cc} {CLHEP/src/*.cc}
+
+sourceDeps {PGS_SOURCE} {src/ExRootClasses.cc} {src/ExRootTreeBranch.cc} {src/ExRootTreeWriter.cc}
+
+sourceDeps {PGS} {pgs/*.cc}
+
+stdhepDeps
+
+tclDeps
+
+headerDeps
+
+puts {
+
+###
+
+all: $(SHARED) $(EXECUTABLE) $(STDHEP_EXECUTABLE)
+
+static: $(STATIC)
+
+$(STATIC): $(PGS_DICT_OBJ) $(PGS_SOURCE_OBJ) $(PGS_OBJ)
+	@mkdir -p $(@D)
+	$(AR) $(ARFLAGS) $@ $^
+	$(RANLIB) $@
+
+$(SHARED): $(DICT_OBJ) $(SOURCE_OBJ) $(TCL_OBJ)
+		@mkdir -p $(@D)
+		@echo ">> Building $@"
+ifeq ($(ARCH),aix)
+		@/usr/ibmcxx/bin/makeC++SharedLib $(OutPutOpt)$@ $(LIBS) -p 0 $^
+else
+ifeq ($(ARCH),aix5)
+		@/usr/vacpp/bin/makeC++SharedLib $(OutPutOpt)$@ $(LIBS) -p 0 $^
+else
+ifeq ($(ARCH),macosx)
+# We need to make both the .dylib and the .so
+		@$(LD) $(SOFLAGS) $^ $(OutPutOpt)$@
+		@$(LD) -bundle -undefined suppress $(LDFLAGS) $^ $(LIBS) \
+		   $(OutPutOpt)$(subst .$(DllSuf),.so,$@)
+else
+ifeq ($(PLATFORM),win32)
+		@bindexplib $* $^ > $*.def
+		@lib -nologo -MACHINE:IX86 $^ -def:$*.def \
+		   $(OutPutOpt)$(EVENTLIB)
+		@$(LD) $(SOFLAGS) $(LDFLAGS) $^ $*.exp $(LIBS) \
+		   $(OutPutOpt)$@
+else
+		@$(LD) $(SOFLAGS) $(LDFLAGS) $^ $(OutPutOpt) $@ $(EXPLLINKLIBS)
+endif
+endif
+endif
+endif
+
+clean:
+		@rm -f $(PGS_DICT_OBJ) $(PGS_SOURCE_OBJ) $(PGS_OBJ) $(DICT_OBJ) $(SOURCE_OBJ) $(TCL_OBJ) $(STDHEP_OBJ) core
+
+distclean: clean
+		@rm -f $(SHARED) $(STATIC) $(EXECUTABLE) $(STDHEP_EXECUTABLE)
+
+###
+
+.SUFFIXES: .$(SrcSuf) .$(ObjSuf) .$(DllSuf)
+
+%Dict.$(SrcSuf):
+	@mkdir -p $(@D)
+	@echo ">> Generating $@"
+	@rootcint -f $@ -c $<
+	@echo "#define private public" > $@.arch
+	@echo "#define protected public" >> $@.arch
+	@mv $@ $@.base
+	@cat $@.arch $< $@.base > $@
+	@rm $@.arch $@.base
+
+$(SOURCE_OBJ): tmp/%.$(ObjSuf): %.$(SrcSuf)
+	@mkdir -p $(@D)
+	@echo ">> Compiling $<"
+	@$(CXX) $(CXXFLAGS) -c $< $(OutPutOpt)$@
+
+$(PGS_OBJ): tmp/%.$(ObjSuf): %.$(SrcSuf)
+	@mkdir -p $(@D)
+	@echo ">> Compiling $<"
+	@$(CXX) $(CXXFLAGS) -c $< $(OutPutOpt)$@
+
+$(DICT_OBJ): %.$(ObjSuf): %.$(SrcSuf)
+	@mkdir -p $(@D)
+	@echo ">> Compiling $<"
+	@$(CXX) $(CXXFLAGS) -c $< $(OutPutOpt)$@
+
+$(PGS_DICT_OBJ): %.$(ObjSuf): %.$(SrcSuf)
+	@mkdir -p $(@D)
+	@echo ">> Compiling $<"
+	@$(CXX) $(CXXFLAGS) -c $< $(OutPutOpt)$@
+
+$(TCL_OBJ): tmp/%.$(ObjSuf): %.c
+	@mkdir -p $(@D)
+	@echo ">> Compiling $<"
+	@gcc $(CXXFLAGS) -c $< $(OutPutOpt)$@
+
+$(STDHEP_OBJ): tmp/%.$(ObjSuf): %.c
+	@mkdir -p $(@D)
+	@echo ">> Compiling $<"
+	@gcc $(CXXFLAGS) -c $< $(OutPutOpt)$@
+
+$(STDHEP_EXECUTABLE_OBJ): tmp/%.$(ObjSuf): %.cpp
+	@mkdir -p $(@D)
+	@echo ">> Compiling $<"
+	@$(CXX) $(CXXFLAGS) -c $< $(OutPutOpt)$@
+
+$(STDHEP_EXECUTABLE): %$(ExeSuf): $(DICT_OBJ) $(SOURCE_OBJ) $(TCL_OBJ) $(STDHEP_OBJ)
+	@echo ">> Building $@"
+	@$(LD) $(LDFLAGS) $^ $(LIBS) $(OutPutOpt)$@
+
+$(EXECUTABLE_OBJ): tmp/%.$(ObjSuf): %.cpp
+	@mkdir -p $(@D)
+	@echo ">> Compiling $<"
+	@$(CXX) $(CXXFLAGS) -c $< $(OutPutOpt)$@
+
+$(EXECUTABLE): %$(ExeSuf): $(DICT_OBJ) $(SOURCE_OBJ) $(TCL_OBJ)
+	@echo ">> Building $@"
+	@$(LD) $(LDFLAGS) $^ $(LIBS) $(OutPutOpt)$@
+
+###
+
+}
Index: /trunk/doc/pgs_event.txt
===================================================================
--- /trunk/doc/pgs_event.txt	(revision 2)
+++ /trunk/doc/pgs_event.txt	(revision 2)
@@ -0,0 +1,158 @@
+    1  !p+!                  3     2212     0     0     0     0     0.00000     0.00000  6999.99994  7000.00000     0.93827
+    2  !p+!                  3     2212     0     0     0     0     0.00000     0.00000 -6999.99994  7000.00000     0.93827
+    3  !u~!                  3       -2     1     0     0     0    -2.26172    -0.11287   332.37885   332.38656     0.00000
+    4  !u!                   3        2     2     0     0     0    -1.35956    -0.85605   -78.83961    78.85598     0.00000
+    5  !u~!                  3       -2     3     0     0     0    -2.79742     1.67248    47.29086    47.40304     0.00000
+    6  !u!                   3        2     4     0     0     0     1.16616     1.59813   -43.90361    43.94816     0.00000
+    7  !e+!                  3      -11     5     6     0     0    29.05428    34.79091    -7.72125    45.98017     0.00000
+    8  !e-!                  3       11     5     6     0     0   -30.68554   -31.52031    11.10849    45.37103     0.00002
+    9  e-                    1       11     8     0     0     0   -30.68546   -31.52023    11.10847    45.37092     0.00002
+   10  gamma                 1       22     7     0     0     0     0.03140     0.03070    -0.00823     0.04467     0.00000
+   11  gamma                 1       22     7     0     0     0     0.00431     0.00514    -0.00095     0.00677     0.00000
+   12  e+                    1      -11     7     0     0     0    28.73969    34.42105    -7.63792    45.48754     0.00000
+   13  gamma                 1       22     7     0     0     0     0.27880     0.33394    -0.07412     0.44130     0.00000
+   14  p+                    1     2212     1     0     0     0     1.03423    -0.42176  4412.78921  4412.78945     0.93827
+   15  (u)                   2        2     1     0    28    28     1.22750     0.53462  2254.81947  2254.81989     0.33000
+   16  (g)                   2       21     3     0    28    28    -1.65229    -0.33376    64.46725    64.48929     0.00000
+   17  (g)                   2       21     3     0    28    28     0.16577     0.10652     0.03666     0.20043     0.00000
+   18  (g)                   2       21     3     0    28    28    -1.01762    -1.13102    15.16056    15.23671     0.00000
+   19  (g)                   2       21     3     0    28    28     2.21511    -4.40553   189.68954   189.75362     0.00000
+   20  (g)                   2       21     3     0    28    28    -0.25112    -0.41191     1.25753     1.34689     0.00000
+   21  (g)                   2       21     3     0    28    28     0.25830    -0.04810     0.59093     0.64670     0.00000
+   22  (g)                   2       21     3     0    28    28    -0.71699     0.25173     1.36438     1.56172     0.00000
+   23  (g)                   2       21     3     0    28    28     1.82485     4.34683    11.23894    12.18765     0.00000
+   24  (g)                   2       21     3     0    28    28    -0.25821    -0.13064     0.22632     0.36736     0.00000
+   25  (g)                   2       21     4     0    28    28    -0.23885    -1.18807   -11.54845    11.61186     0.00000
+   26  (g)                   2       21     4     0    28    28    -2.31898    -1.29558   -22.33167    22.48910     0.00000
+   27  (ud_0)                2     2101     2     0    28    28     1.35956     0.85605 -6921.14791  6921.14812     0.57933
+   28  (gen. code)           2       92    15    27    29    66     0.59703    -2.84885 -4416.17646  9495.85935  8406.46904
+   29  (Sigma+)              2     3222    28     0    67    68     1.22119     0.25723  1842.63313  1842.63393     1.18937
+   30  (Sigma~-)             2    -3222    28     0    69    70    -0.43418     0.11271   265.77242   265.77546     1.18937
+   31  (rho(770)+)           2      213    28     0    71    72    -0.07069    -0.07126   166.12552   166.12766     0.83784
+   32  pi-                   1     -211    28     0     0     0    -0.43688    -0.13292     9.63590     9.64772     0.13957
+   33  (pi0)                 2      111    28     0    73    74     0.17593     0.65348     7.87231     7.90250     0.13498
+   34  K+                    1      321    28     0     0     0    -0.43062    -0.57926     6.88489     6.94020     0.49360
+   35  K-                    1     -321    28     0     0     0    -0.80501     0.25022    21.99043    22.01212     0.49360
+   36  p+                    1     2212    28     0     0     0     0.03289    -0.89375    11.02726    11.10318     0.93827
+   37  (Delta~-)             2    -2214    28     0    75    76     0.75514    -0.71606    30.58247    30.62591     1.25529
+   38  (pi0)                 2      111    28     0    77    78    -0.22977    -1.12104    27.77793    27.80182     0.13498
+   39  (Delta++)             2     2224    28     0    79    80     0.18842    -0.52209    34.05070    34.07748     1.23149
+   40  (K*(892)-)            2     -323    28     0    81    82     0.13095    -1.59843    76.18728    76.20943     0.89607
+   41  (Sigma~0)             2    -3212    28     0    83    84     0.70383    -0.80659    17.26633    17.34054     1.19255
+   42  (omega(782))          2      223    28     0    85    87    -0.27707     0.17045     2.81905     2.93678     0.75617
+   43  (Delta-)              2     1114    28     0    88    89     0.44973     0.22695     6.26137     6.40255     1.23860
+   44  (rho(770)0)           2      113    28     0    90    91    -0.09855     0.13253     2.31416     2.43121     0.72675
+   45  (Sigma~+)             2    -3112    28     0    92    93     0.14204     1.21110     3.88023     4.23992     1.19744
+   46  K-                    1     -321    28     0     0     0     0.53884     1.52955     2.16955     2.75326     0.49360
+   47  pi+                   1      211    28     0     0     0     0.47362    -0.06519     1.92802     1.99131     0.13957
+   48  pi-                   1     -211    28     0     0     0    -0.06174     0.08815    -0.28459     0.33475     0.13957
+   49  (rho(770)+)           2      213    28     0    94    95    -0.10102     0.72191     0.47432     0.98983     0.47268
+   50  (eta)                 2      221    28     0    96    97    -0.09551    -0.43762    -0.67519     0.97786     0.54745
+   51  pi-                   1     -211    28     0     0     0     0.04040     0.02089    -0.03125     0.15008     0.13957
+   52  K+                    1      321    28     0     0     0     0.47623    -0.02707     0.05344     0.68850     0.49360
+   53  (K*(892)~0)           2     -313    28     0    98    99    -0.45540     0.12792    -2.13523     2.35579     0.87568
+   54  pi-                   1     -211    28     0     0     0     0.20916    -0.49595    -1.35271     1.46253     0.13957
+   55  (omega(782))          2      223    28     0   100   102    -0.75969    -0.08648    -2.98904     3.18581     0.79398
+   56  (omega(782))          2      223    28     0   103   105    -0.26953    -0.46476    -4.04193     4.15244     0.78546
+   57  (pi0)                 2      111    28     0   106   107    -0.88681    -0.15747    -4.84567     4.93052     0.13498
+   58  K+                    1      321    28     0     0     0     0.46110    -0.38884    -4.11115     4.18438     0.49360
+   59  (K*(892)~0)           2     -313    28     0   108   109    -0.90280    -0.13309   -28.58945    28.61875     0.91830
+   60  (rho(770)0)           2      113    28     0   110   111     0.00521    -0.16286   -10.85025    10.87310     0.68537
+   61  (K0)                  2      311    28     0   112   112    -0.50279    -0.47789   -18.87369    18.89299     0.49767
+   62  (K~0)                 2     -311    28     0   113   113     0.25514     0.30944  -101.80193   101.80393     0.49767
+   63  (eta)                 2      221    28     0   114   116    -0.23750    -0.05693  -141.13098   141.13226     0.54745
+   64  (eta'(958))           2      331    28     0   117   118     0.35871     0.05405  -256.80436   256.80641     0.95837
+   65  (Delta-)              2     1114    28     0   119   120     1.19254     0.45333 -5773.30918  5773.30946     1.27875
+   66  (rho(770)+)           2      213    28     0   121   122    -0.15847     0.22678  -602.05655   602.05698     0.66860
+   67  p+                    1     2212    29     0     0     0     1.23976     0.17446  1670.04130  1670.04203     0.93827
+   68  (pi0)                 2      111    29     0   123   124    -0.01856     0.08276   172.59183   172.59190     0.13498
+   69  n~0                   1    -2112    30     0     0     0    -0.36509     0.19532   185.13699   185.13984     0.93957
+   70  pi-                   1     -211    30     0     0     0    -0.06910    -0.08260    80.63543    80.63562     0.13957
+   71  pi+                   1      211    31     0     0     0    -0.14410    -0.01776   159.56149   159.56162     0.13957
+   72  (pi0)                 2      111    31     0   125   126     0.07340    -0.05350     6.56402     6.56604     0.13498
+   73  gamma                 1       22    33     0     0     0     0.11299     0.54852     5.95106     5.97735     0.00000
+   74  gamma                 1       22    33     0     0     0     0.06294     0.10496     1.92125     1.92514     0.00000
+   75  p~-                   1    -2212    37     0     0     0     0.30011    -0.43370    20.90906    20.93675     0.93827
+   76  (pi0)                 2      111    37     0   127   128     0.45503    -0.28236     9.67341     9.68916     0.13498
+   77  gamma                 1       22    38     0     0     0    -0.09043    -0.63651    16.86422    16.87647     0.00000
+   78  gamma                 1       22    38     0     0     0    -0.13934    -0.48453    10.91372    10.92535     0.00000
+   79  p+                    1     2212    39     0     0     0    -0.04839    -0.26933    24.69561    24.71494     0.93827
+   80  pi+                   1      211    39     0     0     0     0.23681    -0.25276     9.35509     9.36254     0.13957
+   81  (K~0)                 2     -311    40     0   129   129     0.14443    -1.50264    73.24889    73.26613     0.49767
+   82  pi-                   1     -211    40     0     0     0    -0.01349    -0.09579     2.93839     2.94330     0.13957
+   83  (Lambda~0)            2    -3122    41     0   130   131     0.71989    -0.83576    16.95513    17.02756     1.11568
+   84  gamma                 1       22    41     0     0     0    -0.01606     0.02917     0.31120     0.31298     0.00000
+   85  pi-                   1     -211    42     0     0     0    -0.06474     0.27554     0.61679     0.69284     0.13957
+   86  pi+                   1      211    42     0     0     0    -0.04567    -0.11658     1.43457     1.44678     0.13957
+   87  (pi0)                 2      111    42     0   132   133    -0.16666     0.01149     0.76769     0.79716     0.13498
+   88  n0                    1     2112    43     0     0     0     0.10713     0.12952     4.43750     4.53899     0.93957
+   89  pi-                   1     -211    43     0     0     0     0.34260     0.09744     1.82387     1.86356     0.13957
+   90  pi+                   1      211    44     0     0     0    -0.12372     0.17609     2.25808     2.27260     0.13957
+   91  pi-                   1     -211    44     0     0     0     0.02517    -0.04356     0.05608     0.15861     0.13957
+   92  n~0                   1    -2112    45     0     0     0     0.10565     0.75945     2.46070     2.74331     0.93957
+   93  pi+                   1      211    45     0     0     0     0.03639     0.45165     1.41953     1.49662     0.13957
+   94  pi+                   1      211    49     0     0     0    -0.13464     0.70161     0.38801     0.82488     0.13957
+   95  (pi0)                 2      111    49     0   134   135     0.03362     0.02030     0.08630     0.16496     0.13498
+   96  gamma                 1       22    50     0     0     0    -0.03181    -0.55881    -0.60431     0.82369     0.00000
+   97  gamma                 1       22    50     0     0     0    -0.06370     0.12119    -0.07087     0.15417     0.00000
+   98  K-                    1     -321    53     0     0     0    -0.54926     0.19788    -1.36694     1.56621     0.49360
+   99  pi+                   1      211    53     0     0     0     0.09385    -0.06996    -0.76829     0.78959     0.13957
+  100  pi-                   1     -211    55     0     0     0    -0.04073    -0.03846    -0.74977     0.76470     0.13957
+  101  pi+                   1      211    55     0     0     0    -0.47588    -0.08554    -1.96624     2.02962     0.13957
+  102  (pi0)                 2      111    55     0   136   137    -0.24307     0.03752    -0.27302     0.39148     0.13498
+  103  pi-                   1     -211    56     0     0     0     0.04703    -0.16857    -0.64675     0.68439     0.13957
+  104  pi+                   1      211    56     0     0     0    -0.01984     0.09475    -1.34238     1.35308     0.13957
+  105  (pi0)                 2      111    56     0   138   139    -0.29673    -0.39094    -2.05280     2.11497     0.13498
+  106  gamma                 1       22    57     0     0     0    -0.71633    -0.17991    -3.88813     3.95766     0.00000
+  107  gamma                 1       22    57     0     0     0    -0.17048     0.02244    -0.95754     0.97285     0.00000
+  108  K-                    1     -321    59     0     0     0    -0.71994     0.19368   -20.23715    20.25690     0.49360
+  109  pi+                   1      211    59     0     0     0    -0.18286    -0.32676    -8.35230     8.36185     0.13957
+  110  pi+                   1      211    60     0     0     0     0.07193    -0.27216    -9.85348     9.85849     0.13957
+  111  pi-                   1     -211    60     0     0     0    -0.06672     0.10930    -0.99678     1.01461     0.13957
+  112  (KS0)                 2      310    61     0   140   141    -0.50279    -0.47789   -18.87369    18.89299     0.49767
+  113  KL0                   1      130    62     0     0     0     0.25514     0.30944  -101.80193   101.80393     0.49767
+  114  (pi0)                 2      111    63     0   142   143    -0.17860    -0.00843   -57.00448    57.00492     0.13498
+  115  (pi0)                 2      111    63     0   144   145    -0.01723    -0.14728   -48.89587    48.89628     0.13498
+  116  (pi0)                 2      111    63     0   146   147    -0.04167     0.09879   -35.23064    35.23106     0.13498
+  117  gamma                 1       22    64     0     0     0     0.12117    -0.01063   -24.97614    24.97644     0.00000
+  118  (rho(770)0)           2      113    64     0   148   149     0.23754     0.06468  -231.82822   231.82997     0.86604
+  119  n0                    1     2112    65     0     0     0     0.56079     0.32343 -3869.02688  3869.02704     0.93957
+  120  pi-                   1     -211    65     0     0     0     0.63175     0.12990 -1904.28230  1904.28242     0.13957
+  121  pi+                   1      211    66     0     0     0    -0.18226    -0.11045  -416.40324   416.40331     0.13957
+  122  (pi0)                 2      111    66     0   150   151     0.02380     0.33724  -185.65331   185.65367     0.13498
+  123  gamma                 1       22    68     0     0     0     0.04977     0.03107   109.14294   109.14296     0.00000
+  124  gamma                 1       22    68     0     0     0    -0.06833     0.05169    63.44889    63.44895     0.00000
+  125  gamma                 1       22    72     0     0     0    -0.01336    -0.07164     2.57251     2.57354     0.00000
+  126  gamma                 1       22    72     0     0     0     0.08676     0.01814     3.99151     3.99250     0.00000
+  127  gamma                 1       22    76     0     0     0     0.37750    -0.22251     6.81416     6.82823     0.00000
+  128  gamma                 1       22    76     0     0     0     0.07753    -0.05985     2.85925     2.86093     0.00000
+  129  KL0                   1      130    81     0     0     0     0.14443    -1.50264    73.24889    73.26613     0.49767
+  130  p~-                   1    -2212    83     0     0     0     0.72169    -0.70608    14.94963    15.01304     0.93827
+  131  pi+                   1      211    83     0     0     0    -0.00180    -0.12967     2.00550     2.01453     0.13957
+  132  gamma                 1       22    87     0     0     0    -0.08348    -0.00214     0.63156     0.63705     0.00000
+  133  gamma                 1       22    87     0     0     0    -0.08317     0.01363     0.13613     0.16011     0.00000
+  134  gamma                 1       22    95     0     0     0     0.02407    -0.00803     0.11840     0.12109     0.00000
+  135  gamma                 1       22    95     0     0     0     0.00956     0.02833    -0.03210     0.04387     0.00000
+  136  gamma                 1       22   102     0     0     0    -0.22923     0.00228    -0.18138     0.29232     0.00000
+  137  gamma                 1       22   102     0     0     0    -0.01384     0.03524    -0.09165     0.09916     0.00000
+  138  gamma                 1       22   105     0     0     0    -0.09874    -0.04127    -0.45449     0.46692     0.00000
+  139  gamma                 1       22   105     0     0     0    -0.19799    -0.34966    -1.59831     1.64805     0.00000
+  140  pi+                   1      211   112     0     0     0    -0.13271    -0.39766    -8.54289     8.55431     0.13957
+  141  pi-                   1     -211   112     0     0     0    -0.37009    -0.08023   -10.33079    10.33867     0.13957
+  142  gamma                 1       22   114     0     0     0    -0.03608     0.05665   -18.18142    18.18155     0.00000
+  143  gamma                 1       22   114     0     0     0    -0.14252    -0.06509   -38.82305    38.82337     0.00000
+  144  gamma                 1       22   115     0     0     0    -0.03007     0.01771    -7.85681     7.85688     0.00000
+  145  gamma                 1       22   115     0     0     0     0.01284    -0.16499   -41.03906    41.03940     0.00000
+  146  gamma                 1       22   116     0     0     0    -0.02526     0.12895   -31.15545    31.15572     0.00000
+  147  gamma                 1       22   116     0     0     0    -0.01641    -0.03016    -4.07519     4.07533     0.00000
+  148  pi+                   1      211   118     0     0     0     0.04387    -0.37253   -95.68883    95.68967     0.13957
+  149  pi-                   1     -211   118     0     0     0     0.19367     0.43721  -136.13939   136.14030     0.13957
+  150  gamma                 1       22   122     0     0     0    -0.04371     0.22716  -131.08533   131.08553     0.00000
+  151  gamma                 1       22   122     0     0     0     0.06750     0.11008   -54.56798    54.56814     0.00000
+
+  object  type         ET      p
+     1    electron   44.48   28.51   34.15   -7.58   45.12
+     2    electron   43.41  -30.28  -31.10   10.96   44.77
+
+
+
Index: /trunk/doc/replace_troot.sh
===================================================================
--- /trunk/doc/replace_troot.sh	(revision 2)
+++ /trunk/doc/replace_troot.sh	(revision 2)
@@ -0,0 +1,8 @@
+#! /bin/sh
+
+for file in `grep -l 'TRoot' *`
+do
+  echo $file
+  sed 's/TRoot/ExRoot/g' ${file} > ${file}.tmp
+  mv ${file}.tmp ${file}
+done
Index: /trunk/doc/useful_commands.txt
===================================================================
--- /trunk/doc/useful_commands.txt	(revision 2)
+++ /trunk/doc/useful_commands.txt	(revision 2)
@@ -0,0 +1,7 @@
+./doc/genMakefile.tcl > Makefile
+make
+
+make static
+cd test
+g77 test.f -o test.exe -L../lib -l ExRootAnalysisPGS -l stdc++ `root-config --libs`
+./test.exe
Index: /trunk/mcfio/mcf_NTuIOFiles.c
===================================================================
--- /trunk/mcfio/mcf_NTuIOFiles.c	(revision 2)
+++ /trunk/mcfio/mcf_NTuIOFiles.c	(revision 2)
@@ -0,0 +1,965 @@
+/*******************************************************************************
+*									       *
+* mcf_NTuIOFiles.c -- Utilities to manipulate files within the MCFIO Gen.      *
+*        				Ntuple schema                          *
+*									       *
+*	P. Lebrun, September 1995.					       *
+*									       *
+*******************************************************************************/
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+#include <sys/param.h>
+#include <limits.h>
+#include <time.h>
+#include <rpc/types.h>
+#include <sys/types.h>
+#include <rpc/xdr.h>
+#include <unistd.h>
+#include <ctype.h>
+#include "mcf_nTupleDescript.h"
+#include "mcf_xdr.h"
+#include "mcfio_Dict.h"
+#include "mcfio_Direct.h"
+#include "mcfio_Util1.h"
+#include "mcf_NTuIOFiles.h"
+#include "mcf_NTuIOUtils.h"
+#include "mcf_ntubld_db.h"
+#include "mcf_ntuBldDbinc.h"
+#ifndef False
+#define False 0
+#endif
+#ifndef True
+#define True 1
+#endif
+
+extern char *VarTypesNamesF77[N_VAR_TYPES];
+extern char *VarTypesNamesC[N_VAR_TYPES];
+
+extern struct line_title_c line_title_c_;
+extern struct header_c header_c_;
+extern struct variable_c variable_c_;
+
+/*
+** Ntuple identifiers list, initialized here and in mcfio_Util1
+*/
+nTuDDL **NTuDDLList = NULL;
+int NumOfNTuples = 0;
+bool_t McfNTuPleSaveDecoding = True;
+
+static char *makeStructName(char *title, int orgStyle);
+static size_t nDatVariable(varGenNtuple *varTmp);
+static size_t sizeVariable(varGenNtuple *varTmp);
+static char *mcf_copyNtrim(char *fromString);
+
+int mcfioC_DeclareNtuple(int uid, char *title, char *category, 
+                                int stream, char *filename)
+{
+    nTuDDL *ddl, *ddlRef;
+    int i, j, jstr, dejaVu, id, **ip;
+    
+    
+    if ((stream < 1) || (stream > MCF_STREAM_NUM_MAX)) {
+     fprintf(stderr,
+  " mcfio_NtupleDDLRead: Illegal MCFIO stream number.\n"); 
+     return -1;
+    }
+    jstr = stream-1;
+    if (McfStreamPtrList[jstr] == NULL) { 
+        fprintf(stderr,
+   " mcfio_DeclareNtuple: First, declare the stream by calling mcfio_Open...\n"); 
+     return -1;
+    }
+      
+    if (McfStreamPtrList[jstr]->row != MCFIO_WRITE) {
+        fprintf(stderr,
+   " mcfio_DeclareNtuple: You must declare an Ntuple for an Output Stream\n"); 
+     return -1;
+    }
+        
+    if (!mcf_CheckValidCat(category, False)) return 0;
+    
+    /* Check that this item characterized by uid/Category has not already been 
+         created. If so, do not create a new one.  If associated to the same
+         stream, flag this as an error. */
+    
+    id = mcf_NTuId(uid, category);			
+    if (id != -1) {
+       ddl = mcf_GetNTuByPtrID(id);
+       if (ddl->streamId == stream) {  
+        fprintf(stderr,
+        "Mcfio Declare Ntuple:  An item with this uid/Category already exists.\n");
+        fprintf(stderr, "  uid = %d, Category = %s, ", uid, category);
+        fprintf(stderr, "Ntuple not created.\n");
+        return -1;
+        }
+     }
+     /*
+     ** May be this dbin template has already been digested. If so, refer
+     ** to it, to avoid re-computing all the offsets.
+    */
+     ip = (int **) NTuDDLList;
+     for (i=0, dejaVu=False; i< NumOfNTuples; i++, ip++) {
+	 ddlRef = (nTuDDL *) *ip;
+         if ((ddlRef->dbinFileName != NULL) && 
+             (strcmp(filename, ddlRef->dbinFileName) == 0)) {
+             dejaVu = True;
+            /* Create a holder for this Ntuple Description */
+             ddl = (nTuDDL * ) malloc(sizeof(nTuDDL));
+             /*
+             ** back up in the linked list if need be, until we 
+             ** a fully documented descriptor.
+             */
+             while (ddlRef->descrNtu == NULL) ddlRef = ddlRef->reference;
+             ddl->reference = ddlRef; 
+             ddl->descrNtu = NULL;
+             ddl->dbinFileName = NULL;
+             break;
+         }
+     }
+     if (dejaVu == False)  {
+         ddl = mcf_GetFileNTuDDL(filename);
+         if (ddl == NULL) { 
+              fprintf(stderr,
+                  " mcfio_NtupleDDLRead: Error reading %s\n", filename );
+                 return -1; 
+         }
+         ddl->reference = NULL;
+    }
+    ddl->title = mcf_copyNtrim(mcf_ValidStr(title, NTU_MAX_TITLE_LENGTH, 
+    				 "title"));
+    if (category == NULL)
+      ddl->category = 
+         mcf_copyNtrim(mcf_ValidStr(category, NTU_MAX_CATEGORY_LENGTH, 
+    				 "category"));
+    else {
+	ddl->category = mcf_copyNtrim(category);
+    }
+    AddNTuDDLtoList(ddl);
+/*
+** Now we compute the offssets. 
+*/
+    if (dejaVu == False)  {
+        mcf_ComputeNTuOffsets(ddl);    
+/*
+** Now we compute the lengths..
+*/
+       mcf_ComputeNTuLengths(ddl);
+    }
+    ddl->uid = uid;
+    ddl->streamId = stream;
+    /*
+    ** Set the sequential id for this particular stream
+    */
+    for (i=0, j=0; i<NumOfNTuples; i++) 
+        if (NTuDDLList[i]->streamId == ddl->streamId) j++;
+    ddl->seqNTuId = j;
+    (McfStreamPtrList[jstr]->fhead->nNTuples)++;
+    return ddl->seqNTuId;
+}
+     
+int mcfioC_EndDeclNTuples(int stream)
+/*
+** Routine to end theNtuple delcaration and rewrite the beginning of the 
+** file.
+*/
+{
+   int i, jstr;
+   u_int p1;
+   FILE *ff;
+   mcfStream *str;
+   
+  if (McfStreamPtrList == NULL) { 
+     fprintf(stderr,
+  " mcfio_EndDeclNtuple: No stream open, No inialization.\n"); 
+     return -1;
+  }
+  jstr = stream-1;
+  if (McfStreamPtrList[jstr] == NULL) { 
+     fprintf(stderr,
+ " mcfio_EndDeclNtuple: First, declare the stream by calling mcfio_Open...\n"); 
+     return -1;
+  }
+  str = McfStreamPtrList[jstr];
+  if (str->row != MCFIO_WRITE) {
+     fprintf(stderr,
+ " mcfio_EndDeclNtuple: This routine is not applicable to Input streams...\n"); 
+     return -1;
+  }
+  if (str->fhead->nNTuples < 1) {
+     fprintf(stderr,
+ " mcfio_EndDeclNtuple: No Ntuple declared for this stream...\n"); 
+     return 0;
+  }     
+   /*
+   ** Now we can try toto complete the file header. As it is now bigger, 
+   ** and it is the first structure written, it is easier to start over.
+   ** Destroy the XDR stream, close the file, and reopen it.
+   */  
+   xdr_destroy(str->xdr);
+   fclose(str->filePtr);
+   remove(str->filename);
+   ff = fopen(str->filename, "w");
+   if (ff == NULL) {
+     fprintf(stderr,
+  " mcfio_EndDeclNtuple: Problem re-opening file %s, message \n", 
+        str->filename);
+     return -1;
+   }
+   xdrstdio_create(str->xdr, ff, XDR_ENCODE);
+   p1 = xdr_getpos(str->xdr);
+   str->firstPos = p1;
+   str->currentPos = p1;
+   /*
+   ** In the file header, we do not store the NTuple Ids, as they are 
+   ** not necessarily valid in an other context, where we have different
+   ** streams/NTuples combinations. The SeqNTuId are trivial, 
+   ** within a stream, at the file header (1,2,3,..) 
+   **  But, of course, we must provide an array for the event header..
+   */
+   str->ehead->dimNTuples = str->fhead->nNTuples;
+   str->ehead->nNTuples = 0;
+   str->ehead->nTupleIds = 
+          (int *) malloc(sizeof(int) * str->fhead->nNTuples);
+   
+   str->ehead->ptrNTuples = 
+          (u_int *) malloc(sizeof(u_int) * str->fhead->nNTuples);
+   for (i=0; i<str->ehead->dimNTuples; i++) str->ehead->ptrNTuples[i]=0;       
+   
+   str->status = MCFIO_BOF;
+   if (mcfioC_Wrtfhead(str, INITIATE) == FALSE){
+       mcfioC_FreeStream(&McfStreamPtrList[jstr]);
+       fclose(ff);
+       return -1;
+   }
+   /*
+   ** Write the first dummy table 
+   */
+   if (mcfioC_Wrttable(str, INITIATE) == FALSE) return -1;
+   /*
+   ** Write the first dummy event header
+   */
+   if (mcfioC_WrtEvt(str, INITIATE) == FALSE) return -1;
+   str->ehead->evtnum = 0;
+   str->status = MCFIO_RUNNING;
+   return (str->fhead->nNTuples);
+}
+
+nTuDDL *mcf_GetFileNTuDDL(char*filename)
+{
+    nTuDDL *ddl;
+    int i, l, j;
+    char *text, *tc;
+    varGenNtuple *varTmp;
+    descrGenNtuple *dNTu;
+    
+    /* Create a holder for this Ntuple Description */
+    ddl = (nTuDDL * ) malloc(sizeof(nTuDDL));
+    ddl->dbinFileName = (char *) malloc(sizeof(char) * (strlen(filename) +1));
+    strcpy(ddl->dbinFileName, filename);
+    ddl->descrNtu = (descrGenNtuple *) malloc(sizeof(descrGenNtuple));
+    dNTu = ddl->descrNtu;
+    
+    header_c_.n_obj_header = 0;
+    line_title_c_.n_obj_line_title = 0;
+    mcf_ntubldRead(filename);
+    if ((line_title_c_.n_obj_line_title < 1)  ||
+        (header_c_.n_obj_header != 1)) {
+        fprintf(stderr, 
+                " This file was not created by the ntuBuild aplication!");
+        return NULL;
+    }
+    if (strcmp(line_title_c_.line_title[0].line,
+               "ntuBuild Database, v1.0") != 0) {
+        fprintf(stderr, 
+                " This file was not created by a wrong version of ntuBuild!");
+        return NULL;
+    }
+    /*
+    ** There are 80 character per lines in dbin..
+    */
+    text = (char *)
+            malloc(sizeof(char) * 80 * (line_title_c_.n_obj_line_title -1));
+    for (i=1, tc=text; i<line_title_c_.n_obj_line_title; i++) {
+        strcpy(tc, line_title_c_.line_title[i].line); 
+        tc += strlen(line_title_c_.line_title[i].line);
+        *tc = '\n'; tc++;
+    }
+    *tc = '\0';
+    dNTu->description = text;
+    
+    l = strlen(header_c_.header[0].title);
+    dNTu->title = (char *) malloc(sizeof(char) * (l+1));
+    strcpy(dNTu->title, header_c_.header[0].title);
+    
+    strcpy(dNTu->version, header_c_.header[0].version);
+    
+    strcpy(dNTu->nameIndex, header_c_.header[0].namemaxindex);
+    
+    dNTu->maxMultiplicity = header_c_.header[0].maxmult;
+    
+    dNTu->orgStyle = header_c_.header[0].orgstyle;
+    dNTu->numVariables = header_c_.header[0].nvar;
+    dNTu->numAvailable = dNTu->numVariables;
+    dNTu->variables =
+     (varGenNtuple **) malloc(sizeof(varGenNtuple *) * dNTu->numVariables);
+    /*
+    ** Now the variables
+    */
+    for (i=0; i<variable_c_.n_obj_variable; i++) {
+        dNTu->variables[i] =   
+                (varGenNtuple *) malloc(sizeof(varGenNtuple));
+        varTmp = dNTu->variables[i];
+        varTmp->nameBlank = False;
+        varTmp->name = (char *)
+            malloc(sizeof(char) * (strlen(variable_c_.variable[i].name) + 1));
+        strcpy(varTmp->name, variable_c_.variable[i].name);
+        
+        if ((strlen(variable_c_.variable[i].description) > 1) ||
+                    variable_c_.variable[i].description[0] != ' ') { 
+           varTmp->description = (char *) malloc(sizeof(char) * 
+                (strlen(variable_c_.variable[i].description) + 1));
+           strcpy(varTmp->description, variable_c_.variable[i].description);
+        } else varTmp->description = NULL;  
+        varTmp->type = variable_c_.variable[i].type;
+        varTmp->isFixedSize = True;
+        if (strncmp(variable_c_.variable[i].isfixedsize,"Yes",3))
+            varTmp->isFixedSize = False;
+        varTmp->numDim = variable_c_.variable[i].numdim;
+        if (varTmp->numDim > 0) 
+           for (j=0; j< varTmp->numDim; j++)
+               varTmp->dimensions[j] = variable_c_.variable[i].dimensions[j];
+                
+    }
+    /*
+    ** Set the ordering. Trivial in this case, it has been ordered in 
+    ** the save routine.
+    */
+    dNTu->varOrdering = (int *) malloc(sizeof(int) * dNTu->numAvailable);
+    for (i=0; i<dNTu->numVariables; i++)
+       dNTu->varOrdering[i] = i; 
+    dNTu->subOffset = NULL;
+    dNTu->subXDROffset = NULL;    
+    return ddl;
+    
+}
+
+/*
+** Compute the offsets by writing a simple program, stand alone, that uses
+** the d/s
+*/
+void    mcf_ComputeNTuOffsets(nTuDDL *ddl)    
+{
+     char tmpName[128], *tc, *tc1, *nameCom;
+     int i, j, l, fd, firstIndexed, nDat;
+     char filenameInclude[128], filenameProgram[128], filenameExec[128];
+     char filenameData[128], nameMaxIndex[32];
+     char line[256];
+     void **ptrBegVar;
+     varGenNtuple *varTmp;
+     descrGenNtuple *dNTu;
+     FILE *Ffp;
+     
+     dNTu =ddl->descrNtu;  
+     for (i=0; i< dNTu->numVariables; i++) { 
+        varTmp = dNTu->variables[i];
+        varTmp->offset = 0;
+     }
+        
+     memset(tmpName, 0, 127);
+     tc = tmpName;
+     sprintf(tc, "tmp_%s_XXXXXX", ddl->descrNtu->title);
+/* this is a kludge - we create a temporary file, close it, and use the name */
+     fd = mkstemp(tmpName);
+     if ( fd < 0 ) {
+         fprintf(stderr, 
+        " Can not compose a tempoary name in mcf_ComputeOffsets!");
+         return;
+     }
+     tc1 = tc;
+     close(fd);
+     sprintf(filenameInclude, "%s.h", tc1);
+     sprintf(filenameProgram, "%s.c", tc1);
+     sprintf(filenameData, "%s.dat", tc1);
+     strcpy(filenameExec, tc1);
+     mcf_ComposeDoth(ddl->descrNtu, filenameInclude);
+/*
+** Compose a little moronic program that establishes the addresses of all 
+** variables. There might be a better way, though.. However, this ought to be
+** safe. 
+*/
+     Ffp =  fopen( filenameProgram, "w");
+     fprintf(Ffp, "#include <stdio.h>\n");
+     fprintf(Ffp, "#include \"%s\"\n",filenameInclude);
+     if (dNTu->orgStyle == PARALLEL_ARRAY_NTU)
+         fprintf(Ffp, "#define NUM_VAR %d\n", (dNTu->numVariables+3));
+     else 
+         fprintf(Ffp, "#define NUM_VAR %d\n",
+                (dNTu->numVariables + 3 + dNTu->maxMultiplicity) );
+         
+     nameCom = makeStructName(dNTu->title, dNTu->orgStyle);
+     
+     fprintf(Ffp, "%s_struct tmpStruct; \n", nameCom);
+     fprintf(Ffp, "main(int argc, char **argv)\n");
+     fprintf(Ffp, "{\n");
+     fprintf(Ffp, "    void *ptrBegVar[NUM_VAR];\n");
+     fprintf(Ffp, "    FILE *Ffp;\n");
+     fprintf(Ffp, "    int i;\n");
+     fprintf(Ffp, "\n");
+     fprintf(Ffp, "    ptrBegVar[0] = (void *) &tmpStruct.version[0];\n");
+     fprintf(Ffp,
+      "    ptrBegVar[1] = (void *) &tmpStruct.%s;\n",dNTu->nameIndex);
+     for(i=0, firstIndexed=-1; i<dNTu->numVariables; i++) {
+           if (dNTu->variables[i]->isFixedSize == False) {
+                  firstIndexed = i; break;
+           }       
+     }
+     dNTu->firstIndexed = firstIndexed;             
+     if (dNTu->orgStyle == PARALLEL_ARRAY_NTU) {
+         for(i=0; i<dNTu->numVariables; i++) {
+           varTmp =  dNTu->variables[i];
+           /*
+           ** Assume that all the variables are properly 
+           ** defined at this stage (e..g, coming from a valid DDL dbin file)
+           ** and in order
+           */
+           tc = line;
+           if ((varTmp->numDim == 0) && (varTmp->isFixedSize == True)) 
+               sprintf(tc,
+                "    ptrBegVar[%d] = (void *) &tmpStruct.%s%n",
+                    (i+2), varTmp->name, &l);
+           else           
+               sprintf(tc,
+                "    ptrBegVar[%d] = (void *) tmpStruct.%s%n",
+                    (i+2), varTmp->name, &l);
+           tc+=l;
+           fprintf(Ffp, "%s;\n", line);    
+         }
+         fprintf(Ffp,
+      "    ptrBegVar[%d] = (void *) tmpStruct.fence;\n",dNTu->numVariables+2);
+     } else {
+         for(i=0; i<dNTu->numVariables; i++) {
+           varTmp =  dNTu->variables[i];
+           tc = line;
+           if (varTmp->isFixedSize == True) {
+              if (varTmp->numDim == 0)
+                sprintf(tc,
+               "    ptrBegVar[%d] = (void *) &tmpStruct.%s%n",
+                    (i+2), varTmp->name, &l);
+               else 
+                sprintf(tc,
+               "    ptrBegVar[%d] = (void *) tmpStruct.%s%n",
+                    (i+2), varTmp->name, &l);
+           } else {
+               if (varTmp->numDim == 0)         
+                   sprintf(tc,
+                   "    ptrBegVar[%d] = (void *) &tmpStruct.var[0].%s%n",
+                    (i+2), varTmp->name, &l);
+               else 
+                   sprintf(tc,
+                   "    ptrBegVar[%d] = (void *) tmpStruct.var[0].%s%n",
+                    (i+2), varTmp->name, &l);
+           }                                     
+           fprintf(Ffp, "%s;\n", line); 
+         }
+         tc1 = dNTu->nameIndex;
+         strcpy(nameMaxIndex, tc1);
+         l = strlen(tc1); 
+         if (l > 26) {
+            strncpy(nameMaxIndex, tc1, 26);
+            sprintf(&nameMaxIndex[26],"_max");
+         } else
+            sprintf(nameMaxIndex, "%s_max", tc1);
+         fprintf(Ffp,"    for (i=0; i<%s; i++) \n", nameMaxIndex);
+         tc = line;
+         if (firstIndexed != -1) {
+             varTmp = dNTu->variables[firstIndexed];
+             sprintf(tc,
+             "       ptrBegVar[i+%d] = (void *) &tmpStruct.var[i].%s%n",
+              (2+dNTu->numVariables), varTmp->name, &l); tc+=l;
+              if (varTmp->numDim > 0) for (j=0; j<varTmp->numDim; j++, tc+=l) 
+                                             sprintf(tc, "[0]%n", &l);   
+              fprintf(Ffp, "%s;\n", line);
+         }      
+         fprintf(Ffp,
+      "    ptrBegVar[%d] = (void *) tmpStruct.fence;\n",
+              dNTu->numVariables+2+dNTu->maxMultiplicity);
+     }
+     fprintf(Ffp, " ");
+     fprintf(Ffp,"    Ffp = fopen(\"%s\",\"w\");\n",filenameData);
+     fprintf(Ffp,"    fwrite((void *) ptrBegVar, sizeof(void *),\
+(size_t) NUM_VAR, Ffp);\n");
+     fprintf(Ffp,"    fclose(Ffp);\n");
+     fprintf(Ffp,"}\n");
+     fclose(Ffp);
+     free(nameCom);
+     /*
+     ** Now compile, link and load this exec, read the result
+     */
+     sprintf(line,"rm -f %s", filenameExec);
+     system(line);
+#ifdef _HPUX_SOURCE
+     sprintf(line,"cc -Aa -D_HPUX_SOURCE -o %s %s", 
+                            filenameExec, filenameProgram);
+#else
+     sprintf(line,"cc -o %s %s", filenameExec, filenameProgram);
+#endif
+     system(line);
+     sprintf(line,"./%s", filenameExec);
+     system(line);
+     if (dNTu->orgStyle == PARALLEL_ARRAY_NTU) nDat = dNTu->numVariables+3;
+        else nDat = dNTu->numVariables+3+dNTu->maxMultiplicity;
+     if (firstIndexed == -1) nDat = dNTu->numVariables+3;   
+     ptrBegVar = (void **) malloc (sizeof(void *) * (nDat));
+     Ffp = fopen(filenameData, "r");
+     fread((void *) ptrBegVar, sizeof(void *), (size_t) nDat, Ffp);
+     fclose(Ffp);
+     /*
+     ** remove garbage files..
+     */
+     remove(filenameData); remove(filenameProgram); remove(filenameExec);
+     remove(filenameInclude);
+     /*
+     ** Convert these addresses to offsets
+     */
+     dNTu->multOffset =  ((long) ptrBegVar[1] - (long) ptrBegVar[0]);
+     if (dNTu->orgStyle == PARALLEL_ARRAY_NTU) {
+         dNTu->fenceOffset =
+          ((long) ptrBegVar[dNTu->numVariables+2] - (long) ptrBegVar[0]); 
+         for (i=0; i< dNTu->numVariables; i++) 
+            dNTu->variables[i]->offset = 
+                   ((long) ptrBegVar[i+2] - (long) ptrBegVar[0]);
+     } else {
+         for (i=0; i< dNTu->numVariables; i++) {
+            varTmp = dNTu->variables[i]; 
+            if (varTmp->isFixedSize)
+                varTmp->offset = 
+                    ((long) ptrBegVar[i+2] - (long) ptrBegVar[0]);
+            else 
+                varTmp->offset = 
+                   ((long) ptrBegVar[i+2] - (long)ptrBegVar[firstIndexed+2]);
+         }
+         if (dNTu->subOffset != NULL) free(dNTu->subOffset);
+         dNTu->subOffset =
+            (long *) malloc(sizeof(long) * dNTu->maxMultiplicity);
+         if (firstIndexed != -1) {    
+            for (i=0; i<dNTu->maxMultiplicity; i++) 
+                dNTu->subOffset[i] =          
+               ((long) ptrBegVar[i+2+dNTu->numVariables]  - 
+               (long) ptrBegVar[0]);
+         }          
+         dNTu->fenceOffset =
+            ((long) ptrBegVar[dNTu->numVariables+2+dNTu->maxMultiplicity]
+                     - (long) ptrBegVar[0]); 
+     }   
+     free(ptrBegVar);
+}
+
+/*
+** Compute the lengths for the XDR Array statements. It is assumed that the 
+** NTUple descriptor is sorted, no blank variables.
+*/
+void    mcf_ComputeNTuLengths(nTuDDL *ddl)    
+{
+     int i, j, lastTmp, sameType;
+     size_t nDat, sizeItem;
+     varGenNtuple *var1, *var2;
+     descrGenNtuple *dNTu;
+     
+     dNTu =ddl->descrNtu;
+     if (dNTu->firstIndexed != -1) lastTmp = dNTu->firstIndexed;
+         else lastTmp = dNTu->numVariables;
+     /*
+     ** fixed size first.. 
+     */   
+     for (i=0; i<lastTmp; i++)
+         dNTu->variables[i]->lengthW = nDatVariable(dNTu->variables[i]); 
+/*
+** This, in principle, is the optimized version, where we collaps single
+** fields of the same type into an array. However, this is machine 
+** dependant.
+*/                                    
+     for (i=0; i<lastTmp; i++) {
+         var1 = dNTu->variables[i];
+         if (var1->lengthW != 0) {
+            nDat = nDatVariable(var1);
+            j=i+1;
+            sizeItem = sizeVariable(var1); 
+            sameType = True;
+            while ((j<lastTmp) && (sameType)) { 
+               var2 = dNTu->variables[j];
+               if (var2->type != var1->type) sameType = False;
+               if (sameType  && ((( var2->offset - 
+                                    var1->offset)/sizeItem) ==
+                                     nDat)) {
+                  nDat += nDatVariable(var2);
+                  var2->lengthW = 0; j++;
+               }
+            }
+            var1->lengthW = nDat;
+            var1->lengthB = nDat*sizeItem;
+         }
+     } 
+     /*
+     ** The variable size, similar code. This fill is very simple if the 
+     ** if the organisation is parallel arrays, as we can not implmenent
+     ** compaction 
+     */           
+     if (dNTu->firstIndexed == -1) return;
+     if (dNTu->orgStyle == PARALLEL_ARRAY_NTU) {
+         for (i=dNTu->firstIndexed; i<dNTu->numVariables; i++) { 
+              dNTu->variables[i]->lengthW
+                          =  nDatVariable(dNTu->variables[i]);
+              dNTu->variables[i]->lengthB = dNTu->variables[i]->lengthW   
+                         * sizeVariable(dNTu->variables[i]);
+         }                
+     } else {
+         for (i=dNTu->firstIndexed; i<dNTu->numVariables; i++) 
+            dNTu->variables[i]->lengthW =  nDatVariable(dNTu->variables[i]);
+         for (i=dNTu->firstIndexed; i<dNTu->numVariables; i++) {
+             var1 = dNTu->variables[i];
+             if (var1->lengthW != 0) {
+                 nDat = nDatVariable(var1);
+                 j=i+1;
+                 sizeItem = sizeVariable(var1); 
+                 sameType = True;
+                 while ((j<dNTu->numVariables) && (sameType)) { 
+                    var2 = dNTu->variables[j];
+                    if (var2->type != var1->type) sameType = False;
+                    if (sameType  && (((var2->offset - 
+                                   var1->offset)/sizeItem) ==
+                                     nDat)) {
+                     nDat += nDatVariable(var2);
+                     var2->lengthW = 0; j++; 
+                  }
+                }
+                var1->lengthW = nDat;
+                var1->lengthB = nDat*sizeItem;
+             }
+         }
+     }
+     
+}
+/*
+** Compute, in size_t units (bytes, I hope) the length of a particular
+** variable.  Only the fixed size part, we will have to multiplity 
+** by the multiplicty in the XDR filter.
+*/
+
+static size_t nDatVariable(varGenNtuple *var)
+{
+   size_t n;
+   int i;
+    
+    n=1;
+    for (i=0; i<var->numDim; i++) n = n * var->dimensions[i];
+    return n;
+}
+static size_t sizeVariable(varGenNtuple *var)
+{
+   size_t n;
+   
+   switch (var->type) {
+        case BYTE_NTU: case CHARACTER_NTU:
+           n = sizeof(char);
+           break;
+        case INTEGER2_NTU:
+           n = sizeof(short);
+           break;
+        case LOGICAL_NTU: case INTEGER_NTU:
+           n = sizeof(int);
+           break;
+        case REAL_NTU:
+           n = sizeof(float);
+           break;
+        case DBL_PRECISION_NTU:
+           n = sizeof(double);
+           break;
+        case COMPLEX_NTU:
+           n = 2 * sizeof(float);
+           break;
+        case DBL_COMPLEX_NTU:
+           n = 2 * sizeof(double);
+           break;
+        case POINTER_NTU:
+           n = sizeof(void *);
+           break;
+        default : 
+           fprintf(stderr, " mcf_ComputNTuLength, internal error \n");
+           n = 0;
+           break;
+    }
+    return n;
+}
+
+/*
+** Compose the .h file. Called from NTuBldMenu and this file. The structure 
+** is assumed valid. 
+*/
+void    mcf_ComposeDoth(descrGenNtuple *dNTu, char *filename)
+{
+    char *nameCom, line[FILENAME_MAX+500], *tmp, *version, *text, *tc, *tc2;
+    char nameMaxIndex[32], nameTmpIndex[32];
+    char nullDescr[4], *descrTmp;
+    int i, j, l, kmode, nc, ncTot, nl, iv;
+    time_t clock;
+    FILE *Ffp;
+    varGenNtuple *var;
+    
+    nameCom = makeStructName(dNTu->title, dNTu->orgStyle);
+    strcpy(nullDescr, "? ");
+    strcpy(line, filename);
+    tc = strchr(line, '.');
+    if (tc == NULL) {
+         l = strlen(filename);
+         tc = line; tc+=l;
+    }     
+    strcpy(tc,".h");   
+    Ffp = fopen(line, "w");
+    fprintf(Ffp,"/* ntuBuild\n");
+    time(&clock);
+    tmp = line; sprintf(tmp,"** Creation Date : %n", &l); tmp += l;
+    strncpy(tmp,ctime(&clock), 24); tmp += 24; *tmp='\n'; tmp++; *tmp = '\0';
+    fprintf(Ffp,line);
+    fprintf(Ffp,"**  User Comments\n");
+    text = dNTu->description;
+    tc = text; 
+    if (*tc == '\0') 
+       fprintf(Ffp,"** no user comments\n");
+    else {
+       ncTot = strlen(tc); nc =0;
+       while (nc < ncTot) {
+            tc2 = strchr(tc,'\n');
+            nl = (int) (tc2-tc)/sizeof(char);
+            if ((tc2 == NULL) || (nl > 75)) nl = 75;
+            strncpy(line, tc, nl); line[nl] = '\0';
+            fprintf (Ffp,"** %s\n", line);
+            tc += nl; nc += nl;
+            if (*tc == '\n') {
+               tc++;
+               nc++;
+            }
+       }
+    }
+    fprintf(Ffp,"*/    \n");
+    version = dNTu->version;
+    text = dNTu->nameIndex;
+    strcpy(nameTmpIndex, text);
+    l = strlen(text); 
+    if (l > 26) {
+            strncpy(nameMaxIndex, text, 26);
+            sprintf(&nameMaxIndex[26],"_max");
+    } else
+            sprintf(nameMaxIndex, "%s_max", text);
+    fprintf(Ffp,"#define %s %d\n", nameMaxIndex, dNTu->maxMultiplicity);        
+    if (dNTu->orgStyle == PARALLEL_ARRAY_NTU) {
+        fprintf(Ffp, "typedef struct _%s_struct {\n", nameCom);
+        /*
+        ** The first 64 bits contain the version token, as a char[8] string
+        ** floowed by the multiplicty variable, followed by an integer pad
+        */ 
+        fprintf(Ffp,"    char version[8]; /* Version token */\n");
+        fprintf(Ffp,
+        "    int %s; /* Generalized Ntuple Multiplicity value */ \n",
+                                              nameTmpIndex);
+        fprintf(Ffp,
+        "    int padding; /* Padding for 64 bit architecture */ \n");
+        for (iv=0; iv< dNTu->numVariables; iv++) {
+           for (j=0; j<dNTu->numAvailable; j++)  
+                if (dNTu->varOrdering[j] == iv)  i = j; 
+           var = dNTu->variables[i];
+           kmode = 0; if (var->isFixedSize != True) kmode = 1;
+           if (var->description == NULL) descrTmp = nullDescr;
+                  else descrTmp = var->description;
+           tc = line;
+           if ((var->type != COMPLEX_NTU) &&
+               (var->type != DBL_COMPLEX_NTU)) { 
+                  sprintf(tc,"    %s %n", VarTypesNamesC[var->type], &l);
+                  tc +=l;            
+                  if ((var->numDim == 0) && (kmode ==0))
+                            sprintf(tc," %s; /* %s */",
+                                              var->name, descrTmp);
+                  else if (var->numDim == 0) {
+                        sprintf(tc," %s[%s]; /* %s */",
+                        var->name, nameMaxIndex, descrTmp); 
+                  } else { 
+                       sprintf(tc," %s%n",var->name, &l); tc+=l;
+                       if (kmode == 1) {
+                           sprintf(tc, "[%s]%n", nameMaxIndex, &l);
+                           tc +=l;
+                   }    
+                   for (j=var->numDim-1; j>-1; j--, tc+=l) 
+                             sprintf(tc,"[%d]%n", var->dimensions[j], &l); 
+                     
+                        sprintf (tc,"; /* %s */", descrTmp);
+                  }  
+               } else { /* got to convert to float or dbl */
+                    if (var->type == COMPLEX_NTU)
+                       sprintf(tc,"    float %n", &l);
+                       
+                     else if (var->type == DBL_COMPLEX_NTU)
+                       sprintf(tc,"    double %n", &l);
+                       
+                     tc +=l;            
+                     if ((var->numDim == 0) && (kmode ==0)) 
+                          sprintf(tc," %s[2]; /* %s */", var->name, descrTmp);
+                     else if (var->numDim == 0) {
+                       sprintf(tc," %s[%s][2]; /* %s */",
+                        var->name, nameMaxIndex, descrTmp); 
+                     } else { 
+                       sprintf(tc," %s%n",var->name, &l); tc+=l;
+                       if (kmode == 1) {
+                          sprintf(tc, "[%s]%n", nameMaxIndex, &l);
+                         tc +=l;
+                       }    
+                       for (j=var->numDim-1; j>-1; j--, tc+=l) 
+                             sprintf(tc,"[%d]%n", var->dimensions[j], &l); 
+                       sprintf (tc,"[2]; /* %s */", descrTmp);
+                    }
+               }
+               fprintf(Ffp,"%s\n", line);
+           }
+        fprintf(Ffp,"    int fence[2]; \n");
+        fprintf(Ffp,"} %s_struct; \n", nameCom);
+     }else { 
+     /*
+     ** The other type of organisation, using structure
+     */
+        fprintf(Ffp, "typedef struct _%s_v_struct{\n", nameCom);
+        for (iv=0; iv< dNTu->numVariables; iv++) {
+           for (j=0; j<dNTu->numAvailable; j++)  
+                if (dNTu->varOrdering[j] == iv)  i = j; 
+           var = dNTu->variables[i];
+           if (var->isFixedSize == False) {
+               tc = line;
+               if (var->type == COMPLEX_NTU)
+                       sprintf(tc,"    float %n", &l);
+               else if (var->type == DBL_COMPLEX_NTU)
+                       sprintf(tc,"    double %n", &l);
+               else 
+                     sprintf(tc,"    %s %n", VarTypesNamesC[var->type], &l);
+               tc +=l;            
+               sprintf(tc," %s%n",var->name, &l); tc+=l;
+               if (var->numDim != 0) {
+                    for (j=var->numDim-1; j>-1; j--, tc+=l) 
+                           sprintf(tc,"[%d]%n", var->dimensions[j], &l); 
+               }
+               if ((var->type == COMPLEX_NTU) ||
+                   (var->type == DBL_COMPLEX_NTU)) {
+                       sprintf (tc,"[2]%n",&l);
+                       tc += l;
+               }       
+               if (var->description == NULL) descrTmp = nullDescr;
+                    else descrTmp = var->description;
+               sprintf(tc,"; /* %s */%n", descrTmp, &l); tc += l;
+               fprintf(Ffp,"%s\n", line);
+            }
+        }
+        fprintf(Ffp,"} %s_v_struct; \n", nameCom);
+        fprintf(Ffp,"/* ----- */  \n");
+        /*
+        ** the mother structure now
+        */
+        fprintf(Ffp, "typedef struct _%s_struct{\n", nameCom);
+        fprintf(Ffp,"    char version[8]; /* Version token */\n");
+        fprintf(Ffp,
+        "    int %s; /* Generalized Ntuple Multiplicity value */ \n",
+                                              nameTmpIndex);
+        fprintf(Ffp,
+        "    int padding; /* Padding for 64 bit architecture */ \n");
+        for (iv=0; iv< dNTu->numVariables; iv++) {
+           for (j=0; j<dNTu->numAvailable; j++)  
+                if (dNTu->varOrdering[j] == iv)  i = j; 
+           var = dNTu->variables[i];
+           if (var->isFixedSize == True) {
+              tc = line;
+               if (var->type == COMPLEX_NTU)
+                       sprintf(tc,"    float %n", &l);
+               else if (var->type == DBL_COMPLEX_NTU)
+                       sprintf(tc,"    double %n", &l);
+               else 
+                     sprintf(tc,"    %s %n", VarTypesNamesC[var->type], &l);
+               tc +=l;            
+               sprintf(tc," %s%n",var->name, &l); tc+=l;
+               if (var->numDim != 0) {
+                    for (j=var->numDim-1; j>-1; j--, tc+=l) 
+                           sprintf(tc,"[%d]%n", var->dimensions[j], &l); 
+               }
+               if ((var->type == COMPLEX_NTU) ||
+                     (var->type == DBL_COMPLEX_NTU)) {
+                       sprintf (tc,"[2]%n",&l);
+                       tc += l;
+               }       
+               if (var->description == NULL) descrTmp = nullDescr;
+                    else descrTmp = var->description;
+               sprintf(tc,"; /* %s */%n", descrTmp, &l); tc += l;
+               fprintf(Ffp,"%s\n", line);
+            }
+        }
+        fprintf(Ffp,
+        "    %s_v_struct var[%s]; /* The array of substructures */\n",  
+                              nameCom, nameMaxIndex); 
+        fprintf(Ffp,"    int fence[2]; \n");
+        fprintf(Ffp,"} %s_struct; \n", nameCom);
+    }    
+    free(nameCom);
+    fclose(Ffp);
+    
+}
+
+void mcfioC_SetForSaveDecoding(int val)
+{
+     if(val != 0) McfNTuPleSaveDecoding = True;
+     else McfNTuPleSaveDecoding = False;
+}
+     
+static char *makeStructName(char *title, int orgStyle)
+{
+    char *out;
+    int i, l, nMax;
+    
+    l = strlen(title);
+    if (orgStyle  == PARALLEL_ARRAY_NTU) nMax = 23;  
+    else nMax = 21;
+    if (l > nMax) l = nMax;
+    out = (char *) malloc(sizeof(char) * (l+1));
+    strncpy(out, title, l); out[l]='\0';    
+    for (i=0; i<l; i++) if (out[i] == ' ') out[i] = '_';
+    return out;
+} 
+/*
+** CopyNtrim -  Copy "fromString" to a malloc'd new string,
+** 		trimming off leading and trailing spaces & tabs.
+**		The newly malloc'd string is returned.
+** 		If fromString is NULL, NULL is returned.
+*/
+static char *mcf_copyNtrim(char *fromString)
+{
+    char *c, *toString;
+    int len, i;
+    
+    if (fromString == NULL)
+    	return NULL;
+    toString = (char *) malloc(strlen(fromString)+1);
+    
+    /* Find the first non-white character */
+    for (c=fromString; *c == ' ' || *c == '\t'; c++);
+
+    /* Copy the remainder of fromString to toString */
+    strcpy(toString, c);
+    
+    /* Remove trailing spaces and tabs by converting to nulls */
+    len = strlen(toString);
+    if (len == 0)			/* special case for empty strings */
+    	return toString;
+    for (i = len-1; i >= 0; --i) {
+    	if (isspace(toString[i]))
+    	    toString[i] = '\0';
+    	else
+    	    break;
+    }
+    return toString;
+}    
+     
+     
+     
Index: /trunk/mcfio/mcf_NTuIOFiles.h
===================================================================
--- /trunk/mcfio/mcf_NTuIOFiles.h	(revision 2)
+++ /trunk/mcfio/mcf_NTuIOFiles.h	(revision 2)
@@ -0,0 +1,15 @@
+/*******************************************************************************
+*									       *
+* mcf_NTuIOFiles.h -- Utilities to manipulate files within the MCFIO Gen.      *
+*        				Ntuple schema                          *
+*									       *
+*	P. Lebrun, September 1995.					       *
+*									       *
+*******************************************************************************/
+int mcfioC_DeclareNtuple(int uid, char *title, char *category, 
+                                int stream, char *filename);
+int mcfioC_EndDeclNTuples(int stream);                                
+nTuDDL *mcf_GetFileNTuDDL(char*filename);
+void    mcf_ComputeNTuOffsets(nTuDDL *ddl); 
+void    mcf_ComputeNTuLengths(nTuDDL *ddl); 
+void    mcf_ComposeDoth(descrGenNtuple *dNtu, char *filename);
Index: /trunk/mcfio/mcf_NTuIOUtils.c
===================================================================
--- /trunk/mcfio/mcf_NTuIOUtils.c	(revision 2)
+++ /trunk/mcfio/mcf_NTuIOUtils.c	(revision 2)
@@ -0,0 +1,290 @@
+/*******************************************************************************
+*									       *
+* mcf_NTuIOUtils.c -- Utilities to manipulate files within the MCFIO Gen.      *
+*        				Ntuple schema                          *
+*									       *
+*	P. Lebrun, September 1995.					       *
+*									       *
+*******************************************************************************/
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+#include <sys/param.h>
+#include <limits.h>
+#include <rpc/types.h>
+#include <sys/types.h>
+#include <rpc/xdr.h>
+#include "mcf_nTupleDescript.h"
+#include "mcf_xdr.h"
+#include "mcfio_Dict.h"
+#include "mcf_NTuIOFiles.h"
+#include "mcf_NTuIOUtils.h"
+#include "mcf_ntubld_db.h"
+#ifndef False
+#define False 0
+#endif
+#ifndef True
+#define True 1
+#endif
+
+extern nTuDDL **NTuDDLList;
+extern int NumOfNTuples;
+
+nTuDDL *mcf_GetNTuByPtrID(int id)
+{
+    int **ip;
+    
+    if ( (id < 1) || (id > NumOfNTuples)) return NULL;
+    ip = (int **) NTuDDLList;
+    ip += (id-1);
+    return (nTuDDL *) *ip; 
+}
+     
+nTuDDL *mcf_GetNTuByStreamID(int stream, int id)
+{
+     int i, num;
+     nTuDDL *ddl;
+     
+     for (i=0, num=0; i<NumOfNTuples; i++) { 
+          ddl = NTuDDLList[i];
+          if ((ddl->streamId == stream) && (ddl->seqNTuId == id)) return ddl;
+     }
+     return NULL;
+}   
+int mcf_NTuId(int uid, char *category)
+/* 
+	uid		Unique User id 
+	category	Category name, must be an exact match
+
+	Returns:	Macfio_Ntuple id, or -1 if no items matched, or if 
+			Category is illegal..
+*/
+{
+	int i, j, **ip;
+	nTuDDL *item;
+	char *cat;
+	
+     if (!mcf_CheckValidCat(category, FALSE))  return -1;
+     ip = (int **) NTuDDLList;
+     cat = mcf_ValidStr(category, NTU_MAX_CATEGORY_LENGTH, "category");
+     for (i=0; i< NumOfNTuples; i++, ip++) {
+	 item = (nTuDDL *) *ip;
+	 if (item->uid == uid) { /* Look first at uid, if match, */
+	         		    /* Confirm with Category */
+	    if ((category == NULL) && (item->category == NULL)) 
+	      				return (item->id);
+	    if (strcmp(category, item->category) == 0)
+	    				return (item->id);
+            j = strspn(category, " ");	
+	    if (strcmp((category+j), item->category) == 0)
+	                                return (item->id); 
+	 }
+     }
+     return -1;
+}
+
+int mcfioC_GetNTupleIds(int stream, int *ids, int max)
+{
+     int i, num;
+     nTuDDL *ddl;
+     
+     for (i=0, num=0; i<NumOfNTuples; i++) { 
+          ddl = NTuDDLList[i];
+          if (ddl->streamId == stream) {
+              if (num < max ) ids[num] = ddl->id;
+              num++;
+          }
+     }
+     return num;
+}   
+
+int mcfioC_GetNTupleUID(int stream, int id)
+{
+   nTuDDL *ddl = mcf_GetNTuByStreamID(stream, id);
+   return ddl->uid;
+}
+
+void mcfioC_GetNTupleCategory(int stream, int id, char **answer)
+{
+   nTuDDL *ddl = mcf_GetNTuByStreamID(stream, id);
+   *answer = ddl->category;
+}
+ 
+void mcfioC_GetNTupleTitle(int stream, int id, char **answer)
+{
+   nTuDDL *ddl = mcf_GetNTuByStreamID(stream, id);
+   *answer = ddl->title;
+}
+
+void mcfioC_GetNTupleName(int stream, int id, char **answer)
+{
+   nTuDDL *ddl = mcf_GetNTuByStreamID(stream, id);
+   if (ddl->reference == NULL) 
+       *answer = ddl->descrNtu->title;
+   else *answer = ddl->reference->descrNtu->title;    
+}
+
+/*
+** Copy utility routine for a General Ntuple Variable descriptor d/s
+** It is the responsability of the usr to allocate memory for the 
+** structure where data will be copied to.
+*/           
+void CopyVarGenNtuple(varGenNtuple *vFrom, varGenNtuple *vTo)
+{
+    int i, ll;
+
+    if ((vTo == NULL)  || (vFrom == NULL)) return;
+    vTo->nameBlank = vFrom->nameBlank;
+    if (vTo->name != NULL) {
+        free(vTo->name);
+        vTo->name = NULL;
+    }
+    if (vFrom->name != NULL) {
+        ll = (1 + strlen(vFrom->name));
+        vTo->name = 
+           (char *) malloc(sizeof(char) * ll);
+        strcpy(vTo->name, vFrom->name);
+    }
+    if (vTo->description != NULL) {
+         free(vTo->description);
+         vTo->description = NULL;
+    }
+    if (vFrom->description != NULL) {
+        vTo->description = 
+           (char *) malloc(sizeof(char) * (1 + strlen(vFrom->description)));
+        strcpy(vTo->description, vFrom->description);
+    }
+    vTo->type = vFrom->type;
+    vTo->isFixedSize = vFrom->isFixedSize;
+    vTo->numDim = vFrom->numDim;
+    if (vFrom->numDim > 0)  {
+           for (i=0; i<vFrom->numDim; i++)
+              vTo->dimensions[i] = vFrom->dimensions[i]; 
+    }
+    vTo->offset = vFrom->offset;
+    vTo->offsetXDR = vFrom->offsetXDR;
+}
+/*
+** insert this ddl into the Global List, expand the list if need be.
+** Also increment the number of NTuples defined (don't do it twice!). 
+*/
+void AddNTuDDLtoList(nTuDDL *ddl)
+{
+    int **ipo;
+    
+    NumOfNTuples++;
+    ddl->id = NumOfNTuples;
+    /*
+    ** insert this ddl into the Global List, expand the list if need be
+    */
+    if( (NumOfNTuples - (NumOfNTuples/NTU_START_LIST_SIZE)*NTU_START_LIST_SIZE)
+                     == 1 && (NumOfNTuples != 1)) {
+            ipo = (int **) NTuDDLList;
+    	    NTuDDLList  = (nTuDDL **) malloc(sizeof(int *)*
+              ((NumOfNTuples/NTU_START_LIST_SIZE + 1)*NTU_START_LIST_SIZE));
+            memcpy(NTuDDLList, ipo, (sizeof(int *)*(NumOfNTuples-1)));
+    	    free (ipo);
+    }
+    NTuDDLList[NumOfNTuples-1] = ddl;
+            
+}
+/*
+** Free the memory for a Ntuple Data Descrp. Lang (DDL).  
+*/
+void DestroyNTuDDL(nTuDDL *ddl)
+{
+   if (ddl->title != NULL) free(ddl->title);
+   if (ddl->category != NULL) free(ddl->category);
+   if (ddl->dbinFileName != NULL) free(ddl->dbinFileName);
+   DestroyGenNtuple(ddl->descrNtu);
+   free(ddl);
+} 
+/*
+** Free the memory for a Description NTuple
+** Note : the pointer to adrresses are lost, the user will have to give 
+** them to this application back..
+*/
+void DestroyGenNtuple(descrGenNtuple *dNTu)
+{
+    int i;
+
+    if (dNTu == NULL) return;
+    if (dNTu->title != NULL) free(dNTu->title);
+    if (dNTu->description != NULL) free(dNTu->description);
+    if (dNTu->varOrdering != NULL) free(dNTu->varOrdering);
+    if (dNTu->subOffset != NULL) free(dNTu->subOffset);
+    if (dNTu->subXDROffset != NULL) free(dNTu->subXDROffset);
+    for (i=0; i<dNTu->numAvailable; i++)
+         DestroyVarGenNtuple(dNTu->variables[i]);
+    free(dNTu->variables);
+    free(dNTu);     
+}    
+
+
+void DestroyVarGenNtuple(varGenNtuple *var)
+{
+
+    if (var == NULL) return;
+    if (var->name != NULL) free(var->name);
+    if (var->description != NULL) free(var->description);
+    free(var);
+}    
+/*
+ * ValidStr - Validate strings supplied by user
+ *
+ *	      returns: pointer to valid same or new truncated string
+ *
+ *  Note: ** copy string returned, if needed, before calling ValidStr again **
+ */
+char *mcf_ValidStr(char *string, int max_length, char *strKind)
+{
+    static char str[NTU_MAX_CATEGORY_LENGTH+1];	     /* make longest string */
+    static char str1[1] = "";
+    
+    if (string == NULL)
+    	return str1;			   /* return empty string	    */
+    if (strlen(string) <= max_length)
+    	return string;			   /* return pointer to same string */
+    fprintf(stderr,
+      "Mcfio_Ntuple: Error. Specified %s string is too long, truncating\n     ->%s\n",
+    	 strKind, string);
+    memset(str, 0, NTU_MAX_CATEGORY_LENGTH+1);
+    return strncpy(str, string, max_length); /* return ptr to trunc. string */
+}
+/*
+** Based on the HistoScope Check Category 
+*/      
+int mcf_CheckValidCat(char *category, int dotDotDot)
+{
+    static char validChars[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZ\
+abcdefghijklmnopqrstuvwxyz1234567890/~!@#$%^&*()_+=-`\"\'\t?><,. ";
+    char *strDots, *error = NULL;
+    int len;
+    
+    if (category == NULL)
+    	return 1;
+    len = strlen(category);
+    strDots = strstr(category, "...");
+    if (len >= NTU_MAX_CATEGORY_LENGTH)
+    	error = "is too long";
+    else if (strspn(category, validChars) != len)
+    	error = "contains invalid characters";
+    else if (strstr(category, "//") != NULL)
+    	error = "contains \"//\"";
+    else if (category[0] == '/')
+    	error = "contains leading slash";
+    else if (category[len-1] == '/')
+    	error = "contains trailing slash";
+    else if ((dotDotDot == 0 && strDots != NULL) 
+    	  || (dotDotDot != 0 && strDots != NULL && strDots != category + len-3))
+    	error = "contains invalid \"...\"";
+    	
+    if (error != NULL) {
+    	fprintf(stderr, "Error in declared category %s: %s\n",
+    		error, category);
+    	return 0;
+    } else {
+    	return (strDots == NULL ? 1 : -1);
+    }
+}
+
Index: /trunk/mcfio/mcf_NTuIOUtils.h
===================================================================
--- /trunk/mcfio/mcf_NTuIOUtils.h	(revision 2)
+++ /trunk/mcfio/mcf_NTuIOUtils.h	(revision 2)
@@ -0,0 +1,24 @@
+/*******************************************************************************
+*									       *
+* mcf_NTuIOUtil.h -- Utilities to manipulate files within the MCFIO Gen.      *
+*        				Ntuple schema                          *
+*									       *
+*	P. Lebrun, October 1995.					       *
+*									       *
+*******************************************************************************/
+nTuDDL *mcf_GetNTuByPtrID(int id);
+nTuDDL *mcf_GetNTuByStreamID(int stream, int id);
+int mcf_CheckValidCat(char *category, int dotDotDot);
+char *mcf_ValidStr(char *string, int max_length, char *strKind);
+int mcf_NTuId(int uid, char *category);
+int mcfioC_GetNTupleIds(int stream, int *ids, int max);
+int mcfioC_GetNTupleUID(int stream, int id);
+void mcfioC_GetNTupleCategory(int stream, int id, char **answer);
+void mcfioC_GetNTupleTitle(int stream, int id, char **answer);
+void mcfioC_GetNTupleName(int stream, int id, char **answer);
+void AddNTuDDLtoList(nTuDDL *ddl);
+void DestroyNTuDDL(nTuDDL *ddl);
+void DestroyVarGenNtuple(varGenNtuple *var);
+void CopyVarGenNtuple(varGenNtuple *vFrom, varGenNtuple *vTo);
+void DestroyGenNtuple(descrGenNtuple  *dNTu);
+void mcfioC_SetForSaveDecoding(int val);
Index: /trunk/mcfio/mcf_evt_xdr.c
===================================================================
--- /trunk/mcfio/mcf_evt_xdr.c	(revision 2)
+++ /trunk/mcfio/mcf_evt_xdr.c	(revision 2)
@@ -0,0 +1,1569 @@
+/*******************************************************************************
+*									       *
+* mcf_evt_xdr.c -- XDR Utility routines for the McFast Monte-Carlo             *
+*									       *
+* Copyright (c) 1994 Universities Research Association, Inc.		       *
+* All rights reserved.							       *
+* 									       *
+* This material resulted from work developed under a Government Contract and   *
+* is subject to the following license:  The Government retains a paid-up,      *
+* nonexclusive, irrevocable worldwide license to reproduce, prepare derivative *
+* works, perform publicly and display publicly by or for the Government,       *
+* including the right to distribute to other Government contractors.  Neither  *
+* the United States nor the United States Department of Energy, nor any of     *
+* their employees, makes any warranty, express or implied, or assumes any      *
+* legal liability or responsibility for the accuracy, completeness, or         *
+* usefulness of any information, apparatus, product, or process disclosed, or  *
+* represents that its use would not infringe privately owned rights.           *
+*                                        				       *
+*									       *
+* Written by Paul Lebrun						       *
+*									       *
+*									       *
+*******************************************************************************/
+#include <stdio.h>
+#include <string.h>
+#include <sys/param.h>
+#include <rpc/types.h>
+#include <sys/types.h>
+#include <rpc/xdr.h>
+#include <limits.h>
+#ifdef SUNOS
+#include <floatingpoint.h>
+#else /* SUNOS */
+#include <float.h>
+#endif /* SUNOS */
+#include <stdlib.h>
+#include <time.h>
+#include "mcf_nTupleDescript.h"
+#include "mcf_xdr.h"
+#include "mcf_xdr_Ntuple.h"
+#include "mcf_NTuIOFiles.h"
+#include "mcf_NTuIOUtils.h"
+#include "mcfio_Util1.h"
+#ifndef FALSE
+#define FALSE 0
+#endif
+#ifndef TRUE
+#define TRUE 1
+#endif
+
+
+static bool_t xdr_mcfast_NTuDDL(XDR *xdrs, char *version, nTuDDL *ddl);
+static bool_t xdr_mcfast_descrNTU(XDR *xdrs, char *version,
+                                    descrGenNtuple *dNTu);
+static bool_t xdr_mcfast_varDescrNTU(XDR *xdrs, char *version,
+                                    varGenNtuple *var);
+
+extern nTuDDL **NTuDDLList;
+extern int NumOfNTuples;
+
+bool_t xdr_mcfast_generic(XDR *xdrs, int *blockid,
+ 				 int *ntot, char** version, char** data)
+{
+/*  Translate a Generic mcfFast block. This module will allocate memory 
+    for the data. */
+        
+    unsigned int nn;
+    
+    if (xdrs->x_op == XDR_ENCODE) {
+      nn = strlen(*data);  
+      *ntot = 12+nn;
+       strcpy(*version, "0.00");
+       } else if (xdrs->x_op == XDR_FREE) {
+          free(*data);
+          return 1;
+       }
+      
+     if (( xdr_int(xdrs, blockid) && 
+     	      xdr_int(xdrs, ntot) &&
+     	      xdr_string(xdrs, version, MCF_XDR_VERSION_LENGTH)) 
+     	         == FALSE) return FALSE;
+     nn = *ntot - 12;	      
+     if (xdrs->x_op == XDR_DECODE) *data = NULL; 
+     return (xdr_string(xdrs, data, nn));     	
+}   
+
+
+bool_t xdr_mcfast_headerBlock(XDR *xdrs, int *blockid,
+ 				 int *ntot, char** version)
+{
+/*  Translate a Generic mcfFast block. This module will allocate memory 
+    for the data. */
+
+    if (xdrs->x_op == XDR_ENCODE) {
+       printf ("xdr_mcfast_headerBlock: Internal error \n");
+       return FALSE;
+       }
+      
+     return ( xdr_int(xdrs, blockid) && 
+     	      xdr_int(xdrs, ntot) &&
+     	      xdr_string(xdrs, version, MCF_XDR_VERSION_LENGTH));
+}   
+bool_t xdr_mcfast_fileheader(XDR *xdrs, int *blockid,
+ 		 int *ntot, char** version, mcfxdrFileHeader **mcf,
+ 		  int streamId)
+{
+/*  Translate a mcf FileHeader block.  This subroutine will allocate
+	the memory needed if the stream is DECODE */
+        
+    int i;
+    unsigned int nn, oldNumOfNTuples;
+    char **ctmp;
+    char *atmp, *btmp, *dtmp;
+    int *itmp;
+    mcfxdrFileHeader *mcftmp;
+    nTuDDL *ddl;
+    float fv;
+    
+    
+    mcftmp = *mcf;
+    if (xdrs->x_op == XDR_ENCODE) {
+      *ntot = sizeof(mcfxdrFileHeader) - sizeof(int *) - sizeof(char **) 
+              + 2 * sizeof(int) * mcftmp->nBlocks 
+              - sizeof(char) * MCF_XDR_F_TITLE_LENGTH
+              + sizeof(char) * strlen(mcftmp->title) + 
+              + sizeof(char) * strlen(mcftmp->comment) ;
+      for (i=0, ctmp = mcftmp->blockNames; 
+             i< mcftmp->nBlocks; i++, ctmp++) *ntot += strlen(*ctmp);  
+       strcpy(*version, "2.01");
+     }  else if (xdrs->x_op == XDR_FREE) {
+          mcfioC_Free_FileHeader(mcf);
+          return 1;
+     } else if((xdrs->x_op == XDR_DECODE) && (*mcf == NULL)) {
+          mcftmp = (mcfxdrFileHeader *) malloc(sizeof(mcfxdrFileHeader));
+          *mcf = mcftmp;
+     } 
+        
+
+       
+     if (( xdr_int(xdrs, blockid) && 
+     	      xdr_int(xdrs, ntot) &&
+     	      xdr_string(xdrs, version, MCF_XDR_VERSION_LENGTH))
+     	                  == FALSE) return FALSE;
+     
+     /*
+     ** Code valid for version 1.00
+     */
+     if (strcmp(*version, "1.00") == 0) {
+         atmp = &(mcftmp->title[0]);
+         btmp = &(mcftmp->comment[0]);
+         dtmp = &(mcftmp->date[0]);
+     	      
+        if ((xdr_string(xdrs, &atmp, MCF_XDR_F_TITLE_LENGTH) &&
+             xdr_string(xdrs,&btmp, MCF_XDR_F_TITLE_LENGTH) &&
+             xdr_string(xdrs,&dtmp, 30)) == FALSE) return FALSE;
+	
+        if ((xdr_u_int(xdrs,&(mcftmp->numevts_expect)) &&
+             xdr_u_int(xdrs,&(mcftmp->numevts)) &&
+             xdr_u_int(xdrs,&(mcftmp->firstTable)) &&
+             xdr_u_int(xdrs,&(mcftmp->dimTable)) &&
+             xdr_u_int(xdrs,&(mcftmp->nBlocks))) == FALSE) return FALSE;
+        if(xdrs->x_op == XDR_DECODE) {
+           mcftmp->blockIds = (int *) malloc(sizeof(int) * mcftmp->nBlocks);
+           mcftmp->blockNames = 
+           	(char**) malloc(sizeof(char *) * mcftmp->nBlocks);
+           for (i=0; i<mcftmp->nBlocks; i++) 
+                mcftmp->blockNames[i] =
+                  (char *) malloc(sizeof(char) * (MCF_XDR_B_TITLE_LENGTH +1));
+        }
+        itmp = mcftmp->blockIds;
+        if (xdrs->x_op == XDR_ENCODE) nn = mcftmp->nBlocks;
+	if (xdr_array(xdrs, (char **) &itmp, &nn, 
+	             mcftmp->nBlocks, sizeof(int), (void *) xdr_int) == FALSE) 
+	              return FALSE;
+	for (i=0; i<mcftmp->nBlocks; i++) {
+	       if (xdr_string(xdrs, &(mcftmp->blockNames[i]), 
+	               MCF_XDR_B_TITLE_LENGTH) == FALSE) return FALSE; 
+	    }	              
+	 mcftmp->nNTuples = 0;  
+     } else if (strncmp(*version, "2.",2) == 0){
+         sscanf(*version, "%f", &fv);
+     /*
+     ** Code valid for version 2.xx, adding the NTuples
+     */
+         atmp = &(mcftmp->title[0]);
+         btmp = &(mcftmp->comment[0]);
+         dtmp = &(mcftmp->date[0]);
+     	      
+        if ((xdr_string(xdrs, &atmp, MCF_XDR_F_TITLE_LENGTH) &&
+             xdr_string(xdrs,&btmp, MCF_XDR_F_TITLE_LENGTH) &&
+             xdr_string(xdrs,&dtmp, 30)) == FALSE) return FALSE;
+             
+         if (fv == 2.) strcpy(mcftmp->closingDate, mcftmp->date);
+         else {
+             atmp = &(mcftmp->closingDate[0]);
+            if (xdr_string(xdrs, &atmp, 30) == FALSE) return FALSE; 
+     	}      
+        if ((xdr_u_int(xdrs,&(mcftmp->numevts_expect)) &&
+             xdr_u_int(xdrs,&(mcftmp->numevts)) &&
+             xdr_u_int(xdrs,&(mcftmp->firstTable)) &&
+             xdr_u_int(xdrs,&(mcftmp->dimTable)) &&
+             xdr_u_int(xdrs,&(mcftmp->nBlocks)) &&
+             xdr_u_int(xdrs,&(mcftmp->nNTuples))) == FALSE) return FALSE;
+        if((xdrs->x_op == XDR_DECODE) && (mcftmp->nBlocks > 0)) {
+           mcftmp->blockIds = (int *) malloc(sizeof(int) * mcftmp->nBlocks);
+           mcftmp->blockNames = 
+           	(char**) malloc(sizeof(char *) * mcftmp->nBlocks);
+           for (i=0; i<mcftmp->nBlocks; i++) 
+                mcftmp->blockNames[i] =
+                  (char *) malloc(sizeof(char) * (MCF_XDR_B_TITLE_LENGTH +1));
+        }
+        itmp = mcftmp->blockIds;
+        if (xdrs->x_op == XDR_ENCODE) nn = mcftmp->nBlocks;
+        if (mcftmp->nBlocks > 0) {
+	    if (xdr_array(xdrs, (char **) &itmp, &nn, 
+	             mcftmp->nBlocks, sizeof(int), (void *) xdr_int) == FALSE) 
+	              return FALSE;
+	    for (i=0; i<mcftmp->nBlocks; i++) {
+	          if (xdr_string(xdrs, &(mcftmp->blockNames[i]), 
+	               MCF_XDR_B_TITLE_LENGTH) == FALSE) return FALSE; 
+	    }
+	  } else {
+	   mcftmp->blockNames = NULL;
+	   mcftmp->blockIds = NULL;
+	}
+	/*
+	** Now take care of the Ntuples
+	*/
+        if((xdrs->x_op == XDR_DECODE) && (mcftmp->nNTuples > 0)) {
+	   oldNumOfNTuples = NumOfNTuples;
+           for (i=0; i<mcftmp->nNTuples; i++) {
+                ddl = (nTuDDL * ) malloc(sizeof(nTuDDL));
+                AddNTuDDLtoList(ddl);
+                if (xdr_mcfast_NTuDDL(xdrs, *version, ddl) == FALSE) 
+                                                        return FALSE;
+           }
+        }  else if ((xdrs->x_op == XDR_ENCODE)  && (mcftmp->nNTuples > 0)) {  
+            for (i=0; i<NumOfNTuples; i++) {
+                ddl =mcf_GetNTuByPtrID(i+1);
+                if ((ddl->streamId == streamId) &&  
+                    (xdr_mcfast_NTuDDL(xdrs, *version, ddl) == FALSE)) 
+                                                        return FALSE;
+           }                                             
+       }                                                  
+		              
+     } else return FALSE; /* Other Futur version encoded here. */
+     return TRUE;
+     	      
+}   
+
+bool_t xdr_mcfast_eventtable(XDR *xdrs, int *blockid,
+ 		 int *ntot, char** version, mcfxdrEventTable **mcf)
+{
+/*  Translate a mcf EventTable block.  This subroutine will allocate
+	the memory needed if the stream is DECODE */
+        
+    int *idat;
+    unsigned int nn, nnold, *uidat;
+    mcfxdrEventTable *mcftmp;
+    
+    
+    mcftmp = *mcf;
+    if (xdrs->x_op == XDR_ENCODE) {
+      *ntot = sizeof(mcfxdrEventTable) + 4 * sizeof(int)* mcftmp->dim
+              + sizeof(unsigned int)* mcftmp->dim - 2 * sizeof(int)
+              - 4 * sizeof(int *) - sizeof(u_int *);
+       strcpy(*version, "1.00");
+     }  else if (xdrs->x_op == XDR_FREE) {
+          mcfioC_Free_EventTable(mcf);
+          return 1;
+     } else if((xdrs->x_op == XDR_DECODE) && ( mcftmp == NULL)) {
+          mcftmp = (mcfxdrEventTable *) malloc(sizeof(mcfxdrEventTable));
+          *mcf = mcftmp;
+     } 
+        
+
+       
+     if (( xdr_int(xdrs, blockid) && 
+     	      xdr_int(xdrs, ntot) &&
+     	      xdr_string(xdrs, version, MCF_XDR_VERSION_LENGTH)) 
+     	                 == FALSE) return FALSE;
+     
+     /*
+     ** Code valid for version 1.00
+     */
+     if (strcmp(*version, "1.00") == 0) {
+     	      
+        if((xdrs->x_op == XDR_DECODE) && (mcftmp->evtnums != NULL))
+             nnold = mcftmp->previousnumevts;
+          else nnold = 0;
+        idat = &mcftmp->nextLocator;
+        uidat = (u_int *) &mcftmp->numevts;  
+        if ((xdr_int(xdrs,idat) && xdr_u_int(xdrs,uidat )) == FALSE)
+                  return FALSE; 
+        if(xdrs->x_op == XDR_DECODE) {
+           if ((mcftmp->evtnums == NULL) || (mcftmp->numevts > nnold)) {
+           if (mcftmp->evtnums != NULL) {
+            /*
+            ** I don't trust realloc.. just alloc again.. 
+            */
+            free(mcftmp->evtnums); free(mcftmp->storenums); 
+            free(mcftmp->runnums); free(mcftmp->trigMasks);
+            free(mcftmp->ptrEvents);
+            }  
+           mcftmp->evtnums = (int *) malloc(sizeof(int) * mcftmp->dim);
+           mcftmp->storenums = (int *) malloc(sizeof(int) * mcftmp->dim);
+           mcftmp->runnums = (int *) malloc(sizeof(int) * mcftmp->dim);
+           mcftmp->trigMasks = (int *) malloc(sizeof(int) * mcftmp->dim);
+           mcftmp->ptrEvents = 
+            (unsigned int *) malloc(sizeof(unsigned int) * mcftmp->dim);
+            mcftmp->previousnumevts = mcftmp->dim;
+           }
+        }
+        if (xdrs->x_op == XDR_ENCODE) nn = mcftmp->dim;
+        idat = mcftmp->evtnums;
+	if (xdr_array(xdrs, (char **) &idat, &nn, 
+	              mcftmp->dim, sizeof(int), (void *) xdr_int) == FALSE) 
+	              return FALSE;
+        idat = mcftmp->storenums;
+	if (xdr_array(xdrs, (char **) &idat, &nn, 
+	              mcftmp->dim, sizeof(int), (void *) xdr_int) == FALSE) 
+	              return FALSE;
+        idat = mcftmp->runnums;
+	if (xdr_array(xdrs, (char **) &idat, &nn, 
+	              mcftmp->dim, sizeof(int), (void *) xdr_int) == FALSE) 
+	              return FALSE;
+        idat = mcftmp->trigMasks;
+	if (xdr_array(xdrs, (char **) &idat, &nn, 
+	              mcftmp->dim, sizeof(int), (void *) xdr_int) == FALSE) 
+	              return FALSE;
+        uidat = mcftmp->ptrEvents;
+	if (xdr_array(xdrs, (char **) &uidat, &nn, 
+	              mcftmp->dim, sizeof(int), (void *) xdr_u_int) == FALSE) 
+	              return FALSE;
+     } else return FALSE; /* Future version encoded here. */
+     return TRUE;
+     	      
+}
+   
+bool_t xdr_mcfast_seqheader(XDR *xdrs, int *blockid,
+ 		 int *ntot, char** version, mcfxdrSequentialHeader **mcf)
+{
+/*  Translate a mcf EventTable block.  This subroutine will allocate
+	the memory needed if the stream is DECODE */
+        
+    mcfxdrSequentialHeader *mcftmp;
+    
+    
+    if (xdrs->x_op == XDR_ENCODE) {
+      mcftmp = *mcf;
+      *ntot = sizeof(mcfxdrSequentialHeader);
+       strcpy(*version, "1.00");
+     }  else if (xdrs->x_op == XDR_FREE) {
+          mcfioC_Free_SeqHeader(mcf);
+          return 1;
+     } else if(xdrs->x_op == XDR_DECODE) {
+          if (*mcf == NULL) {
+              mcftmp = (mcfxdrSequentialHeader *) 
+                        malloc(sizeof(mcfxdrSequentialHeader));
+              *mcf = mcftmp;
+          } else mcftmp = *mcf;
+          
+     } 
+        
+
+       
+/*     if (( xdr_int(xdrs, blockid) && 
+     	      xdr_int(xdrs, ntot) &&
+     	      xdr_string(xdrs, version, MCF_XDR_VERSION_LENGTH)) 
+     	                 == FALSE) return FALSE;
+*/
+      if (xdr_int(xdrs,blockid) == FALSE) return FALSE;
+      if (xdr_int(xdrs,ntot) == FALSE) return FALSE; 
+      if (xdr_string(xdrs, version, MCF_XDR_VERSION_LENGTH) 
+     	                 == FALSE) return FALSE;    
+     /*
+     ** Code valid for version 1.00
+     */
+     if (strcmp(*version, "1.00") == 0) {
+     	      
+        if (xdr_u_int(xdrs,&(mcftmp->nRecords)) == FALSE) return FALSE; 
+     } else return FALSE; /* Futur version encoded here. */
+     return TRUE;
+     	      
+}
+
+bool_t xdr_mcfast_eventheader(XDR *xdrs, int *blockid,
+ 		 int *ntot, char** version, mcfxdrEventHeader **mcf)
+{
+/*  Translate a mcf Event header block.  This subroutine will allocate
+	the memory needed if the stream is DECODE */
+        
+    int *itmp;
+    unsigned int nn, nnold, nNTuOld, *uitmp;
+    mcfxdrEventHeader *mcftmp;
+    
+    
+    mcftmp = *mcf;
+    if (xdrs->x_op == XDR_ENCODE) {
+      *ntot = sizeof(mcfxdrEventHeader)
+              + sizeof(unsigned int)* mcftmp->nBlocks
+              + sizeof(int ) * mcftmp->nBlocks 
+              - sizeof(int *)  - sizeof(u_int *) ;
+       strcpy(*version, "2.00");
+     }  else if (xdrs->x_op == XDR_FREE) {
+          mcfioC_Free_EventHeader(mcf);
+          return 1;
+     } else if((xdrs->x_op == XDR_DECODE) && (mcftmp == NULL)) {
+          mcftmp =
+           (mcfxdrEventHeader *) malloc(sizeof(mcfxdrEventHeader));
+          *mcf = mcftmp;
+          mcftmp->blockIds = NULL;
+          mcftmp->ptrBlocks = NULL;
+     } 
+        
+
+       
+     if (( xdr_int(xdrs, blockid) && 
+     	      xdr_int(xdrs, ntot) &&
+     	      xdr_string(xdrs, version, MCF_XDR_VERSION_LENGTH)) 
+     	                  == FALSE) return FALSE;
+     
+     /*
+     ** Code valid for version 1.00
+     */
+     if (strcmp(*version, "1.00") == 0) {
+        if((xdrs->x_op == XDR_DECODE) && (mcftmp->blockIds != NULL))
+             nnold = mcftmp->dimBlocks;  
+     	else nnold = 0;      
+        if ((xdr_int(xdrs,&(mcftmp->evtnum)) &&
+             xdr_int(xdrs,&(mcftmp->storenum)) &&
+             xdr_int(xdrs,&(mcftmp->runnum)) &&
+             xdr_int(xdrs,&(mcftmp->trigMask)) &&
+             xdr_u_int(xdrs,&(mcftmp->nBlocks)) &&
+             xdr_u_int(xdrs,&(mcftmp->dimBlocks))) == FALSE) return FALSE; 
+        if(xdrs->x_op == XDR_DECODE) {
+           if ((mcftmp->blockIds == NULL) || (mcftmp->dimBlocks > nnold)) {
+           if (mcftmp->blockIds != NULL) {
+            /*
+            ** I don't trust realloc.. just alloc again.. 
+            */
+            free(mcftmp->blockIds); free(mcftmp->ptrBlocks); 
+            }  
+           mcftmp->blockIds =
+             (int *) malloc(sizeof(unsigned int) * mcftmp->dimBlocks);
+           mcftmp->ptrBlocks =
+             (unsigned int *) malloc(sizeof(unsigned int) * mcftmp->dimBlocks);
+           }
+        }
+        if (xdrs->x_op == XDR_ENCODE)  nn = mcftmp->dimBlocks;
+        itmp = mcftmp->blockIds;
+	if (xdr_array(xdrs, (char **) &itmp, &nn, 
+	              mcftmp->dimBlocks, sizeof(int), (void *) xdr_int) == FALSE) 
+	              return FALSE;
+	uitmp = mcftmp->ptrBlocks;              
+	if (xdr_array(xdrs, (char **) &uitmp, &nn, 
+	              mcftmp->dimBlocks, sizeof(u_int), (void *) xdr_u_int) == FALSE) 
+	              return FALSE;
+     } else if (strcmp(*version, "2.00") == 0) {
+        if (xdrs->x_op == XDR_DECODE) {
+           nnold = 0;
+           if (mcftmp->blockIds != NULL)  nnold = mcftmp->dimBlocks;
+           nNTuOld = 0;
+           if (mcftmp->nTupleIds != NULL)  nNTuOld = mcftmp->dimNTuples;
+        }  
+        if ((xdr_int(xdrs,&(mcftmp->evtnum)) &&
+             xdr_int(xdrs,&(mcftmp->storenum)) &&
+             xdr_int(xdrs,&(mcftmp->runnum)) &&
+             xdr_int(xdrs,&(mcftmp->trigMask)) &&
+             xdr_u_int(xdrs,&(mcftmp->nBlocks)) &&
+             xdr_u_int(xdrs,&(mcftmp->dimBlocks)) &&
+             xdr_u_int(xdrs,&(mcftmp->nNTuples)) &&
+             xdr_u_int(xdrs,&(mcftmp->dimNTuples))) == FALSE) return FALSE;
+        if(xdrs->x_op == XDR_DECODE) {
+           if ((mcftmp->blockIds == NULL) || (mcftmp->dimBlocks > nnold)) {
+           if (mcftmp->blockIds != NULL) { 
+               free(mcftmp->blockIds);
+               free(mcftmp->ptrBlocks);
+           }     
+           mcftmp->blockIds =
+             (int *) malloc(sizeof(unsigned int) * mcftmp->dimBlocks);
+           mcftmp->ptrBlocks =
+             (unsigned int *) malloc(sizeof(unsigned int) * mcftmp->dimBlocks);
+           }
+           if ((mcftmp->nTupleIds == NULL) || (mcftmp->dimNTuples > nNTuOld)) {
+           if (mcftmp->nTupleIds != NULL) { 
+               free(mcftmp->nTupleIds);
+               free(mcftmp->ptrNTuples);
+           }     
+           mcftmp->nTupleIds =
+             (int *) malloc(sizeof(unsigned int) * mcftmp->dimNTuples);
+           mcftmp->ptrNTuples =
+             (unsigned int *) malloc(sizeof(unsigned int) * mcftmp->dimNTuples);
+           }
+        }
+        if (mcftmp->dimBlocks > 0) {
+            if (xdrs->x_op == XDR_ENCODE)  nn = mcftmp->dimBlocks;
+            itmp = mcftmp->blockIds;
+	    if (xdr_array(xdrs, (char **) &itmp, &nn, 
+	              mcftmp->dimBlocks, sizeof(int), (void *) xdr_int) == FALSE) 
+	              return FALSE;
+	    uitmp = mcftmp->ptrBlocks;              
+	    if (xdr_array(xdrs, (char **) &uitmp, &nn, 
+	              mcftmp->dimBlocks, sizeof(u_int), (void *) xdr_u_int) == FALSE) 
+	              return FALSE;
+        }
+        if (mcftmp->dimNTuples > 0) {
+            if (xdrs->x_op == XDR_ENCODE)  nn = mcftmp->dimNTuples;
+            itmp = mcftmp->nTupleIds;
+	    if (xdr_array(xdrs, (char **) &itmp, &nn, 
+	              mcftmp->dimNTuples, sizeof(int), (void *) xdr_int) == FALSE) 
+	              return FALSE;
+	    uitmp = mcftmp->ptrNTuples;              
+	    if (xdr_array(xdrs, (char **) &uitmp, &nn, 
+	              mcftmp->dimNTuples, sizeof(u_int), (void *) xdr_u_int) == FALSE) 
+	              return FALSE;
+	}              
+     } else 
+      return FALSE; /* Futur version encoded here. */
+     return TRUE;
+     	      
+}
+
+static bool_t xdr_mcfast_NTuDDL(XDR *xdrs, char *version, nTuDDL *ddl)
+{
+    int i, nc_title, nc_category, idRef;
+    descrGenNtuple *dNTu;
+    
+    
+    /*
+    ** This is the first version, let us not get too compilcated..
+    */
+    if (xdrs->x_op == XDR_ENCODE) {
+           nc_title = strlen(ddl->title);
+           nc_category = strlen(ddl->category);
+           idRef = -1;
+           /*
+           ** Cross reference is only valid within the same stream.
+           */
+           if ((ddl->reference != NULL) && 
+               (ddl->streamId == ddl->reference->streamId )) { 
+               /*
+               ** compute the rerefence token. This is the sequential 
+               ** number of the reference Ntuple for this stream.
+               */
+               for (i=0, idRef=0; i<NumOfNTuples; i++) { 
+                   if (NTuDDLList[i]->streamId == ddl->reference->streamId)
+                       idRef++;
+                   if (NTuDDLList[i]->id == ddl->reference->id) break;
+               }    
+          }
+    }      
+    if (xdr_int(xdrs, &nc_title) == FALSE) return FALSE;
+    if (xdr_int(xdrs, &nc_category) == FALSE) return FALSE;
+    if (xdr_int(xdrs, &idRef) == FALSE) return FALSE;
+    if (xdrs->x_op == XDR_DECODE) {
+       ddl->title = (char *) malloc(sizeof(char) * (nc_title +1));
+       ddl->category = (char *) malloc(sizeof(char) * (nc_category +1));
+       ddl->dbinFileName = NULL;
+       ddl->streamId = -1;
+    }   
+    if (xdr_int(xdrs,&(ddl->uid)) == FALSE) return FALSE;
+    if (xdr_string(xdrs, &(ddl->title), nc_title) == FALSE) return FALSE;
+    if (xdr_string(xdrs, &(ddl->category), 
+                      nc_category) == FALSE) return FALSE;
+    if (idRef == -1) {                  
+        if (xdrs->x_op == XDR_DECODE) 
+           ddl->descrNtu = (descrGenNtuple *) malloc (sizeof(descrGenNtuple));
+         if (ddl->descrNtu == NULL) dNTu = ddl->reference->descrNtu;
+           else dNTu = ddl->descrNtu; 
+        if (xdr_mcfast_descrNTU(xdrs, version, dNTu) == FALSE) 
+            return FALSE;
+        if (xdrs->x_op == XDR_DECODE) ddl->reference = NULL; 
+    } else {
+        if (xdrs->x_op == XDR_DECODE) {
+              ddl->descrNtu = NULL;
+              ddl->referenceId = idRef;
+              /* we will set the reference pointer in mcfio_Direct */
+        }
+    }        
+    return TRUE; 
+    	      
+}
+
+static bool_t xdr_mcfast_descrNTU(XDR *xdrs, char *version,
+                                    descrGenNtuple *dNTu)
+{
+    int i, nc_desc, nc_title;
+    u_int nn;
+    char *tc;
+    /*
+    ** This is the first version, let us not get too compilcated..
+    */
+    
+    if (xdr_int(xdrs,&(dNTu->numVariables)) == FALSE) return FALSE;
+    dNTu->numAvailable = dNTu->numVariables;
+    if (xdr_int(xdrs,&(dNTu->maxMultiplicity)) == FALSE) return FALSE;
+    if (xdr_int(xdrs,&(dNTu->orgStyle)) == FALSE)return FALSE;
+    if (xdr_int(xdrs,&(dNTu->firstIndexed)) == FALSE) return FALSE;
+    if (xdrs->x_op == XDR_ENCODE)  nc_title = strlen(dNTu->title);
+    if (xdr_int(xdrs, &nc_title) == FALSE) return FALSE;
+    if (xdrs->x_op == XDR_ENCODE)  nc_desc = strlen(dNTu->description);
+    if (xdr_int(xdrs, &nc_desc) == FALSE) return FALSE;
+    if (xdrs->x_op == XDR_DECODE) {
+        dNTu->title = (char *) malloc(sizeof(char) * (nc_title+1));
+        dNTu->subXDROffset = NULL;
+        dNTu->description = (char *) malloc(sizeof(char) * (nc_desc+1));
+        dNTu->varOrdering = (int *) malloc(sizeof(int) * dNTu->numVariables);
+        for (i=0; i<dNTu->numVariables; i++) dNTu->varOrdering[i] = i;
+        if (dNTu->orgStyle == PARALLEL_ARRAY_NTU) {
+           dNTu->subXDROffset = NULL;
+           dNTu->subOffset = NULL;  
+        } else {
+           dNTu->subOffset = 
+          (long *) malloc(sizeof(long) * dNTu->maxMultiplicity);
+           dNTu->subXDROffset = 
+          (u_int *) malloc(sizeof(long) * dNTu->maxMultiplicity);
+        }  
+        dNTu->variables =
+        (varGenNtuple **) malloc(sizeof(varGenNtuple *) * dNTu->numVariables);  
+        for (i=0; i<dNTu->numVariables; i++)
+            dNTu->variables[i] = (varGenNtuple *) malloc(sizeof(varGenNtuple));
+     }
+     tc = dNTu->nameIndex;
+     if (xdr_string(xdrs, &tc, 31) == FALSE) return FALSE;
+     if (xdr_string(xdrs, 
+        (char **) &(dNTu->title), nc_title) == FALSE) return FALSE;
+     if (xdr_string(xdrs,
+           &(dNTu->description), nc_desc) == FALSE) return FALSE;
+     tc =  dNTu->version;     
+     if (xdr_string(xdrs,  &tc, 7) == FALSE) return FALSE;
+     if (xdr_long(xdrs,  &(dNTu->multOffset)) == FALSE) return FALSE;
+     if (xdr_long(xdrs,  &(dNTu->fenceOffset)) == FALSE) return FALSE;
+     nn = dNTu->maxMultiplicity;
+     if (dNTu->orgStyle != PARALLEL_ARRAY_NTU) { 
+        if (xdr_array(xdrs, 
+      (char **) &(dNTu->subOffset), &nn, nn, sizeof(long), (void *) xdr_long) == FALSE) 
+           return FALSE;
+     }      
+     for (i=0; i<dNTu->numVariables; i++) 
+	if (xdr_mcfast_varDescrNTU(xdrs, version, dNTu->variables[i]) == FALSE)
+	        return FALSE;
+     return TRUE;
+}
+static bool_t xdr_mcfast_varDescrNTU(XDR *xdrs, char *version,
+                                    varGenNtuple *var)
+{
+    int nc_name, nc_desc, *pdim;
+    u_int nn;
+    
+    
+    
+    if (xdrs->x_op == XDR_ENCODE)  nc_name = strlen(var->name);
+    if (xdr_int(xdrs, &nc_name) == FALSE) return FALSE;
+    if (xdrs->x_op == XDR_ENCODE) {
+         if (var->description == NULL) nc_desc = 0;
+             else nc_desc = strlen(var->description);
+    }     
+    if (xdr_int(xdrs, &nc_desc) == FALSE) return FALSE;
+    if (xdrs->x_op == XDR_DECODE) {
+        var->name = (char *) malloc(sizeof(char) * (nc_name+1));
+        if (nc_desc>0) 
+           var->description = (char *) malloc(sizeof(char) * (nc_desc+1));
+        else    var->description = NULL;
+        var->nameBlank = FALSE;
+     }
+  
+     if (xdr_string(xdrs, &(var->name), nc_name) == FALSE) return FALSE;
+     if (nc_desc > 0) 
+        if (xdr_string(xdrs, &(var->description), nc_desc) == FALSE) 
+             return FALSE;
+     if (xdr_int(xdrs,&(var->type)) == FALSE) return FALSE;
+     if (xdr_char(xdrs,&(var->isFixedSize)) == FALSE) return FALSE;
+     if (xdr_int(xdrs,&(var->numDim)) == FALSE) return FALSE;
+     nn = var->numDim;
+     pdim = var->dimensions;
+     if ((nn > 0) && (xdr_array(xdrs, 
+        (char **) &pdim, &nn, nn, sizeof(int), (void *) xdr_int)) == FALSE) 
+           return FALSE;
+     if (xdrs->x_op == XDR_ENCODE) nn = (u_int) var->lengthB;  
+     if (xdr_u_int(xdrs,&(nn)) == FALSE) return FALSE;
+     if (xdrs->x_op == XDR_DECODE) var->lengthB = (size_t) nn;
+     if (xdrs->x_op == XDR_ENCODE) nn = (u_int) var->lengthW;  
+     if (xdr_u_int(xdrs,&(nn)) == FALSE) return FALSE;
+     if (xdrs->x_op == XDR_DECODE) var->lengthW = (size_t) nn;  
+     if (xdr_long(xdrs,&(var->offset)) == FALSE) return FALSE;
+     return TRUE;
+}
+/*
+** Generalized NTuple XDR filter
+*/
+bool_t xdr_mcfast_NTuple(XDR *xdrs, descrGenNtuple *dNTu,
+ 		 int *pnTot, int nTupleId, char* version)
+{
+    int i, j, id, nm, lastFixed;
+    u_int nn;
+    char *vv, *cDat, *start;
+    int *pnMult;
+    void *pnFence;
+    int *ipnFence;
+    void *pt;
+    bool_t ok;
+/*
+** Upon write, check that the version token is identical to the one stored 
+** in the ddl. 
+*/
+     start = version;
+     if(dNTu->firstIndexed == -1) lastFixed = dNTu->numVariables;
+        else lastFixed = dNTu->firstIndexed;
+     if ((xdrs->x_op == XDR_ENCODE) || (xdrs->x_op == XDR_MCFIOCODE)) {
+         nn = strlen(dNTu->version);
+         if (strncmp(version, dNTu->version, (size_t) nn ) != 0) {
+              fprintf (stderr, "mcfio_NTuple: version mismatch! \n\
+          Version used in the Event loop = %s\n\
+                  ...  in the DDl template = %s\n", version,dNTu->version);
+              return FALSE;
+         }
+         id = nTupleId;
+/*
+**   Compute the total length 
+*/
+         cDat = start; cDat +=  dNTu->multOffset;
+         pnMult = (int *) cDat;
+         nm = *pnMult;
+         for (i=0, nn=0; i<lastFixed; i++)
+               nn += dNTu->variables[i]->lengthB;
+         if(dNTu->firstIndexed != -1) 
+             for(i=dNTu->firstIndexed; i<dNTu->numVariables; i++) 
+                nn += (dNTu->variables[i]->lengthB * nm);
+         *pnTot = 6 + nn/4;      
+     }
+     if (xdr_int(xdrs, &id) == FALSE) return FALSE;
+     if (xdr_int(xdrs, pnTot) == FALSE) return FALSE;
+     if (xdrs->x_op == XDR_ENCODE) {
+         vv = dNTu->version;
+         if (xdr_string(xdrs, &vv, 11) == FALSE) return FALSE;
+     } else  if (xdrs->x_op == XDR_DECODE) {
+         if (xdr_string(xdrs, &version, 11) == FALSE) return FALSE;
+         if (strcmp(version, dNTu->version) != 0) {
+              fprintf (stderr, "mcfio_NTuple: version mismatch! \n\
+          Version used in the Event loop = %s\n\
+                  ...  in the DDl template = %s\n", version,dNTu->version);
+              return FALSE;
+         }
+         if (id != nTupleId) {
+              fprintf (stderr, "mcfio_NTuple: internal error! \n\
+          Unexpected NTuple identifier %d instead of %d\n", id, nTupleId);
+          return FALSE;
+          }
+     }
+         
+     cDat = start; cDat +=  dNTu->multOffset;
+     pnMult = (int *) cDat;
+     if (xdr_int(xdrs, pnMult) == FALSE) return FALSE;
+     /*
+     ** Close the fence now, we will check it upon DECODE at the end
+     */
+     cDat = start; cDat +=  dNTu->fenceOffset;
+     pnFence = (void *) cDat;
+     if (xdrs->x_op == XDR_ENCODE) memcpy(pnFence, pnTot, sizeof(int));
+     if (xdr_int(xdrs, (int *) pnFence) == FALSE) return FALSE;
+     nm = *pnMult;
+     for (i=0; i<lastFixed; i++) {
+        if (dNTu->variables[i]->lengthW == 1) {
+           cDat = start; cDat += dNTu->variables[i]->offset;
+           pt = (void *) cDat;
+           switch (dNTu->variables[i]->type) {
+                   case BYTE_NTU: case CHARACTER_NTU:
+                      ok = xdr_char(xdrs, (char *) pt);
+                      break;
+                   case INTEGER2_NTU:
+                      ok = xdr_short(xdrs, (short *) pt);
+                      break;
+                   case LOGICAL_NTU: case INTEGER_NTU:
+                      ok = xdr_int(xdrs, (int *) pt);
+                      break;
+                   case REAL_NTU:
+                      ok = xdr_float(xdrs, (float *) pt); 
+                      break;
+                   case DBL_PRECISION_NTU:
+                      ok = xdr_double(xdrs, (double *) pt);
+                      break;
+                   case COMPLEX_NTU:
+                      nn =2;
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(float), (void *) xdr_float);
+                      break;
+                   case DBL_COMPLEX_NTU:
+                      nn =2;
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(double), (void *) xdr_double);
+                      break;
+                   case POINTER_NTU:
+                      ok = xdr_long(xdrs, (long *) pt);
+                      break;
+                   default :
+                       fprintf (stderr, "mcfio_NTuple: internal error! \n\
+          Unexpected variables type %d on NTuple %d\n", 
+                       dNTu->variables[i]->type, nTupleId);
+                       break;
+              }
+        }      
+        else if (dNTu->variables[i]->lengthW > 0) {
+           cDat = start; cDat +=  dNTu->variables[i]->offset;
+           pt = (void *) cDat;
+           nn = dNTu->variables[i]->lengthW;
+           switch (dNTu->variables[i]->type) {
+                   case BYTE_NTU: case CHARACTER_NTU:
+                      ok = xdr_bytes(xdrs, (char **) &pt, &nn, nn);
+                      break;
+                   case INTEGER2_NTU:
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(short), (void *) xdr_short);
+                      break;
+                   case LOGICAL_NTU: case INTEGER_NTU:
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(int), (void *) xdr_int);
+                      break;
+                   case REAL_NTU:
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(float), (void *) xdr_float);
+                      break;
+                   case DBL_PRECISION_NTU:
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(double), (void *) xdr_double);
+                      break;
+                   case COMPLEX_NTU:
+                      nn = nn*2;
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(float), (void *) xdr_float);
+                      break;
+                   case DBL_COMPLEX_NTU:
+                      nn = nn*2;
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(double), (void *) xdr_double);
+                      break;
+                   case POINTER_NTU:
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(long), (void *) xdr_long);
+                      break;
+                   default :
+                       fprintf (stderr, "mcfio_NTuple: internal error! \n\
+          Unexpected variables type %d on NTuple %d\n", 
+                       dNTu->variables[i]->type, nTupleId);
+                       break;
+              }
+          if (ok == FALSE) return FALSE;    
+         }
+      }
+      if (dNTu->firstIndexed != -1) {
+         if (dNTu->orgStyle == PARALLEL_ARRAY_NTU) {
+          for (i=dNTu->firstIndexed; i<dNTu->numVariables; i++) {
+                 cDat = start; cDat +=  dNTu->variables[i]->offset;
+                 pt = (void *) cDat;
+                 nn = nm * dNTu->variables[i]->lengthW;
+                 switch (dNTu->variables[i]->type) {
+                   case BYTE_NTU: case CHARACTER_NTU:
+                      vv = (char *) pt;
+                      ok = xdr_bytes(xdrs, (char **) &pt, &nn, nn);
+                      break;
+                   case INTEGER2_NTU:
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(short), (void *) xdr_short);
+                      break;
+                   case LOGICAL_NTU: case INTEGER_NTU:
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(int), (void *) xdr_int);
+                      break;
+                   case REAL_NTU:
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(float), (void *) xdr_float);
+                      break;
+                   case DBL_PRECISION_NTU:
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(double), (void *) xdr_double);
+                      break;
+                   case COMPLEX_NTU:
+                      nn = nn*2;
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(float), (void *) xdr_float);
+                      break;
+                   case DBL_COMPLEX_NTU:
+                      nn = nn*2;
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(double), (void *) xdr_double);
+                      break;
+                   case POINTER_NTU:
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(long), (void *) xdr_long);
+                      break;
+                   default :
+                       fprintf (stderr, "mcfio_NTuple: internal error! \n\
+          Unexpected variables type %d on NTuple %d\n", 
+                       dNTu->variables[i]->type, nTupleId);
+                       break;
+              }
+          if (ok == FALSE) return FALSE;    
+        }
+     } else { /*dump the substructures one a time */
+     for (j=0; j<nm; j++) {
+       for (i=dNTu->firstIndexed; i<dNTu->numVariables; i++) {
+        cDat = start; 
+        cDat += (dNTu->subOffset[j] + dNTu->variables[i]->offset);
+        pt = (void *) cDat;
+        if (dNTu->variables[i]->lengthW == 1) {
+           switch (dNTu->variables[i]->type) {
+                   case BYTE_NTU: case CHARACTER_NTU:
+                      ok = xdr_char(xdrs, (char *) pt);
+                      break;
+                   case INTEGER2_NTU:
+                      ok = xdr_short(xdrs, (short *) pt);
+                      break;
+                   case LOGICAL_NTU: case INTEGER_NTU:
+                      ok = xdr_int(xdrs, (int *) pt);
+                      break;
+                   case REAL_NTU:
+                      ok = xdr_float(xdrs, (float *) pt); 
+                      break;
+                   case DBL_PRECISION_NTU:
+                      ok = xdr_double(xdrs, (double *) pt);
+                      break;
+                   case COMPLEX_NTU:
+                      nn =2;
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(float), (void *) xdr_float);
+                      break;
+                   case DBL_COMPLEX_NTU:
+                      nn =2;
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(double), (void *) xdr_double);
+                      break;
+                   case POINTER_NTU:
+                      ok = xdr_long(xdrs, (long *) pt);
+                      break;
+                   default :
+                       fprintf (stderr, "mcfio_NTuple: internal error! \n\
+          Unexpected variables type %d on NTuple %d\n", 
+                       dNTu->variables[i]->type, nTupleId);
+                       break;
+              }
+        }      
+        else if (dNTu->variables[i]->lengthW > 0) {
+           nn = dNTu->variables[i]->lengthW;
+           switch (dNTu->variables[i]->type) {
+                   case BYTE_NTU: case CHARACTER_NTU:
+                      ok = xdr_bytes(xdrs, (char **) &pt, &nn, nn);
+                      break;
+                   case INTEGER2_NTU:
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(short), (void *) xdr_short);
+                      break;
+                   case LOGICAL_NTU: case INTEGER_NTU:
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(int), (void *) xdr_int);
+                      break;
+                   case REAL_NTU:
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(float), (void *) xdr_float);
+                      break;
+                   case DBL_PRECISION_NTU:
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(double), (void *) xdr_double);
+                      break;
+                   case COMPLEX_NTU:
+                      nn = nn*2;
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(float), (void *) xdr_float);
+                      break;
+                   case DBL_COMPLEX_NTU:
+                      nn = nn*2;
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(double), (void *) xdr_double);
+                      break;
+                   case POINTER_NTU:
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(long), (void *) xdr_long);
+                      break;
+                   default :
+                       fprintf (stderr, "mcfio_NTuple: internal error! \n\
+          Unexpected variables type %d on NTuple %d\n", 
+                       dNTu->variables[i]->type, nTupleId);
+                       break;
+              }
+          if (ok == FALSE) return FALSE;    
+         }
+        } /*end of i loop */
+       } /*end of j loop */
+      } /* End of orgStyle clause */
+      } /* End of firstIndexed clause */
+      /*
+      ** Check the fence.. 
+      */
+      ipnFence = (int *) pnFence;
+      if ((xdrs->x_op == XDR_DECODE) && (*ipnFence != *pnTot)) {
+              fprintf (stderr, "mcfio_NTuple: Suspected Data Overwrite! \n\
+          Fence content found on the input stream is = %d\n\
+                  ...  while we expect %d\n", *ipnFence, *pnTot);
+              return FALSE;
+      }
+      return TRUE;
+}
+
+/*
+** Generalized NTuple XDR filter, for DECODE only, used exclusively 
+** to establish the relative XDR pointers.
+*/
+bool_t xdr_mcfast_NTupleXDRPtr(XDR *xdrs, descrGenNtuple *dNTu,
+ 		 int *pnTot, int nTupleId, char* version)
+{
+    int i, j, id, nm, lastFixed;
+    u_int nn, startXDR;
+    char *vv, *cDat;
+    int *pnMult, *pnFence;
+    void *start, *pt;
+    bool_t ok;
+    
+    /*
+    ** Allocate memory for supointer array if need be.
+    */
+     if(dNTu->firstIndexed == -1) lastFixed = dNTu->numVariables;
+        else lastFixed = dNTu->firstIndexed;
+        
+     if (dNTu->subXDROffset != NULL) free(dNTu->subXDROffset);
+     dNTu->subXDROffset = 
+          (u_int *) malloc (sizeof(u_int) * dNTu->maxMultiplicity);
+     start = (void *) version;
+     startXDR = xdr_getpos(xdrs);
+     if (xdr_int(xdrs, &id) == FALSE) return FALSE;
+      if (xdr_int(xdrs, pnTot) == FALSE) return FALSE;
+
+      if (xdr_string(xdrs, &version, 11) == FALSE) return FALSE;
+      if (id != nTupleId) {
+              fprintf (stderr, "mcfio_NTuple: internal error! \n\
+          Unexpected NTuple identifier %d instead of %d\n", id, nTupleId);
+          return FALSE;
+      }
+     cDat = start; cDat +=  dNTu->multOffset;
+     pnMult = (int *) cDat;
+     dNTu->multXDROffset = xdr_getpos(xdrs) - startXDR;
+     if (xdr_int(xdrs, pnMult) == FALSE) return FALSE;
+     /*
+     ** Close the fence now, we will check it upon DECODE at the end
+     */
+     cDat = start; cDat += dNTu->fenceOffset;
+     pnFence = (int *) cDat;
+     dNTu->fenceXDROffset = xdr_getpos(xdrs) - startXDR;
+     if (xdr_int(xdrs, (int *) pnFence) == FALSE) return FALSE;
+     nm = *pnMult;
+     for (i=0; i<lastFixed; i++) {
+        dNTu->variables[i]->offsetXDR = 0;
+        if (dNTu->variables[i]->lengthW == 1) {
+           cDat = start; cDat +=  dNTu->variables[i]->offset;
+           pt = (void *) cDat;
+          dNTu->variables[i]->offsetXDR = xdr_getpos(xdrs) - startXDR;
+           switch (dNTu->variables[i]->type) {
+                   case BYTE_NTU: case CHARACTER_NTU:
+                      ok = xdr_char(xdrs, (char *) pt);
+                      break;
+                   case INTEGER2_NTU:
+                      ok = xdr_short(xdrs, (short *) pt);
+                      break;
+                   case LOGICAL_NTU: case INTEGER_NTU:
+                      ok = xdr_int(xdrs, (int *) pt);
+                      break;
+                   case REAL_NTU:
+                      ok = xdr_float(xdrs, (float *) pt); 
+                      break;
+                   case DBL_PRECISION_NTU:
+                      ok = xdr_double(xdrs, (double *) pt);
+                      break;
+                   case COMPLEX_NTU:
+                      nn =2;
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(float), (void *) xdr_float);
+                      break;
+                   case DBL_COMPLEX_NTU:
+                      nn =2;
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(double), (void *) xdr_double);
+                      break;
+                   case POINTER_NTU:
+                      ok = xdr_long(xdrs, (long *) pt);
+                      break;
+                   default :
+                       fprintf (stderr, "mcfio_NTuple: internal error! \n\
+          Unexpected variables type %d on NTuple %d\n", 
+                       dNTu->variables[i]->type, nTupleId);
+                       break;
+              }
+        }      
+        else if (dNTu->variables[i]->lengthW > 0) {
+           cDat = start;  cDat += dNTu->variables[i]->offset;
+           pt = (void *) cDat;
+           nn = dNTu->variables[i]->lengthW;
+           dNTu->variables[i]->offsetXDR = xdr_getpos(xdrs) - startXDR;
+           switch (dNTu->variables[i]->type) {
+                   case BYTE_NTU: case CHARACTER_NTU:
+                      ok = xdr_bytes(xdrs, (char **) &pt, &nn, nn);
+                      break;
+                   case INTEGER2_NTU:
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(short), (void *) xdr_short);
+                      break;
+                   case LOGICAL_NTU: case INTEGER_NTU:
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(int), (void *) xdr_int);
+                      break;
+                   case REAL_NTU:
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(float), (void *) xdr_float);
+                      break;
+                   case DBL_PRECISION_NTU:
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(double), (void *) xdr_double);
+                      break;
+                   case COMPLEX_NTU:
+                      nn = nn*2;
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(float), (void *) xdr_float);
+                      break;
+                   case DBL_COMPLEX_NTU:
+                      nn = nn*2;
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(double), (void *) xdr_double);
+                      break;
+                   case POINTER_NTU:
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(long), (void *) xdr_long);
+                      break;
+                   default :
+                       fprintf (stderr, "mcfio_NTuple: internal error! \n\
+          Unexpected variables type %d on NTuple %d\n", 
+                       dNTu->variables[i]->type, nTupleId);
+                       break;
+              }
+          if (ok == FALSE) return FALSE;    
+         }
+      }
+      if (dNTu->firstIndexed != -1) {
+      if (dNTu->orgStyle == PARALLEL_ARRAY_NTU) {
+          for (i=dNTu->firstIndexed; i<dNTu->numVariables; i++) {
+                 cDat =start;  cDat += dNTu->variables[i]->offset;
+                 pt = (void *) cDat;
+                 nn = nm * dNTu->variables[i]->lengthW;
+                 dNTu->variables[i]->offsetXDR = xdr_getpos(xdrs) - startXDR;
+                 switch (dNTu->variables[i]->type) {
+                   case BYTE_NTU: case CHARACTER_NTU:
+                      vv = (char *) pt;
+                      ok = xdr_bytes(xdrs, (char **) &pt, &nn, nn);
+                      break;
+                   case INTEGER2_NTU:
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(short), (void *) xdr_short);
+                      break;
+                   case LOGICAL_NTU: case INTEGER_NTU:
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(int), (void *) xdr_int);
+                      break;
+                   case REAL_NTU:
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(float), (void *) xdr_float);
+                      break;
+                   case DBL_PRECISION_NTU:
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(double), (void *) xdr_double);
+                      break;
+                   case COMPLEX_NTU:
+                      nn = nn*2;
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(float), (void *) xdr_float);
+                      break;
+                   case DBL_COMPLEX_NTU:
+                      nn = nn*2;
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(double), (void *) xdr_double);
+                      break;
+                   case POINTER_NTU:
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(long), (void *) xdr_long);
+                      break;
+                   default :
+                       fprintf (stderr, "mcfio_NTuple: internal error! \n\
+          Unexpected variables type %d on NTuple %d\n", 
+                       dNTu->variables[i]->type, nTupleId);
+                       break;
+              }
+          if (ok == FALSE) return FALSE;    
+        }
+     } else { /*dump the substructure one a time */
+     for (j=0; j<nm; j++) {
+       dNTu->subXDROffset[j] = xdr_getpos(xdrs) - startXDR;
+       for (i=dNTu->firstIndexed; i<dNTu->numVariables; i++) {
+        cDat = start; 
+        cDat += (dNTu->subOffset[j] + dNTu->variables[i]->offset);
+        pt = (void *) cDat;
+        if (j == 0) dNTu->variables[i]->offsetXDR = 0;
+        if (dNTu->variables[i]->lengthW == 1) {
+          if (j == 0)  dNTu->variables[i]->offsetXDR =
+                 xdr_getpos(xdrs) - startXDR- dNTu->subXDROffset[j];
+           switch (dNTu->variables[i]->type) {
+                   case BYTE_NTU: case CHARACTER_NTU:
+                      ok = xdr_char(xdrs, (char *) pt);
+                      break;
+                   case INTEGER2_NTU:
+                      ok = xdr_short(xdrs, (short *) pt);
+                      break;
+                   case LOGICAL_NTU: case INTEGER_NTU:
+                      ok = xdr_int(xdrs, (int *) pt);
+                      break;
+                   case REAL_NTU:
+                      ok = xdr_float(xdrs, (float *) pt); 
+                      break;
+                   case DBL_PRECISION_NTU:
+                      ok = xdr_double(xdrs, (double *) pt);
+                      break;
+                   case COMPLEX_NTU:
+                      nn =2;
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(float), (void *) xdr_float);
+                      break;
+                   case DBL_COMPLEX_NTU:
+                      nn =2;
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(double), (void *) xdr_double);
+                      break;
+                   case POINTER_NTU:
+                      ok = xdr_long(xdrs, (long *) pt);
+                      break;
+                   default :
+                       fprintf (stderr, "mcfio_NTuple: internal error! \n\
+          Unexpected variables type %d on NTuple %d\n", 
+                       dNTu->variables[i]->type, nTupleId);
+                       break;
+              }
+        }      
+        else if (dNTu->variables[i]->lengthW > 0) {
+           nn = dNTu->variables[i]->lengthW;
+           if (j == 0) dNTu->variables[i]->offsetXDR =
+                 xdr_getpos(xdrs) - startXDR - dNTu->subXDROffset[0];
+           switch (dNTu->variables[i]->type) {
+                   case BYTE_NTU: case CHARACTER_NTU:
+                      ok = xdr_bytes(xdrs, (char **) &pt, &nn, nn);
+                      break;
+                   case INTEGER2_NTU:
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(short), (void *) xdr_short);
+                      break;
+                   case LOGICAL_NTU: case INTEGER_NTU:
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(int), (void *) xdr_int);
+                      break;
+                   case REAL_NTU:
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(float), (void *) xdr_float);
+                      break;
+                   case DBL_PRECISION_NTU:
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(double), (void *) xdr_double);
+                      break;
+                   case COMPLEX_NTU:
+                      nn = nn*2;
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(float), (void *) xdr_float);
+                      break;
+                   case DBL_COMPLEX_NTU:
+                      nn = nn*2;
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(double), (void *) xdr_double);
+                      break;
+                   case POINTER_NTU:
+                      ok = xdr_array(xdrs, 
+                         (char **) &pt, &nn, nn, sizeof(long), (void *) xdr_long);
+                      break;
+                   default :
+                       fprintf (stderr, "mcfio_NTuple: internal error! \n\
+          Unexpected variables type %d on NTuple %d\n", 
+                       dNTu->variables[i]->type, nTupleId);
+                       break;
+              }
+          if (ok == FALSE) return FALSE;    
+         }
+        } /*end of i loop */
+       } /*end of j loop */
+      } /* End of orgStyle clause */
+      } /* End of firstIndexed clause */
+      /*
+      ** Check the fence.. 
+      */
+      if (*pnFence != *pnTot) {
+              fprintf (stderr, "mcfio_NTuple: Suspected Data Overwrite! \n\
+          Fence content found on the input stream is = %d\n\
+                  ...  while we expect %d\n", *pnFence, *pnTot);
+              return FALSE;
+      }
+      return TRUE;
+}
+/*
+** Generalized NTuple XDR filter, used for Decode only. 
+** Simply decode the multiplicty value. No checks whatsoever!
+*/
+bool_t xdr_mcfast_NTupleMult(mcfStream *str, descrGenNtuple *dNTu,
+ 		char* version)
+{
+    char *cDat;
+    
+     cDat = version;
+     cDat +=  dNTu->multOffset;     
+     xdr_setpos(str->xdr, (str->currentPos + dNTu->multXDROffset) );
+     return  (xdr_int(str->xdr, ((int *) cDat)));
+}
+
+/*
+** Generalized NTuple XDR filter, used for Decode only. 
+** Simply decode one variable (scalar) or array value. No checks whatsoever!
+** Not applicable if the structure organization style is VAX FORTRAN d/s 
+** and the index corresponds to an indexed variable.
+*/
+bool_t xdr_mcfast_NTupleVar(mcfStream *str, descrGenNtuple *dNTu,
+ 		int ivar, char* version)
+{
+    char *cDat;
+    u_int nn;
+    void *pt;
+    int ivarP;
+    
+     ivarP = ivar;
+     while (dNTu->variables[ivarP]->lengthW == 0) ivarP--;
+     cDat = version;
+     cDat += dNTu->variables[ivarP]->offset;
+     pt = (void *) cDat;     
+     xdr_setpos(str->xdr, 
+              (str->currentPos + dNTu->variables[ivarP]->offsetXDR));
+     if ((dNTu->variables[ivarP]->lengthW == 1) &&
+         (ivarP < dNTu->firstIndexed)) {
+          switch (dNTu->variables[ivarP]->type) {
+                   case BYTE_NTU: case CHARACTER_NTU:
+                      return  xdr_char(str->xdr, (char *) pt);
+                   case INTEGER2_NTU:
+                      return  xdr_short(str->xdr, (short *) pt);
+                   case LOGICAL_NTU: case INTEGER_NTU:
+                      return  xdr_int(str->xdr, (int *) pt);
+                   case REAL_NTU:
+                      return  xdr_float(str->xdr, (float *) pt); 
+                   case DBL_PRECISION_NTU:
+                      return  xdr_double(str->xdr, (double *) pt);
+                   case COMPLEX_NTU:
+                      nn =2;
+                      return  xdr_array(str->xdr, 
+                         (char **) &pt, &nn, nn, sizeof(float), (void *) xdr_float);
+                   case DBL_COMPLEX_NTU:
+                      nn =2;
+                      return  xdr_array(str->xdr, 
+                         (char **) &pt, &nn, nn, sizeof(double), (void *) xdr_double);
+                   case POINTER_NTU:
+                      return  xdr_long(str->xdr, (long *) pt);
+                   default :
+                      return FALSE;
+              }
+        } else {
+           nn = dNTu->variables[ivarP]->lengthW;
+           switch (dNTu->variables[ivarP]->type) {
+                   case BYTE_NTU: case CHARACTER_NTU:
+                      return  xdr_bytes(str->xdr, (char **) &pt, &nn, nn);
+                   case INTEGER2_NTU:
+                      return  xdr_array(str->xdr, 
+                         (char **) &pt, &nn, nn, sizeof(short), (void *) xdr_short);
+                   case LOGICAL_NTU: case INTEGER_NTU:
+                      return  xdr_array(str->xdr, 
+                         (char **) &pt, &nn, nn, sizeof(int), (void *) xdr_int);
+                   case REAL_NTU:
+                      return  xdr_array(str->xdr, 
+                         (char **) &pt, &nn, nn, sizeof(float), (void *) xdr_float);
+                   case DBL_PRECISION_NTU:
+                      return  xdr_array(str->xdr, 
+                         (char **) &pt, &nn, nn, sizeof(double), (void *) xdr_double);
+                   case COMPLEX_NTU:
+                      nn = nn*2;
+                      return  xdr_array(str->xdr, 
+                         (char **) &pt, &nn, nn, sizeof(float), (void *) xdr_float);
+                   case DBL_COMPLEX_NTU:
+                      nn = nn*2;
+                      return  xdr_array(str->xdr, 
+                         (char **) &pt, &nn, nn, sizeof(double), (void *) xdr_double);
+                   case POINTER_NTU:
+                      return  xdr_array(str->xdr, 
+                         (char **) &pt, &nn, nn, sizeof(long), (void *) xdr_long);
+                   default :
+                       return FALSE;
+              }
+         }
+}
+/*
+** Generalized NTuple XDR filter, used for Decode only. 
+** Simply decode one variable (scalar) or array value. No checks whatsoever!
+** Not applicable if the structure organization style is parallel array
+** or the index corresponds to a fixed size variable.
+*/
+bool_t xdr_mcfast_NTupleSubVar(mcfStream *str, descrGenNtuple *dNTu,
+ 		int ivar, int multIndex, char* version)
+{
+    char *cDat;
+    u_int nn;
+    void *pt;
+    int ivarP;
+    
+     ivarP = ivar;
+     while (dNTu->variables[ivarP]->lengthW == 0) ivarP--;
+     cDat = version;
+     cDat += dNTu->subOffset[multIndex];
+     cDat += dNTu->variables[ivarP]->offset;
+     pt = (void *) cDat;     
+     xdr_setpos(str->xdr, 
+              (str->currentPos +  dNTu->subXDROffset[multIndex] +
+              dNTu->variables[ivarP]->offsetXDR));
+     if (dNTu->variables[ivarP]->lengthW == 1) { 
+          switch (dNTu->variables[ivarP]->type) {
+                   case BYTE_NTU: case CHARACTER_NTU:
+                      return  xdr_char(str->xdr, (char *) pt);
+                   case INTEGER2_NTU:
+                      return  xdr_short(str->xdr, (short *) pt);
+                   case LOGICAL_NTU: case INTEGER_NTU:
+                      return  xdr_int(str->xdr, (int *) pt);
+                   case REAL_NTU:
+                      return  xdr_float(str->xdr, (float *) pt); 
+                   case DBL_PRECISION_NTU:
+                      return  xdr_double(str->xdr, (double *) pt);
+                   case COMPLEX_NTU:
+                      nn =2;
+                      return  xdr_array(str->xdr, 
+                         (char **) &pt, &nn, nn, sizeof(float), (void *) xdr_float);
+                   case DBL_COMPLEX_NTU:
+                      nn =2;
+                      return  xdr_array(str->xdr, 
+                         (char **) &pt, &nn, nn, sizeof(double), (void *) xdr_double);
+                   case POINTER_NTU:
+                      return  xdr_long(str->xdr, (long *) pt);
+                   default :
+                      return FALSE;
+              }
+        } else {
+           nn = dNTu->variables[ivarP]->lengthW;
+           switch (dNTu->variables[ivarP]->type) {
+                   case BYTE_NTU: case CHARACTER_NTU:
+                      return  xdr_bytes(str->xdr, (char **) &pt, &nn, nn);
+                   case INTEGER2_NTU:
+                      return  xdr_array(str->xdr, 
+                         (char **) &pt, &nn, nn, sizeof(short), (void *) xdr_short);
+                   case LOGICAL_NTU: case INTEGER_NTU:
+                      return  xdr_array(str->xdr, 
+                         (char **) &pt, &nn, nn, sizeof(int), (void *) xdr_int);
+                   case REAL_NTU:
+                      return  xdr_array(str->xdr, 
+                         (char **) &pt, &nn, nn, sizeof(float), (void *) xdr_float);
+                   case DBL_PRECISION_NTU:
+                      return  xdr_array(str->xdr, 
+                         (char **) &pt, &nn, nn, sizeof(double), (void *) xdr_double);
+                   case COMPLEX_NTU:
+                      nn = nn*2;
+                      return  xdr_array(str->xdr, 
+                         (char **) &pt, &nn, nn, sizeof(float), (void *) xdr_float);
+                   case DBL_COMPLEX_NTU:
+                      nn = nn*2;
+                      return  xdr_array(str->xdr, 
+                         (char **) &pt, &nn, nn, sizeof(double), (void *) xdr_double);
+                   case POINTER_NTU:
+                      return  xdr_array(str->xdr, 
+                         (char **) &pt, &nn, nn, sizeof(long), (void *) xdr_long);
+                   default :
+                       return FALSE;
+              }
+         }
+}
+/*
+** Generalized NTuple XDR filter, used for Decode only. 
+** Simply decode a sub-structure given a value for the multiplicity index.
+** Not applicable if the structure organization style is parallel array.
+** No check whatsover!
+*/
+bool_t xdr_mcfast_NTupleSubStruct(mcfStream *str, descrGenNtuple *dNTu,
+ 		int multIndex, char* version)
+{
+    char *cDat;
+    u_int nn;
+    void *pt;
+    int iv;
+    bool_t ok;
+    
+     xdr_setpos(str->xdr, 
+              (str->currentPos +  dNTu->subXDROffset[multIndex]));
+     for (iv=dNTu->firstIndexed; iv<dNTu->numVariables; iv++) {          
+        cDat = version;
+        cDat += 
+             dNTu->subOffset[multIndex] + dNTu->variables[iv]->offset;
+        pt = (void *) cDat;
+        if (dNTu->variables[iv]->lengthW == 1) {
+              switch (dNTu->variables[iv]->type) {
+                   case BYTE_NTU: case CHARACTER_NTU:
+                      ok =  xdr_char(str->xdr, (char *) pt);
+                      break;
+                   case INTEGER2_NTU:
+                      ok = xdr_short(str->xdr, (short *) pt);
+                      break;
+                   case LOGICAL_NTU: case INTEGER_NTU:
+                      ok = xdr_int(str->xdr, (int *) pt);
+                      break;
+                   case REAL_NTU:
+                      ok = xdr_float(str->xdr, (float *) pt); 
+                      break;
+                   case DBL_PRECISION_NTU:
+                      ok = xdr_double(str->xdr, (double *) pt);
+                      break;
+                   case COMPLEX_NTU:
+                      nn =2;
+                      ok = xdr_array(str->xdr, 
+                         (char **) &pt, &nn, nn, sizeof(float), (void *) xdr_float);
+                      break;
+                   case DBL_COMPLEX_NTU:
+                      nn =2;
+                      ok = xdr_array(str->xdr, 
+                         (char **) &pt, &nn, nn, sizeof(double), (void *) xdr_double);
+                      break;
+                   case POINTER_NTU:
+                      ok = xdr_long(str->xdr, (long *) pt);
+                   default :
+                      return FALSE;
+              }
+        } else if (dNTu->variables[iv]->lengthW > 1){
+           nn = dNTu->variables[iv]->lengthW;
+           switch (dNTu->variables[iv]->type) {
+                   case BYTE_NTU: case CHARACTER_NTU:
+                      ok = xdr_bytes(str->xdr, (char **) &pt, &nn, nn);
+                      break;
+                   case INTEGER2_NTU:
+                      ok = xdr_array(str->xdr, 
+                         (char **) &pt, &nn, nn, sizeof(short), (void *) xdr_short);
+                      break;
+                   case LOGICAL_NTU: case INTEGER_NTU:
+                      ok = xdr_array(str->xdr, 
+                         (char **) &pt, &nn, nn, sizeof(int), (void *) xdr_int);
+                      break;
+                   case REAL_NTU:
+                      ok = xdr_array(str->xdr, 
+                         (char **) &pt, &nn, nn, sizeof(float), (void *) xdr_float);
+                      break;
+                   case DBL_PRECISION_NTU:
+                      ok = xdr_array(str->xdr, 
+                         (char **) &pt, &nn, nn, sizeof(double), (void *) xdr_double);
+                      break;
+                   case COMPLEX_NTU:
+                      nn = nn*2;
+                      ok = xdr_array(str->xdr, 
+                         (char **) &pt, &nn, nn, sizeof(float), (void *) xdr_float);
+                      break;
+                   case DBL_COMPLEX_NTU:
+                      nn = nn*2;
+                      ok = xdr_array(str->xdr, 
+                         (char **) &pt, &nn, nn, sizeof(double), (void *) xdr_double);
+                      break;
+                   case POINTER_NTU:
+                      ok = xdr_array(str->xdr, 
+                         (char **) &pt, &nn, nn, sizeof(long), (void *) xdr_long);
+                      break;
+                   default :
+                       return FALSE;
+              }
+           }
+       }
+       return TRUE;
+}
Index: /trunk/mcfio/mcf_nTupleDescript.h
===================================================================
--- /trunk/mcfio/mcf_nTupleDescript.h	(revision 2)
+++ /trunk/mcfio/mcf_nTupleDescript.h	(revision 2)
@@ -0,0 +1,86 @@
+/*******************************************************************************
+*									       *
+* mcf_nTupleDescript.h -- Include file for mcfast generalized nTuple           *
+*    descriptors.  This is a genric structres that can hold info about	       *
+*    specficic instances of a generalized nTuple. 			       *
+*									       *
+*	P. Lebrun, September 1995.					       *
+*									       *
+*******************************************************************************/
+/*
+** Information concerning a generic variable within an Ntuple
+*/
+enum varTypes {BYTE_NTU, CHARACTER_NTU, INTEGER2_NTU, LOGICAL_NTU,
+               INTEGER_NTU, REAL_NTU,
+               DBL_PRECISION_NTU, COMPLEX_NTU, DBL_COMPLEX_NTU, POINTER_NTU};
+
+enum orgStyles {PARALLEL_ARRAY_NTU, DATA_STRUCT_NTU};               
+               
+#define N_VAR_TYPES 10
+#define MAX_VAR_NAME  31
+#define MAX_NTU_TITLE 80
+#define MAX_VAR_DESCRIP 1023
+#define MAX_VAR_DIMENSIONS 4
+#define NUM_START_VARIABLES 10
+#define NTU_MAX_TITLE_LENGTH 80
+#define NTU_MAX_CATEGORY_LENGTH 255
+#define NTU_MAX_CATEGORY_DEPTH 40
+#define NTU_START_LIST_SIZE 20
+
+typedef struct {
+    char nameBlank;   /* flag indicating that the variable does not exist. */
+    char *name;       /* Mnemonic name of the variable. */
+    char *description;/* description for the variable */
+    int  type;        /* Variable type (int, ...) see above enum varTypes */
+    char isFixedSize; /* Variable is or is not indexed by nTuple multiplicity*/
+    int  numDim;      /* The variable dimensions, not counting mult. one */
+    int  dimensions[MAX_VAR_DIMENSIONS+1];
+                      /* Variable dims, not counting the multiplicity one*/
+    size_t lengthW;   /* Used in XDR filtering, length in words */
+    size_t lengthB; /* Used in XDR filtering, length in byte */                
+    long offset;    /* The variable virtual address for a given instance */
+    u_int offsetXDR; /* The variable relative address within the struct. */
+} varGenNtuple;
+
+typedef struct {
+    int numVariables;    /* The total number of variables in the structure */
+    int numAvailable;    /* The number of available var. in var. array  */
+    char nameIndex[32];  /* The name for the Ntuple single index */
+    int maxMultiplicity; /* The maximum multiplicity for any instances  */
+    char *title;	 /* Title for the structure */
+    char *description;   /* Description of this structure. */
+    char version[8];	 /* The version string */
+    int orgStyle;	 /* The organization of the indexed variables */
+    void *address;	 /* Virtual address of a particular instance */
+    long multOffset;      /* Offset for the multiplicity offset */
+    u_int multXDROffset;   /* Adress for the multiplicity offset */
+    long fenceOffset;     /* Offset for the fence */
+    u_int fenceXDROffset;  /* XDR offset for the fence */
+    long  *subOffset;     /* Offset for the sub structures */
+    u_int  *subXDROffset;  /* XDR offset for the sub structures */
+    varGenNtuple **variables; /* The variable descriptions */
+    int *varOrdering;    /* Ordering of the variables for the dbin, .h..  file*/
+    int firstIndexed;    /* Once ordered, the first indexed for indexed part */
+} descrGenNtuple; 
+
+/*
+** A Data structure to hold a DDL, without MOTIF widget, to be used in 
+** stand alone mode in mcfio.
+*/
+
+typedef struct nTuDDLRec {
+    int id;             /* The id of the NTuple, as returned to the user */
+    int seqNTuId;	/* The sequential number for this particular stream */
+    int uid;            /* The user Id, Unique (within a Category) id */    
+    char *category;
+    char *title;
+    char *dbinFileName; /* dbin filename, not guarantted to be there. */
+    int streamId;       /* The stream on which this ddl is assigned to */
+    int referenceId;     
+    struct nTuDDLRec *reference;
+                       /* the reference in case a similar ddl has already 
+    			   been installed in the running image. */
+    			   
+    descrGenNtuple *descrNtu; /* The Ntuple Descriptor */
+} nTuDDL;    
+
Index: /trunk/mcfio/mcf_ntuBldDbinc.c
===================================================================
--- /trunk/mcfio/mcf_ntuBldDbinc.c	(revision 2)
+++ /trunk/mcfio/mcf_ntuBldDbinc.c	(revision 2)
@@ -0,0 +1,526 @@
+/*
+ *     dbin.cc
+ *
+ *  C++ utility routines for the dbin package: see dbin.lex
+ *
+ *  N.B. The Strings class from the CLHEP library is used.
+ *
+ *       Torre Wenaus 04/01/1994
+ *
+ * Modifications:
+ * 8/21/95   T. Wenaus Mod history started
+ * 8/21/95   TW        Strings class removed from dbin generated code.
+ * 8/22/95   TW        Strings class removed from dbinc.cc
+ *
+ * November 1995: some clean up to be able to run this code and 
+ * standard dbin simulateneously..
+ * Make some routine & variable static, and change the name of routine 
+ * called from the outside, following the Nirvana/mcfio conventions.
+ * 
+ */
+
+#include <stdlib.h>
+#include <string.h>
+#include <stdio.h>
+#include <limits.h>
+#include "mcf_ntuBldDbinc.h"
+#include "mcf_ntubld_db.h"
+
+static void dbin_debug();
+static void lineparse();
+static void dbinparse(char* str, char* typ, char* nam, 
+                      char* var, char* com, char* dim);
+static void  getmembers(long nmems);
+static void getvalues();
+static char* stlower(char*);
+static void chrcat(char* str, char chr);
+static char* token(char** str, char* sep);
+static int testsep(char chr, char *sep);
+static void mcf_ntubld_interpret();
+
+static char varname[40], objname[40], curstruct[40];
+static char chvalues[500], *values, dim[20];
+static char tok1[30], tok2[30], tok3[100], com[100];
+static char line[1000];
+static int n_instance_line_title, n_instance_header, n_instance_variable;
+
+static double dvar[100];
+static float rvar[100];
+static char chvar[100][80];
+static char dbpath[FILENAME_MAX+1], filename[FILENAME_MAX+1];
+static long nvars, morevalues, n_templates;
+static long inc_depth, n_instance, debug_on;
+static int isl;
+static long n_significant, lnlen=0; 
+static FILE *inFile, *curFile1,  *curFile2,  *curFile3,  *curFile4,  *curFile5;
+static const char *fnamep;
+static void dbin_getrec(char* fname[],void (*)(void));
+
+static void dbin_getrec(char* fname[],void (*interpret)(void))
+{
+  char chr;
+  int istat;
+  long inc_depth_old = 0;
+  /*
+  ** Start be intializing all these globals, to be able to call this routine
+  ** more than once.. 
+  */
+  inc_depth = 0;
+  n_instance = 0;
+  lnlen = 0; 
+  /* extract path from filename */
+  strcpy(filename,*fname);
+  if (strrchr(filename,'/') != NULL)  {
+      strcpy(dbpath,filename);
+      *(strrchr(dbpath,'/')+1)='\0';
+  } else {
+      dbpath[0] = '\0';
+  }
+
+  /* open file */
+  inFile = fopen(*fname,"r");
+  if (inFile == NULL) {
+    fprintf(stdout,"Error opening %s\n",*fname);
+    return;
+  }
+  else
+      {
+          if (debug_on) fprintf(stdout,"Opened %s\n",*fname);
+      }
+  /*  read a line */
+  while (inc_depth>=0) {
+    istat=1;
+    while (istat!=EOF) {
+        if (inc_depth > inc_depth_old) /*  need to open new file */
+        {
+          long ifstat;
+          ifstat=1;
+          fnamep = (const char *)filename;
+          if (inc_depth==1) {curFile1 = fopen(fnamep,"r");
+            if (curFile1==NULL) {
+              fprintf(stdout,"Error opening %s\n",fnamep);
+              ifstat=0;
+            }
+            else {
+                if (debug_on) fprintf(stdout,"Opened %s\n",fnamep);
+            }
+          }
+          if (inc_depth==2) {curFile2 = fopen(fnamep,"r");
+            if (curFile2==NULL) {
+              fprintf(stdout,"Error opening %s\n",fnamep);
+              ifstat=0;
+            }
+            else {
+                if (debug_on) fprintf(stdout,"Opened %s\n",fnamep);
+            }
+          }
+          if (inc_depth==3) {curFile3 = fopen(fnamep,"r");
+            if (curFile3==NULL) {
+              fprintf(stdout,"Error opening %s\n",fnamep);
+              ifstat=0;
+            }
+            else {
+                if (debug_on) fprintf(stdout,"Opened %s\n",fnamep);
+            }
+          }
+          if (inc_depth==4) {curFile4 = fopen(fnamep,"r");
+            if (curFile4==NULL) {
+              fprintf(stdout,"Error opening %s\n",fnamep);
+              ifstat=0;
+            }
+            else {
+                if (debug_on) fprintf(stdout,"Opened %s\n",fnamep);
+            }
+          }
+          if (inc_depth==5) {curFile5 = fopen(fnamep,"r");
+            if (curFile5==NULL) {
+              fprintf(stdout,"Error opening %s\n",fnamep);
+              ifstat=0;
+            }
+            else {
+                if (debug_on) fprintf(stdout,"Opened %s\n",fnamep);
+            }
+          }
+        }
+      inc_depth_old = inc_depth;
+      if (inc_depth==0) istat=fgetc(inFile);
+      if (inc_depth==1) istat=fgetc(curFile1);
+      if (inc_depth==2) istat=fgetc(curFile2);
+      if (inc_depth==3) istat=fgetc(curFile3);
+      if (inc_depth==4) istat=fgetc(curFile4);
+      if (inc_depth==5) istat=fgetc(curFile5);
+      chr = istat;
+        if (chr == '\t') chr = ' '; /*  remove tabs */
+        if (chr == '\n') { /* line is complete; process it */
+            if (morevalues == 1) {  /* line extension containing values */
+                /* if final significant char is '/', mark next
+                   line as values continuation */
+                int i;
+                isl=0;
+                for (i=0;i<strlen(line);i++) {
+                    if (line[i] == '!') i=strlen(line);
+                    if (line[i] == '/') isl=i;
+                }
+                if (isl != 0) {
+                    n_significant = 0;
+                    for (i=isl;i<strlen(line);i++) {
+                        if (line[i] == '!') i=strlen(line);
+                        if (line[i]!='/' && line[i]!=' ' && line[i]!='\t'
+                            && i < strlen(line) ) n_significant++;
+                    }
+                    if (n_significant != 0) morevalues = 0;
+                } else {
+                    morevalues = 0;
+                }
+                strcat(values," "); 
+                if (morevalues == 0) {
+                    strcat(values,line);
+                } else {
+                    strncat(values,line,isl-1);
+                }
+            } else { /* line is not an extension. Parse it. */
+                dbinparse(line, tok1, tok2, tok3, com, dim);
+            }
+            if (morevalues == 0) { 
+                /* no more line extensions to read. Process line. */
+                /* now interpret the line */
+                if (tok1[0] != '\0') {
+                    if (debug_on) fprintf(stdout,"%s %s %s\n",tok1,tok2,values);
+                    lineparse();
+                    (*interpret)();
+                }
+            }
+            line[0] = '\0';
+            lnlen = 0;
+        } else {
+            /* add to line */
+            if (chr != '\r') { line[lnlen++]=chr; line[lnlen]='\0'; }
+        }
+    }
+    inc_depth--; line[0] = '\0';
+  }
+  return;
+}
+
+/****************************************************************************/
+static void lineparse()
+{
+  char* tokn, *env, *envName, *tmp1, *tmp2;
+  long l, in_template;
+  varname[0] = '\0';
+  objname[0] = '\0';
+  if (!strcmp(tok1,"end")) {strcpy(curstruct,"--"); in_template = 0;}
+  if (!strcmp(tok1,"structure")) {strcpy(curstruct,tok2);}
+  if (!strcmp(tok1,"database")) ;
+  if (!strcmp(tok1,"incname")) ;
+  if (!strcmp(tok1,"index")) ;
+  if (!strcmp(tok1,"provide")) ;
+  if (!strcmp(tok1,"parent")) ;
+  if (!strcmp(tok1,"child")) ;
+  if (!strcmp(tok1,"dimension")) ;
+  if (!strcmp(tok1,"template")) {in_template = 1; strcpy(curstruct,tok2);
+    n_instance = 0;}
+  if (!strcmp(tok1,"command")) {in_template = 1; strcpy(curstruct,tok2);}
+  if (!strcmp(tok1,"include")) {  /* switch input to specified file */
+ /*
+ ** Commented out, we use absolute path name in the includes. 
+ ** This allows us to go to more than one directory..
+ */
+/*    strcpy(filename,dbpath); */ 
+/*    strcat(filename,tok2); */
+/*
+** We now implement translation of environmental variable
+**
+*/
+      if (tok2[0] == '$') {
+         tmp1 = strchr(&tok2[1], '/');
+         if (tmp1 == NULL) {
+              fprintf(stderr, "DBin error, Unkonw path %s\n", tok2);
+              return;
+         }
+         envName = (char *) malloc(sizeof(char) * (strlen(tok2)+1));
+         strcpy(envName, &tok2[1]);
+         tmp2 = strchr(envName, '/'); *tmp2 = '\0';
+         env = getenv(envName);
+         free(envName);
+         
+         if (env == NULL) { 
+              fprintf(stderr, "DBin error, Unkonw path %s\n", tok2);
+              return;
+         }
+         strcpy(filename,env); l = strlen(env); filename[l] = '/'; l++;
+         strcpy(&filename[l], tmp1);
+            
+      } else  strcpy(filename, tok2);
+    inc_depth++;
+  } 
+  if (!strcmp(tok1,"make")) {
+    n_instance++;
+    strcpy(varname,"TEMPLATE_");
+    strcat(varname,stlower(tok2));
+  }
+  if (!strcmp(tok1,"define")) {
+      /* get first token (name) from values list */
+    tokn = token(&values," \t");
+    strcpy(varname,"TEMPLATE_");
+    strcat(varname,tok2);
+    strcpy(objname,tok2);
+    strcat(objname,"_");
+    strcat(objname,tokn);
+  }
+  if (!strcmp(tok1,"call")) {
+      /* get first token (name) from values list */
+    tokn = token(&values," \t");
+    strcpy(varname,"COMMAND_");
+    strcat(varname,tok2);
+  }
+  if (!strncmp(tok1,"int",3) || !strcmp(tok1,"real") || !strcmp(tok1,"double") ||
+      !strncmp(tok1,"char",4) || !strcmp(tok1,"material") ) {
+    if ((! strncmp(curstruct,"--",2)) && (in_template == 0)) {
+      fprintf(stdout,"dbin: Parameter \"%s\" not in structure; ignored:\n",
+              tok2);
+      fprintf(stdout,"      %s\n",line);
+    } else {
+        /* parse values */
+      strcpy(varname,curstruct);
+      strcat(varname,".");
+      strcat(varname,tok2);
+      getvalues();
+    }
+  }
+}
+
+/****************************************************************************/
+static void dbinparse(char* str, char* typ, 
+                      char* nam, char* var, char* com, char* dim)
+{
+/* Parse from line the type, name, value, comment */
+  int i;
+  long nc = 0;
+
+  nvars = 1;
+  chvalues[0] = dim[0] = typ[0] = nam[0] = var[0] = com[0] = '\0';
+  values = chvalues;
+  
+/* if final significant char is '/', mark next line as values continuation */
+  isl=strlen(str);
+  for (i=0;i<strlen(str);i++) {
+      if (str[i] == '!') i=strlen(str);
+      if (str[i] == '/') isl=i;
+  }
+  morevalues = 0;
+  if (isl != strlen(str)) {
+      n_significant = 0;
+      for (i=isl;i<strlen(str);i++) {
+          if (str[i] == '!') i=strlen(str);
+          if (str[i]!='/' && str[i]!=' ' && str[i]!='\t'
+               && i < strlen(line) ) n_significant++;
+      }
+      if (n_significant == 0) morevalues = 1;
+  }
+
+    /* initial whitespace, type, whitespace */
+  while ((str[nc] == ' ') || (str[nc] == '\t')) ++nc;
+  while ((str[nc] != ' ') && (str[nc] != '\t')
+         && (nc < strlen(str))) chrcat(typ,str[nc++]);
+  while ((str[nc] == ' ') || (str[nc] == '\t')) ++nc;
+    /* name, whitespace, dimension? */
+  while ((str[nc] != ' ') && (str[nc] != '\t') && (str[nc] != '(' )
+         && (nc < strlen(str))) chrcat(nam,str[nc++]);
+  while ((str[nc] == ' ') || (str[nc] == '\t')
+         && (nc < strlen(str))) ++nc;
+  if (str[nc] == '(') {  /* have a dimensioned array */
+      /* get dimension */
+    while (str[++nc] != ')') chrcat(dim,str[nc]); nc++;
+    nvars = atol(dim);
+  }
+    /* skip over value(s) to comment */
+  while (  (str[nc] != '!')   && 
+           (str[nc] != '/' || ( morevalues && (nc != isl) ) )   &&
+           ( (nc < strlen(str)) || ( morevalues && (nc < isl)) )   ) chrcat(chvalues,str[nc++]);
+    /* comment */
+  while (((str[nc] == '!') || (str[nc] == '\t'))
+         && (nc < strlen(str))) ++nc;
+  while (nc <= strlen(str)) { chrcat(com,str[nc++]); }
+    /* turn mnemonic num into variable name var */
+  var = nam;
+}
+
+/****************************************************************************/
+
+static void getvalues()
+{
+    char* tokn;
+    long nv=0; while (nv < nvars) {
+          /* get next token and trim it from the values list. */
+        if (!strncmp(tok1,"char",4) || !strncmp(tok1,"material",8) ) {
+            char *iq1, *iq2;
+            iq1 = strchr(values,'"');
+            iq2 = strrchr(values,'"');
+            if (iq1 != NULL) {
+                strncpy(chvar[nv],iq1+1,iq2-iq1-1);
+                chvar[nv][iq2-iq1-1] = '\0';
+            }
+            else
+                strcpy(chvar[nv],values);
+        } else {
+            tokn = token(&values," \t");
+            if (tokn != NULL) {
+                if (!strncmp(tok1,"int",3)) rvar[nv] = atol(tokn);
+                if (!strcmp(tok1,"real"))   rvar[nv] = atof(tokn);
+                if (!strcmp(tok1,"double")) dvar[nv] = atof(tokn);
+            }
+        }
+        nv++;
+    }
+}
+
+/****************************************************************************/
+
+static void getmembers(long nmems)
+{
+    char *tokn, *iq1, *iq2;
+    long n, nq, nv=0;
+    /* fill string interiors with '@' so they are delineated as tokens */
+    n=0; nq=0; while (n<strlen(values)) {
+        if (values[n]=='"') nq++;
+        if ((values[n]==' '||values[n]=='\t') && nq%2==1) values[n] = '@';
+        n++;
+    }
+    while (nv < nmems) {
+          /* get next token and trim it from the values list. */
+        tokn = token(&values," \t");
+        if ( tokn[0]=='"' ) {
+            n=0; while (n<strlen(tokn))
+                { if (tokn[n]=='@') tokn[n] = ' '; n++; }
+            iq1 = strchr(tokn,'"');
+            iq2 = strrchr(tokn,'"');
+            strncpy(chvar[nv],iq1+1,iq2-iq1-1);
+            chvar[nv][iq2-iq1-1] = '\0';
+        } else {
+            strcpy(chvar[nv],tokn);
+        }
+        rvar[nv] = atof(tokn);
+        nv++;
+    }
+}
+
+/****************************************************************************/
+static void dbin_debug()
+{
+    debug_on = 1;
+}
+
+/****************************************************************************/
+static void chrcat(char* str, char chr)
+{
+    int ln;
+    ln = strlen(str);
+    str[ln] = chr;
+    str[ln+1]='\0';
+}
+
+/****************************************************************************/
+static char * stlower(char* st) {
+  int i=0;
+  while (st[i] != '\0') {
+    if (st[i] >= 'A' && st[i] <= 'Z') st[i] = st[i] + 'a' - 'A';
+    i++;
+  }
+  return st;
+}
+
+/****************************************************************************/
+static char* token(char** str, char* sep)
+{
+    int i=0;
+    char *if1=NULL, *if2=NULL, *strend = *str + strlen(*str);
+    /* if1 = rel. pointer to 1st token char */
+    i=0; while (if1 == NULL && i<strlen(*str)) {
+        if (!testsep(*(*str+i),sep))
+            if1= *str+i;
+        i++;
+    }
+    if (if1 == NULL) return if1;
+    /* if2 = 1st char past the token */
+    i=0; while (if2 == NULL && i<strlen(if1)) 
+        { if (testsep(if1[i],sep)) if2=&if1[i]; i++; }
+    if (if2<strend && if2 != NULL) {
+        if (if2 != NULL) *if2 = '\0';
+        *str = if2+1;
+    } else {
+        *str = strend;
+    }
+    return if1;
+}
+
+/****************************************************************************/
+static int testsep(char chr, char *sep)
+{
+    int ist=0, i=0;
+    while (sep[i] != '\0')
+        if (sep[i++] == chr || chr == '\0' || chr == '\n' ) ist=1;
+    return ist;
+}
+/***  Database read routine  ***/
+/***    Generated automatically using the dbin tool. */
+/***    Not to be modified by user. */
+/*
+** Modifiedt by P.L., to abe able to load all the templates into 
+** one file... And included in this file, to avoid defining too many 
+** global symbols.  This clearly breaks the dbin mold, to be discussed 
+** later.. 
+*/
+void mcf_ntubldRead(char* fname)
+{
+  void (*pf)(); /* pointer to interpreter */
+  inc_depth = 0;
+  n_instance =0;
+  lnlen=0; 
+  debug_on = 0;  
+  pf = &mcf_ntubld_interpret;
+  mcf_ntubldInit();
+  n_instance_line_title = 0;
+  n_instance_header = 0;
+  n_instance_variable = 0;
+  dbin_getrec(&fname,pf);
+}
+static void mcf_ntubld_interpret()
+{
+int inum, index, i, iok;
+iok=0;
+if ( !strcmp(varname,"TEMPLATE_line_title") ) {
+  inum = 0; iok = 1;
+  getmembers(n_el_line_title);
+  index = n_instance_line_title;
+  *n_obj_line_title = n_instance_line_title+1;
+  strcpy(line_title[index].line,chvar[inum++]);
+  n_instance_line_title++;
+}
+if ( !strcmp(varname,"TEMPLATE_header") ) {
+  inum = 0; iok = 1;
+  getmembers(n_el_header);
+  index = n_instance_header;
+  *n_obj_header = n_instance_header+1;
+  strcpy(header[index].title,chvar[inum++]);
+  strcpy(header[index].version,chvar[inum++]);
+  strcpy(header[index].namemaxindex,chvar[inum++]);
+  header[index].maxmult = rvar[inum++];
+  header[index].orgstyle = rvar[inum++];
+  header[index].nvar = rvar[inum++];
+  n_instance_header++;
+}
+if ( !strcmp(varname,"TEMPLATE_variable") ) {
+  inum = 0; iok = 1;
+  getmembers(n_el_variable);
+  index = n_instance_variable;
+  *n_obj_variable = n_instance_variable+1;
+  strcpy(variable[index].name,chvar[inum++]);
+  strcpy(variable[index].description,chvar[inum++]);
+  variable[index].type = rvar[inum++];
+  strcpy(variable[index].isfixedsize,chvar[inum++]);
+  variable[index].numdim = rvar[inum++];
+  for (i=0;i<5;i++) variable[index].dimensions[i] = rvar[inum++];
+  n_instance_variable++;
+}
+}
Index: /trunk/mcfio/mcf_ntuBldDbinc.h
===================================================================
--- /trunk/mcfio/mcf_ntuBldDbinc.h	(revision 2)
+++ /trunk/mcfio/mcf_ntuBldDbinc.h	(revision 2)
@@ -0,0 +1,21 @@
+/*
+ *     dbin.h
+ *
+ *  C++ utility routines for the dbin package: see dbin.lex
+ *
+ *  N.B. The Strings class from the CLHEP library is used.
+ *
+ *       Torre Wenaus 04/01/1994
+ *
+ * Modifications:
+ * 8/21/95   T. Wenaus Mod history started
+ * 8/21/95   TW        Strings class removed from dbin generated code.
+ * 8/22/95   TW        Strings class removed from dbinc.cc
+ *
+ * November 1995: some clean up to be able to run this code and 
+ * standard dbin simulateneously..
+ * Make some routine & variable static, and change the name of routine 
+ * called from the outside, following the Nirvana/mcfio conventions.
+ * 
+ */
+void mcf_ntubldRead(char* fname);
Index: /trunk/mcfio/mcf_ntubldInit.c
===================================================================
--- /trunk/mcfio/mcf_ntubldInit.c	(revision 2)
+++ /trunk/mcfio/mcf_ntubldInit.c	(revision 2)
@@ -0,0 +1,31 @@
+/***  Database default init routine  ***/
+/***  Generated automatically using the dbin tool. */
+/***  Not to be modified by user. */
+#include "mcf_ntubld_db.h"
+void mcf_ntubldInit() {
+
+/***** template line_title *****/
+/*   char line " "  */
+/* end template */
+*n_obj_line_title=0;
+
+/***** template header *****/
+/*     char title  */
+/*     char version */
+/*     char nameMaxIndex */
+/*     int maxMult */
+/*     int orgStyle */
+/*     int nVar */
+/* end template */
+*n_obj_header=0;
+
+/***** template variable *****/
+/*     char name  */
+/*     char description  */
+/*     int  type    */
+/*     char isFixedSize */
+/*     int  numDim  */
+/*     int  dimensions(5) */
+/* end template  */
+*n_obj_variable=0;
+}
Index: /trunk/mcfio/mcf_ntubld_db.h
===================================================================
--- /trunk/mcfio/mcf_ntubld_db.h	(revision 2)
+++ /trunk/mcfio/mcf_ntubld_db.h	(revision 2)
@@ -0,0 +1,57 @@
+#ifndef _mcf_tmp_INC
+#define _mcf_tmp_INC
+
+
+/***** template line_title *****/
+
+typedef struct _line_title_s {
+  char line[80]; /*  */
+} line_title_s;
+static const int n_el_line_title=1;
+extern struct line_title_c {
+  int n_obj_line_title;
+  int idmline_title;
+  line_title_s line_title[500];
+} line_title_c_;
+static int *n_obj_line_title = &(line_title_c_.n_obj_line_title);
+static line_title_s *line_title = &line_title_c_.line_title[0];
+
+/***** template header *****/
+
+typedef struct _header_s {
+  char title[80]; /*  */
+  char version[80]; /*  */
+  char namemaxindex[80]; /*  */
+  int maxmult; /*  */
+  int orgstyle; /*  */
+  int nvar; /*  */
+} header_s;
+static const int n_el_header=6;
+extern struct header_c {
+  int n_obj_header;
+  int idmheader;
+  header_s header[1];
+} header_c_;
+static int *n_obj_header = &(header_c_.n_obj_header);
+static header_s *header = &header_c_.header[0];
+
+/***** template variable *****/
+
+typedef struct _variable_s {
+  char name[80]; /*  */
+  char description[80]; /*  */
+  int type; /*  */
+  char isfixedsize[80]; /*  */
+  int numdim; /*  */
+  int dimensions[5]; /*  */
+} variable_s;
+static const int n_el_variable=10;
+extern struct variable_c {
+  int n_obj_variable;
+  int idmvariable;
+  variable_s variable[100];
+} variable_c_;
+static int *n_obj_variable = &(variable_c_.n_obj_variable);
+static variable_s *variable = &variable_c_.variable[0];
+
+#endif
Index: /trunk/mcfio/mcf_xdr.h
===================================================================
--- /trunk/mcfio/mcf_xdr.h	(revision 2)
+++ /trunk/mcfio/mcf_xdr.h	(revision 2)
@@ -0,0 +1,185 @@
+/*******************************************************************************
+*									       *
+* mcf_xdr.h --  Include file for mcfast Xdr layer. Specifies the headers     *
+*                 ( Block, event, table and files) 			       *	       *
+*									       *
+* Copyright (c) 1994 Universities Research Association, Inc.		       *
+* All rights reserved.							       *
+* 									       *
+* This material resulted from work developed under a Government Contract and   *
+* is subject to the following license:  The Government retains a paid-up,      *
+* nonexclusive, irrevocable worldwide license to reproduce, prepare derivative *
+* works, perform publicly and display publicly by or for the Government,       *
+* including the right to distribute to other Government contractors.  Neither  *
+* the United States nor the United States Department of Energy, nor any of     *
+* their employees, makes any warrenty, express or implied, or assumes any      *
+* legal liability or responsibility for the accuracy, completeness, or         *
+* usefulness of any information, apparatus, product, or process disclosed, or  *
+* represents that its use would not infringe privately owned rights.           *
+*									       *
+*******************************************************************************/
+#define MCF_XDR_F_TITLE_LENGTH 255
+#define MCF_XDR_B_TITLE_LENGTH 80
+#define MCF_XDR_MAXLREC 32000
+#define MCF_XDR_MINLREC 512
+#define MCF_XDR_VERSION "v0.0"
+#define MCF_STREAM_NUM_MAX 20
+#define MCF_DEFAULT_TABLE_SIZE 100
+#define MCF_XDR_VERSION_LENGTH 4
+#define MCF_XDR_STDCM2_LENGTH 20
+#define XDR_MCFIOCODE 1025 /* Private code to be passed to the encoding  
+				filter to estimate the length prior to encode
+				in memory */ 
+
+typedef enum _mcfxdrBlockType { 
+	GENERIC, FILEHEADER, EVENTTABLE, SEQUENTIALHEADER, 
+	EVENTHEADER, NOTHING
+} mcfxdrBlockType;
+
+
+typedef struct _mcfxdrGeneric{
+	int id;		/* Identifier for this item =  FILEHEADER */
+	int length;     /* The length of data body, byte count, excluding 
+				the id and version, and this word */
+	char version[MCF_XDR_VERSION_LENGTH+1];
+	                /* The version of this particular block */
+	int *data;	/* The data block */
+} mcfxdrGeneric;
+
+typedef struct _mcfxdrFileHeader{
+	int id;		/* Identifier for this item =  FILEHEADER */
+	int length;     /* The length of data body, byte count, excluding 
+				the id and version, and this word */
+	char version[MCF_XDR_VERSION_LENGTH+1];
+	                /* The version of this particular block */
+	char title[MCF_XDR_F_TITLE_LENGTH+1];
+		        /* The title length */
+	char comment[MCF_XDR_F_TITLE_LENGTH+1]; /* The comment ..*/
+	char date[30];
+	char closingDate[30];
+	unsigned int numevts_expect;    /* The number of event expected */
+	unsigned int numevts;    /* The number of evts really written on tape */
+	unsigned int firstTable; /* The XDR locator for the first table */
+	unsigned int dimTable; /* The number of events listed in the fixed-sized 
+	                           event table */
+	unsigned int nBlocks;		
+			/* The maximum number of Block types in the file
+				( excluding File headers and Event Tables) */
+	int *blockIds;     /* The list of Block identifiers */
+	
+	char **blockNames; /* The list of names ( Titles) for these blocks */
+	unsigned int nNTuples;
+	                /* The maximum number of Ntuples defined for this 
+	                	stream */
+	
+} mcfxdrFileHeader;
+
+typedef struct _mcfxdrEventTable{
+	int id;		/* Identifier for this item =  EVENTTABLE */
+	int length;     /* The length of data body, byte count, excluding 
+				the id and version, and this word */
+	char version[MCF_XDR_VERSION_LENGTH+1];
+	                 /* The version of this particular block */
+	int nextLocator; /*The Locator for the next Event Table. */
+	int previousnumevts; /* The size of the previous Table */
+        int numevts;	/* The number of events in this chunk */
+        unsigned int dim; /* The dimension of the arrays listed below */
+	unsigned int ievt;     /* The current index in the list */
+	int *evtnums;	/* The List of event numbers, within a store */
+	int *storenums; /* The list of Store number within a Run */
+	int *runnums;   /* The list of run numbers */
+	int *trigMasks; /* The list of user-defined Trigger masks */
+	unsigned int *ptrEvents;
+			/* The list of XDR pointers for these events */ 
+} mcfxdrEventTable;
+
+typedef struct _mcfxdrSequentialHeader{
+	int id;		/* Identifier for this item =  SEQUENTIALHEADER */
+	int length;     /* The length of data body, byte count, excluding 
+				the id and version, and this word */
+	char version[MCF_XDR_VERSION_LENGTH+1];
+	               /* The version of this particular block */
+	unsigned int nRecords; /* The number of records (including this one) 
+				in the logical event */			
+} mcfxdrSequentialHeader;
+ 
+typedef struct _mcfxdrEventHeader{
+	int id;		/* Identifier for this item =  CHUNKHEADER */
+	int length;     /* The length of data body, byte count, excluding 
+				the id and version, and this word */
+	char version[MCF_XDR_VERSION_LENGTH+1];
+	               /* The version of this particular block */
+	int previousevtnum; /* The previous event number */
+	int evtnum;	/* The event numbers, within a store */
+	int storenum;   /* The Store number within a Run */
+	int runnum;     /* The Run numbers */
+	int trigMask;  /* The Trigger masks */
+	unsigned int nBlocks;  /* The number of Blocks  */
+	unsigned int dimBlocks; /* The dimension of the two following arrays */
+	int *blockIds;     /* The list of Block identifiers */
+	unsigned int *ptrBlocks;
+			/* The list of XDR pointers for these blocks */ 
+	unsigned int nNTuples;
+	                /* The number of Ntuples defined for this event */
+	                
+	unsigned int dimNTuples; /* The dimension of the two following arrays */
+	int *nTupleIds; /* The list of Ntuple identifiers, pointing to the 
+				global list array */                				
+	unsigned int *ptrNTuples;
+			/* The list of XDR pointers for these NTuples */ 
+	
+} mcfxdrEventHeader;
+
+typedef struct _mcfStream{
+	int id; 	/* Id of the Stream */
+	int row;	/* Read or Write */
+	int dos;	/* Direct, Memory Mapped I/O or Sequential */
+	int status;     /* The Stream status, either at BOF, RUNNING, EOF 
+	                   or simply declared, and needs to be opened 
+	                   (NTuple usage) */
+	int numWordsC;  /* The number of words read or written, Content */
+	int numWordsT;  /* The number of words read or written, Total */
+	mcfxdrFileHeader *fhead; /* The File header */
+	mcfxdrEventHeader *ehead; /* The current Event Header */  
+	unsigned int currentPos; /* The XDR current position */
+	unsigned int evtPos;     /* The XDR position for the begingin of evt */
+	unsigned int tablePos;   /* The XDR position for the table */
+	unsigned int firstPos;   /* The XDR position just before file header */
+	XDR *xdr;       /* The XDR stream */
+	char *filename; /* Filename */
+	FILE *filePtr;  /* The file pointer */
+	int fileDescr;      /* File descriptor if Memory Mapped */
+	char *fileAddr;  /* Address in virtual memory if Memory Mapped */
+	size_t fileLen;   /* The file length */
+	mcfxdrEventTable *table; /* The event table */
+	char *device;	/* The device name, if any */
+	char *vsn;      /* The Visual S. number, e.g., the tape label */
+	int filenumber; /* The sequential file number, if any */
+	int minlrec;    /* The minimum record length for this stream */
+	int maxlrec;    /* The maximum record length for this stream */
+	int bufferSize; /* The current size of the primary buffer */	
+	mcfxdrSequentialHeader *shead; /* The Sequential header */
+	char *buffer;   /*  A pointer to a generic data buffer, to get the 
+				data from tape and then decode it */
+	char *buffer2; /* A secondary buffer, to hold the event 
+				as the event grows */
+} mcfStream;
+
+extern mcfStream **McfStreamPtrList;
+extern char **McfGenericVersion;
+extern unsigned int McfNumOfStreamActive;	 
+extern bool_t McfNTuPleSaveDecoding;
+
+bool_t xdr_mcfast_generic(XDR *xdrs, int *blockid,
+ 				 int *ntot, char** version, char** data);
+bool_t xdr_mcfast_headerBlock(XDR *xdrs, int *blockid,
+ 				 int *ntot, char** version);
+bool_t xdr_mcfast_fileheader(XDR *xdrs, int *blockid,
+ 		 int *ntot, char** version, mcfxdrFileHeader **mcf, 
+ 		 int streamId);
+bool_t xdr_mcfast_eventtable(XDR *xdrs, int *blockid,
+ 		 int *ntot, char** version, mcfxdrEventTable **mcf);
+bool_t xdr_mcfast_seqheader(XDR *xdrs, int *blockid,
+ 		 int *ntot, char** version, mcfxdrSequentialHeader **mcf);
+bool_t xdr_mcfast_eventheader(XDR *xdrs, int *blockid,
+ 		 int *ntot, char** version, mcfxdrEventHeader **mcf);
Index: /trunk/mcfio/mcf_xdr_Ntuple.h
===================================================================
--- /trunk/mcfio/mcf_xdr_Ntuple.h	(revision 2)
+++ /trunk/mcfio/mcf_xdr_Ntuple.h	(revision 2)
@@ -0,0 +1,32 @@
+/*******************************************************************************
+*									       *
+* mcf_xdr_Ntuple.h --  Include file for mcfast Xdrlayer used in the 	       *
+*       Ntuple code. Refers to a bunch of structure not included in this file. *	 Specifies the headers     *
+*									       *
+* Copyright (c) 1994 Universities Research Association, Inc.		       *
+* All rights reserved.							       *
+* 									       *
+* This material resulted from work developed under a Government Contract and   *
+* is subject to the following license:  The Government retains a paid-up,      *
+* nonexclusive, irrevocable worldwide license to reproduce, prepare derivative *
+* works, perform publicly and display publicly by or for the Government,       *
+* including the right to distribute to other Government contractors.  Neither  *
+* the United States nor the United States Department of Energy, nor any of     *
+* their employees, makes any warrenty, express or implied, or assumes any      *
+* legal liability or responsibility for the accuracy, completeness, or         *
+* usefulness of any information, apparatus, product, or process disclosed, or  *
+* represents that its use would not infringe privately owned rights.           *
+*									       *
+*******************************************************************************/
+bool_t xdr_mcfast_NTuple(XDR *xdrs, descrGenNtuple *dNTu,
+ 		 int *ntot, int nTupleId,  char* version);
+bool_t xdr_mcfast_NTupleXDRPtr(XDR *xdrs, descrGenNtuple *dNTu,
+ 		 int *ntot, int nTupleId,  char* version);
+bool_t xdr_mcfast_NTupleMult(mcfStream *str,
+                             descrGenNtuple *dNTu, char* version); 		 
+bool_t xdr_mcfast_NTupleVar(mcfStream *str,
+                           descrGenNtuple *dNTu, int ivar, char* version); 		 
+bool_t xdr_mcfast_NTupleSubVar(mcfStream *str,
+             descrGenNtuple *dNTu, int ivar, int multIndex, char* version);
+bool_t xdr_mcfast_NTupleSubStruct(mcfStream *str,
+             descrGenNtuple *dNTu, int multIndex, char* version);
Index: /trunk/mcfio/mcfio_Block.c
===================================================================
--- /trunk/mcfio/mcfio_Block.c	(revision 2)
+++ /trunk/mcfio/mcfio_Block.c	(revision 2)
@@ -0,0 +1,488 @@
+/*******************************************************************************
+*									       *
+* mcfio_Block.c --  Utility routines for the McFast Monte-Carlo                  *
+*		The routine to encode/decode a block 	                       *
+*									       *
+* Copyright (c) 1994 Universities Research Association, Inc.		       *
+* All rights reserved.							       *
+* 									       *
+* This material resulted from work developed under a Government Contract and   *
+* is subject to the following license:  The Government retains a paid-up,      *
+* nonexclusive, irrevocable worldwide license to reproduce, prepare derivative *
+* works, perform publicly and display publicly by or for the Government,       *
+* including the right to distribute to other Government contractors.  Neither  *
+* the United States nor the United States Department of Energy, nor any of     *
+* their employees, makes any warranty, express or implied, or assumes any      *
+* legal liability or responsibility for the accuracy, completeness, or         *
+* usefulness of any information, apparatus, product, or process disclosed, or  *
+* represents that its use would not infringe privately owned rights.           *
+*                                        				       *
+*									       *
+* Written by Paul Lebrun						       *
+*									       *
+*									       *
+*******************************************************************************/
+#include <stdio.h>
+#include <string.h>
+#include <sys/param.h>
+#include <rpc/types.h>
+#include <sys/types.h>
+#include <rpc/xdr.h>
+#include <limits.h>
+#include <stdlib.h>
+#include <time.h>
+#ifdef SUNOS
+#include <floatingpoint.h>
+#else /* SUNOS */
+#include <float.h>
+#endif /* SUNOS */
+#include "mcf_nTupleDescript.h"
+#include "mcf_xdr.h"
+#include "mcf_xdr_Ntuple.h"
+#include "mcfio_Dict.h"
+#include "mcfio_Util1.h"
+#include "mcf_NTuIOUtils.h"
+#include "mcfio_Direct.h"
+#include "mcfio_Block.h"
+#ifndef FALSE
+#define FALSE 0
+#endif
+#ifndef TRUE
+#define TRUE 1
+#endif
+
+int mcfioC_Block(int stream, int blkid, 
+ bool_t xdr_filtercode(XDR *xdrs, int *blockid, int *ntot, char **version))
+/*
+** Routine to decode or encode a particular Block. Return 1 if O.K, 
+** -1 if a problem or unknow block.  
+**
+** Adding Ntuple instances ... October 1995.
+*/
+{ 
+  int i, j, jstr, idtmp, ntot, nbuff;
+  bool_t ok;
+  u_int p1;
+  mcfStream *str;
+   
+  if (McfStreamPtrList == NULL) { 
+     fprintf(stderr,
+  " mcfio_Block: You must first initialize by calling mcfio_Init.\n"); 
+     return -1;
+  }
+  jstr = stream-1;
+  if (McfStreamPtrList[jstr] == NULL) { 
+     fprintf(stderr,
+ " mcfio_Block: First, declare the stream by calling mcfio_Open...\n"); 
+     return -1;
+  }
+  str = McfStreamPtrList[jstr];
+  if ((str->row == MCFIO_WRITE) && 
+      (str->fhead->nBlocks == str->ehead->nBlocks)) {
+     fprintf(stderr,
+ " mcfio_Block: Maximum number of Blocks reached for stream %d ...\n", stream);
+     fprintf(stderr,
+ "              Please upgrade the declaration mcfio_Open statement \n");
+     return -1;
+  }
+     
+  if (str->row == MCFIO_READ) {
+      for(i=0, j=-1; i<str->ehead->nBlocks; i++) {
+           if (str->ehead->blockIds[i] == blkid) j = i;
+        }
+      if (j == -1) {
+/*
+        fprintf(stderr,
+ " mcfio_Block: Unable to find block i.d. %d in Stream %d \n", blkid, stream);
+*/
+          return -1;  
+      }
+      if (xdr_setpos(str->xdr,str->ehead->ptrBlocks[j]) == FALSE) {
+        fprintf(stderr,
+         " mcfio_Block: Unable to position stream at block %d \n", blkid);
+          return -1;  
+      }
+      str->currentPos = str->ehead->ptrBlocks[j];
+  } else if (str->row == MCFIO_WRITE)  {
+      idtmp = blkid;
+      /*
+      ** if to Sequential media, one first has to make sure we have 
+      ** enough room in the buffer.
+      */
+      if (str->dos == MCFIO_SEQUENTIAL) {
+         str->xdr->x_op = XDR_MCFIOCODE;
+         ok = xdr_filtercode(str->xdr, &idtmp, &ntot, McfGenericVersion);
+         str->xdr->x_op = XDR_ENCODE;
+         if ((str->currentPos + 4*(ntot + 1)) > str->bufferSize) {
+          /*
+          ** Once again, I don't trust realloc, got to copy to the second 
+          ** buffer. 
+          */
+             nbuff = 1 + 
+                    (((4*(ntot + 1)) + (str->currentPos - str->firstPos))/
+                       str->maxlrec);
+             str->buffer2 = 
+                 (char *) malloc (sizeof(char) * (str->maxlrec *nbuff));
+             memcpy(str->buffer2, str->buffer, 
+                       (str->currentPos - str->firstPos));
+             free(str->buffer);
+             str->buffer = str->buffer2;
+             str->buffer2 = NULL;
+             str->bufferSize = str->maxlrec * nbuff;
+             xdrmem_create(str->xdr, str->buffer, str->bufferSize, XDR_ENCODE);
+             if (xdr_setpos(str->xdr, str->currentPos) == FALSE) {
+                 fprintf(stderr,
+             " mcfio_Block:\n\
+ Unable to position stream %d at block %d after realocation.\n", stream, blkid);
+                 return -1; 
+             } 
+          }
+       }
+   }
+   p1 = str->currentPos;
+   ok = xdr_filtercode(str->xdr, &idtmp, &ntot, McfGenericVersion);
+   if (ok == FALSE) {
+        fprintf(stderr,
+         " mcfio_Block: Unable to encode or decode block I.D. %d \n", blkid);
+         j = str->ehead->nBlocks;
+         if (xdr_setpos(str->xdr,p1) == FALSE) 
+           fprintf(stderr,
+         " mcfio_Block: Unable to position stream at block %d \n", blkid);
+         return -1;
+      }
+   if(blkid != idtmp) {
+        fprintf(stderr,
+         " mcfio_Block: Unexpected I.D = %d found instead of I.D. %d \n",
+              idtmp, blkid);
+        return -1;
+      }
+    if (str->row == MCFIO_WRITE)  {  
+      str->ehead->blockIds[str->ehead->nBlocks] = blkid;
+      str->ehead->ptrBlocks[str->ehead->nBlocks] = p1;
+      str->ehead->nBlocks++; 
+    }
+    str->currentPos = xdr_getpos(str->xdr);    
+    str->numWordsC += (ntot/4);
+    str->numWordsT += ((str->currentPos-p1)/4);
+    return 1;
+        
+}
+int mcfioC_NTuple(int stream, int nTupleId, char * version)
+{ 
+  int i, j, jstr, ntot, nbuff;
+  bool_t ok;
+  u_int p1;
+  mcfStream *str;
+  nTuDDL *ddl;
+  descrGenNtuple *dNTu;
+     
+  if (McfStreamPtrList == NULL) { 
+     fprintf(stderr,
+  " mcfio_NTuple: You must first initialize by calling mcfio_Init.\n"); 
+     return -1;
+  }
+  jstr = stream-1;
+  if (McfStreamPtrList[jstr] == NULL) { 
+     fprintf(stderr,
+ " mcfio_NTuple: First, declare the stream by calling mcfio_Open...\n"); 
+     return -1;
+  }
+  
+  ddl = mcf_GetNTuByStreamID(stream, nTupleId);
+  if (ddl == NULL) {
+     fprintf(stderr,
+ " mcfio_NTuple: Illegal or inexistant NTuple Id %d for stream %d \n", 
+     nTupleId, stream); 
+     return -1;
+  }
+  if (ddl->reference == NULL) dNTu = ddl->descrNtu;
+  else dNTu = ddl->reference->descrNtu;
+  str = McfStreamPtrList[jstr];
+  if ((str->row == MCFIO_WRITE) && 
+      (str->fhead->nNTuples == str->ehead->nNTuples)) {
+     fprintf(stderr,
+" mcfio_NTuple: Maximum number of NTuples reached for stream %d ...\n", stream);
+     fprintf(stderr,
+ "              Please upgrade the Ntuple declarations statements. \n");
+     return -1;
+  }
+     
+  if (str->row == MCFIO_READ) {
+      for(i=0, j=-1; i<str->ehead->nNTuples; i++) {
+           if (str->ehead->nTupleIds[i] == ddl->seqNTuId) j = i;
+        }
+      if (j == -1) {
+        fprintf(stderr,
+ " mcfio_NTuple: Unable to find NTuple i.d. %d in Stream %d \n",
+          nTupleId, stream);
+          return -1;  
+      }
+      if (xdr_setpos(str->xdr,str->ehead->ptrNTuples[j]) == FALSE) {
+        fprintf(stderr,
+         " mcfio_NTuple: Unable to position stream at NTuple %d \n", nTupleId);
+          return -1;  
+      }
+      str->currentPos = str->ehead->ptrNTuples[j];
+  } else if (str->row == MCFIO_WRITE)  {
+      /*
+      ** if to Sequential media, one first has to make sure we have 
+      ** enough room in the buffer.
+      */
+      if (str->dos == MCFIO_SEQUENTIAL) {
+         str->xdr->x_op = XDR_MCFIOCODE;
+         ok = xdr_mcfast_NTuple(str->xdr, dNTu, &ntot,
+                                 ddl->seqNTuId, version);
+         str->xdr->x_op = XDR_ENCODE;
+         if (ok == FALSE) {
+             fprintf(stderr,
+ "mcfio_NTuple: can not Encode or Decode Ntuple id %d on Seq. Stream %d ", 
+             nTupleId, stream);
+             return -1;
+         }
+         if ((str->currentPos + 4*(ntot + 1)) > str->bufferSize) {
+          /*
+          ** Once again, I don't trust realloc, got to copy to the second 
+          ** buffer. 
+          */
+             nbuff = 1 + 
+                    (((4*(ntot + 1)) + (str->currentPos - str->firstPos))/
+                       str->maxlrec);
+             str->buffer2 = 
+                 (char *) malloc (sizeof(char) * (str->maxlrec *nbuff));
+             memcpy(str->buffer2, str->buffer, 
+                       (str->currentPos - str->firstPos));
+             free(str->buffer);
+             str->buffer = str->buffer2;
+             str->buffer2 = NULL;
+             str->bufferSize = str->maxlrec * nbuff;
+             xdrmem_create(str->xdr, str->buffer, str->bufferSize, XDR_ENCODE);
+             if (xdr_setpos(str->xdr, str->currentPos) == FALSE) {
+                 fprintf(stderr,
+             " mcfio_NTuple:\n\
+ Unable to position stream %d at Ntuple %d after realocation.\n",
+                 stream, nTupleId);
+                 return -1; 
+             } 
+          }
+       }
+   }
+   p1 = str->currentPos;
+   ok = xdr_mcfast_NTuple(str->xdr, dNTu, &ntot, ddl->seqNTuId, version);
+   if (ok == FALSE) {
+        fprintf(stderr,
+         " mcfio_NTuple: Unable to encode or decode NTuple I.D. %d \n",
+             nTupleId);
+         j = str->ehead->nNTuples;
+         if (xdr_setpos(str->xdr,p1) == FALSE) 
+           fprintf(stderr,
+         " mcfio_NTuple: Unable to position stream at NTuple %d \n", nTupleId);
+         return -1;
+      }
+    if (str->row == MCFIO_WRITE)  {  
+      str->ehead->nTupleIds[str->ehead->nNTuples] = ddl->seqNTuId;
+      str->ehead->ptrNTuples[str->ehead->nNTuples] = p1;
+      str->ehead->nNTuples++; 
+    }
+    str->currentPos = xdr_getpos(str->xdr);    
+    str->numWordsC += (ntot/4);
+    str->numWordsT += ((str->currentPos-p1)/4);
+    return 1;
+        
+}
+/*
+** Optimized version used exclusively to read the multiplicity value 
+** within an NTuple. It is assumed that the stream is open read direct 
+** access (No checks!), and the event table is available, and the 
+** NTuple is accessible.  Once again, No checks! Use at your onw risk.
+** Also, we do not keep record of the number of byte Read.  
+*/
+int mcfioC_NTupleMult(int stream, int nTupleId, char * version)
+{ 
+  int i, j, jstr, ntot;
+  bool_t ok;
+  mcfStream *str;
+  nTuDDL *ddl;
+  descrGenNtuple *dNTu;
+     
+  jstr = stream-1;
+  ddl = mcf_GetNTuByStreamID(stream, nTupleId);
+  if (ddl->reference == NULL) dNTu = ddl->descrNtu;
+  else dNTu = ddl->reference->descrNtu;
+  str = McfStreamPtrList[jstr];
+  for(i=0, j=-1; i<str->ehead->nNTuples; i++) {
+           if (str->ehead->nTupleIds[i] == ddl->seqNTuId) j = i;
+   }
+  if (xdr_setpos(str->xdr,str->ehead->ptrNTuples[j]) == FALSE) {
+        fprintf(stderr,
+    " mcfio_NTupleMult: Unable to position stream at NTuple %d \n", nTupleId);
+          return -1;  
+      }
+  str->currentPos = str->ehead->ptrNTuples[j];
+  if (dNTu->multXDROffset == 0) 
+      ok = xdr_mcfast_NTupleXDRPtr(str->xdr, dNTu, &ntot,
+                                   ddl->seqNTuId, version);
+   else ok = xdr_mcfast_NTupleMult(str, dNTu, version);
+   if (ok == FALSE) {
+        fprintf(stderr,
+         " mcfio_NTuple: Unable to encode or decode NTuple I.D. %d \n",
+             nTupleId);
+         j = str->ehead->nNTuples;
+         if (xdr_setpos(str->xdr, str->currentPos) == FALSE) 
+           fprintf(stderr,
+         " mcfio_NTuple: Unable to position stream at NTuple %d \n", nTupleId);
+         return -1;
+      }
+      /*
+      ** This probably could be optimized away. Note the that the current 
+      ** position of the stream strored in str->currentPos is no longer 
+      ** valied exiting this routine. However, there is enough redundancy 
+      ** in the data structure to figure out where we could go..
+      */
+     /*  xdr_setpos(str->xdr, str->currentPos);   */ 
+    return TRUE;
+        
+}
+            
+/*
+** Optimized version used exclusively to read a specific variable  
+** within an NTuple. Valid only if the variable is of fixed size 
+** (e.g. not indexed by multiplicity) or if the data structure organization is
+** of type parallel array. It is assumed that the stream is open read direct 
+** access (No checks!), and the event table is available, and the 
+** NTuple is accessible.  Once again, No checks! Use at your own risk.
+*/
+int mcfioC_NTupleVar(int stream, int nTupleId, int ivar, char * version)
+{ 
+  int i, j, jstr, ntot;
+  bool_t ok;
+  mcfStream *str;
+  nTuDDL *ddl;
+  descrGenNtuple *dNTu;
+     
+  jstr = stream-1;
+  ddl = mcf_GetNTuByStreamID(stream, nTupleId);
+  if (ddl->reference == NULL) dNTu = ddl->descrNtu;
+  else dNTu = ddl->reference->descrNtu;
+  str = McfStreamPtrList[jstr];
+  for(i=0, j=-1; i<str->ehead->nNTuples; i++) {
+           if (str->ehead->nTupleIds[i] == ddl->seqNTuId) j = i;
+   }
+  if (xdr_setpos(str->xdr,str->ehead->ptrNTuples[j]) == FALSE) {
+        fprintf(stderr,
+    " mcfio_NTupleVar: Unable to position stream at NTuple %d \n", nTupleId);
+          return -1;  
+      }
+  str->currentPos = str->ehead->ptrNTuples[j];
+  if (dNTu->multXDROffset == 0) 
+      ok = xdr_mcfast_NTupleXDRPtr(str->xdr, dNTu, &ntot,
+                                   ddl->seqNTuId, version);
+   else ok = xdr_mcfast_NTupleVar(str, dNTu, ivar, version);
+   if (ok == FALSE) {
+        fprintf(stderr,
+         " mcfio_NTuple: Unable to encode or decode NTuple I.D. %d \n",
+             nTupleId);
+         j = str->ehead->nNTuples;
+         if (xdr_setpos(str->xdr, str->currentPos) == FALSE) 
+           fprintf(stderr,
+         " mcfio_NTuple: Unable to position stream at NTuple %d \n", nTupleId);
+         return -1;
+      }
+    return TRUE;
+        
+}
+/*
+** Optimized version used exclusively to read a specific variable within a  
+** substructure within an NTuple. Valid only if of type indexed  
+** and if the data structure organization is
+** of type VAX FORTRAN d/s. It is assumed that the stream is open read direct 
+** access (No checks!), and the event table is available, and the 
+** NTuple is accessible.  Once again, No checks! Use at your own risk.
+*/
+int mcfioC_NTupleSubVar(int stream, int nTupleId, int ivar, int multIndex,
+                               char * version)
+{ 
+  int i, j, jstr, ntot;
+  bool_t ok;
+  mcfStream *str;
+  nTuDDL *ddl;
+  descrGenNtuple *dNTu;
+     
+  jstr = stream-1;
+  ddl = mcf_GetNTuByStreamID(stream, nTupleId);
+  if (ddl->reference == NULL) dNTu = ddl->descrNtu;
+  else dNTu = ddl->reference->descrNtu;
+  str = McfStreamPtrList[jstr];
+  for(i=0, j=-1; i<str->ehead->nNTuples; i++) {
+           if (str->ehead->nTupleIds[i] == ddl->seqNTuId) j = i;
+   }
+  if (xdr_setpos(str->xdr,str->ehead->ptrNTuples[j]) == FALSE) {
+        fprintf(stderr,
+    " mcfio_NTupleVar: Unable to position stream at NTuple %d \n", nTupleId);
+          return -1;  
+      }
+  str->currentPos = str->ehead->ptrNTuples[j];
+  if (dNTu->multXDROffset == 0) 
+      ok = xdr_mcfast_NTupleXDRPtr(str->xdr, dNTu, &ntot,
+                                   ddl->seqNTuId, version);
+   else ok = xdr_mcfast_NTupleSubVar(str, dNTu, ivar, multIndex, version);
+   if (ok == FALSE) {
+        fprintf(stderr,
+         " mcfio_NTuple: Unable to encode or decode NTuple I.D. %d \n",
+             nTupleId);
+         j = str->ehead->nNTuples;
+         if (xdr_setpos(str->xdr, str->currentPos) == FALSE) 
+           fprintf(stderr,
+         " mcfio_NTuple: Unable to position stream at NTuple %d \n", nTupleId);
+         return -1;
+      }
+    return TRUE;
+        
+}
+/*
+** Optimized version used exclusively to read a specific   
+** substructure within an NTuple. Valid only if of type indexed  
+** and if the data structure organization is
+** of type VAX FORTRAN d/s. It is assumed that the stream is open read direct 
+** access (No checks!), and the event table is available, and the 
+** NTuple is accessible.  Once again, No checks! Use at your own risk.
+*/
+int mcfioC_NTupleSubStruct(int stream, int nTupleId, int multIndex,
+                               char * version)
+{ 
+  int i, j, jstr, ntot;
+  bool_t ok;
+  mcfStream *str;
+  nTuDDL *ddl;
+  descrGenNtuple *dNTu;
+     
+  jstr = stream-1;
+  ddl = mcf_GetNTuByStreamID(stream, nTupleId);
+  if (ddl->reference == NULL) dNTu = ddl->descrNtu;
+  else dNTu = ddl->reference->descrNtu;
+  str = McfStreamPtrList[jstr];
+  for(i=0, j=-1; i<str->ehead->nNTuples; i++) {
+           if (str->ehead->nTupleIds[i] == ddl->seqNTuId) j = i;
+   }
+  if (xdr_setpos(str->xdr,str->ehead->ptrNTuples[j]) == FALSE) {
+        fprintf(stderr,
+    " mcfio_NTupleVar: Unable to position stream at NTuple %d \n", nTupleId);
+          return -1;  
+      }
+  str->currentPos = str->ehead->ptrNTuples[j];
+  if (dNTu->multXDROffset == 0) 
+      ok = xdr_mcfast_NTupleXDRPtr(str->xdr, dNTu, &ntot,
+                                   ddl->seqNTuId, version);
+   else ok = xdr_mcfast_NTupleSubStruct(str, dNTu, multIndex, version);
+   if (ok == FALSE) {
+        fprintf(stderr,
+         " mcfio_NTuple: Unable to encode or decode NTuple I.D. %d \n",
+             nTupleId);
+         j = str->ehead->nNTuples;
+         if (xdr_setpos(str->xdr, str->currentPos) == FALSE) 
+           fprintf(stderr,
+         " mcfio_NTuple: Unable to position stream at NTuple %d \n", nTupleId);
+         return -1;
+      }
+    return TRUE;
+        
+}
Index: /trunk/mcfio/mcfio_Block.h
===================================================================
--- /trunk/mcfio/mcfio_Block.h	(revision 2)
+++ /trunk/mcfio/mcfio_Block.h	(revision 2)
@@ -0,0 +1,19 @@
+/*******************************************************************************
+*									       *
+* mcfio_Block.h --  Include file for mcfast Direct i/o layer. 		       *
+*									       *
+* Copyright (c) 1994 Universities Research Association, Inc.		       *
+* All rights reserved.							       *
+*									       *
+*******************************************************************************/
+int mcfioC_Block(int stream, int blkid, 
+ bool_t xdr_filtercode(XDR *xdrs, int *blockid, int *ntot, char **version));
+int mcfioC_NTuple(int stream, int nTupleid, char * version); 
+int mcfioC_NTupleMult(int stream, int nTupleid, char * version);
+int mcfioC_NTupleVar(int stream, int nTupleid, int ivar, char * version);
+int mcfioC_NTupleSubVar(int stream, int nTupleid, int ivar, int multIndex,
+                           char * version);
+int mcfioC_NTupleSubStruct(int stream, int nTupleid, int multIndex,
+                           char * version);
+ 
+
Index: /trunk/mcfio/mcfio_Dict.h
===================================================================
--- /trunk/mcfio/mcfio_Dict.h	(revision 2)
+++ /trunk/mcfio/mcfio_Dict.h	(revision 2)
@@ -0,0 +1,57 @@
+/*******************************************************************************
+*									       *
+* mcfio_dict.h --  Dictionary for Key words used in Info routines.             *
+*									       *
+* Copyright (c) 1994 Universities Research Association, Inc.		       *
+* All rights reserved.							       *
+*									       *
+*******************************************************************************/
+#define MCFIO_VERSION 100
+#define MCFIO_STATUS 101
+#define MCFIO_RUNNING 102
+#define MCFIO_BOF 103
+#define MCFIO_EOF 104
+#define MCFIO_NUMBLOCKS 501
+#define MCFIO_READORWRITE 502
+#define MCFIO_READ 1
+#define MCFIO_WRITE 2
+#define MCFIO_DIRECTORSEQUENTIAL 503
+#define MCFIO_DIRECT 1
+#define MCFIO_SEQUENTIAL 2
+#define MCFIO_MEMMAPPED 3
+#define MCFIO_BLOCKIDS 504
+#define MCFIO_NUMWORDS 505
+#define MCFIO_EFFICIENCY 506
+#define MCFIO_NUMEVTS 507
+#define MCFIO_FILENUMBER 508
+#define MCFIO_MAXREC 509
+#define MCFIO_MINREC 510
+#define MCFIO_NUMRECORDS 511
+#define MCFIO_RECORDLENGTHS 512
+#define MCFIO_TITLE 1001
+#define MCFIO_COMMENT 1002
+#define MCFIO_CREATIONDATE 1003
+#define MCFIO_CLOSINGDATE 1013
+#define MCFIO_FILENAME 1004
+#define MCFIO_DEVICENAME 1005
+#define MCFIO_EVENTNUMBER 2001
+#define MCFIO_STORENUMBER 2002
+#define MCFIO_RUNNUMBER 2003
+#define MCFIO_TRIGGERMASK 2004
+#define MCFIO_NUMNTUPLES 4001
+#define MCFIO_NTUPLESLIST 4002
+/*
+** Block definition now. Start counting at 101 See also mcfioC_GetBlockNames
+*/
+#define MCFIO_STDHEP 101
+#define MCFIO_OFFTRACKARRAYS 102
+#define MCFIO_OFFTRACKSTRUCT 103
+#define MCFIO_TRACEARRAYS    104
+#define MCFIO_STDHEPM 105
+#define MCFIO_STDHEPBEG 106
+#define MCFIO_STDHEPEND 107
+#define MCFIO_STDHEPCXX 108
+#define MCFIO_STDHEP4 201
+#define MCFIO_STDHEP4M 202
+#define MCFIO_HEPEUP 203
+#define MCFIO_HEPRUP 204
Index: /trunk/mcfio/mcfio_Direct.c
===================================================================
--- /trunk/mcfio/mcfio_Direct.c	(revision 2)
+++ /trunk/mcfio/mcfio_Direct.c	(revision 2)
@@ -0,0 +1,1025 @@
+/*******************************************************************************
+*									       *
+* mcfio_Direct.c --  Utility routines for the McFast Monte-Carlo                 *
+*		Direct Access I/O core routines 	                       *
+*									       *
+* Copyright (c) 1994 Universities Research Association, Inc.		       *
+* All rights reserved.							       *
+* 									       *
+* This material resulted from work developed under a Government Contract and   *
+* is subject to the following license:  The Government retains a paid-up,      *
+* nonexclusive, irrevocable worldwide license to reproduce, prepare derivative *
+* works, perform publicly and display publicly by or for the Government,       *
+* including the right to distribute to other Government contractors.  Neither  *
+* the United States nor the United States Department of Energy, nor any of     *
+* their employees, makes any warranty, express or implied, or assumes any      *
+* legal liability or responsibility for the accuracy, completeness, or         *
+* usefulness of any information, apparatus, product, or process disclosed, or  *
+* represents that its use would not infringe privately owned rights.           *
+*                                        				       *
+*									       *
+* Written by Paul Lebrun						       *
+*									       *
+*									       *
+*******************************************************************************/
+#include <stdio.h>
+#include <string.h>
+#include <sys/param.h>
+#include <rpc/types.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <rpc/xdr.h>
+#include <limits.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <time.h>
+#include <sys/mman.h>
+#include <fcntl.h>
+#ifdef SUNOS
+#include <floatingpoint.h>
+#else /* SUNOS */
+#include <float.h>
+#endif /* SUNOS */
+#include "mcf_nTupleDescript.h"
+#include "mcf_xdr.h"
+#include "mcfio_Dict.h"
+#include "mcfio_Util1.h"
+#include "mcfio_Direct.h"
+#include "mcfio_Sequential.h"
+#include "mcf_NTuIOFiles.h"
+#include "mcf_NTuIOUtils.h"
+#ifndef FALSE
+#define FALSE 0
+#endif
+#ifndef TRUE
+#define TRUE 1
+#endif
+#ifndef MAP_FILE 
+#define MAP_FILE 0
+#endif
+
+extern nTuDDL **NTuDDLList;
+extern int NumOfNTuples;
+
+
+/* Static routine used in this module */
+
+static int mcfioC_gofornextevent(mcfStream *str);   
+static int  mcfioC_nextspecevt(mcfStream *str, int inum, int istore, 
+                                       int irun, int itrig); 
+static int openReadDirect(char*filename, int mode);
+
+
+int mcfioC_OpenReadDirect(char *filename)
+{                                            
+/*
+** Routine to open and read the header file for a Direct access Stream, 
+** Standard Unix I/O 
+*/
+    return openReadDirect(filename, MCFIO_DIRECT);
+}
+
+int mcfioC_OpenReadMapped(char *filename)
+{                                            
+/*
+** Routine to open and read the header file for a Direct access Stream, 
+** Standard Unix I/O 
+*/
+    return openReadDirect(filename, MCFIO_MEMMAPPED);
+}
+
+static int openReadDirect(char *filename, int mode)
+/*
+** Routine to open and read the header file for a Direct access Stream.
+*/
+{
+   int i, j, jstr, idtmp, ntot, ll1, jdRef, oldNumOfNTuples;
+   int iff;
+   u_int p1, p2;
+   FILE *ff;
+   mcfStream *str;
+   nTuDDL *ddl, *ddlRef;
+   struct stat statbuf;
+   char *srcFile;
+   
+   
+  if (McfStreamPtrList == NULL) mcfioC_Init(); 
+   
+  if (McfNumOfStreamActive >= MCF_STREAM_NUM_MAX) {
+     fprintf(stderr,
+  " mcfio_OpenReadDirect: Too many streams opened simultaneously.\n"); 
+     return -1;
+   }
+   jstr = -1; i=0;
+   while ((jstr == -1) && (i<MCF_STREAM_NUM_MAX)) {
+          if (McfStreamPtrList[i] == NULL) jstr=i;
+          i++;
+          }
+   if(jstr == -1) {
+     fprintf(stderr,
+  " mcfio_OpenReadDirect: Internal error, please report \n"); 
+     return -1;
+   }
+   if ((filename == NULL) || (strlen(filename) > 255)) {
+     fprintf(stderr,
+  " mcfio_OpenReadDirect: You must give a valid UNIX filename.\n"); 
+     return -1;
+   }
+   /*
+   ** Now we can try to open this file.... 
+   */
+   if (mode == MCFIO_DIRECT) {
+       ff = fopen(filename, "r");
+       if (ff == NULL) {
+           fprintf(stderr,
+    " mcfio_OpenReadDirect: Problem opening file %s, message \n", filename);
+           perror ("mcfio_OpenReadDirect"); 
+           return -1;
+       }
+   } else { 
+      /*
+      ** Using memory mapped i/o
+      */
+      iff = open(filename, O_RDONLY);
+          if (iff < 0) {
+          fprintf(stderr,
+  " mcfio_OpenReadMapped: Problem opening file %s, message \n", filename);
+          perror ("mcfio_OpenReadMapped"); 
+          return -1;
+      }
+   }
+   McfStreamPtrList[jstr] = (mcfStream *) malloc(sizeof(mcfStream));
+   str = McfStreamPtrList[jstr];
+   str->xdr = (XDR *) malloc(sizeof(XDR));
+   str->id = jstr+1;
+   str->row = MCFIO_READ;
+   str->dos = mode;
+   str->numWordsC = 0;
+   str->numWordsT = 0;
+   ll1 = strlen(filename) + 1;
+   str->filename = (char *) malloc(sizeof(char) * ll1);
+   strcpy(str->filename,filename);
+   if (mode == MCFIO_DIRECT) {
+       str->filePtr = ff;
+       xdrstdio_create(str->xdr, ff, XDR_DECODE);
+       str->fileDescr = 0;
+       str->fileAddr = NULL;
+       str->fileLen = 0; 
+   } else {
+      /*
+      ** Use memory mapped I/O 
+      */
+      if (fstat(iff, &statbuf) < 0) {
+          fprintf (stderr,
+  " mcfio_OpenReadMapped: Problem getting file length for %s \n", filename);
+          perror ("mcfio_OpenReadMapped"); 
+          return -1;
+      }
+      if ((srcFile =
+        mmap(0, statbuf.st_size, PROT_READ, MAP_FILE | MAP_SHARED, iff, 0 )) 
+        == (caddr_t) -1) {
+       fprintf (stderr,
+  " mcfio_OpenReadMapped: Problem with memory mapping for %s \n", filename);
+       perror ("mcfio_OpenReadMapped"); 
+       return -1;
+      }
+      str->filePtr = (FILE *) NULL;
+      str->fileDescr = iff;
+      str->fileAddr = srcFile;
+      str->fileLen = (size_t) statbuf.st_size;
+      xdrmem_create(str->xdr, srcFile, statbuf.st_size,  XDR_DECODE);          
+   }         
+   str->device = NULL;
+   str->vsn = NULL;
+   str->filenumber = -1;
+   str->minlrec = -1;
+   str->maxlrec = -1;
+   str->shead = NULL;
+   str->ehead = NULL;
+   str->table = NULL;
+   str->buffer = NULL;
+   str->buffer2 = NULL;
+   p1 = xdr_getpos(str->xdr);
+   str->firstPos = p1;
+   str->status = MCFIO_BOF;
+   str->fhead = NULL;
+   oldNumOfNTuples = NumOfNTuples;
+   if (xdr_mcfast_fileheader(str->xdr, &idtmp,
+                &ntot, McfGenericVersion, &(str->fhead), str->id) == FALSE) {
+       fprintf (stderr, 
+               "mcfio_OpenReadDirect: Unable to decode fileheader \n");
+       mcfioC_FreeStream(&McfStreamPtrList[jstr]);
+       mcfioC_Close(jstr+1);
+       return -1;
+   }
+   if (idtmp != FILEHEADER) {
+       fprintf (stderr, 
+            "mcfio_OpenReadDirect: First Structure not the header \n");
+      
+       fprintf (stderr, 
+            "                    : Further accesses probably suspicious \n");
+       mcfioC_FreeStream(&McfStreamPtrList[jstr]);
+       mcfioC_Close(jstr+1);
+       return -1;
+   }    
+   p2 = xdr_getpos(str->xdr);
+   str->numWordsC += (ntot/4);
+   /*
+   ** Check if new these Ntuple template are not reference, if so,
+   ** set the reference pointer accordingly, conversely, recompute the 
+   ** offsets and length if requested.  We also fill the sequential 
+   ** id number for the descriptors.  Note: those are trivial for 
+   ** input streams, but we still fill them for consitency.
+   */
+   for (i=0; i<str->fhead->nNTuples; i++) {
+      ddl = mcf_GetNTuByPtrID((oldNumOfNTuples+i+1));
+      if (ddl == NULL) continue;
+      ddl->streamId = (jstr+1);
+      ddl->seqNTuId = (i+1);
+      if (ddl->descrNtu == NULL) {
+          for (j=0, jdRef=1; j<i; j++, jdRef++) {
+             if (jdRef == ddl->referenceId) { 
+               ddlRef = mcf_GetNTuByPtrID((oldNumOfNTuples+j+1));
+               /*
+               ** back up in the linked list if need be, until we 
+                ** a fully documented descriptor.
+                */
+               while (ddlRef->descrNtu == NULL) ddlRef = ddlRef->reference;
+                 ddl->reference = ddlRef;
+                      break;
+             }
+        }
+      } else {
+          if (McfNTuPleSaveDecoding == TRUE) {
+             mcf_ComputeNTuOffsets(ddl);    
+             mcf_ComputeNTuLengths(ddl);
+          }   
+      }           
+   }
+   str->currentPos = p2;
+   str->fhead->firstTable = p2;
+    /* presumably correct , assume standard direct acces file config. */
+   str->numWordsT += ((p2-p1)/4);
+   str->status = MCFIO_RUNNING;
+   str->table = (mcfxdrEventTable *) malloc(sizeof(mcfxdrEventTable));
+   str->table->nextLocator = -1;
+   str->table->dim = str->fhead->dimTable;
+   str->table->numevts = 0;
+   str->table->previousnumevts = 0;
+   str->table->evtnums = NULL;
+   str->table->storenums = NULL;
+   str->table->runnums = NULL;
+   str->table->trigMasks = NULL;
+   str->table->ptrEvents = NULL;
+   str->ehead = (mcfxdrEventHeader *) malloc(sizeof(mcfxdrEventHeader));
+   str->ehead->dimBlocks = str->fhead->nBlocks;
+   str->ehead->blockIds = NULL;
+   str->ehead->ptrBlocks = NULL;
+   str->ehead->dimNTuples = str->fhead->nNTuples;
+   str->ehead->nTupleIds = NULL;
+   str->ehead->ptrNTuples = NULL;
+   McfNumOfStreamActive++;
+   return (jstr+1);
+}
+    
+int mcfioC_OpenWriteDirect(char *filename, char *title, char *comment,
+                           int numevts_pred, int *blkIds, u_int nBlocks)
+
+/*
+** Routine to open and write the header file for a Direct access Stream.
+*/
+{
+   int i, jstr;
+   u_int p1;
+   FILE *ff;
+   mcfStream *str;
+   
+  if (McfStreamPtrList == NULL) { 
+     fprintf(stderr,
+  " mcfio_OpenWriteDirect: We will first initialize by calling mcfio_Init.\n"); 
+     mcfioC_Init();
+  }
+  if (McfNumOfStreamActive >= MCF_STREAM_NUM_MAX) {
+     fprintf(stderr,
+  " mcfio_OpenWriteDirect: Too many streams opened simultaneously.\n"); 
+     return -1;
+   }
+   jstr = -1; i=0;
+   while ((jstr == -1) && (i<MCF_STREAM_NUM_MAX)) {
+          if (McfStreamPtrList[i] == NULL) jstr=i;
+          i++;
+          }
+   if(jstr == -1) {
+     fprintf(stderr,
+  " mcfio_OpenWriteDirect: Internal error, please report \n"); 
+     return -1;
+   }
+   if ((filename == NULL) || (strlen(filename) > 255)) {
+     fprintf(stderr,
+  " mcfio_OpenWriteDirect: You must give a valid UNIX filename.\n"); 
+     return -1;
+   }
+   if ((title != NULL) && (strlen(title) > 255)) {
+     fprintf(stderr,
+  " mcfio_OpenWriteDirect: Title is too long\n"); 
+     return -1;
+   }
+     
+   if ((comment != NULL) && (strlen(comment) > 255)) {
+     fprintf(stderr,
+  " mcfio_OpenWriteDirect: comment is too long\n"); 
+     return -1;
+   }
+      
+   /*
+   ** Now we can try to open this file.... 
+   */
+   ff = fopen(filename, "w");
+   if (ff == NULL) {
+     fprintf(stderr,
+  " mcfio_OpenWriteDirect: Problem opening file %s, message \n", filename);
+     perror ("mcfio_OpenWriteDirect"); 
+     return -1;
+   }
+   McfStreamPtrList[jstr] = (mcfStream *) malloc(sizeof(mcfStream));
+   str = McfStreamPtrList[jstr];
+   str->xdr = (XDR *) malloc(sizeof(XDR));
+   str->id = jstr+1;
+   str->row = MCFIO_WRITE;
+   str->dos = MCFIO_DIRECT;
+   str->numWordsC = 0;
+   str->numWordsT = 0;
+   str->filename = (char *) malloc(sizeof(char) * ( strlen(filename) +1) );
+   strcpy(str->filename,filename); 
+   str->filePtr = ff;
+   str->device = NULL;
+   str->vsn = NULL;
+   str->filenumber = -1;
+   str->minlrec = -1;
+   str->maxlrec = -1;
+   str->shead = NULL;
+   str->ehead = NULL;
+   str->table = NULL;
+   str->buffer = NULL;
+   str->buffer2 = NULL;
+   xdrstdio_create(str->xdr, ff, XDR_ENCODE);
+   p1 = xdr_getpos(str->xdr);
+   str->firstPos = p1;
+   str->currentPos = p1;
+   str->status = MCFIO_BOF;
+   str->fhead = (mcfxdrFileHeader *) malloc(sizeof(mcfxdrFileHeader));
+   /*
+   ** Fill the file header, additional info will be written on tape
+   */
+   if (title == NULL) strcpy(str->fhead->title,"No Title given");
+    else strcpy(str->fhead->title,title);
+    
+   if (comment == NULL) strcpy(str->fhead->comment,"No comment");
+    else strcpy(str->fhead->comment, comment);
+   str->fhead->numevts_expect = numevts_pred;
+   str->fhead->numevts = 0;
+   /* 
+   ** Futur expansion : make this a tunable parameter.
+   */
+   str->fhead->dimTable = MCF_DEFAULT_TABLE_SIZE;
+   str->fhead->firstTable = -1;
+   str->fhead->nBlocks = nBlocks;
+   if (nBlocks > 0) {
+      str->fhead->blockIds = (int *) malloc(sizeof(int) * nBlocks);
+      str->fhead->blockNames = (char**) malloc(sizeof(char *) * nBlocks);
+   } else {
+      str->fhead->blockIds = NULL;
+      str->fhead->blockNames = NULL;
+   }     
+   for (i=0; i<nBlocks; i++) {
+     str->fhead->blockIds[i] = blkIds[i];
+     str->fhead->blockNames[i] = 
+     (char *) malloc(sizeof(char) * (MCF_XDR_B_TITLE_LENGTH + 1));
+     mcfioC_GetBlockName(blkIds[i], str->fhead->blockNames[i]);
+   }
+   str->fhead->nNTuples = 0; /* Will be filled later */ 
+   if (mcfioC_Wrtfhead(str, INITIATE) == FALSE){
+       mcfioC_FreeStream(&McfStreamPtrList[jstr]);
+       fclose(ff);
+       return -1;
+   }
+   str->table = (mcfxdrEventTable *) malloc(sizeof(mcfxdrEventTable));
+   str->table->numevts=-1;
+   str->table->nextLocator = -1;
+   str->table->evtnums =   (int *) malloc(sizeof(int) * str->fhead->dimTable);
+   str->table->storenums = (int *) malloc(sizeof(int) * str->fhead->dimTable);
+   str->table->runnums = (int *) malloc(sizeof(int) * str->fhead->dimTable);
+   str->table->trigMasks = (int *) malloc(sizeof(int) * str->fhead->dimTable);
+   str->table->ptrEvents = 
+         (u_int *) malloc(sizeof(int) * str->fhead->dimTable);
+   /*
+   ** Write the first dummy table 
+   */
+   if (mcfioC_Wrttable(str, INITIATE) == FALSE) return -1;
+   str->ehead = (mcfxdrEventHeader *) malloc(sizeof(mcfxdrEventHeader));
+   str->ehead->dimBlocks = str->fhead->nBlocks;
+   str->ehead->nBlocks = 0;
+   str->ehead->dimNTuples = 0;
+   str->ehead->nNTuples = 0;
+   str->ehead->evtnum = 0;
+   str->ehead->previousevtnum = 0;
+   str->ehead->storenum = 0;
+   str->ehead->runnum = 0;
+   str->ehead->trigMask = 0;
+   str->ehead->nTupleIds = NULL;
+   str->ehead->ptrNTuples = NULL;
+   if (nBlocks > 0) {
+      str->ehead->blockIds = 
+          (int *) malloc(sizeof(int) * str->fhead->nBlocks);
+      str->ehead->ptrBlocks =
+         (u_int *) malloc(sizeof(int) * str->fhead->nBlocks);
+   } else {
+       str->ehead->blockIds = NULL;
+       str->ehead->ptrBlocks = NULL; 
+   }       
+   /*
+   ** Write the first dummy event header
+   */
+   if (mcfioC_WrtEvt(str, INITIATE) == FALSE) return -1;
+   str->ehead->evtnum = 0;
+   str->status = MCFIO_RUNNING;
+   McfNumOfStreamActive++;
+   return (jstr+1);
+
+}
+
+int mcfioC_NextEvent(int stream)
+/*
+** The Core routine for getting or setting the next event d.s. from/to 
+**  a stream. 
+**
+*/
+{
+   int jstr, idtmp, ntot, nn1;
+   u_int p_evt, p2;
+   mcfStream *str;
+   
+  if (McfStreamPtrList == NULL) { 
+     fprintf(stderr,
+  " mcfio_NextEvent: You must first initialize by calling mcfio_Init.\n"); 
+     return -1;
+  }
+  jstr = stream-1;
+  if (McfStreamPtrList[jstr] == NULL) { 
+     fprintf(stderr,
+ " mcfio_NextEvent: First, declare the stream by calling mcfio_Open...\n"); 
+     return -1;
+  }
+  str = McfStreamPtrList[jstr];
+  if (str->dos == MCFIO_SEQUENTIAL) return mcfioC_NextEventSequential(stream);
+  if (str->row == MCFIO_READ) {
+  /*
+  ** Read the next event, hunt for either an event or a table of event
+  **  if event table not available.
+  */
+      if ((str->table == NULL) || 
+         ((str->table != NULL)&& (str->table->evtnums == NULL))) { 
+                idtmp = mcfioC_gofornextevent(str);
+                if (idtmp != EVENTTABLE) {
+                    if (str->table !=NULL) 
+                       mcfioC_Free_EventTable(&(str->table));
+                    if (idtmp == NOTHING) return -1;
+                    p_evt = str->currentPos;
+                 } else {
+                  if( xdr_mcfast_eventtable(str->xdr, &idtmp,
+ 		     &ntot, McfGenericVersion, &(str->table)) == FALSE) {
+                           fprintf(stderr,
+ " mcfio_NextEvent: XDR Error decoding the EventTable \n"); 
+ 		            return -1;
+ 		    }
+                    p2 = xdr_getpos(str->xdr);
+                    str->numWordsC += (ntot/4);
+                    str->numWordsT += ((p2-str->currentPos)/4);
+                    str->currentPos = p2;
+                    str->table->ievt = 0;
+                    /* 
+                    ** If table empty, cal this routine recursively to get 
+                    **   the next event 
+                    */
+                    if (str->table->numevts <= 0) {
+                      if (str->table->nextLocator == -1) 
+                       mcfioC_Free_EventTable(&(str->table));
+                       return mcfioC_NextEvent(str->id);
+                    }     
+                    p_evt = str->table->ptrEvents[0];
+                } 
+      } else {
+           if (str->table->ievt < str->table->numevts) {
+                 p_evt = str->table->ptrEvents[str->table->ievt];
+           } else {
+           /*
+           ** decode the next table, if valid. If not, scrap the 
+           ** existing table and call next event recursively.
+           */
+              if (str->table->nextLocator == -2) {
+                  /* 
+                  ** Stream is at EOF
+                  */
+                   str->status = MCFIO_EOF;
+                   return MCFIO_EOF;
+              } else if (str->table->nextLocator == -1) { 
+                           fprintf(stderr,
+ " mcfio_NextEvent: Corrupted Event Table \n"); 
+ 		            return -1;
+                }
+                if (xdr_setpos(str->xdr, str->table->nextLocator) == FALSE) {
+                           fprintf(stderr,
+ " mcfio_NextEvent: Error Repositioning stream \n"); 
+ 		            return -1;
+ 		 }
+                 if( xdr_mcfast_eventtable(str->xdr, &idtmp,
+ 		     &ntot, McfGenericVersion, &(str->table)) == FALSE) {
+                           fprintf(stderr,
+ " mcfio_NextEvent: XDR Error decoding the EventTable \n"); 
+ 		            return -1;
+ 		    }
+                    p2 = xdr_getpos(str->xdr);
+                    str->numWordsC += (ntot/4);
+                    str->numWordsT += ((p2-str->currentPos)/4);
+                    str->currentPos = p2;
+                    str->table->ievt = 0;
+                    p_evt = str->table->ptrEvents[0];
+                  }
+       }
+       /* 
+       ** we should be pointing to a good event header here. 
+       */
+       if (xdr_setpos(str->xdr, p_evt) == FALSE) return -1;
+       if( xdr_mcfast_eventheader(str->xdr, &idtmp,
+	&ntot, McfGenericVersion, &(str->ehead)) == FALSE) return -1;
+        str->currentPos = xdr_getpos(str->xdr);
+        str->numWordsC += (ntot/4);
+        str->numWordsT += ((str->currentPos - p_evt)/4);
+        if (str->table != NULL) str->table->ievt ++;              
+        return MCFIO_RUNNING;
+  } else {
+    /*
+    ** Writing Code here.
+    */
+    str->table->numevts++;
+    str->fhead->numevts++;
+    if (str->ehead->previousevtnum == str->ehead->evtnum) str->ehead->evtnum++;
+     /*
+     ** Write the current event header, normal case. First Flush the current
+     **  event,  then initiate the next one event. Note that wrtevt will
+     ** reposition the stream after rewriting the event header, if FLUSH. 
+     ** e.g. ready to initiate either a new table or a new event.
+     */
+     if (mcfioC_WrtEvt(str, FLUSH) == FALSE) return -1;
+     str->ehead->previousevtnum = str->ehead->evtnum;
+     if (str->table->numevts == (str->fhead->dimTable - 1)) {
+      /*
+      ** The Event table is now full. Flush it. Then initiate a new table. 
+      */ 
+       str->table->nextLocator = xdr_getpos(str->xdr);
+       if (mcfioC_Wrttable(str, FLUSH) == FALSE) return -1;
+       if (mcfioC_Wrttable(str, INITIATE) == FALSE) return -1;
+     }
+     str->ehead->nBlocks = 0;
+     str->ehead->nNTuples = 0;
+     nn1 = str->ehead->evtnum;
+     if (mcfioC_WrtEvt(str, INITIATE) == FALSE) return -1;
+     str->ehead->evtnum = nn1;
+     return MCFIO_RUNNING;
+  }
+}
+
+int mcfioC_SpecificEvent(int stream, int ievt,
+                             int istore, int irun, int itrig)
+{
+   int jstr, ok;
+   mcfStream *str;
+   
+  if (McfStreamPtrList == NULL) { 
+     fprintf(stderr,
+  " mcfio_SpecificEvent: You must first initialize by calling mcfio_Init.\n"); 
+     return -1;
+  }
+  jstr = stream-1;
+  if (McfStreamPtrList[jstr] == NULL) { 
+     fprintf(stderr,
+ " mcfio_SpecificEvent: First, declare the stream by calling mcfio_Open...\n"); 
+     return -1;
+  }
+  str = McfStreamPtrList[jstr];
+  if ((str->row != MCFIO_READ) || (str->dos == MCFIO_SEQUENTIAL)) {
+     fprintf(stderr,
+" mcfio_SpecificEvent: Only valid for INPUT, DIRECT ACCESS \
+ or Memory Mapped \n"); 
+     return -1;
+     }
+  if (xdr_setpos(str->xdr, str->fhead->firstTable) == FALSE ) {
+       fprintf(stderr,
+ " mcfio_SpecificEvent:  Could not reposition Direct Access Stream %d \n",
+         (jstr+1)) ;
+    return -1;
+   }
+   str->currentPos = str->fhead->firstTable;
+   
+   ok = mcfioC_nextspecevt(str, ievt, istore, irun, itrig);
+   if (ok == FALSE) {
+      mcfioC_RewindDirect(jstr);
+      if (xdr_setpos(str->xdr, str->fhead->firstTable) == FALSE ) {
+           fprintf(stderr,
+     " mcfio_SpecificEvent:  Could not reposition Direct Access Stream %d \n",
+         (jstr+1)) ;
+         return -1;
+      }
+      str->currentPos = str->fhead->firstTable;
+      ok = mcfioC_nextspecevt(str, ievt, istore, irun, itrig);
+    }
+    if (ok == FALSE)   return -1;
+   return ok;
+    
+}	                             
+int mcfioC_NextSpecificEvent(int stream, int ievt,
+                             int istore, int irun, int itrig)
+{
+   int jstr, ok;
+   mcfStream *str;
+   
+  if (McfStreamPtrList == NULL) { 
+     fprintf(stderr,
+  " mcfio_NextSpecific: You must first initialize by calling mcfio_Init.\n"); 
+     return -1;
+  }
+  jstr = stream-1;
+  if (McfStreamPtrList[jstr] == NULL) { 
+     fprintf(stderr,
+ " mcfio_NextSpecific: First, declare the stream by calling mcfio_Open...\n"); 
+     return -1;
+  }
+  str = McfStreamPtrList[jstr];
+  if ((str->row != MCFIO_READ) || (str->dos == MCFIO_SEQUENTIAL)) {
+     fprintf(stderr,
+ " mcfio_NextSpecificEvent: Only valid for INPUT, DIRECT ACCESS\
+ or memory mapped I/O  \n"); 
+     return -1;
+     }
+   ok = mcfioC_nextspecevt(str, ievt, istore, irun, itrig);
+   if (ok == FALSE) return -1;
+   return ok;
+    
+}	                             
+
+
+void mcfioC_CloseDirect(int jstr)
+/*
+** Close a direct access stream, Standard I/O or Memory Mapped
+**
+*/
+{
+   int i;
+   mcfStream *str;
+   nTuDDL *ddl;
+      
+   str =  McfStreamPtrList[jstr];
+   if (str->row == MCFIO_WRITE) {
+       /*
+       **  Flush the event header, and the last table header. 
+       */
+       if (str->status == MCFIO_RUNNING) { 
+         str->table->numevts++;
+         str->ehead->evtnum++;
+         if (mcfioC_WrtEvt(str, FLUSH) == FALSE) return;
+         str->table->nextLocator = -2;
+         str->table->numevts--; /* Decrement, the table is incomplete at 
+         				this point */
+         if (mcfioC_Wrttable(str, FLUSH) == FALSE) return;
+         if (mcfioC_Wrtfhead(str, FLUSH) == FALSE) return;
+       }
+     }
+     xdr_destroy(str->xdr);
+     if (str->dos == MCFIO_DIRECT) { 
+         fclose(str->filePtr);
+     } else {
+         /*
+         ** Memory mapped I/O, one has to unmapped.. 
+         */
+         munmap((caddr_t) str->fileAddr, str->fileLen);
+         close(str->fileDescr);
+     }
+     /*
+     ** One must declare the Ntuples obsolete for this stream. 
+     ** Do not release the memory, just flag these Ntuple with an obsolete 
+     ** stream
+     */
+     for (i=0; i<NumOfNTuples; i++) {
+         ddl = mcf_GetNTuByPtrID((i+1));
+         if ((ddl != NULL) && (ddl->streamId == (jstr+1)))
+               ddl->streamId = -1;
+    }
+}
+       
+void mcfioC_RewindDirect(int jstr)
+/*
+** Rewind a direct access stream, open for Read only
+**
+*/
+{
+    mcfStream *str;
+    
+    str =  McfStreamPtrList[jstr];
+    if (xdr_setpos(str->xdr, str->fhead->firstTable) == FALSE )
+       fprintf(stderr,
+       " mcfio_Rewind:  Could not reposition Direct Access Stream %d \n",
+         (jstr+1)) ;
+    str->currentPos = str->fhead->firstTable;
+    if (str->table != NULL) {
+        str->table->nextLocator = str->fhead->firstTable;
+        str->table->numevts = 0;
+        str->table->previousnumevts = 0;
+    }    
+    if (str->ehead != NULL) {
+        str->ehead->evtnum = 0;
+        str->ehead->previousevtnum = 0;
+    }
+    return;
+}  
+   
+int  mcfioC_Wrtfhead(mcfStream *str, int mode)     
+/*
+** Write the file header. 
+**  IF Mode = INITIATE, write the dummy information, at the current location.
+**  IF mode = Flush, rewite all the information, this time with the 
+**  correct number of events.
+**
+*/
+{
+   int idtmp, ntot;
+   u_int p1, p0;
+   int k;
+    time_t clock;
+   
+   idtmp = FILEHEADER;
+   if (mode == FLUSH) {
+     time(&clock);
+     strcpy(str->fhead->closingDate, ctime(&clock));
+     if(xdr_setpos(str->xdr,str->firstPos) == FALSE) return FALSE; 
+     if (xdr_mcfast_fileheader(str->xdr, &idtmp,
+          &ntot, McfGenericVersion, &(str->fhead), str->id) == FALSE) {
+       fprintf (stderr, 
+               "mcfio_OpenCloseDirect: Unable to reencode file head \n");
+       return FALSE;
+      }
+      /*
+      ** The version of MCFIO is still at this point v2.0 
+      */
+   } else if (mode == INITIATE) {
+       /* Put the current date/time in a string */
+     time(&clock);
+     strcpy(str->fhead->date, ctime(&clock));
+     /*
+     ** We obviously do not have the closing times stamp yet (Causality)
+     ** So we put ?, however, we have to put the right number of them, 
+     ** the we do not screw up the XDR pointers..
+     */
+     for (k=0; k<strlen(ctime(&clock)); k++) str->fhead->closingDate[k] = '?';
+     str->fhead->closingDate[strlen(ctime(&clock))] = '\0';
+     p0 = str->currentPos;
+     if (xdr_mcfast_fileheader(str->xdr, &idtmp,
+               &ntot, McfGenericVersion, &(str->fhead), str->id) == FALSE) {
+       fprintf (stderr, 
+               "mcfio_OpenWriteDirect: Unable to encode fileheader \n");
+       return FALSE;
+      } 
+      p1 = xdr_getpos(str->xdr);
+      str->numWordsC += (ntot/4);
+      str->numWordsT += ((p1-p0)/4);
+      str->currentPos = p1;
+      return TRUE;
+   } else {
+     fprintf(stderr," mcfioC_Wrtfhead: Internal error, lost mode \n");
+     return FALSE;
+   }
+   return TRUE;
+}
+             
+   
+int  mcfioC_WrtEvt(mcfStream *str, int mode)     
+/*
+** Write an event header, and update the table. Presumably, we have room 
+**  in this table to do so.
+**  IF Mode = INITIATE, write the dummy event header, at the current location.
+**   Do not fill the element table.
+**  If mode = FLUSH write the real event header and also
+**     fill the Table elements. 
+**
+*/
+{
+   int idtmp, ntot;
+   u_int p1, p0;
+   
+   idtmp = EVENTHEADER;
+   if (mode == FLUSH) {
+    str->table->evtnums[str->table->numevts] = str->ehead->evtnum;             
+    str->table->storenums[str->table->numevts] = str->ehead->storenum;             
+    str->table->runnums[str->table->numevts] = str->ehead->runnum;             
+    str->table->trigMasks[str->table->numevts] = str->ehead->trigMask;
+    str->table->ptrEvents[str->table->numevts] = str->evtPos;
+    p0 = str->currentPos;
+    if(xdr_setpos(str->xdr,str->evtPos) == FALSE) return FALSE; 
+    p1 = str->evtPos;
+    if(xdr_mcfast_eventheader(str->xdr, &idtmp,
+            &ntot, McfGenericVersion, &(str->ehead)) == FALSE) return FALSE;
+    str->currentPos = xdr_getpos(str->xdr); 
+    str->numWordsC += (ntot/4);
+    str->numWordsT += ((str->currentPos-p1)/4);
+    if(xdr_setpos(str->xdr,p0) == FALSE) return FALSE;
+    str->currentPos = p0;
+    str->ehead->nBlocks = 0;
+    str->ehead->nNTuples = 0;
+    return TRUE;
+   } else if (mode == INITIATE) {
+    str->ehead->nBlocks = 0; /*do not initialize nNTuples, already done */
+    str->ehead->evtnum = -1;
+    str->evtPos = xdr_getpos(str->xdr);
+    
+    if(xdr_mcfast_eventheader(str->xdr, &idtmp,
+            &ntot, McfGenericVersion, &(str->ehead)) == FALSE) return FALSE;
+    str->currentPos = xdr_getpos(str->xdr);
+    return TRUE;
+   } else {
+     fprintf(stderr," mcfioC_WrtEvt: Internal error, lost mode \n");
+     return FALSE;
+   }
+}
+             
+int  mcfioC_Wrttable(mcfStream *str, int mode)     
+/*
+** Write an event table. 
+**  IF Mode = INITIATE, write the dummy event table, at the current location.
+**   Do not fill the element table.
+**  If mode = FLUSH write the real event header and also
+**     fill the Table elements. 
+**
+*/
+{
+   int idtmp, ntot;
+   u_int p1, p0;
+   
+   idtmp = EVENTTABLE;
+   str->table->dim = str->fhead->dimTable;
+   if (mode == FLUSH) {
+    p0 = str->currentPos;
+    if(xdr_setpos(str->xdr,str->tablePos) == FALSE) return FALSE; 
+    p1 = str->tablePos;
+    str->table->numevts++;
+    if(xdr_mcfast_eventtable(str->xdr, &idtmp,
+            &ntot, McfGenericVersion, &(str->table)) == FALSE) return FALSE;
+    str->currentPos = xdr_getpos(str->xdr); 
+    str->numWordsC += (ntot/4);
+    str->numWordsT += ((str->currentPos-p1)/4);
+    if(xdr_setpos(str->xdr,p0) == FALSE) return FALSE;
+    str->currentPos = p0;
+    str->tablePos = -1;
+    str->table->nextLocator = -1;
+    str->table->numevts=-1;
+    return TRUE;
+   } else if (mode == INITIATE) {
+    str->tablePos = xdr_getpos(str->xdr);
+    str->table->nextLocator = -1;
+    if(xdr_mcfast_eventtable(str->xdr, &idtmp,
+            &ntot, McfGenericVersion, &(str->table)) == FALSE) return FALSE;
+    str->currentPos = xdr_getpos(str->xdr);
+    return TRUE;
+   } else {
+     fprintf(stderr," mcfioC_Wrttable: Internal error, lost mode \n");
+     return FALSE;
+   }
+}
+
+static int mcfioC_gofornextevent(mcfStream *str)   
+/*
+** Move in the direct access file to the next event or event table, 
+** whatever comes first. The XDR current position is set to the beginning 
+** of the event header or event table, if search sucessfull.
+** We position the stream to the last Block or Ntuple defined in 
+** the current event. 
+*/
+{
+   u_int p1;
+   int id, ntot, go;
+   
+   go = TRUE;
+   
+   while (go == TRUE) {
+     p1 = xdr_getpos(str->xdr);
+     if (xdr_mcfast_headerBlock(str->xdr, &id, &ntot, McfGenericVersion)
+            == FALSE)  return NOTHING;
+     if ((id == EVENTTABLE) || (id == EVENTHEADER)) {
+         str->currentPos = p1;
+         if(xdr_setpos(str->xdr, p1) == FALSE) return NOTHING;
+         return id;
+     }
+   }
+   return NOTHING; /* This statement is to make the compiler happy */
+}  
+             
+static int  mcfioC_nextspecevt(mcfStream *str, int inum, int istore, 
+                                       int irun, int itrig)
+/*
+** For Input, Direct access streams, hunt for a psecific event
+**
+*/  
+{
+   int j, idtmp, ntot, found;
+   u_int p_evt, p2;
+   
+   if ((str->table == NULL) || 
+         ((str->table != NULL)&& (str->table->evtnums == NULL))) { 
+                idtmp = mcfioC_gofornextevent(str);
+                if (idtmp != EVENTTABLE) {
+                  fprintf(stderr,
+ " mcfio_SpecificEvent: No event table on stream %d \n", str->id);
+                  return FALSE;
+                 } else {
+                  if( xdr_mcfast_eventtable(str->xdr, &idtmp,
+ 		     &ntot, McfGenericVersion, &(str->table)) == FALSE) {
+                           fprintf(stderr,
+ " mcfio_SpecificEvent: XDR Error decoding the EventTable \n"); 
+ 		            return FALSE;
+ 		    }
+                    p2 = xdr_getpos(str->xdr);
+                    str->numWordsC += (ntot/4);
+                    str->numWordsT += ((p2-str->currentPos)/4);
+                    str->currentPos = p2;
+                    str->table->ievt = 0;
+                    /* 
+                    ** If table empty, cal this routine recursively to get 
+                    **   the next event 
+                    */
+                    str->table->ievt = 0;
+                } 
+      }
+      found = FALSE;
+      while (found == FALSE){
+           j =  str->table->ievt;    
+           if (str->table->ievt < str->table->numevts) {
+             if (((inum == 0)
+                 || ( inum != 0 && (str->table->evtnums[j] == inum))) &&
+                 (((istore == 0) 
+                 || (istore != 0) && (str->table->storenums[j] == istore))) &&
+                 (((irun == 0) 
+                 || (irun != 0) && (str->table->runnums[j] == irun))) &&
+                 (((itrig == 0) 
+                 || (itrig != 0) && (str->table->trigMasks[j] == itrig))))
+                  found = TRUE;
+                  p_evt = str->table->ptrEvents[str->table->ievt];
+                  str->table->ievt++;
+           } else {
+           /*
+           ** decode the next table, if valid. If not, scrap the 
+           ** existing table and call next event recursively.
+           */
+              if (str->table->nextLocator == -2) {
+                  /* 
+                  ** Stream is at EOF
+                  */
+                   str->status = MCFIO_EOF;
+		   
+                   return FALSE;
+		   
+              } else  if (str->table->nextLocator == -1) {
+                           fprintf(stderr,
+ " mcfio_NextEvent: Next EventTable corrupted, abandoning search \n"); 
+ 		            return FALSE;
+              }
+              if (xdr_setpos(str->xdr, str->table->nextLocator)
+                      == FALSE) { fprintf(stderr,
+ " mcfio_NextEvent: XDR Error repositioning to the next EventTable \n"); 
+ 		            return FALSE;
+              } else  {
+                     if( xdr_mcfast_eventtable(str->xdr, &idtmp,
+ 		     &ntot, McfGenericVersion, &(str->table)) == FALSE) {
+                           fprintf(stderr,
+ " mcfio_NextEvent: XDR Error decoding the EventTable \n"); 
+ 		            return FALSE;
+ 		    }
+ 	       }
+               p2 = xdr_getpos(str->xdr);
+               str->numWordsC += (ntot/4);
+               str->numWordsT += ((p2-str->currentPos)/4);
+               str->currentPos = p2;
+               str->table->ievt = 0;
+               p_evt = str->table->ptrEvents[0];
+           }
+       }
+       if (found == FALSE) return FALSE;
+       /* 
+       ** we should be pointing to a good event header here. 
+       */
+       if (xdr_setpos(str->xdr, p_evt) == FALSE) return FALSE;
+       if( xdr_mcfast_eventheader(str->xdr, &idtmp,
+	&ntot, McfGenericVersion, &(str->ehead)) == FALSE) return FALSE;
+        str->currentPos = xdr_getpos(str->xdr);
+        str->numWordsC += (ntot/4);
+        str->numWordsT += ((str->currentPos - p_evt)/4);
+        return MCFIO_RUNNING;
+        
+}
Index: /trunk/mcfio/mcfio_Direct.h
===================================================================
--- /trunk/mcfio/mcfio_Direct.h	(revision 2)
+++ /trunk/mcfio/mcfio_Direct.h	(revision 2)
@@ -0,0 +1,24 @@
+/*******************************************************************************
+*									       *
+* mcfio_Direct.h --  Include file for mcfast Direct i/o layer. 		       *
+*									       *
+* Copyright (c) 1994 Universities Research Association, Inc.		       *
+* All rights reserved.							       *
+*									       *
+*******************************************************************************/
+#define INITIATE 3
+#define FLUSH 4
+int mcfioC_OpenReadDirect(char *filename);
+int mcfioC_OpenReadMapped(char *filename);
+int mcfioC_OpenWriteDirect(char *filename, char *title, char *comment, 
+                           int numevts_pred, int *blkIds, u_int nBlocks);
+int mcfioC_NextEvent(int stream);
+int mcfioC_SpecificEvent(int stream, int ievt,
+                             int istore, int irun, int itrig);
+int mcfioC_NextSpecificEvent(int stream, int ievt,
+                             int istore, int irun, int itrig);
+void mcfioC_CloseDirect(int jstr);
+void mcfioC_RewindDirect(int jstr);
+int  mcfioC_WrtEvt(mcfStream *str, int mode);    
+int  mcfioC_Wrttable(mcfStream *str, int mode);     
+int  mcfioC_Wrtfhead(mcfStream *str, int mode);
Index: /trunk/mcfio/mcfio_SeqDummy.c
===================================================================
--- /trunk/mcfio/mcfio_SeqDummy.c	(revision 2)
+++ /trunk/mcfio/mcfio_SeqDummy.c	(revision 2)
@@ -0,0 +1,65 @@
+/*******************************************************************************
+*									       *
+* mcfio_SeqDummy.c --  Utility routines for the McFast Monte-Carlo               *
+*	Dummy Sequential routines, for the library without Sequential          *
+*									       *
+* Copyright (c) 1994 Universities Research Association, Inc.		       *
+* All rights reserved.							       *
+* 									       *
+* This material resulted from work developed under a Government Contract and   *
+* is subject to the following license:  The Government retains a paid-up,      *
+* nonexclusive, irrevocable worldwide license to reproduce, prepare derivative *
+* works, perform publicly and display publicly by or for the Government,       *
+* including the right to distribute to other Government contractors.  Neither  *
+* the United States nor the United States Department of Energy, nor any of     *
+* their employees, makes any warranty, express or implied, or assumes any      *
+* legal liability or responsibility for the accuracy, completeness, or         *
+* usefulness of any information, apparatus, product, or process disclosed, or  *
+* represents that its use would not infringe privately owned rights.           *
+*                                        				       *
+*									       *
+* Written by Paul Lebrun						       *
+*									       *
+*									       *
+*******************************************************************************/
+#include <stdio.h>
+#include <string.h>
+#include "mcfio_Sequential.h"
+
+int mcfioC_OpenReadSequential(char *device, char *label, int filenumber)
+{
+	fprintf(stderr,
+	"mcfioC_OpenReadSequential: Not available in this library. \n");
+	return -1;
+}
+
+
+int mcfioC_OpenWriteSequential(char *device, char *label, char *title,
+             char *comment, int numevts_pred,
+              int *blkIds, unsigned int nBlocks)
+{
+	fprintf(stderr,
+	"mcfioC_OpenWriteSequential: Not available in this library. \n");
+	return -1;
+}
+
+int mcfioC_NextEventSequential(int stream)
+{
+	fprintf(stderr,
+	"mcfioC_NextEventSequential: Not available in this library. \n");
+	return -1;
+}
+
+void mcfioC_CloseSequentialFile(int jstr)
+{
+	fprintf(stderr,
+	"mcfioC_CloseSequentialFile: Not available in this library. \n");
+	return;
+}
+
+void mcfioC_CloseSequentialTape(int jstr)
+{
+	fprintf(stderr,
+	"mcfioC_CloseSequentialTape: Not available in this library. \n");
+	return;
+}
Index: /trunk/mcfio/mcfio_Sequential.h
===================================================================
--- /trunk/mcfio/mcfio_Sequential.h	(revision 2)
+++ /trunk/mcfio/mcfio_Sequential.h	(revision 2)
@@ -0,0 +1,15 @@
+/*******************************************************************************
+*									       *
+* mc_Sequential.h --  Include file for mcfast Sequential i/o layer.            *
+*									       *
+* Copyright (c) 1994 Universities Research Association, Inc.		       *
+* All rights reserved.							       *
+*									       *
+*******************************************************************************/
+int mcfioC_OpenReadSequential(char *device, char *label, int filenumber);
+int mcfioC_OpenWriteSequential(char *device, char *label, char *title, 
+                char *comment, int numevts_pred, 
+                int *blkIds, unsigned int nBlocks);
+int mcfioC_NextEventSequential(int stream);
+void mcfioC_CloseSequentialFile(int stream);
+void mcfioC_CloseSequentialTape(int stream);
Index: /trunk/mcfio/mcfio_UserDictionary.c
===================================================================
--- /trunk/mcfio/mcfio_UserDictionary.c	(revision 2)
+++ /trunk/mcfio/mcfio_UserDictionary.c	(revision 2)
@@ -0,0 +1,57 @@
+/*
+** A small container to hold a set of user block declaration
+**
+* Written by Paul Lebrun, Aug 2001
+*/
+#include <stdio.h>
+#include <string.h>
+#include <sys/param.h>
+#include <rpc/types.h>
+#include <sys/types.h>
+#include <rpc/xdr.h>
+#include <limits.h>
+#include <stdlib.h>
+#include "mcfio_UserDictionary.h"
+
+#define NUMUSERBLOCKDEFAULT 100
+
+allMCFIO_UserBlockDecl *AllMCFIO_UserBlockDecl = NULL;
+
+
+char *mcfioC_UserBlockDescript(int blkn)
+{
+   int i;
+   if (AllMCFIO_UserBlockDecl == NULL) return NULL;
+   for (i=0; i<AllMCFIO_UserBlockDecl->num; i++) {
+     if (AllMCFIO_UserBlockDecl->decls[i]->blkNum == blkn) 
+        return AllMCFIO_UserBlockDecl->decls[i]->title;
+   }
+   return NULL;
+}
+
+void mcfioC_DefineUserBlock(int blkN, char *descr){
+   aUserBlockDecl *abd;
+   
+   if (AllMCFIO_UserBlockDecl == NULL) {
+   
+      AllMCFIO_UserBlockDecl = (allMCFIO_UserBlockDecl *) malloc (
+                             sizeof(allMCFIO_UserBlockDecl));
+      AllMCFIO_UserBlockDecl->numPreAlloc = NUMUSERBLOCKDEFAULT;
+      AllMCFIO_UserBlockDecl->num = 0;
+      AllMCFIO_UserBlockDecl->decls = (aUserBlockDecl **) malloc( 
+                            NUMUSERBLOCKDEFAULT * sizeof(aUserBlockDecl *));
+   }
+   if (AllMCFIO_UserBlockDecl->num == AllMCFIO_UserBlockDecl->numPreAlloc) {
+       AllMCFIO_UserBlockDecl->numPreAlloc += NUMUSERBLOCKDEFAULT;
+       AllMCFIO_UserBlockDecl->decls = 
+	(aUserBlockDecl **) realloc (((void *) AllMCFIO_UserBlockDecl->decls), 
+	   (AllMCFIO_UserBlockDecl->numPreAlloc  * sizeof(aUserBlockDecl *)));
+   }
+   AllMCFIO_UserBlockDecl->decls[AllMCFIO_UserBlockDecl->num] = 
+     (aUserBlockDecl *) malloc (sizeof(aUserBlockDecl));
+   abd = AllMCFIO_UserBlockDecl->decls[AllMCFIO_UserBlockDecl->num];
+   AllMCFIO_UserBlockDecl->num++;
+   abd->blkNum = blkN;
+   abd->title = (char *) malloc (sizeof(char) * (strlen(descr) + 1));
+   strcpy(abd->title, descr);
+}    
Index: /trunk/mcfio/mcfio_UserDictionary.h
===================================================================
--- /trunk/mcfio/mcfio_UserDictionary.h	(revision 2)
+++ /trunk/mcfio/mcfio_UserDictionary.h	(revision 2)
@@ -0,0 +1,25 @@
+/*
+** A small container to hold a set of user block declaration
+**
+* Written by Paul Lebrun, Aug 2001
+*/
+
+typedef struct _aUserBlockDecl {
+	int blkNum;
+	char *title;
+} aUserBlockDecl;
+
+typedef struct _allMCFIO_UserBlockDecl {
+	int num;
+	int numPreAlloc;
+	aUserBlockDecl **decls;
+}allMCFIO_UserBlockDecl ;
+
+extern allMCFIO_UserBlockDecl *AllMCFIO_UserBlockDecl;
+
+/*
+** Internally used in mcfio. Return NULL if not on the list, 
+** otherwise return the point to the relevant title block.
+*/
+char *mcfioC_UserBlockDescript(int blkNum);
+	
Index: /trunk/mcfio/mcfio_Util1.c
===================================================================
--- /trunk/mcfio/mcfio_Util1.c	(revision 2)
+++ /trunk/mcfio/mcfio_Util1.c	(revision 2)
@@ -0,0 +1,910 @@
+/*******************************************************************************
+*									       *
+* mcfio_Init.c -- Utility routines for the McFast Monte-Carlo                    *
+*		Initialisation & info routines                                 *
+*									       *
+* Copyright (c) 1994 Universities Research Association, Inc.		       *
+* All rights reserved.							       *
+* 									       *
+* This material resulted from work developed under a Government Contract and   *
+* is subject to the following license:  The Government retains a paid-up,      *
+* nonexclusive, irrevocable worldwide license to reproduce, prepare derivative *
+* works, perform publicly and display publicly by or for the Government,       *
+* including the right to distribute to other Government contractors.  Neither  *
+* the United States nor the United States Department of Energy, nor any of     *
+* their employees, makes any warranty, express or implied, or assumes any      *
+* legal liability or responsibility for the accuracy, completeness, or         *
+* usefulness of any information, apparatus, product, or process disclosed, or  *
+* represents that its use would not infringe privately owned rights.           *
+*                                        				       *
+*									       *
+* Written by Paul Lebrun						       *
+*									       *
+*									       *
+*******************************************************************************/
+#include <stdio.h>
+#include <string.h>
+#include <sys/param.h>
+#include <rpc/types.h>
+#include <sys/types.h>
+#include <rpc/xdr.h>
+#include <limits.h>
+#include <stdlib.h>
+#ifdef SUNOS
+#include <floatingpoint.h>
+#else /* SUNOS */
+#include <float.h>
+#endif /* SUNOS */
+#include <time.h>
+#include "mcf_nTupleDescript.h"
+#include "mcf_xdr.h"
+#include "mcfio_Util1.h"
+#include "mcfio_Direct.h"
+#include "mcfio_Sequential.h"
+#include "mcfio_Dict.h"
+#include "mcf_ntubld_db.h"
+#include "mcf_NTuIOFiles.h"
+#include "mcf_NTuIOUtils.h"
+#include "mcf_NTuIOUtils.h"
+#include "mcfio_UserDictionary.h"
+#ifndef FALSE
+#define FALSE 0
+#endif
+#ifndef TRUE
+#define TRUE 1
+#endif
+
+mcfStream **McfStreamPtrList=NULL;
+unsigned int McfNumOfStreamActive=0;
+char **McfGenericVersion=NULL;
+
+/*
+** This stuff is needed for dbin utilities...
+*/
+struct line_title_c line_title_c_;
+struct header_c header_c_;
+struct variable_c variable_c_;
+/*
+** Names of variable types for Ntuple utilities
+*/ 
+char *VarTypesNamesF77[N_VAR_TYPES];
+char *VarTypesNamesC[N_VAR_TYPES];
+/*
+** Ntuple global list
+*/
+extern nTuDDL **NTuDDLList;
+extern int NumOfNTuples;
+
+
+void mcfioC_Init(void)
+/* Global Initialisation routine. Simply set the 
+**
+*/
+{
+  int i;
+
+/*
+** This is no longer needed... 
+
+    char *env, *line;
+    FILE *Ffp;  
+
+    env = NULL;
+    env = getenv("MCFIO_DIR");
+    if (env == NULL) { 
+       printf ("You must first set the environment variable MCFIO_DIR\n");
+       printf ("  by either setting up mcfio (Fermi UPS), or setting \n");
+       printf
+        ("  this env. variable to the place where mcf_NTuBld.db resides.\n");
+       exit(0);
+    } */
+    
+    
+    /*
+    ** Check now that the master template exist.
+    
+    line = (char *) malloc(sizeof(char) * (FILENAME_MAX+1));
+    sprintf(line,"%s/mcf_NTuBld.db", env);
+    Ffp = fopen(line, "r");
+    if (Ffp == NULL) {
+       printf ("The file %s could not be opened. \n", line);
+       printf (" Please check MCFIO installation. \n"); 
+       exit(0);
+    }
+    fclose(Ffp);
+    free(line);
+    
+*/
+  /*
+  ** Use only one version for now.  Possible extension here.
+  */
+  McfGenericVersion = (char **) malloc(sizeof(char *));
+  *McfGenericVersion = (char *) malloc(sizeof(char) * 8);
+  
+  VarTypesNamesF77[0]= "Byte         ";
+  VarTypesNamesF77[1]= "Character    ";
+  VarTypesNamesF77[2]= "Integer*2    ";
+  VarTypesNamesF77[3]= "Logical      ";
+  VarTypesNamesF77[4]= "Integer      ";
+  VarTypesNamesF77[5]= "Real         ";
+  VarTypesNamesF77[6]= "Double Precision";
+  VarTypesNamesF77[7]= "Complex      ";
+  VarTypesNamesF77[8]= "Double Complex  ";
+  VarTypesNamesF77[9]= "Pointer      ";
+        
+  VarTypesNamesC[0]= "char         ";
+  VarTypesNamesC[1]= "char         ";
+  VarTypesNamesC[2]= "short        ";
+  VarTypesNamesC[3]= "int          ";
+  VarTypesNamesC[4]= "int          ";
+  VarTypesNamesC[5]= "float        ";
+  VarTypesNamesC[6]= "double       ";
+  VarTypesNamesC[7]= "float[2]     ";
+  VarTypesNamesC[8]= "double[2]    ";
+  VarTypesNamesC[9]= "void *       ";
+  
+  if (NTuDDLList != NULL) {
+      for (i=0; i<NumOfNTuples; i++) DestroyNTuDDL(NTuDDLList[i]);
+      free(NTuDDLList);
+  }
+  NTuDDLList = (nTuDDL **) malloc(sizeof(int *)* NTU_START_LIST_SIZE);
+  NumOfNTuples = 0;
+  
+  if (McfStreamPtrList == NULL) {  
+	McfStreamPtrList = (mcfStream **)
+		 malloc(sizeof(mcfStream *) * MCF_STREAM_NUM_MAX);
+        for (i=0; i< MCF_STREAM_NUM_MAX; i++) McfStreamPtrList[i] = NULL;
+        return;
+   } 
+  for (i=0; i< MCF_STREAM_NUM_MAX; i++) McfStreamPtrList[i] = NULL;
+  mcfioC_Close(0); 
+  McfNumOfStreamActive=0;
+  
+}
+
+void mcfioC_Close(int istream) 
+/* 
+** Closing a Stream istream is the F77 index to the array of mcf Streams.
+*/
+{
+   int i;
+   
+   if (McfStreamPtrList == NULL) return;
+   if ((istream < 0) || (istream >  MCF_STREAM_NUM_MAX)) {
+      fprintf (stderr, "mcf_close, Illegal argument, stream = %d \n", istream);
+      return;
+   }   
+   if (istream == 0) {
+       for (i=0; i<MCF_STREAM_NUM_MAX; i++) {
+          if (McfStreamPtrList[i] != NULL) {
+               switch (McfStreamPtrList[i]->dos) {
+                   case MCFIO_DIRECT: case MCFIO_MEMMAPPED:
+                      mcfioC_CloseDirect(i);
+                      break;
+                   case MCFIO_SEQUENTIAL: 
+                      mcfioC_CloseSequentialTape(i);
+                      break;
+		   default:
+		      fprintf
+		       (stderr," mcf_close, Internal Error, please report \n");
+		      break;
+		      }
+             mcfioC_FreeStream(&McfStreamPtrList[i]);
+         }
+      }
+      return;
+   }
+   i = istream -1;
+   if (McfStreamPtrList[i] != NULL) {
+                switch (McfStreamPtrList[i]->dos) {
+                   case MCFIO_DIRECT: case MCFIO_MEMMAPPED:
+                      mcfioC_CloseDirect(i);
+                      break;
+                   case MCFIO_SEQUENTIAL: 
+                      mcfioC_CloseSequentialTape(i);
+                      break;
+		   default:
+		      fprintf
+		       (stderr," mcf_close, Internal Error, please report \n");
+		      break;
+		      }
+          mcfioC_FreeStream(&McfStreamPtrList[i]); 
+       }
+}
+
+void mcfioC_Rewind(int istream) 
+/* 
+** Closing a Stream istream is the F77 index to the array of mcf Streams.
+*/
+{
+   int i;
+   
+   if (McfStreamPtrList == NULL) return;
+   if ((istream <= 0) || (istream >  MCF_STREAM_NUM_MAX)) {
+      fprintf (stderr, "mcfio_Rewind, Illegal argument, stream = %d \n",
+                         istream);
+      return;
+   }   
+   i = istream -1;
+   
+   if (McfStreamPtrList[i] != NULL) {
+                if(McfStreamPtrList[i]->row == MCFIO_WRITE) {
+		     fprintf
+	   (stderr," mcf_Rewind, Not support for Output Stream \n");
+		      return;
+		   }
+                switch (McfStreamPtrList[i]->dos) {
+                   case MCFIO_DIRECT: case MCFIO_MEMMAPPED:
+                      mcfioC_RewindDirect(i);
+                      break;
+                   case MCFIO_SEQUENTIAL: 
+		      fprintf
+    (stderr," mcf_Rewind, Sequential, done by a close Sequential File\n\
+    Then reopening a stream on the same sequential  media  \n");
+                      break;
+		   default:
+		      fprintf
+		       (stderr," mcf_Rewind, Internal Error, please report \n");
+		      break;
+		      }
+		McfStreamPtrList[i]->numWordsC = 0;
+		McfStreamPtrList[i]->numWordsT = 0;
+       }
+}
+
+void mcfioC_Free_FileHeader(mcfxdrFileHeader **p)
+{
+   int i;
+   mcfxdrFileHeader *head = *p;
+   
+   if (head == NULL) return;
+   for (i=0; i<head->nBlocks; i++) 
+     if (head->blockNames[i] != NULL) free(head->blockNames[i]);
+   if (head->blockNames != NULL) free (head->blockNames); 
+   if (head->blockIds != NULL) free(head->blockIds);
+   free(head);
+   *p = NULL;
+} 
+
+void mcfioC_Free_SeqHeader(mcfxdrSequentialHeader **p)
+{
+   mcfxdrSequentialHeader *head = *p;
+   
+   if (head == NULL) return;
+   free(head);
+   *p = NULL;
+} 
+
+void mcfioC_Free_EventHeader(mcfxdrEventHeader **p)
+{
+   mcfxdrEventHeader *head = *p;
+   
+   if (head == NULL) return;
+   if (head->ptrBlocks != NULL) free(head->ptrBlocks);
+   if (head->blockIds != NULL) free(head->blockIds);
+   if (head->ptrNTuples != NULL) free(head->ptrNTuples);
+   if (head->nTupleIds != NULL) free(head->nTupleIds);
+   free(head);
+   *p = NULL;
+}
+
+void mcfioC_Free_EventTable(mcfxdrEventTable **p)
+{
+   mcfxdrEventTable *table = *p;
+   
+   if (table == NULL) return;
+   if (table->evtnums != NULL) free(table->evtnums);
+   if (table->storenums != NULL) free(table->storenums);
+   if (table->runnums != NULL) free(table->runnums);
+   if (table->trigMasks != NULL) free(table->trigMasks);
+   if (table->ptrEvents != NULL) free(table->ptrEvents);
+   free(table);
+   *p = NULL;
+}
+ 
+void mcfioC_FreeStream(mcfStream **stream)
+{
+   mcfStream *str = *stream;
+   if (str == NULL) return;
+   if (str->filename != NULL) free (str->filename);
+   if (str->device != NULL) free (str->device);
+   if (str->vsn != NULL) free (str->vsn);
+   if (str->fhead != NULL) mcfioC_Free_FileHeader(&(str->fhead)); 
+   if (str->shead != NULL) mcfioC_Free_SeqHeader(&(str->shead));
+   if (str->ehead != NULL) mcfioC_Free_EventHeader(&(str->ehead));
+   if (str->table != NULL) mcfioC_Free_EventTable(&(str->table));
+   if (str->buffer != NULL) free (str->buffer);
+   if (str->buffer2 != NULL) free (str->buffer2);
+   free(str);
+   *stream = NULL;
+   McfNumOfStreamActive--;
+}
+
+
+void mcfioC_PrintDictionary(void)
+{
+   printf (" \n");
+   printf
+    (" Mcfast I/o Dictionary for Key words used in mcfio_Info routines \n");
+   
+   printf
+    (" --------------------------------------------------------------- \n");
+   printf (" \n");
+   printf (" For Streams \n");
+   printf (" -------------- \n");
+   printf (" MCFIO_STATUS: The current status of the file;  \n");
+   printf ("               the answer can be set to: \n");
+   printf
+ ("   MCFIO_BOF : at beginning of file \n");
+   printf
+ ("   MCFIO_EOF : at the end of file \n");
+   printf 
+ ("   MCFIO_RUNNING: At least a valid file header has been read or written\n");
+   
+   printf
+    (" MCFIO_READORWRITE: if set MCFIO_READ, open for  read only \n");
+   printf
+    ("                    if set MCFIO_WRITE, open for  write only \n");
+   printf
+   (" MCFIO_DIRECTORSEQUENTIAL: if set MCFIO_DIRECT, accessing a UNIX file \n");
+   printf
+   ("                         : if set MCFIO_SEQUENTIAL, accessing a tape \n");
+   printf
+ (" MCFIO_NUMEVTS : Total number of events encode/decoded so far. \n");
+   printf
+    (" MCFIO_NUMBLOCK: The number of blocks defined in the file. \n");
+    
+   printf
+   (" MCFIO_BLOCKIDS: The I.D. of the block defined in the file.\n");
+   printf
+ (" MCFIO_NUMWORDS: Total number of 4-bytes words encode/decoded so far. \n");
+   printf
+ (" MCFIO_EFFICIENCY: The overhead in blocking and XDR (*10000 ) \n");
+   printf
+ (" MCFIO_CREATIONDATE: The date (30 Character) when the file was opened \n");
+   printf
+ (" MCFIO_CLOSINGDATE: The date (30 Character) when the file was closed \n");
+   printf
+ (" MCFIO_TITLE: The title (255 Characters max) for the job \n");
+   printf
+ (" MCFIO_COMMENT: The comment (255 Characters max) for the job \n");
+ 
+   printf (" \n");
+   printf (" For Sequential Access only \n");
+   printf 
+   ("    MCFIO_FILENUMBER : The Sequential file number currently accessed.\n");
+   printf ("    MCFIO_MAXLREC: Maximum Record length\n");
+   printf ("    MCFIO_MINLREC: Minumum Record length\n");
+   printf
+   ("    MCFIO_NUMRECORDS: The number of records in the current event\n");
+   printf 
+   ("    MCFIO_RECORDLENGTHS: The record lengths for the current event\n"); 
+   printf ("    MCFIO_DEVICENAME: The device name opened by the stream\n ");
+   printf ("                    (character string, 255 l.)\n");
+   printf (" \n");
+   printf (" For Direct Access only \n");
+   printf ("    MCFIO_FILENAME: The UNIX file name opened by the stream\n ");
+   printf ("                    (character string, 255 l.)\n");
+   
+   printf (" \n");
+   printf (" For Events \n");
+   printf (" -------------- \n");
+   printf
+    (" MCFIO_NUMBLOCK: The number of blocks defined in the event.\n");
+    
+   printf
+   (" MCFIO_BLOCKIDS: The I.D. of the block defined in the event.\n");
+   printf
+   (" MCFIO_EVENTNUMBER: The Event Number for this event. \n");
+   printf
+   (" MCFIO_STORENUMBER: The Store Number for this event. \n");
+   printf
+   (" MCFIO_RUNNUMBER: The Run Number for this event. \n");
+   printf
+   (" MCFIO_TRIGGERMASK: The Trigger Mask for this event. \n");
+   printf (" MCFIO_VERSION: The 4-Character version of the event header \n ");
+   
+   printf (" \n");
+   printf (" For Blocks \n");
+   printf (" -------------- \n");
+   printf (" MCFIO_VERSION: The 4-Character version of a particular block \n ");
+   
+   printf (" \n");
+   printf (" For NTuples \n");
+   printf (" -------------- \n");
+   printf (" MCFIO_NUMNTUPLES: The number of defined NTuples on a stream \n ");
+   printf (" See also mcfio_GetNTupleIds, mcfio_GetNTupleUID, \n");
+   printf ("           mcfio_GetNTupleCategory, mcfio_GetNTupleTitle and \n");
+   printf ("           mcfio_GetNTupleName \n");
+   
+}
+   
+unsigned int mcfioC_InfoNumStream(int *istreams,  unsigned int nmax)
+/*
+** Returns in the arrary istream the list of active stream indices.
+** 
+*/
+{
+   int i,j;
+   
+   if (nmax >= MCF_STREAM_NUM_MAX) {
+     fprintf(stderr, "mcfio_Info, Illegal size of Stream Pointer array \n");
+     return 0;
+   }   
+   for (i=0,j=0; i<MCF_STREAM_NUM_MAX; i++) {
+   	if (McfStreamPtrList[i] != NULL) { 
+          if (j < nmax) istreams[j] = McfStreamPtrList[i]->id;
+   	  j++;  
+          }
+   } 
+   return  McfNumOfStreamActive;
+}
+
+void mcfioC_InfoStreamInt(int stream, int key, int *values)
+/*
+** Information routine for the Stream.  Based on key, return in *values 
+** the requested information 
+*/
+{
+    int i, num, jstr;
+    float a;
+    mcfStream *str;
+    jstr = stream - 1;
+    if ((jstr <0) || (jstr >= MCF_STREAM_NUM_MAX)) {
+      fprintf(stderr,"mcfio_InfoStream: Stream id %d is illegal \n",
+                     stream);
+      return;
+    }
+    str = McfStreamPtrList[jstr];
+    if (str == NULL) {
+      fprintf(stderr,"mcfio_InfoStream: Stream id %d is inactive \n",
+                     stream);
+      return;
+    }
+    switch (key) {
+      case MCFIO_STATUS: 
+           *values = str->status;
+           break;
+      case MCFIO_READORWRITE:
+            *values = str->row;
+            break;
+      case MCFIO_DIRECTORSEQUENTIAL:
+            *values = str->dos;
+            break;
+      case MCFIO_NUMWORDS:
+            *values = str->numWordsT;
+            break;
+      case MCFIO_EFFICIENCY:
+            a = ((float ) (str->numWordsC))/ (float) (str->numWordsT); 
+            *values = (int) (10000. * a);
+            break;
+      case MCFIO_NUMEVTS:
+           if(str->fhead != NULL)  *values = str->fhead->numevts;
+           break;
+      case MCFIO_NUMBLOCKS:
+            if(str->fhead != NULL) *values = str->fhead->nBlocks;
+            break;
+      case MCFIO_BLOCKIDS:
+      	/* 
+      	** Crash bug possibility here, if the dimension is wrong ! 
+      	*/
+      	  if(str->fhead != NULL) {
+            for (i=0; i<str->fhead->nBlocks; i++)
+              values[i] = str->fhead->blockIds[i];
+            }
+            break;
+        /*
+        ** Now the specific items for Sequential stuff
+        */
+      case MCFIO_FILENUMBER:
+          if (str->dos != MCFIO_SEQUENTIAL) {
+             fprintf(stderr,
+ "mcfio_InfoStream: Meaningless request for stream %d, key MCFIO_FILENUMBER\n", 
+   stream);
+   	     return;
+   	    }
+            *values = str->filenumber;
+            break;
+       case MCFIO_MAXREC:
+          if (str->dos != MCFIO_SEQUENTIAL) {
+             fprintf(stderr,
+   "mcfio_InfoStream: Meaningless request for stream %d, key MCFIO_MAXREC\n", 
+   stream);
+   	     return;
+   	   }
+           *values = str->maxlrec;
+   	   break;
+       case MCFIO_MINREC:
+          if (str->dos != MCFIO_SEQUENTIAL) {
+             fprintf(stderr,
+   "mcfio_InfoStream: Meaningless request for stream %d, key MCFIO_MINREC \n", 
+   stream);
+   	     return;
+   	   }
+           *values = str->minlrec;
+   	   break;   	              
+       case MCFIO_NUMRECORDS:
+          if ((str->dos != MCFIO_SEQUENTIAL) || (str->shead == NULL) ) {
+             fprintf(stderr,
+ "mcfio_InfoStream: Meaningless request for stream %d, key MCFIO_NUMRECORDS \n", 
+   stream);
+   	     return;
+   	   }
+           *values = str->shead->nRecords;
+   	   break;
+       case MCFIO_RECORDLENGTHS:
+          if ((str->dos != MCFIO_SEQUENTIAL) || (str->shead == NULL) ) {
+             fprintf(stderr,
+ "mcfio_InfoStream: Meaningless request for stream %d, key MCFIO_RECORDLENGTHS \n", 
+   stream);
+   	     return;
+   	   }
+   	   *values = str->maxlrec;
+   	   break;
+       case MCFIO_NUMNTUPLES:
+          for (i=0, num=0; i<NumOfNTuples; i++)
+               if (NTuDDLList[i]->streamId == stream) num++; 
+          *values = num;
+          break;            
+      default:
+            fprintf(stderr,
+             "mcfio_InfoStream: Unrecognized Keyword %d\n", key);
+    }
+}
+
+void mcfioC_InfoStreamChar(int stream, int key, char *answer, int *lret)
+/*
+** Information routine for the Stream.  Based on key, return in *values 
+** the requested information 
+*/
+{
+    int jstr;
+    mcfStream *str;
+    jstr = stream - 1;
+    if ((jstr <0) || (jstr >= MCF_STREAM_NUM_MAX)) {
+      fprintf(stderr,"mcfio_InfoStream: Stream id %d is illegal \n",
+                     stream);
+      *lret = 0;
+      return;
+    }
+    str = McfStreamPtrList[jstr];
+    if (str == NULL) {
+      fprintf(stderr,"mcfio_InfoStream: Stream id %d is inactive \n",
+                     stream);
+      *lret = 0;
+      return;
+    }
+    switch (key) {
+      case MCFIO_TITLE:
+            if (str->fhead != NULL) strcpy(answer,str->fhead->title);
+            break;
+      case MCFIO_COMMENT:
+            if (str->fhead != NULL) strcpy(answer,str->fhead->comment);
+            break;
+      case MCFIO_CREATIONDATE:
+            if (str->fhead != NULL) strcpy(answer,str->fhead->date);
+            break;
+      case MCFIO_CLOSINGDATE:
+            if (str->fhead != NULL) strcpy(answer,str->fhead->closingDate);
+            break;
+      case MCFIO_FILENAME:
+          if (str->dos == MCFIO_SEQUENTIAL) {
+             fprintf(stderr,
+   "mcfio_InfoStream: Meaningless request for stream %d, key MCFIO_FILENAME \n", 
+   stream);
+             *lret = 0;
+   	     return;
+   	   }
+            strcpy(answer,str->filename);
+            break;
+      case MCFIO_DEVICENAME:
+          if (str->dos != MCFIO_SEQUENTIAL) {
+             fprintf(stderr,
+ "mcfio_InfoStream: Meaningless request for stream %d, key MCFIO_DEVICENAME \n", 
+   stream);
+             *lret = 0;
+   	     return;
+   	   }
+            strcpy(answer,str->device);
+            break;
+      default:
+            fprintf(stderr,
+             "mcfio_InfoStream: Unrecognized Keyword %d\n", key);
+             *lret = 0;
+   	     return;
+                           
+    }
+    *lret = strlen(answer);
+} 
+void mcfioC_InfoEventInt(int stream, int key, int *values)
+/*
+** Information routine for the current Event.  
+**   Based on key, return in *values the requested information 
+*/
+{
+    int i, jstr;
+    mcfStream *str;
+    jstr = stream - 1;
+    if ((jstr <0) || (jstr >= MCF_STREAM_NUM_MAX)) {
+      fprintf(stderr,"mcfio_InfoEvent: Stream id %d is illegal \n",
+                     stream);
+      return;
+    }
+    str = McfStreamPtrList[jstr];
+    if (str == NULL) {
+      fprintf(stderr,"mcfio_InfoEvent: Stream id %d is inactive \n",
+                     stream);
+      return;
+    }
+    if (str->ehead ==NULL) {
+      fprintf(stderr,"mcfio_InfoEvent: Stream id %d is at beginning \n",
+                     stream);
+      return;
+    }  
+    switch (key) {
+      case MCFIO_EVENTNUMBER:
+       *values = str->ehead->evtnum;
+       break;
+      case MCFIO_STORENUMBER:
+       *values = str->ehead->storenum;
+       break;
+      case MCFIO_RUNNUMBER:
+       *values = str->ehead->runnum;
+       break;
+      case MCFIO_TRIGGERMASK:
+       *values = str->ehead->trigMask;
+       break;
+      case MCFIO_NUMBLOCKS:
+       *values = str->ehead->nBlocks;
+       break;
+      case MCFIO_BLOCKIDS:
+       for(i=0; i<str->ehead->nBlocks; i++) 
+               values[i] = str->ehead->blockIds[i];
+       break;        
+      case MCFIO_NUMNTUPLES:
+        *values = str->ehead->nNTuples;
+        break;
+      case MCFIO_NTUPLESLIST:
+       for(i=0; i<str->ehead->nNTuples; i++) 
+               values[i] = str->ehead->nTupleIds[i];
+       break;
+      default:
+            fprintf(stderr,
+             "mcfio_InfoEvent: Unrecognized Keyword %d\n", key);
+                      
+    }
+}
+ 
+void mcfioC_SetEventInfo(int stream, int key, int *values)
+/*
+** Set anciallary information for the current Event.  
+**   Based on key, return in *values the requested information 
+**   Only valid for Output Streams. 
+*/
+{
+    int jstr;
+    mcfStream *str;
+    jstr = stream - 1;
+    if ((jstr <0) || (jstr >= MCF_STREAM_NUM_MAX)) {
+      fprintf(stderr,"mcfio_InfoStream: Stream id %d is illegal \n",
+                     stream);
+      return;
+    }
+    str = McfStreamPtrList[jstr];
+    if (str == NULL) {
+      fprintf(stderr,"mcfio_SetEvent: Stream id %d is inactive \n",
+                     stream);
+      return;
+    }
+    if (str->ehead ==NULL) {
+      fprintf(stderr,"mcfio_SetEvent: Stream id %d is at beginning \n",
+                     stream);
+      return;
+    }
+    if (str->row != MCFIO_WRITE) {  
+      fprintf(stderr,
+      "mcfio_SetEvent: Stream id %d must be an Output stream \n",
+                     stream);
+      return;
+    }
+    switch (key) {
+      case MCFIO_EVENTNUMBER:
+       str->ehead->evtnum = *values;
+       break;
+      case MCFIO_STORENUMBER:
+       str->ehead->storenum = *values;
+       break;
+      case MCFIO_RUNNUMBER:
+       str->ehead->runnum = *values;
+       break;
+      case MCFIO_TRIGGERMASK:
+       str->ehead->trigMask = *values;
+       break;
+      case MCFIO_NUMBLOCKS: case MCFIO_BLOCKIDS:
+      fprintf(stderr,
+  "mcfio_SetEvent: Blocks and Block contents are set by mcfio_Blocks\n" );
+      return;
+      default:
+            fprintf(stderr,
+             "mcfio_SetEvent: Unrecognized Keyword %d\n", key);
+                      
+    }
+} 
+
+void mcfioC_InfoEventChar(int stream, int key, char *answer, int *lret)
+/*
+** Information routine for the current Event.  
+**   Based on key, return in *values the requested information 
+*/
+{
+    int jstr;
+    mcfStream *str;
+    jstr = stream - 1;
+    if ((jstr <0) || (jstr >= MCF_STREAM_NUM_MAX)) {
+      fprintf(stderr,"mcfio_InfoStream: Stream id %d is illegal \n",
+                     stream);
+      *lret = 0;
+      return;
+    }
+    str = McfStreamPtrList[jstr];
+    if (str == NULL) {
+      fprintf(stderr,"mcfio_InfoStream: Stream id %d is inactive \n",
+                     stream);
+      *lret = 0;
+      return;
+    }
+    if (str->ehead ==NULL) {
+      fprintf(stderr,"mcfio_InfoStream: Stream id %d is at beginning \n",
+                     stream);
+      *lret = 0;
+      return;
+    }  
+    switch (key) {
+      case MCFIO_VERSION:
+       strcpy(answer, str->ehead->version);
+       break;
+      
+      default:
+            fprintf(stderr,
+             "mcfio_InfoEvent: Unrecognized Keyword %d\n", key);
+            *lret = 0;
+            return;
+                      
+    }
+    *lret = strlen(answer);
+} 
+
+void mcfioC_InfoBlockChar(int stream, int blkid,
+                            int key, char *answer, int *lret)
+/*
+** Information routine for a particular block within the current Event.  
+**   Based on key, return the requested information in string answer.
+*/
+{
+    int i, jstr, itmp, nn;
+    u_int pos;
+    bool_t tt;
+    char* data, *vv;
+    mcfStream *str;
+    jstr = stream - 1;
+    if ((jstr <0) || (jstr >= MCF_STREAM_NUM_MAX)) {
+      fprintf(stderr,"mcfio_InfoStream: Stream id %d is illegal \n",
+                     stream);
+      *lret = 0;               
+      return;
+    }
+    str = McfStreamPtrList[jstr];
+    if (str == NULL) {
+      fprintf(stderr,"mcfio_InfoStream: Stream id %d is inactive \n",
+                     stream);
+      *lret = 0;               
+      return;
+    }
+    if (str->ehead ==NULL) {
+      fprintf(stderr,"mcfio_InfoStream: Stream id %d is at beginning \n",
+                     stream);
+      *lret = 0;               
+      return;
+    }
+    pos = 0;
+    if(str->xdr != NULL) for(i=0; i<str->ehead->nBlocks; i++) 
+      if( str->ehead->blockIds[i] == blkid) pos = str->ehead->ptrBlocks[i];
+    if (pos == 0) {
+      fprintf(stderr,
+      "mcfio_InfoStream: Stream id %d event %d does not contain block %d \n",
+             stream,str->ehead->evtnum, blkid );
+      *lret = 0;               
+      return;
+    }
+     
+    switch (key) {
+      case MCFIO_VERSION:
+       tt = xdr_setpos(str->xdr, pos); 
+       tt = xdr_mcfast_generic(str->xdr, &itmp, &nn, &vv, &data);
+       xdr_free((void *) xdr_string, data); 
+       strcpy(answer, vv);
+       break;
+      
+      default:
+            fprintf(stderr,
+             "mcfio_InfoEvent: Unrecognized Keyword %d\n", key);
+            *lret = 0;
+            return;               
+                      
+    }
+    *lret = strlen(answer);
+} 
+void mcfioC_GetBlockName(int blkId, char *answer)
+/*
+**  Get a Block name from the dictionary..It is assume that answer has 
+**     pre-malloc, size MCF_XDR_B_TITLE_LENGTH 
+*/
+{
+   char *uDescr;
+    switch (blkId) {
+       case MCFIO_STDHEP:
+         strcpy(answer,
+         " Standard HEP COMMON block, see STDHEP Product");
+         break;
+         
+       case MCFIO_STDHEPM:
+         strcpy(answer,
+         " Standard HEP COMMON block with multiple interaction, see STDHEP Product");
+         break;
+         
+       case MCFIO_STDHEP4:
+         strcpy(answer,
+         " Standard HEP COMMON block with Les Houches, see STDHEP Product");
+         break;
+         
+       case MCFIO_STDHEP4M:
+         strcpy(answer,
+         " Standard HEP COMMON block with Les Houches and multiple interaction");
+         break;
+         
+       case MCFIO_HEPEUP:
+         strcpy(answer,
+         " Les Houches HEPEUP common block");
+         break;
+         
+       case MCFIO_HEPRUP:
+         strcpy(answer,
+         " Les Houches HEPRUP common block");
+         break;
+         
+       case MCFIO_STDHEPCXX:
+         strcpy(answer,
+         " StdHep::Event class, see StdHepC++ Product");
+         break;
+         
+       case MCFIO_STDHEPBEG:
+         strcpy(answer,
+         " Stdhep begin run record, see STDHEP Product");
+         break;
+         
+       case MCFIO_STDHEPEND:
+         strcpy(answer,
+         " Stdhep end run record, see STDHEP Product");
+         break;
+         
+       case MCFIO_OFFTRACKARRAYS:
+         strcpy(answer,
+         " The mcfast Offline Tracks, saved into parallel arrays");
+         break;
+         
+       case MCFIO_OFFTRACKSTRUCT:
+         strcpy(answer,
+         " The mcfast Offline Tracks, saved as the structure");
+         break;
+       default:          
+         sprintf(answer, " Private User Block number %d ", blkId );
+	 uDescr = mcfioC_UserBlockDescript(blkId);
+	 if (uDescr == NULL) fprintf(stderr,
+          "mcfio_GetBlockName: Warning Unrecognized block I.D. %d\n", blkId);
+         else answer = uDescr;             
+  }         
+	
+}
+
+
+
Index: /trunk/mcfio/mcfio_Util1.h
===================================================================
--- /trunk/mcfio/mcfio_Util1.h	(revision 2)
+++ /trunk/mcfio/mcfio_Util1.h	(revision 2)
@@ -0,0 +1,25 @@
+/*******************************************************************************
+*									       *
+* mcfio_Util1.h --  Include file for mcfast initialisation & info i/o layer.   *
+*									       *
+* Copyright (c) 1994 Universities Research Association, Inc.		       *
+* All rights reserved.							       *
+*									       *
+*******************************************************************************/
+void mcfioC_Init(void);
+void mcfioC_Close(int istream);
+void mcfioC_PrintDictionary(void);
+unsigned int mcfioC_InfoNumSream(int *istreams, unsigned int nmax);
+void mcfioC_InfoStreamInt(int istream, int key, int *value);
+void mcfioC_InfoStreamChar(int istream, int key, char *answer, int *lret);
+void mcfioC_InfoEventInt(int istream, int key, int *value);
+void mcfioC_InfoEventChar(int istream, int key, char *answer, int *lret);
+void mcfioC_SetEventInfo(int istream, int key, int *value);
+void mcfioC_Free_FileHeader(mcfxdrFileHeader **p);
+void mcfioC_Free_SeqHeader(mcfxdrSequentialHeader **p);
+void mcfioC_Free_EventHeader(mcfxdrEventHeader **p);
+void mcfioC_Free_EventTable(mcfxdrEventTable **p);
+void mcfioC_FreeStream(mcfStream **stream);
+void mcfioC_InfoBlockChar(int stream, int blk, int key,
+                            char *answer, int *lret);
+void mcfioC_GetBlockName(int blkId, char *answer);
Index: /trunk/modules/MadGraphAnalysis.cc
===================================================================
--- /trunk/modules/MadGraphAnalysis.cc	(revision 2)
+++ /trunk/modules/MadGraphAnalysis.cc	(revision 2)
@@ -0,0 +1,238 @@
+
+#include "modules/MadGraphAnalysis.h"
+
+
+#include "ExRootAnalysis/ExRootResult.h"
+#include "ExRootAnalysis/ExRootClasses.h"
+
+#include "ExRootAnalysis/ExRootCandidate.h"
+
+#include "TClonesArray.h"
+
+#include "TH1.h"
+#include "TH2.h"
+#include "TString.h"
+#include "TCanvas.h"
+#include "TLorentzVector.h"
+
+#include <iostream>
+
+using namespace std;
+
+//------------------------------------------------------------------------------
+
+MadGraphAnalysis::MadGraphAnalysis()
+{
+}
+
+//------------------------------------------------------------------------------
+
+MadGraphAnalysis::~MadGraphAnalysis()
+{
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphAnalysis::Init()
+{
+  fOutputFileName = GetString("OutputFile", "pythia_plots.root");
+
+  // import array with output from filter/classifier module
+
+  fInputArray = ImportArray(GetString("InputArray", "merger/candidates"));
+
+  fIsUnWeighted = GetBool("IsUnWeighted", kFALSE);
+
+  // import ROOT tree branch
+  
+  if(fIsUnWeighted)
+  {
+    fBranchEvent = UseBranch("Event");
+  }
+  else
+  {
+    fBranchEvent = 0;
+  }
+
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphAnalysis::Finish()
+{
+  GetPlots()->Write(fOutputFileName);
+
+  GetPlots()->GetCanvas()->SetLogy(1);
+  GetPlots()->Print();
+  GetPlots()->GetCanvas()->SetLogy(0);
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphAnalysis::Process()
+{
+  ExRootCandidate *candidate1 = 0, *candidate2 = 0;
+  ParticleHistograms *histogramsParticle = 0;
+  PairHistograms *histogramsPair = 0;
+  Int_t maxEntry, entry1, entry2;
+
+  Double_t weight = 1.0;
+  Double_t pt1, pt2, dr, rapidity, signPz;
+
+  ExRootLHEFEvent *eventInfo = 0;
+  if(fIsUnWeighted && fBranchEvent && fBranchEvent->GetEntriesFast() == 1)
+  {
+    eventInfo = static_cast<ExRootLHEFEvent*>(fBranchEvent->At(0));
+
+    weight = eventInfo->Weight;
+  }
+
+  // fill histograms
+  maxEntry = fInputArray->GetEntriesFast();
+  for(entry1 = 0; entry1 < maxEntry; ++entry1)
+  {
+    candidate1 = static_cast<ExRootCandidate*>(fInputArray->At(entry1));
+
+    const TLorentzVector &vector1 = candidate1->GetP4();
+
+    pt1 = vector1.Pt();
+    signPz = (vector1.Pz() >= 0.0) ? 1.0 : -1.0;
+    rapidity = (pt1 == 0.0 ? signPz*999.9 : vector1.Rapidity());
+
+    // fill histograms for single particles
+
+    histogramsParticle = GetParticleHistograms(candidate1->GetName());
+
+    histogramsParticle->fParticlePt->Fill(pt1, weight);
+
+    histogramsParticle->fParticleRapidity->Fill(rapidity, weight);
+    
+    // skip pairs of resonances
+    if(candidate1->IsResonance()) continue;
+
+    for(entry2 = entry1 + 1; entry2 < maxEntry; ++entry2)
+    {
+      candidate2 = static_cast<ExRootCandidate*>(fInputArray->At(entry2));
+
+      // skip pairs of resonances
+      if(candidate2->IsResonance()) continue;
+
+      const TLorentzVector &vector2 = candidate2->GetP4();
+
+      pt2 = vector2.Pt();
+      dr = (pt1 == 0.0 || pt2 == 0.0 ? 999.9 : vector1.DeltaR(vector2));
+
+      // fill histograms for pairs of particles
+
+      histogramsPair = GetPairHistograms(candidate1->GetName(), candidate2->GetName());
+
+      histogramsPair->fPairDeltaR->Fill(dr, weight);
+      histogramsPair->fPairMass->Fill((vector1 + vector2).M(), weight);
+    }
+  }
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphAnalysis::BookParticleHistograms(MadGraphAnalysis::ParticleHistograms *histograms,
+                                                    const char *name, const char *title)
+{
+  ExRootResult *result = GetPlots();
+  histograms->fParticlePt = result->AddHist1D(Form("pt_%s", name),
+                                              Form("P_{T}(%s)", title),
+                                              Form("P_{T}(%s), GeV/c", title),
+                                              "pb/bin",
+                                              60, 0.0, 300.0, 0, 1);
+  histograms->fParticlePt->SetStats(kTRUE);
+
+  histograms->fParticleRapidity = result->AddHist1D(Form("y_%s", name),
+                                                    Form("y(%s)", title),
+                                                    Form("y(%s)", title),
+                                                    "pb/bin",
+                                                    100, -5.0, 5.0, 0, 0);
+  histograms->fParticleRapidity->SetStats(kTRUE);
+
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphAnalysis::BookPairHistograms(MadGraphAnalysis::PairHistograms *histograms,
+                                                const char *name, const char *title)
+{
+  ExRootResult *result = GetPlots();
+  histograms->fPairDeltaR = result->AddHist1D(Form("dr_%s", name),
+                                              Form("#DeltaR(%s)", title),
+                                              Form("#DeltaR(%s)", title),
+                                              "pb/bin",
+                                              70, 0.0, 7.0, 0, 1);
+  histograms->fPairDeltaR->SetStats(kTRUE);
+
+  histograms->fPairMass = result->AddHist1D(Form("mass_%s", name),
+                                            Form("M_{inv}(%s)", title),
+                                            Form("M_{inv}(%s), GeV/c^{2}", title),
+                                            "pb/bin",
+                                            120, 0.0, 600.0, 0, 1);
+  histograms->fPairMass->SetStats(kTRUE);
+
+}
+
+//------------------------------------------------------------------------------
+
+MadGraphAnalysis::ParticleHistograms *
+MadGraphAnalysis::GetParticleHistograms(const char *candName)
+{
+  map<TString, ParticleHistograms *>::iterator itParticleHistogramsMap;
+  ParticleHistograms *histograms = 0;
+  TString name = Form("%s", candName);
+  name.ReplaceAll("{", "");
+  name.ReplaceAll("}", "");
+  name.ReplaceAll("^", "");
+  name.ReplaceAll("#bar", "anti_");
+  name.ReplaceAll("#", "");
+  TString title = Form("%s", candName);
+  itParticleHistogramsMap = fParticleHistogramsMap.find(name);
+  if(itParticleHistogramsMap == fParticleHistogramsMap.end())
+  {
+    histograms = new ParticleHistograms;
+
+    BookParticleHistograms(histograms, name, title);
+
+    fParticleHistogramsMap[name] = histograms;
+  }
+  else
+  {
+    histograms = itParticleHistogramsMap->second;
+  }
+  return histograms;
+}
+
+//------------------------------------------------------------------------------
+
+MadGraphAnalysis::PairHistograms *
+MadGraphAnalysis::GetPairHistograms(const char *candName1, const char *candName2)
+{
+  map<TString, PairHistograms *>::iterator itPairHistogramsMap;
+  PairHistograms *histograms = 0;
+  TString name = Form("%s_%s", candName1, candName2);
+  name.ReplaceAll("{", "");
+  name.ReplaceAll("}", "");
+  name.ReplaceAll("^", "");
+  name.ReplaceAll("#bar", "anti_");
+  name.ReplaceAll("#", "");
+  TString title = Form("%s, %s", candName1, candName2);
+  itPairHistogramsMap = fPairHistogramsMap.find(name);
+  if(itPairHistogramsMap == fPairHistogramsMap.end())
+  {
+    histograms = new PairHistograms;
+
+    BookPairHistograms(histograms, name, title);
+
+    fPairHistogramsMap[name] = histograms;
+  }
+  else
+  {
+    histograms = itPairHistogramsMap->second;
+  }
+  return histograms;
+}
+
Index: /trunk/modules/MadGraphAnalysis.h
===================================================================
--- /trunk/modules/MadGraphAnalysis.h	(revision 2)
+++ /trunk/modules/MadGraphAnalysis.h	(revision 2)
@@ -0,0 +1,61 @@
+#ifndef MadGraphAnalysis_h
+#define MadGraphAnalysis_h
+
+#include "ExRootAnalysis/ExRootModule.h"
+
+#include "TString.h"
+
+#include <map>
+
+class TH1;
+class TObjArray;
+class TClonesArray;
+
+class MadGraphAnalysis: public ExRootModule
+{
+public:
+
+  MadGraphAnalysis();
+  ~MadGraphAnalysis();
+
+  void Init();
+  void Process();
+  void Finish();
+
+private:
+
+  struct ParticleHistograms
+  {
+    TH1 *fParticlePt;
+    TH1 *fParticleRapidity;
+  };
+
+  struct PairHistograms
+  {
+    TH1 *fPairDeltaR;
+    TH1 *fPairMass;
+  };
+
+  void BookParticleHistograms(ParticleHistograms *histograms,
+                              const char *name, const char *title);
+  void BookPairHistograms(PairHistograms *histograms,
+                          const char *name, const char *title);
+
+  ParticleHistograms *GetParticleHistograms(const char *candName);
+  PairHistograms *GetPairHistograms(const char *candName1, const char *candName2);
+
+  TString fOutputFileName; //!
+  
+  Bool_t fIsUnWeighted; //!
+
+  const TObjArray *fInputArray; //!
+
+  TClonesArray *fBranchEvent; //!
+
+  std::map<TString, ParticleHistograms *> fParticleHistogramsMap; //!
+  std::map<TString, PairHistograms *> fPairHistogramsMap; //!
+
+  ClassDef(MadGraphAnalysis, 1)
+};
+
+#endif
Index: /trunk/modules/MadGraphClassFilter.cc
===================================================================
--- /trunk/modules/MadGraphClassFilter.cc	(revision 2)
+++ /trunk/modules/MadGraphClassFilter.cc	(revision 2)
@@ -0,0 +1,130 @@
+
+#include "modules/MadGraphClassFilter.h"
+
+#include "modules/MadGraphParticleClassifier.h"
+
+#include "ExRootAnalysis/ExRootResult.h"
+#include "ExRootAnalysis/ExRootClasses.h"
+
+#include "ExRootAnalysis/ExRootFilter.h"
+
+#include "TClonesArray.h"
+
+#include <map>
+#include <set>
+#include <deque>
+
+#include <iostream>
+
+using namespace std;
+
+//------------------------------------------------------------------------------
+
+MadGraphClassFilter::MadGraphClassFilter()
+{
+}
+
+//------------------------------------------------------------------------------
+
+MadGraphClassFilter::~MadGraphClassFilter()
+{
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphClassFilter::Init()
+{
+  TString className;
+  ExRootConfParam param, classParticles;
+  
+  Bool_t extendable;
+  Int_t i, j, status, pid, sizeParam, sizeParticles;
+
+  // import ROOT tree branch
+
+  fBranchParticle = UseBranch("Particle");
+
+  // create classifier and filter
+
+  fClassifier = new MadGraphParticleClassifier();
+  fFilter = new ExRootFilter(fBranchParticle);
+
+  // read particle status from configuration file and setup classifier
+
+  param = GetParam("ParticleStatus");
+  sizeParam = param.GetSize();
+
+  for(i = 0; i < sizeParam; ++i)
+  {
+    status = param[i].GetInt();
+    fClassifier->InsertParticleStatus(status);
+  }
+
+  // read particle classes from configuration file and setup classifier
+
+  param = GetParam("ClassParticles");
+  sizeParam = param.GetSize();
+
+  for(i = 0; i < sizeParam/2; ++i)
+  {
+    className = param[i*2].GetString();
+    classParticles = param[i*2 + 1];
+    sizeParticles = classParticles.GetSize();
+
+    for(j = 0; j < sizeParticles; ++j)
+    {
+      pid = classParticles[j].GetInt();
+      fClassifier->InsertClassPID(className, pid);
+    }
+  }
+
+  // allow classifier to create additional classes for particles with unknown PID
+
+  extendable = GetBool("AllowExtendableClasses", kTRUE);
+
+  fClassifier->SetExtendable(extendable);
+
+  // create output arrays
+
+  fOutputArray = ExportArray("particles");
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphClassFilter::Finish()
+{
+  if(fFilter) delete fFilter;
+  if(fClassifier) delete fClassifier;
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphClassFilter::Process()
+{
+  TObjArray *subarray;
+  Int_t category;
+
+  fFilter->Reset();
+
+  // make filter classify particles and fill all subarrays
+  // at this point classifier creates additional/missing classes
+  fFilter->GetSubArray(fClassifier, 0);
+
+  // loop over all classes and export class names and classified particles
+  for(category = 0; category < fClassifier->GetMaxCategories(); ++category)
+  {
+    subarray = fFilter->GetSubArray(fClassifier, category);
+    if(subarray)
+    {
+      subarray->SetName(fClassifier->GetCategoryClassName(category));
+      fOutputArray->Add(subarray);
+  
+      // sort particles by PT
+      ExRootLHEFParticle::fgCompare = ExRootComparePT<ExRootLHEFParticle>::Instance();
+      subarray->Sort();
+    }
+  }
+}
+
+//------------------------------------------------------------------------------
+
Index: /trunk/modules/MadGraphClassFilter.h
===================================================================
--- /trunk/modules/MadGraphClassFilter.h	(revision 2)
+++ /trunk/modules/MadGraphClassFilter.h	(revision 2)
@@ -0,0 +1,35 @@
+#ifndef MadGraphClassFilter_h
+#define MadGraphClassFilter_h
+
+#include "ExRootAnalysis/ExRootModule.h"
+
+class TClonesArray;
+class TObjArray;
+
+class ExRootFilter;
+class MadGraphParticleClassifier;
+
+class MadGraphClassFilter: public ExRootModule
+{
+public:
+    
+  MadGraphClassFilter();
+  ~MadGraphClassFilter();
+
+  void Init();
+  void Process();
+  void Finish();
+  
+private:
+
+  ExRootFilter *fFilter; //!
+  MadGraphParticleClassifier *fClassifier; //!
+
+  TClonesArray *fBranchParticle; //!
+
+  TObjArray *fOutputArray; //!
+
+  ClassDef(MadGraphClassFilter, 1)
+};
+
+#endif
Index: /trunk/modules/MadGraphClassMerger.cc
===================================================================
--- /trunk/modules/MadGraphClassMerger.cc	(revision 2)
+++ /trunk/modules/MadGraphClassMerger.cc	(revision 2)
@@ -0,0 +1,84 @@
+
+#include "modules/MadGraphClassMerger.h"
+
+#include "ExRootAnalysis/ExRootClasses.h"
+#include "ExRootAnalysis/ExRootFactory.h"
+#include "ExRootAnalysis/ExRootCandidate.h"
+
+#include "TString.h"
+#include "TLorentzVector.h"
+
+#include <iostream>
+
+using namespace std;
+
+//------------------------------------------------------------------------------
+
+MadGraphClassMerger::MadGraphClassMerger() :
+  fItInputArray(0)
+{
+}
+
+//------------------------------------------------------------------------------
+
+MadGraphClassMerger::~MadGraphClassMerger()
+{
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphClassMerger::Init()
+{
+  // import array with output from filter/classifier module
+
+  fInputArray = ImportArray(GetString("InputArray", "selection/candidates"));
+  fItInputArray = fInputArray->MakeIterator();
+
+  // create output array
+
+  fOutputArray = ExportArray("candidates");
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphClassMerger::Finish()
+{
+  if(fItInputArray) delete fItInputArray;
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphClassMerger::Process()
+{
+  TObjArray *array = 0;
+  ExRootLHEFParticle *particle = 0;
+  ExRootCandidate *candidate = 0;
+  ExRootFactory *factory = GetFactory();
+
+  Int_t entry;
+  TString name;
+  TLorentzVector momentum;
+
+  fItInputArray->Reset();
+  while(array = static_cast<TObjArray*>(fItInputArray->Next()))
+  {
+    TIter itArray(array);
+    name = array->GetName();
+    entry = 1;
+
+    while(particle = static_cast<ExRootLHEFParticle*>(itArray.Next()))
+    {
+      momentum.SetPxPyPzE(particle->Px, particle->Py, particle->Pz, particle->E);
+
+      candidate = factory->NewCandidate();
+
+      candidate->SetP4(momentum);
+      candidate->SetName(Form("%s_{%d}", name.Data(), entry ));
+      if(particle->Status != 1) candidate->SetResonance(kTRUE);
+
+      fOutputArray->Add(candidate);
+      ++entry;
+    }
+  }
+}
+
Index: /trunk/modules/MadGraphClassMerger.h
===================================================================
--- /trunk/modules/MadGraphClassMerger.h	(revision 2)
+++ /trunk/modules/MadGraphClassMerger.h	(revision 2)
@@ -0,0 +1,31 @@
+#ifndef MadGraphClassMerger_h
+#define MadGraphClassMerger_h
+
+#include "ExRootAnalysis/ExRootModule.h"
+
+class TObjArray;
+class TIterator;
+
+class MadGraphClassMerger: public ExRootModule
+{
+public:
+    
+  MadGraphClassMerger();
+  ~MadGraphClassMerger();
+
+  void Init();
+  void Process();
+  void Finish();
+  
+private:
+
+  TIterator *fItInputArray; //!
+
+  const TObjArray *fInputArray; //!
+
+  TObjArray *fOutputArray; //!
+
+  ClassDef(MadGraphClassMerger, 1)
+};
+
+#endif
Index: /trunk/modules/MadGraphConeJetFinder.cc
===================================================================
--- /trunk/modules/MadGraphConeJetFinder.cc	(revision 2)
+++ /trunk/modules/MadGraphConeJetFinder.cc	(revision 2)
@@ -0,0 +1,111 @@
+
+#include "modules/MadGraphConeJetFinder.h"
+
+#include "ExRootAnalysis/ExRootClasses.h"
+#include "ExRootAnalysis/ExRootFactory.h"
+#include "ExRootAnalysis/ExRootCandidate.h"
+
+#include "CDFCones/JetCluAlgorithm.hh"
+#include "CDFCones/MidPointAlgorithm.hh"
+
+#include "TString.h"
+#include "TLorentzVector.h"
+
+#include <iostream>
+#include <vector>
+
+using namespace std;
+
+//------------------------------------------------------------------------------
+
+MadGraphConeJetFinder::MadGraphConeJetFinder() :
+  fJetAlgo(0), fItInputArray(0)
+{
+
+}
+
+//------------------------------------------------------------------------------
+
+MadGraphConeJetFinder::~MadGraphConeJetFinder()
+{
+
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphConeJetFinder::Init()
+{
+  
+  // define MidPoint algorithm
+
+  double seedThreshold    = GetDouble("SeedThreshold", 1.0);
+  double coneRadius       = GetDouble("ConeRadius", 0.5);
+  double coneAreaFraction = GetDouble("ConeAreaFraction", 1.0);
+  int    maxPairSize      = GetInt("MaxPairSize", 2);
+  int    maxIterations    = GetInt("MaxIterations", 100);
+  double overlapThreshold = GetDouble("OverlapThreshold", 0.75);
+
+  fJetAlgo = new MidPointAlgorithm(seedThreshold, coneRadius, coneAreaFraction,
+                                   maxPairSize, maxIterations, overlapThreshold);
+
+  // import array with output from filter/classifier module
+
+  fInputArray = ImportArray(GetString("InputArray", "selection/candidates"));
+  fItInputArray = fInputArray->MakeIterator();
+
+  // create output arrays
+
+  fOutputArray = ExportArray("candidates");
+
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphConeJetFinder::Finish()
+{
+  if(fJetAlgo) delete fJetAlgo;
+  if(fItInputArray) delete fItInputArray;
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphConeJetFinder::Process()
+{
+  ExRootCandidate *candidate;
+  TLorentzVector momentum;
+  LorentzVector jetMomentum;
+  Int_t entry;
+
+  ExRootFactory *factory = GetFactory();
+
+  fTowersList.clear();
+
+  // loop over all particles in event and select stable ones
+  fItInputArray->Reset();
+  while((candidate = static_cast<ExRootCandidate*>(fItInputArray->Next())))
+  {
+     momentum = candidate->GetP4();
+     fTowersList.push_back(PhysicsTower(LorentzVector(momentum.Px(), momentum.Py(),
+                                                      momentum.Pz(), momentum.E())));
+  }
+
+  // construct jets from a list of stable particles
+  fJetsList.clear();
+  fJetAlgo->run(fTowersList, fJetsList);
+
+  // loop over all jets and export them
+  vector<Cluster>::iterator itJet;
+  for(itJet = fJetsList.begin(), entry = 1; itJet != fJetsList.end(); ++itJet, ++entry)
+  {
+  	jetMomentum = itJet->fourVector;
+
+  	momentum.SetPxPyPzE(jetMomentum.px, jetMomentum.py, jetMomentum.pz, jetMomentum.E);
+
+    candidate = factory->NewCandidate();
+
+    candidate->SetP4(momentum);
+    candidate->SetName(Form("jet_{%d}", entry ));
+
+    fOutputArray->Add(candidate);
+  }
+}
Index: /trunk/modules/MadGraphConeJetFinder.h
===================================================================
--- /trunk/modules/MadGraphConeJetFinder.h	(revision 2)
+++ /trunk/modules/MadGraphConeJetFinder.h	(revision 2)
@@ -0,0 +1,43 @@
+#ifndef MadGraphConeJetFinder_h
+#define MadGraphConeJetFinder_h
+
+#include "ExRootAnalysis/ExRootModule.h"
+
+#include "CDFCones/PhysicsTower.hh"
+#include "CDFCones/Cluster.hh"
+
+#include <vector>
+
+class TObjArray;
+class TIterator;
+
+class MidPointAlgorithm;
+
+class MadGraphConeJetFinder: public ExRootModule
+{
+public:
+
+  MadGraphConeJetFinder();
+  ~MadGraphConeJetFinder();
+
+  void Init();
+  void Process();
+  void Finish();
+  
+private:
+
+  std::vector<PhysicsTower> fTowersList;
+  std::vector<Cluster> fJetsList;
+
+  MidPointAlgorithm *fJetAlgo; //!
+
+  TIterator *fItInputArray; //!
+
+  const TObjArray *fInputArray; //!
+
+  TObjArray *fOutputArray; //!
+
+  ClassDef(MadGraphConeJetFinder, 1)
+};
+
+#endif
Index: /trunk/modules/MadGraphIsolatedLeptonFinder.cc
===================================================================
--- /trunk/modules/MadGraphIsolatedLeptonFinder.cc	(revision 2)
+++ /trunk/modules/MadGraphIsolatedLeptonFinder.cc	(revision 2)
@@ -0,0 +1,173 @@
+
+#include "modules/MadGraphIsolatedLeptonFinder.h"
+
+#include "modules/MadGraphParticleClassifier.h"
+
+#include "ExRootAnalysis/ExRootClasses.h"
+#include "ExRootAnalysis/ExRootFilter.h"
+
+#include "ExRootAnalysis/ExRootFactory.h"
+#include "ExRootAnalysis/ExRootCandidate.h"
+
+#include "TString.h"
+#include "TClonesArray.h"
+#include "TLorentzVector.h"
+
+#include <map>
+#include <set>
+#include <deque>
+
+#include <iostream>
+
+using namespace std;
+
+//------------------------------------------------------------------------------
+
+Double_t MadGraphIsolatedLeptonFinder::GetMinDeltaR(ExRootGenParticle *lepton)
+{
+  Double_t distMin = 1.0e6;
+  Double_t pt1, pt2, dist;
+  TLorentzVector vector1, vector2;
+  ExRootGenParticle *particle;
+ 
+  vector1.SetPxPyPzE(lepton->Px, lepton->Py, lepton->Pz, lepton->E);
+  pt1 = vector1.Pt();
+
+  fItParticle->Reset();
+  while(particle = static_cast<ExRootGenParticle*>(fItParticle->Next()))
+  {
+    if(particle->Status != 1) continue;
+
+    vector2.SetPxPyPzE(particle->Px, particle->Py, particle->Pz, particle->E);
+    pt2 = vector2.Pt();
+
+    dist = (pt1 == 0.0 || pt2 == 0.0 ? 1.0e6 : vector1.DeltaR(vector2));
+
+    if(pt2 > fMinPT && dist < distMin)
+    {
+      distMin = dist;
+    }
+  }
+
+  return distMin;
+}
+
+//------------------------------------------------------------------------------
+
+MadGraphIsolatedLeptonFinder::MadGraphIsolatedLeptonFinder() :
+  fItParticle(0)
+{
+}
+
+//------------------------------------------------------------------------------
+
+MadGraphIsolatedLeptonFinder::~MadGraphIsolatedLeptonFinder()
+{
+  if(fItParticle) delete fItParticle;
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphIsolatedLeptonFinder::Init()
+{
+  TString className;
+  ExRootConfParam param, classParticles;
+
+  Int_t i, j, pid, sizeParam, sizeParticles;
+
+  // import ROOT tree branch
+
+  fBranchParticle = UseBranch("GenParticle");
+
+  fItParticle = fBranchParticle->MakeIterator();
+
+  // create classifier and filter
+
+  fMinPT = GetDouble("MinPT", 1.0);
+  fMinDeltaR = GetDouble("MinDR", 0.1);
+
+  fClassifier = new MadGraphParticleClassifier();
+  fFilter = new ExRootFilter(fBranchParticle);
+
+  // read particle classes from configuration file and setup classifier
+
+  param = GetParam("ClassParticles");
+  sizeParam = param.GetSize();
+
+  for(i = 0; i < sizeParam/2; ++i)
+  {
+    className = param[i*2].GetString();
+    classParticles = param[i*2 + 1];
+    sizeParticles = classParticles.GetSize();
+
+    for(j = 0; j < sizeParticles; ++j)
+    {
+      pid = classParticles[j].GetInt();
+      fClassifier->InsertClassPID(className, pid);
+    }
+  }
+
+  fClassifier->SetExtendable(kFALSE);
+
+  // create output arrays
+
+  fOutputArray = ExportArray("candidates");
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphIsolatedLeptonFinder::Finish()
+{
+  if(fFilter) delete fFilter;
+  if(fClassifier) delete fClassifier;
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphIsolatedLeptonFinder::Process()
+{
+  TObjArray *array = 0;
+  ExRootGenParticle *particle = 0;
+  ExRootCandidate *candidate = 0;
+  ExRootFactory *factory = GetFactory();
+
+  Int_t category;
+  TString name;
+  TLorentzVector momentum;
+
+  fFilter->Reset();
+
+  // make filter classify particles and fill all subarrays
+  // at this point classifier creates additional/missing classes
+  fFilter->GetSubArray(fClassifier, 0);
+
+  // loop over all classes and export class names and classified particles
+  for(category = 0; category < fClassifier->GetMaxCategories(); ++category)
+  {
+    array = fFilter->GetSubArray(fClassifier, category);
+    name = fClassifier->GetCategoryClassName(category);
+
+    if(array == 0) continue;
+
+    // sort particles by PT
+    ExRootGenParticle::fgCompare = ExRootComparePT<ExRootGenParticle>::Instance();
+    array->Sort();
+
+    TIter itArray(array);
+
+    while(particle = static_cast<ExRootGenParticle*>(itArray.Next()))
+    {
+      if(GetMinDeltaR(particle) < fMinDeltaR) continue;
+
+      momentum.SetPxPyPzE(particle->Px, particle->Py, particle->Pz, particle->E);
+
+      candidate = factory->NewCandidate();
+
+      candidate->SetP4(momentum);
+      candidate->SetName(name);
+
+      fOutputArray->Add(candidate);
+    }
+  }
+}
+
Index: /trunk/modules/MadGraphIsolatedLeptonFinder.h
===================================================================
--- /trunk/modules/MadGraphIsolatedLeptonFinder.h	(revision 2)
+++ /trunk/modules/MadGraphIsolatedLeptonFinder.h	(revision 2)
@@ -0,0 +1,44 @@
+#ifndef MadGraphIsolatedLeptonFinder_h
+#define MadGraphIsolatedLeptonFinder_h
+
+#include "ExRootAnalysis/ExRootModule.h"
+
+class TClonesArray;
+class TObjArray;
+class TIterator;
+
+class ExRootFilter;
+class MadGraphParticleClassifier;
+
+class ExRootGenParticle;
+
+class MadGraphIsolatedLeptonFinder: public ExRootModule
+{
+public:
+    
+  MadGraphIsolatedLeptonFinder();
+  ~MadGraphIsolatedLeptonFinder();
+
+  void Init();
+  void Process();
+  void Finish();
+  
+private:
+
+  Double_t GetMinDeltaR(ExRootGenParticle *lepton);
+
+  TIterator *fItParticle; //!
+
+  ExRootFilter *fFilter; //!
+  MadGraphParticleClassifier *fClassifier; //!
+
+  TClonesArray *fBranchParticle; //!
+
+  TObjArray *fOutputArray; //!
+  
+  Double_t fMinPT, fMinDeltaR;
+
+  ClassDef(MadGraphIsolatedLeptonFinder, 1)
+};
+
+#endif
Index: /trunk/modules/MadGraphJetLeptonMerger.cc
===================================================================
--- /trunk/modules/MadGraphJetLeptonMerger.cc	(revision 2)
+++ /trunk/modules/MadGraphJetLeptonMerger.cc	(revision 2)
@@ -0,0 +1,78 @@
+
+#include "modules/MadGraphJetLeptonMerger.h"
+
+#include "ExRootAnalysis/ExRootClasses.h"
+
+#include "ExRootAnalysis/ExRootFactory.h"
+#include "ExRootAnalysis/ExRootCandidate.h"
+
+#include "TString.h"
+
+#include <iostream>
+
+using namespace std;
+
+//------------------------------------------------------------------------------
+
+MadGraphJetLeptonMerger::MadGraphJetLeptonMerger() :
+  fItInputLeptons(0), fItInputJets(0)
+{
+}
+
+//------------------------------------------------------------------------------
+
+MadGraphJetLeptonMerger::~MadGraphJetLeptonMerger()
+{
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphJetLeptonMerger::Init()
+{
+  // import array with output from lepton and jet finders
+
+  fInputLeptons = ImportArray(GetString("InputLeptonsArray", "leptonfinder/leptons"));
+  fItInputLeptons = fInputLeptons->MakeIterator();
+
+  fInputJets = ImportArray(GetString("InputJetsArray", "jetfinder/jets"));
+  fItInputJets = fInputJets->MakeIterator();
+
+  fJetNumberMax = GetInt("JetNumberMax", 4);
+
+  // create output arrays
+
+  fOutputArray = ExportArray("candidates");
+
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphJetLeptonMerger::Finish()
+{
+  if(fItInputLeptons) delete fItInputLeptons;
+  if(fItInputJets) delete fItInputJets;
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphJetLeptonMerger::Process()
+{
+  TObject *object = 0;
+  Int_t entry;
+
+  fItInputLeptons->Reset();
+  while((object = fItInputLeptons->Next()))
+  {
+    fOutputArray->Add(object);
+  }
+
+  entry = 0;
+  fItInputJets->Reset();
+  while((object = fItInputJets->Next()) && entry < fJetNumberMax)
+  {
+    fOutputArray->Add(object);
+    ++entry;
+  }
+}
+
+//------------------------------------------------------------------------------
Index: /trunk/modules/MadGraphJetLeptonMerger.h
===================================================================
--- /trunk/modules/MadGraphJetLeptonMerger.h	(revision 2)
+++ /trunk/modules/MadGraphJetLeptonMerger.h	(revision 2)
@@ -0,0 +1,35 @@
+#ifndef MadGraphJetLeptonMerger_h
+#define MadGraphJetLeptonMerger_h
+
+#include "ExRootAnalysis/ExRootModule.h"
+
+class TObjArray;
+class TIterator;
+
+class MadGraphJetLeptonMerger: public ExRootModule
+{
+public:
+
+  MadGraphJetLeptonMerger();
+  ~MadGraphJetLeptonMerger();
+
+  void Init();
+  void Process();
+  void Finish();
+
+private:
+
+  const TObjArray *fInputLeptons; //!
+  const TObjArray *fInputJets; //!
+
+  TIterator *fItInputLeptons; //!
+  TIterator *fItInputJets; //!
+
+  TObjArray *fOutputArray; //!
+  
+  Int_t fJetNumberMax;
+
+  ClassDef(MadGraphJetLeptonMerger, 1)
+};
+
+#endif
Index: /trunk/modules/MadGraphJetParticleSelector.cc
===================================================================
--- /trunk/modules/MadGraphJetParticleSelector.cc	(revision 2)
+++ /trunk/modules/MadGraphJetParticleSelector.cc	(revision 2)
@@ -0,0 +1,274 @@
+
+#include "modules/MadGraphJetParticleSelector.h"
+
+
+#include "ExRootAnalysis/ExRootResult.h"
+#include "ExRootAnalysis/ExRootClasses.h"
+
+#include "ExRootAnalysis/ExRootFilter.h"
+#include "ExRootAnalysis/ExRootClassifier.h"
+
+#include "ExRootAnalysis/ExRootFactory.h"
+#include "ExRootAnalysis/ExRootCandidate.h"
+
+#include "TMath.h"
+#include "TString.h"
+#include "TLorentzVector.h"
+#include "TClonesArray.h"
+
+#include <iostream>
+#include <set>
+
+using namespace std;
+
+
+//------------------------------------------------------------------------------
+
+class MadGraphJetParticleClassifier : public ExRootClassifier
+{
+public:
+
+  MadGraphJetParticleClassifier(TClonesArray *branch);
+
+  Int_t GetCategory(TObject *object);
+
+  void SetEtaMax(Double_t eta);
+  void InsertSpecialParticleID(Int_t pid);
+  void InsertExcludedAncestorID(Int_t pid);
+  void InsertExcludedParticleID(Int_t pid);
+  void SetHadronizationInfo(Bool_t info);
+
+private:
+
+  Bool_t hasBadAncestor(ExRootGenParticle *object);
+
+  Double_t fEtaMax;
+
+  TClonesArray *fBranchParticle;
+
+  set< Int_t > fSpecialParticleIDSet;
+  set< Int_t > fExcludedAncestorIDSet;
+  set< Int_t > fExcludedParticleIDSet;
+};
+
+//------------------------------------------------------------------------------
+
+MadGraphJetParticleClassifier::MadGraphJetParticleClassifier(TClonesArray *branch) :
+  fBranchParticle(branch)
+{
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphJetParticleClassifier::SetEtaMax(Double_t eta)
+{
+  fEtaMax = eta;
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphJetParticleClassifier::InsertSpecialParticleID(Int_t pid)
+{
+  fSpecialParticleIDSet.insert(pid);
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphJetParticleClassifier::InsertExcludedAncestorID(Int_t pid)
+{
+  fExcludedAncestorIDSet.insert(pid);
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphJetParticleClassifier::InsertExcludedParticleID(Int_t pid)
+{
+  fSpecialParticleIDSet.insert(pid);
+}
+
+//------------------------------------------------------------------------------
+
+Bool_t MadGraphJetParticleClassifier::hasBadAncestor(ExRootGenParticle *object)
+{
+  const int kMaxAncestors = 10;
+  Int_t i, pidAbs;
+  ExRootGenParticle *particle = object;
+  set< Int_t >::const_iterator itAncestorIDSet;
+  set< Int_t >::const_iterator itParticleIDSet;
+
+  for(i = 0; i < kMaxAncestors; ++i)
+  {
+    if(particle->M1 < 0) return kFALSE;
+
+    particle = static_cast<ExRootGenParticle*>(fBranchParticle->At(particle->M1));
+
+    pidAbs = TMath::Abs(particle->PID);
+
+    // skip particles with pid included in list
+    itAncestorIDSet = fExcludedAncestorIDSet.find(pidAbs);
+
+    if(itAncestorIDSet != fExcludedAncestorIDSet.end()) return kTRUE;
+  }
+
+  return kFALSE;
+}
+
+//------------------------------------------------------------------------------
+
+Int_t MadGraphJetParticleClassifier::GetCategory(TObject *object)
+{
+  ExRootGenParticle *particle = static_cast<ExRootGenParticle*>(object);
+
+  set< Int_t >::const_iterator itParticleIDSet;
+
+  Int_t pidAbs = TMath::Abs(particle->PID);
+  Double_t etaAbs = TMath::Abs(particle->Eta);
+
+  // skip beam particles and initial state partons
+  if(particle->M1 < 2) return -1;
+
+  if(etaAbs > fEtaMax) return -1;
+
+  if(particle->Status != 1) return -1;
+
+  // skip particles with pid included in list
+  itParticleIDSet = fExcludedParticleIDSet.find(pidAbs);
+
+  if(itParticleIDSet != fExcludedParticleIDSet.end()) return -1;
+
+  // check ancestors for particles with pid included in list
+  itParticleIDSet = fSpecialParticleIDSet.find(pidAbs);
+
+  if(itParticleIDSet != fSpecialParticleIDSet.end())
+  {
+    if(hasBadAncestor(particle)) return -1;
+  }
+
+  return 0;
+}
+
+//------------------------------------------------------------------------------
+
+MadGraphJetParticleSelector::MadGraphJetParticleSelector() :
+  fFilter(0), fClassifier(0)
+{
+}
+
+//------------------------------------------------------------------------------
+
+MadGraphJetParticleSelector::~MadGraphJetParticleSelector()
+{
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphJetParticleSelector::Init()
+{
+  ExRootConfParam param;
+
+  Int_t i, pid, sizeParam;
+
+  // import ROOT tree branch
+
+  fBranchParticle = UseBranch("GenParticle");
+
+  // create classifier and filter
+
+  fClassifier = new MadGraphJetParticleClassifier(fBranchParticle);
+  fFilter = new ExRootFilter(fBranchParticle);
+
+  fEtaMax = GetDouble("EtaMax", 5.0);
+  fClassifier->SetEtaMax(fEtaMax);
+
+  // read particle IDs from configuration file and setup classifier
+
+  param = GetParam("SpecialParticleIDs");
+  sizeParam = param.GetSize();
+
+  for(i = 0; i < sizeParam; ++i)
+  {
+    pid = param[i].GetInt();
+    fClassifier->InsertSpecialParticleID(pid);
+  }
+
+  // read ancestor IDs from configuration file and setup classifier
+
+  param = GetParam("ExcludedAncestorIDs");
+  sizeParam = param.GetSize();
+
+  for(i = 0; i < sizeParam; ++i)
+  {
+    pid = param[i].GetInt();
+    fClassifier->InsertExcludedAncestorID(pid);
+  }
+
+  // read particle IDs from configuration file and setup classifier
+
+  param = GetParam("ExcludedParticleIDs");
+  sizeParam = param.GetSize();
+
+  for(i = 0; i < sizeParam; ++i)
+  {
+    pid = param[i].GetInt();
+    fClassifier->InsertExcludedParticleID(pid);
+  }
+
+  // create output arrays
+
+  fOutputArray = ExportArray("candidates");
+
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphJetParticleSelector::Finish()
+{
+  if(fFilter) delete fFilter;
+  if(fClassifier) delete fClassifier;
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphJetParticleSelector::Process()
+{
+  TObjArray *array = 0;
+  ExRootGenParticle *particle = 0;
+  ExRootCandidate *candidate = 0;
+  ExRootFactory *factory = GetFactory();
+
+  TLorentzVector momentum;
+
+  fFilter->Reset();
+  array = fFilter->GetSubArray(fClassifier, 0);
+
+  if(array == 0) return;
+
+  TIter itArray(array);
+
+  while(particle = static_cast<ExRootGenParticle*>(itArray.Next()))
+  {
+    momentum.SetPxPyPzE(particle->Px, particle->Py, particle->Pz, particle->E);
+
+    candidate = factory->NewCandidate();
+
+    candidate->SetP4(momentum);
+    candidate->SetType(particle->PID);
+
+    fOutputArray->Add(candidate);
+  }
+
+/*
+  cout << "==============================" << endl;
+  Int_t indexParticle = -1;
+  itArray.Reset();
+  while(particle = static_cast<ExRootGenParticle*>(itArray.Next()))
+  {
+    ++indexParticle;
+    cout << "--->\t" << particle->Status << "\t" << particle->PID << "\t";
+    cout << particle->M1 << "\t" << particle->M2 << "\t";
+    cout << particle->Px << "\t" << particle->Py << "\t" << particle->Pz << endl;
+  }
+*/
+}
+
+//------------------------------------------------------------------------------
Index: /trunk/modules/MadGraphJetParticleSelector.h
===================================================================
--- /trunk/modules/MadGraphJetParticleSelector.h	(revision 2)
+++ /trunk/modules/MadGraphJetParticleSelector.h	(revision 2)
@@ -0,0 +1,37 @@
+#ifndef MadGraphJetParticleSelector_h
+#define MadGraphJetParticleSelector_h
+
+#include "ExRootAnalysis/ExRootModule.h"
+
+class TClonesArray;
+class TObjArray;
+
+class ExRootFilter;
+class MadGraphJetParticleClassifier;
+
+class MadGraphJetParticleSelector: public ExRootModule
+{
+public:
+
+  MadGraphJetParticleSelector();
+  ~MadGraphJetParticleSelector();
+
+  void Init();
+  void Process();
+  void Finish();
+
+private:
+
+  ExRootFilter *fFilter; //!
+  MadGraphJetParticleClassifier *fClassifier; //!
+
+  TClonesArray *fBranchParticle; //!
+
+  TObjArray *fOutputArray; //!
+  
+  Double_t fEtaMax;
+
+  ClassDef(MadGraphJetParticleSelector, 1)
+};
+
+#endif
Index: /trunk/modules/MadGraphKtJetFinder.cc
===================================================================
--- /trunk/modules/MadGraphKtJetFinder.cc	(revision 2)
+++ /trunk/modules/MadGraphKtJetFinder.cc	(revision 2)
@@ -0,0 +1,141 @@
+
+#include "modules/MadGraphKtJetFinder.h"
+
+#include "ExRootAnalysis/ExRootClasses.h"
+#include "ExRootAnalysis/ExRootFactory.h"
+#include "ExRootAnalysis/ExRootCandidate.h"
+
+#include "KtJet/KtEvent.h"
+#include "KtJet/KtLorentzVector.h"
+
+#include "TString.h"
+#include "TLorentzVector.h"
+
+#include <iostream>
+#include <vector>
+
+using namespace std;
+using namespace KtJet;
+
+//------------------------------------------------------------------------------
+
+MadGraphKtJetFinder::MadGraphKtJetFinder() :
+  fItInputArray(0)
+{
+
+}
+
+//------------------------------------------------------------------------------
+
+MadGraphKtJetFinder::~MadGraphKtJetFinder()
+{
+
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphKtJetFinder::Init()
+{
+
+  // define KtJet algorithm
+
+  fCollisionType = GetInt("CollisionType", 4); // PP
+  fDistanceScheme = GetInt("DistanceScheme", 1); // Angular
+  fRecombinationScheme = GetInt("RecombinationScheme", 1); // E
+  fParameterR = GetDouble("ParameterR", 1.0);
+
+  fIsExclusive = GetBool("Exclusive", false);
+  fECut = GetDouble("ECut", -1.0);
+  fDCut = GetDouble("DCut", 900.0);
+
+  fParticleNumberMin = GetInt("ParticleNumberMin", 1);
+
+  // import array with output from filter/classifier module
+
+  fInputArray = ImportArray(GetString("InputArray", "selection/candidates"));
+  fItInputArray = fInputArray->MakeIterator();
+
+  // create output arrays
+
+  fOutputArrayCandidates = ExportArray("candidates");
+  fOutputArrayMatching = ExportArray("matching");
+
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphKtJetFinder::Finish()
+{
+  if(fItInputArray) delete fItInputArray;
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphKtJetFinder::Process()
+{
+  ExRootCandidate *candidate;
+  ExRootMatching* matching;
+  TLorentzVector momentum;
+  KtEvent *event = 0;
+  Int_t entry;
+
+  if(fInputArray->GetEntriesFast() < fParticleNumberMin) return;
+
+  ExRootFactory *factory = GetFactory();
+
+  fTowersList.clear();
+
+  // loop over all particles in event and select stable ones
+  fItInputArray->Reset();
+  while((candidate = static_cast<ExRootCandidate*>(fItInputArray->Next())))
+  {
+     momentum = candidate->GetP4();
+     fTowersList.push_back(KtLorentzVector(momentum.Px(), momentum.Py(),
+                                           momentum.Pz(), momentum.E()));
+  }
+
+  // construct jets from a list of stable particles
+  if(fIsExclusive)
+  {
+    event = new KtEvent(fTowersList, fCollisionType, fDistanceScheme,
+                        fRecombinationScheme);
+
+    if(fECut > 0.0) event->setECut(fECut);
+    event->findJetsY(fDCut);
+  }
+  else
+  {
+    event = new KtEvent(fTowersList, fCollisionType, fDistanceScheme,
+                        fRecombinationScheme, fParameterR);
+
+  }
+
+  fJetsList.clear();
+  fJetsList = event->getJetsPt();
+
+  // loop over all jets and export them
+  vector<KtLorentzVector>::iterator itJet;
+  for(itJet = fJetsList.begin(), entry = 1; itJet != fJetsList.end(); ++itJet, ++entry)
+  {
+    momentum.SetPxPyPzE(itJet->px(), itJet->py(), itJet->pz(), itJet->e());
+
+    candidate = factory->NewCandidate();
+
+    candidate->SetP4(momentum);
+    candidate->SetName(Form("jet_{%d}", entry ));
+
+    fOutputArrayCandidates->Add(candidate);
+  }
+
+  for(entry = 0; entry < fTowersList.size(); ++entry)
+  {
+    matching = factory->New<ExRootMatching>();
+
+    matching->DMerge = event->getDMerge(entry);
+    matching->YMerge = event->getYMerge(entry);
+
+    fOutputArrayMatching->Add(matching);
+  }
+
+  if(event) delete event;
+}
Index: /trunk/modules/MadGraphKtJetFinder.h
===================================================================
--- /trunk/modules/MadGraphKtJetFinder.h	(revision 2)
+++ /trunk/modules/MadGraphKtJetFinder.h	(revision 2)
@@ -0,0 +1,47 @@
+#ifndef MadGraphKtJetFinder_h
+#define MadGraphKtJetFinder_h
+
+#include "ExRootAnalysis/ExRootModule.h"
+
+#include "KtJet/KtLorentzVector.h"
+
+#include <vector>
+
+class TObjArray;
+class TIterator;
+
+class MadGraphKtJetFinder: public ExRootModule
+{
+public:
+
+  MadGraphKtJetFinder();
+  ~MadGraphKtJetFinder();
+
+  void Init();
+  void Process();
+  void Finish();
+
+private:
+
+  Bool_t fIsExclusive;
+
+  Int_t fParticleNumberMin;
+
+  Double_t fParameterR, fECut, fDCut;
+
+  Int_t fCollisionType, fDistanceScheme, fRecombinationScheme;
+
+  std::vector<KtJet::KtLorentzVector> fTowersList; //!
+  std::vector<KtJet::KtLorentzVector> fJetsList; //!
+
+  TIterator *fItInputArray; //!
+
+  const TObjArray *fInputArray; //!
+
+  TObjArray *fOutputArrayCandidates; //!
+  TObjArray *fOutputArrayMatching; //!
+
+  ClassDef(MadGraphKtJetFinder, 1)
+};
+
+#endif
Index: /trunk/modules/MadGraphMatchingAnalysis.cc
===================================================================
--- /trunk/modules/MadGraphMatchingAnalysis.cc	(revision 2)
+++ /trunk/modules/MadGraphMatchingAnalysis.cc	(revision 2)
@@ -0,0 +1,144 @@
+
+#include "modules/MadGraphMatchingAnalysis.h"
+
+
+#include "ExRootAnalysis/ExRootResult.h"
+#include "ExRootAnalysis/ExRootClasses.h"
+
+#include "ExRootAnalysis/ExRootCandidate.h"
+
+#include "TClonesArray.h"
+
+#include "TH1.h"
+#include "TH2.h"
+#include "TString.h"
+#include "TCanvas.h"
+#include "TLorentzVector.h"
+
+#include <iostream>
+
+using namespace std;
+
+//------------------------------------------------------------------------------
+
+MadGraphMatchingAnalysis::MadGraphMatchingAnalysis()
+{
+}
+
+//------------------------------------------------------------------------------
+
+MadGraphMatchingAnalysis::~MadGraphMatchingAnalysis()
+{
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphMatchingAnalysis::Init()
+{
+  fOutputFileName = GetString("OutputFile", "matching_plots.root");
+
+  // import array with output from filter/classifier module
+
+  fInputArrayCandidates = ImportArray(GetString("InputArrayCandidates", "jetfinder/candidates"));
+
+  fInputArrayMatching = ImportArray(GetString("InputArrayMatching", "jetfinder/matching"));
+
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphMatchingAnalysis::Finish()
+{
+  GetPlots()->Write(fOutputFileName);
+
+  GetPlots()->GetCanvas()->SetLogy(1);
+  GetPlots()->Print();
+  GetPlots()->GetCanvas()->SetLogy(0);
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphMatchingAnalysis::Process()
+{
+  ExRootCandidate *candidate = 0;
+  ExRootMatching *matching = 0;
+  MatchingHistograms *histograms = 0;
+  Int_t maxEntry, entry;
+  TString name;
+
+  Double_t pt, signPz, rapidity;
+
+  // loop over jets
+  maxEntry = fInputArrayCandidates->GetEntriesFast();
+  for(entry = 0; entry < maxEntry; ++entry)
+  {
+    candidate = static_cast<ExRootCandidate*>(fInputArrayCandidates->At(entry));
+
+    const TLorentzVector &momentum = candidate->GetP4();
+
+    pt = momentum.Pt();
+    signPz = (momentum.Pz() >= 0.0) ? 1.0 : -1.0;
+    rapidity = (pt == 0.0 ? signPz*999.9 : momentum.Rapidity());
+  }
+  
+
+  // fill matching histograms
+  maxEntry = fInputArrayMatching->GetEntriesFast();
+  for(entry = 0; entry < maxEntry; ++entry)
+  {
+    matching = static_cast<ExRootMatching*>(fInputArrayMatching->At(entry));
+
+    name = Form("q_{%d #rightarrow %d}", entry + 1, entry);
+    histograms = GetMatchingHistograms(name);
+
+    histograms->fYMerge->Fill(TMath::Log10(matching->DMerge));
+  }
+
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphMatchingAnalysis::BookMatchingHistograms(MadGraphMatchingAnalysis::MatchingHistograms *histograms,
+                                                      const char *name, const char *title)
+{
+  ExRootResult *result = GetPlots();
+  histograms->fYMerge = result->AddHist1D(name, title, title,
+                                          "entries", 60, 0.0, 10.0, 0, 1);
+  histograms->fYMerge->SetStats(kTRUE);
+
+}
+
+//------------------------------------------------------------------------------
+
+MadGraphMatchingAnalysis::MatchingHistograms *
+MadGraphMatchingAnalysis::GetMatchingHistograms(const char *name)
+{
+  map<TString, MatchingHistograms *>::iterator itMatchingHistogramsMap;
+  MatchingHistograms *histograms = 0;
+  TString newName = Form("%s", name);
+  newName.ReplaceAll("{", "");
+  newName.ReplaceAll("}", "");
+  newName.ReplaceAll("^", "");
+  newName.ReplaceAll("#bar", "anti_");
+  newName.ReplaceAll("#rightarrow", "to");
+  newName.ReplaceAll("#", "");
+  newName.ReplaceAll(" ", "_");
+  TString title = Form("%s", name);
+  itMatchingHistogramsMap = fMatchingHistogramsMap.find(newName);
+  if(itMatchingHistogramsMap == fMatchingHistogramsMap.end())
+  {
+    histograms = new MatchingHistograms;
+
+    BookMatchingHistograms(histograms, newName, title);
+
+    fMatchingHistogramsMap[newName] = histograms;
+  }
+  else
+  {
+    histograms = itMatchingHistogramsMap->second;
+  }
+  return histograms;
+}
+
+//------------------------------------------------------------------------------
+
Index: /trunk/modules/MadGraphMatchingAnalysis.h
===================================================================
--- /trunk/modules/MadGraphMatchingAnalysis.h	(revision 2)
+++ /trunk/modules/MadGraphMatchingAnalysis.h	(revision 2)
@@ -0,0 +1,47 @@
+#ifndef MadGraphMatchingAnalysis_h
+#define MadGraphMatchingAnalysis_h
+
+#include "ExRootAnalysis/ExRootModule.h"
+
+#include "TString.h"
+
+#include <map>
+
+class TH1;
+class TObjArray;
+class TClonesArray;
+
+class MadGraphMatchingAnalysis: public ExRootModule
+{
+public:
+
+  MadGraphMatchingAnalysis();
+  ~MadGraphMatchingAnalysis();
+
+  void Init();
+  void Process();
+  void Finish();
+
+private:
+
+  struct MatchingHistograms
+  {
+    TH1 *fYMerge;
+  };
+
+  void BookMatchingHistograms(MatchingHistograms *histograms,
+                              const char *name, const char *title);
+
+  MatchingHistograms *GetMatchingHistograms(const char *name);
+
+  TString fOutputFileName; //!
+
+  const TObjArray *fInputArrayCandidates; //!
+  const TObjArray *fInputArrayMatching; //!
+
+  std::map<TString, MatchingHistograms *> fMatchingHistogramsMap; //!
+
+  ClassDef(MadGraphMatchingAnalysis, 1)
+};
+
+#endif
Index: /trunk/modules/MadGraphMatchingTreeWriter.cc
===================================================================
--- /trunk/modules/MadGraphMatchingTreeWriter.cc	(revision 2)
+++ /trunk/modules/MadGraphMatchingTreeWriter.cc	(revision 2)
@@ -0,0 +1,181 @@
+
+#include "modules/MadGraphMatchingTreeWriter.h"
+
+
+#include "ExRootAnalysis/ExRootResult.h"
+#include "ExRootAnalysis/ExRootClasses.h"
+#include "ExRootAnalysis/ExRootTreeBranch.h"
+
+#include "ExRootAnalysis/ExRootCandidate.h"
+
+#include "TClonesArray.h"
+
+#include "TH1.h"
+#include "TH2.h"
+#include "TString.h"
+#include "TCanvas.h"
+#include "TLorentzVector.h"
+
+#include <iostream>
+
+using namespace std;
+
+//------------------------------------------------------------------------------
+
+MadGraphMatchingTreeWriter::MadGraphMatchingTreeWriter()
+{
+}
+
+//------------------------------------------------------------------------------
+
+MadGraphMatchingTreeWriter::~MadGraphMatchingTreeWriter()
+{
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphMatchingTreeWriter::Init()
+{
+  fJetPTMin = GetDouble("JetPTMin", 20.0);
+  fJetEtaMax = GetDouble("JetEtaMax", 4.5);
+
+  // import array with output from filter/classifier/jetfinder modules
+
+  fInputArrayPartonJets = ImportArray(GetString("InputArrayPartonJets", "partonjetfinder/candidates"));
+  fItInputArrayPartonJets = fInputArrayPartonJets->MakeIterator();
+
+  fInputArrayHadronJets = ImportArray(GetString("InputArrayHadronJets", "hadronjetfinder/candidates"));
+  fItInputArrayHadronJets = fInputArrayHadronJets->MakeIterator();
+
+  fInputArrayMatching = ImportArray(GetString("InputArrayMatching", "partonjetfinder/matching"));
+  fItInputArrayMatching = fInputArrayMatching->MakeIterator();
+
+  fInputArrayPartons = ImportArray(GetString("InputArrayPartons", "initstateselection/candidates"));
+  fItInputArrayPartons = fInputArrayPartons->MakeIterator();
+
+  fBranchPartonJets = NewBranch("PartonJet", ExRootGenJet::Class());
+  fBranchHadronJets = NewBranch("HadronJet", ExRootGenJet::Class());
+  fBranchMatching = NewBranch("Match", ExRootMatching::Class());
+  fBranchPartons = NewBranch("Parton", ExRootGenParticle::Class());
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphMatchingTreeWriter::Finish()
+{
+  if(fItInputArrayPartonJets) delete fItInputArrayPartonJets;
+  if(fItInputArrayHadronJets) delete fItInputArrayHadronJets;
+  if(fItInputArrayMatching) delete fItInputArrayMatching;
+  if(fItInputArrayPartons) delete fItInputArrayPartons;
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphMatchingTreeWriter::Process()
+{
+  ExRootCandidate *candidate = 0;
+  ExRootGenParticle *entryParton = 0;
+  ExRootMatching *matching = 0, *entryMatching = 0;
+  ExRootGenJet *entryJet = 0;
+  Double_t pt, signPz, eta, rapidity;
+
+  // loop over all parton jets
+  fItInputArrayPartonJets->Reset();
+  while((candidate = static_cast<ExRootCandidate*>(fItInputArrayPartonJets->Next())))
+  {
+    const TLorentzVector &momentum = candidate->GetP4();
+
+    pt = momentum.Pt();
+    signPz = (momentum.Pz() >= 0.0) ? 1.0 : -1.0;
+    eta = (pt == 0.0 ? signPz*999.9 : momentum.Eta());
+    rapidity = (pt == 0.0 ? signPz*999.9 : momentum.Rapidity());
+
+    if(pt < fJetPTMin) continue;
+    if(TMath::Abs(eta) > fJetEtaMax) continue;
+
+    entryJet = static_cast<ExRootGenJet*>(fBranchPartonJets->NewEntry());
+
+    entryJet->E = momentum.E();
+    entryJet->Px = momentum.Px();
+    entryJet->Py = momentum.Py();
+    entryJet->Pz = momentum.Pz();
+
+    entryJet->Eta = eta;
+    entryJet->Phi = momentum.Phi();
+    entryJet->PT = pt;
+
+    entryJet->Rapidity = rapidity;
+
+    entryJet->Mass = momentum.M();
+  }
+
+  // loop over all hadron jets
+  fItInputArrayHadronJets->Reset();
+  while((candidate = static_cast<ExRootCandidate*>(fItInputArrayHadronJets->Next())))
+  {
+    const TLorentzVector &momentum = candidate->GetP4();
+
+    pt = momentum.Pt();
+    signPz = (momentum.Pz() >= 0.0) ? 1.0 : -1.0;
+    eta = (pt == 0.0 ? signPz*999.9 : momentum.Eta());
+    rapidity = (pt == 0.0 ? signPz*999.9 : momentum.Rapidity());
+
+    if(pt < fJetPTMin) continue;
+    if(TMath::Abs(eta) > fJetEtaMax) continue;
+
+    entryJet = static_cast<ExRootGenJet*>(fBranchHadronJets->NewEntry());
+
+    entryJet->E = momentum.E();
+    entryJet->Px = momentum.Px();
+    entryJet->Py = momentum.Py();
+    entryJet->Pz = momentum.Pz();
+
+    entryJet->Eta = eta;
+    entryJet->Phi = momentum.Phi();
+    entryJet->PT = pt;
+
+    entryJet->Rapidity = rapidity;
+
+    entryJet->Mass = momentum.M();
+  }
+
+  // loop over all matching
+  fItInputArrayMatching->Reset();
+  while((matching = static_cast<ExRootMatching*>(fItInputArrayMatching->Next())))
+  {
+    entryMatching = static_cast<ExRootMatching*>(fBranchMatching->NewEntry());
+
+    entryMatching->DMerge = matching->DMerge;
+    entryMatching->YMerge = matching->YMerge;
+  }
+
+  // loop over all partons
+  fItInputArrayPartons->Reset();
+  while((candidate = static_cast<ExRootCandidate*>(fItInputArrayPartons->Next())))
+  {
+    const TLorentzVector &momentum = candidate->GetP4();
+
+    entryParton = static_cast<ExRootGenParticle*>(fBranchPartons->NewEntry());
+
+    pt = momentum.Pt();
+    signPz = (momentum.Pz() >= 0.0) ? 1.0 : -1.0;
+    eta = (pt == 0.0 ? signPz*999.9 : momentum.Eta());
+    rapidity = (pt == 0.0 ? signPz*999.9 : momentum.Rapidity());
+
+    entryParton->PID = candidate->GetType()->PdgCode();
+
+    entryParton->E = momentum.E();
+    entryParton->Px = momentum.Px();
+    entryParton->Py = momentum.Py();
+    entryParton->Pz = momentum.Pz();
+
+    entryParton->Eta = eta;
+    entryParton->Phi = momentum.Phi();
+    entryParton->PT = pt;
+
+    entryParton->Rapidity = rapidity;
+  }
+}
+
+//------------------------------------------------------------------------------
+
Index: /trunk/modules/MadGraphMatchingTreeWriter.h
===================================================================
--- /trunk/modules/MadGraphMatchingTreeWriter.h	(revision 2)
+++ /trunk/modules/MadGraphMatchingTreeWriter.h	(revision 2)
@@ -0,0 +1,48 @@
+#ifndef MadGraphMatchingTreeWriter_h
+#define MadGraphMatchingTreeWriter_h
+
+#include "ExRootAnalysis/ExRootModule.h"
+
+#include "TString.h"
+
+#include <map>
+
+class TH1;
+class TIterator;
+class TObjArray;
+class TClonesArray;
+
+class MadGraphMatchingTreeWriter: public ExRootModule
+{
+public:
+
+  MadGraphMatchingTreeWriter();
+  ~MadGraphMatchingTreeWriter();
+
+  void Init();
+  void Process();
+  void Finish();
+
+private:
+
+  Double_t fJetPTMin, fJetEtaMax;
+
+  const TObjArray *fInputArrayPartonJets; //!
+  const TObjArray *fInputArrayHadronJets; //!
+  const TObjArray *fInputArrayMatching; //!
+  const TObjArray *fInputArrayPartons; //!
+
+  TIterator *fItInputArrayPartonJets; //!
+  TIterator *fItInputArrayHadronJets; //!
+  TIterator *fItInputArrayMatching; //!
+  TIterator *fItInputArrayPartons; //!
+  
+  ExRootTreeBranch *fBranchPartonJets; //!
+  ExRootTreeBranch *fBranchHadronJets; //!
+  ExRootTreeBranch *fBranchMatching; //!
+  ExRootTreeBranch *fBranchPartons; //!
+
+  ClassDef(MadGraphMatchingTreeWriter, 1)
+};
+
+#endif
Index: /trunk/modules/MadGraphParticleClassifier.cc
===================================================================
--- /trunk/modules/MadGraphParticleClassifier.cc	(revision 2)
+++ /trunk/modules/MadGraphParticleClassifier.cc	(revision 2)
@@ -0,0 +1,118 @@
+
+#include "modules/MadGraphParticleClassifier.h"
+
+#include "ExRootAnalysis/ExRootClasses.h"
+
+#include "TClass.h"
+
+#include <iostream>
+
+using namespace std;
+
+//------------------------------------------------------------------------------
+
+MadGraphParticleClassifier::MadGraphParticleClassifier() :
+  fMaxCategories(0), fIsExtendable(kFALSE)
+{
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphParticleClassifier::InsertParticleStatus(Int_t status)
+{
+  fParticleStatusSet.insert(status);
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphParticleClassifier::InsertClassPID(const TString &className, Int_t pid)
+{
+  Int_t category;
+  map< TString, Int_t >::const_iterator itClassNameMap;
+
+  itClassNameMap = fClassNameMap.find(className);
+  
+  if(itClassNameMap == fClassNameMap.end())
+  {
+    category = fMaxCategories;
+    fClassNameMap[className] = category;
+    fClassNameArray.push_back(className);
+    ++fMaxCategories;
+  }
+  else
+  {
+    category = itClassNameMap->second;
+  }
+  fParticleIDMap[pid] = category;
+}
+
+//------------------------------------------------------------------------------
+
+Int_t MadGraphParticleClassifier::GetCategory(TObject *object)
+{
+  Int_t pidAbs, pid, status;
+  Int_t result = -1;
+
+  if(object->IsA()->InheritsFrom(ExRootLHEFParticle::Class()))
+  {
+    ExRootLHEFParticle *particle = static_cast<ExRootLHEFParticle*>(object);
+    pid = particle->PID;
+    status = particle->Status;
+  }
+  else if(object->IsA()->InheritsFrom(ExRootGenParticle::Class()))
+  {
+    ExRootGenParticle *particle = static_cast<ExRootGenParticle*>(object);
+    pid = particle->PID;
+    status = particle->Status;
+  }
+  else
+  {
+    return -1;
+  }
+
+  map< Int_t, Int_t >::const_iterator itParticleIDMap;
+
+  TString className;
+
+  if(fParticleStatusSet.find(status) == fParticleStatusSet.end()) return -1;
+
+  itParticleIDMap = fParticleIDMap.find(pid);
+
+  if(itParticleIDMap != fParticleIDMap.end())
+  {
+    result = itParticleIDMap->second;
+  }
+  else if(fIsExtendable)
+  {
+    pidAbs = TMath::Abs(pid);
+    className = Form("%d", pidAbs);
+    result = fMaxCategories;
+    InsertClassPID(className, pidAbs);
+    InsertClassPID(className, -pidAbs);
+  }
+
+  return result;
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphParticleClassifier::SetExtendable(Bool_t extendable)
+{
+  fIsExtendable = extendable;
+}
+
+//------------------------------------------------------------------------------
+
+Int_t MadGraphParticleClassifier::GetMaxCategories() const
+{
+  return fMaxCategories;
+}
+
+//------------------------------------------------------------------------------
+
+TString MadGraphParticleClassifier::GetCategoryClassName(Int_t category) const
+{
+  return fClassNameArray[category];
+}
+
+//------------------------------------------------------------------------------
Index: /trunk/modules/MadGraphParticleClassifier.h
===================================================================
--- /trunk/modules/MadGraphParticleClassifier.h	(revision 2)
+++ /trunk/modules/MadGraphParticleClassifier.h	(revision 2)
@@ -0,0 +1,40 @@
+#ifndef MadGraphParticleClassifier_h
+#define MadGraphParticleClassifier_h
+
+#include "ExRootAnalysis/ExRootClassifier.h"
+
+#include <map>
+#include <set>
+#include <deque>
+
+#include "TString.h"
+
+class TObject;
+
+class MadGraphParticleClassifier : public ExRootClassifier
+{
+public:
+
+  MadGraphParticleClassifier();
+
+  void InsertParticleStatus(Int_t status);
+  void InsertClassPID(const TString &className, Int_t pid);
+  void SetExtendable(Bool_t extendable);
+
+  Int_t GetCategory(TObject *object);
+  Int_t GetMaxCategories() const;
+  TString GetCategoryClassName(Int_t category) const;
+
+private:
+
+  std::map< Int_t, Int_t > fParticleIDMap;
+  std::map< TString, Int_t > fClassNameMap;
+  std::deque< TString > fClassNameArray;
+  std::set< Int_t > fParticleStatusSet;
+
+  Int_t fMaxCategories;
+  
+  Bool_t fIsExtendable;
+};
+
+#endif
Index: /trunk/modules/MadGraphPartonSelector.cc
===================================================================
--- /trunk/modules/MadGraphPartonSelector.cc	(revision 2)
+++ /trunk/modules/MadGraphPartonSelector.cc	(revision 2)
@@ -0,0 +1,248 @@
+
+#include "modules/MadGraphPartonSelector.h"
+
+
+#include "ExRootAnalysis/ExRootResult.h"
+#include "ExRootAnalysis/ExRootClasses.h"
+
+#include "ExRootAnalysis/ExRootFilter.h"
+#include "ExRootAnalysis/ExRootClassifier.h"
+
+#include "ExRootAnalysis/ExRootFactory.h"
+#include "ExRootAnalysis/ExRootCandidate.h"
+
+#include "TMath.h"
+#include "TString.h"
+#include "TLorentzVector.h"
+#include "TClonesArray.h"
+
+#include <iostream>
+#include <set>
+
+using namespace std;
+
+//------------------------------------------------------------------------------
+
+class MadGraphPartonClassifier : public ExRootClassifier
+{
+public:
+
+  MadGraphPartonClassifier(TClonesArray *branch);
+
+  Int_t GetCategory(TObject *object);
+
+  void InsertParticleID(Int_t pid);
+  void InsertAncestorID(Int_t pid);
+
+private:
+
+  Bool_t hasBadAncestor(ExRootGenParticle *object);
+
+  TClonesArray *fBranchParticle;
+
+  set< Int_t > fParticleIDSet;
+  set< Int_t > fAncestorIDSet;
+};
+
+//------------------------------------------------------------------------------
+
+MadGraphPartonClassifier::MadGraphPartonClassifier(TClonesArray *branch) :
+  fBranchParticle(branch)
+{
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphPartonClassifier::InsertParticleID(Int_t pid)
+{
+  fParticleIDSet.insert(pid);
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphPartonClassifier::InsertAncestorID(Int_t pid)
+{
+  fAncestorIDSet.insert(pid);
+}
+
+//------------------------------------------------------------------------------
+
+Bool_t MadGraphPartonClassifier::hasBadAncestor(ExRootGenParticle *object)
+{
+  const int kMaxAncestors = 10;
+  Int_t i, pidAbs;
+  ExRootGenParticle *particle = object;
+  set< Int_t >::const_iterator itAncestorIDSet;
+  set< Int_t >::const_iterator itParticleIDSet;
+
+  for(i = 0; i < kMaxAncestors; ++i)
+  {
+
+    if(particle->M1 < 0 || particle->M2 > -1) return kFALSE;
+
+//    if(particle->PID == 21) return kFALSE;
+
+    particle = static_cast<ExRootGenParticle*>(fBranchParticle->At(particle->M1));
+
+    if(particle->PID == 21) return kFALSE;
+
+    pidAbs = TMath::Abs(particle->PID);
+
+    // skip particles with pid included in list
+    itAncestorIDSet = fAncestorIDSet.find(pidAbs);
+
+    if(itAncestorIDSet != fAncestorIDSet.end()) return kTRUE;
+  }
+
+  return kFALSE;
+}
+
+//------------------------------------------------------------------------------
+
+Int_t MadGraphPartonClassifier::GetCategory(TObject *object)
+{
+  ExRootGenParticle *particle = static_cast<ExRootGenParticle*>(object);
+  ExRootGenParticle *beam[2], *mother, *daughter;
+
+  Int_t i, beamPid[2], beamPidAbs[2];
+
+  set< Int_t >::const_iterator itParticleIDSet;
+
+  Int_t pidAbs = TMath::Abs(particle->PID);
+
+  // skip beam particles and initial state partons
+  if(particle->M1 < 2) return -1;
+
+  // skip particles with status != 3
+  if(particle->Status != 3) return -1;
+
+  // skip particles with pid not included in list
+  itParticleIDSet = fParticleIDSet.find(pidAbs);
+
+  if(itParticleIDSet == fParticleIDSet.end()) return -1;
+
+  for(i = 0; i < 2; ++i)
+  {
+    beam[i] = static_cast<ExRootGenParticle*>(fBranchParticle->At(i));
+    beamPid[i] = beam[i]->PID;
+    beamPidAbs[i] = TMath::Abs(beamPid[i]);
+  }
+
+  if(beamPidAbs[0] == 11 && beamPidAbs[1] == 11 && beamPid[0] == -beamPid[1])
+  {
+    mother = static_cast<ExRootGenParticle*>(fBranchParticle->At(particle->M1));
+    if( (mother->PID == 22 || mother->PID == 23)
+      && mother->M1 == 0 && mother->M2 == 1) return -1;
+  }
+
+  // skip particles if they have daughters with status == 3
+  if(particle->D1 > -1)
+  {
+    daughter = static_cast<ExRootGenParticle*>(fBranchParticle->At(particle->D1));
+    if(daughter->Status == 3) return -1;
+  }
+
+  if(hasBadAncestor(particle)) return -1;
+
+  return 0;
+}
+
+//------------------------------------------------------------------------------
+
+MadGraphPartonSelector::MadGraphPartonSelector() :
+  fFilter(0), fClassifier(0)
+{
+}
+
+//------------------------------------------------------------------------------
+
+MadGraphPartonSelector::~MadGraphPartonSelector()
+{
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphPartonSelector::Init()
+{
+  ExRootConfParam param;
+
+  Int_t i, pid, sizeParam;
+
+  // import ROOT tree branch
+
+  fBranchParticle = UseBranch("GenParticle");
+
+  // create classifier and filter
+
+  fClassifier = new MadGraphPartonClassifier(fBranchParticle);
+  fFilter = new ExRootFilter(fBranchParticle);
+
+  // read particle IDs from configuration file and setup classifier
+
+  param = GetParam("PartonIDs");
+  sizeParam = param.GetSize();
+
+  for(i = 0; i < sizeParam; ++i)
+  {
+    pid = param[i].GetInt();
+    fClassifier->InsertParticleID(pid);
+  }
+
+  // read ancestor IDs from configuration file and setup classifier
+
+  param = GetParam("ExcludedAncestorIDs");
+  sizeParam = param.GetSize();
+
+  for(i = 0; i < sizeParam; ++i)
+  {
+    pid = param[i].GetInt();
+    fClassifier->InsertAncestorID(pid);
+  }
+
+  // create output arrays
+
+  fOutputArray = ExportArray("candidates");
+
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphPartonSelector::Finish()
+{ 
+  if(fFilter) delete fFilter;
+  if(fClassifier) delete fClassifier;
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphPartonSelector::Process()
+{
+  TObjArray *array = 0;
+  ExRootGenParticle *particle = 0;
+  ExRootCandidate *candidate = 0;
+  ExRootFactory *factory = GetFactory();
+
+  TLorentzVector momentum;
+
+  fFilter->Reset();
+  array = fFilter->GetSubArray(fClassifier, 0);
+
+  if(array == 0) return;
+
+  TIter itArray(array);
+
+  while(particle = static_cast<ExRootGenParticle*>(itArray.Next()))
+  {
+    momentum.SetPxPyPzE(particle->Px, particle->Py, particle->Pz, particle->E);
+
+    candidate = factory->NewCandidate();
+
+    candidate->SetP4(momentum);
+    candidate->SetType(particle->PID);
+
+    fOutputArray->Add(candidate);
+  }
+
+}
+
+//------------------------------------------------------------------------------
Index: /trunk/modules/MadGraphPartonSelector.h
===================================================================
--- /trunk/modules/MadGraphPartonSelector.h	(revision 2)
+++ /trunk/modules/MadGraphPartonSelector.h	(revision 2)
@@ -0,0 +1,35 @@
+#ifndef MadGraphPartonSelector_h
+#define MadGraphPartonSelector_h
+
+#include "ExRootAnalysis/ExRootModule.h"
+
+class TClonesArray;
+class TObjArray;
+
+class ExRootFilter;
+class MadGraphPartonClassifier;
+
+class MadGraphPartonSelector: public ExRootModule
+{
+public:
+
+  MadGraphPartonSelector();
+  ~MadGraphPartonSelector();
+
+  void Init();
+  void Process();
+  void Finish();
+
+private:
+
+  ExRootFilter *fFilter; //!
+  MadGraphPartonClassifier *fClassifier; //!
+
+  TClonesArray *fBranchParticle; //!
+
+  TObjArray *fOutputArray; //!
+
+  ClassDef(MadGraphPartonSelector, 1)
+};
+
+#endif
Index: /trunk/modules/MadGraphShowerLeptonSelector.cc
===================================================================
--- /trunk/modules/MadGraphShowerLeptonSelector.cc	(revision 2)
+++ /trunk/modules/MadGraphShowerLeptonSelector.cc	(revision 2)
@@ -0,0 +1,155 @@
+
+#include "modules/MadGraphShowerLeptonSelector.h"
+
+#include "modules/MadGraphParticleClassifier.h"
+
+#include "ExRootAnalysis/ExRootClasses.h"
+#include "ExRootAnalysis/ExRootFilter.h"
+
+#include "ExRootAnalysis/ExRootFactory.h"
+#include "ExRootAnalysis/ExRootCandidate.h"
+
+#include "TMath.h"
+#include "TString.h"
+#include "TLorentzVector.h"
+#include "TClonesArray.h"
+
+#include <iostream>
+#include <set>
+
+using namespace std;
+
+//------------------------------------------------------------------------------
+
+MadGraphShowerLeptonSelector::MadGraphShowerLeptonSelector() :
+  fFilter(0), fClassifier(0)
+{
+}
+
+//------------------------------------------------------------------------------
+
+MadGraphShowerLeptonSelector::~MadGraphShowerLeptonSelector()
+{
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphShowerLeptonSelector::Init()
+{
+  TString className;
+  ExRootConfParam param, classParticles;
+
+  Int_t i, j, status, pid, sizeParam, sizeParticles;
+
+  // import ROOT tree branch
+
+  fBranchParticle = UseBranch("GenParticle");
+
+  // create classifier and filter
+
+  fClassifier = new MadGraphParticleClassifier();
+  fFilter = new ExRootFilter(fBranchParticle);
+
+  // read particle status from configuration file and setup classifier
+
+  param = GetParam("ParticleStatus");
+  sizeParam = param.GetSize();
+
+  for(i = 0; i < sizeParam; ++i)
+  {
+    status = param[i].GetInt();
+    fClassifier->InsertParticleStatus(status);
+  }
+
+  // read particle classes from configuration file and setup classifier
+
+  param = GetParam("ClassParticles");
+  sizeParam = param.GetSize();
+
+  for(i = 0; i < sizeParam/2; ++i)
+  {
+    className = param[i*2].GetString();
+    classParticles = param[i*2 + 1];
+    sizeParticles = classParticles.GetSize();
+
+    for(j = 0; j < sizeParticles; ++j)
+    {
+      pid = classParticles[j].GetInt();
+      fClassifier->InsertClassPID(className, pid);
+    }
+  }
+
+  fClassifier->SetExtendable(kFALSE);
+
+  // create output arrays
+
+  fOutputArray = ExportArray("candidates");
+
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphShowerLeptonSelector::Finish()
+{ 
+  if(fFilter) delete fFilter;
+  if(fClassifier) delete fClassifier;
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphShowerLeptonSelector::Process()
+{
+  TObjArray *array = 0;
+  ExRootGenParticle *parent = 0, *particle = 0;
+  ExRootCandidate *candidate = 0;
+  ExRootFactory *factory = GetFactory();
+
+  Int_t category, entry;
+  TString name;
+  TLorentzVector momentum;
+
+  fFilter->Reset();
+
+  // make filter classify particles and fill all subarrays
+  // at this point classifier creates additional/missing classes
+  fFilter->GetSubArray(fClassifier, 0);
+
+  // loop over all classes and export class names and classified particles
+  for(category = 0; category < fClassifier->GetMaxCategories(); ++category)
+  {
+    array = fFilter->GetSubArray(fClassifier, category);
+    name = fClassifier->GetCategoryClassName(category);
+
+    if(array == 0) continue;
+
+    // sort particles by PT
+    ExRootGenParticle::fgCompare = ExRootComparePT<ExRootGenParticle>::Instance();
+    array->Sort();
+
+    entry = 1;
+
+    TIter itArray(array);
+
+    while(particle = static_cast<ExRootGenParticle*>(itArray.Next()))
+    {
+      if(particle->M1 < 0) continue;
+      
+      parent = static_cast<ExRootGenParticle*>(fBranchParticle->At(particle->M1));
+
+      if(parent == 0 || parent->Status != 3) continue;
+
+      momentum.SetPxPyPzE(particle->Px, particle->Py, particle->Pz, particle->E);
+
+      candidate = factory->NewCandidate();
+
+      candidate->SetP4(momentum);
+      candidate->SetName(Form("%s_{%d}", name.Data(), entry ));
+
+      fOutputArray->Add(candidate);
+
+      ++entry;
+    }
+  }
+}
+//------------------------------------------------------------------------------
+
Index: /trunk/modules/MadGraphShowerLeptonSelector.h
===================================================================
--- /trunk/modules/MadGraphShowerLeptonSelector.h	(revision 2)
+++ /trunk/modules/MadGraphShowerLeptonSelector.h	(revision 2)
@@ -0,0 +1,35 @@
+#ifndef MadGraphShowerLeptonSelector_h
+#define MadGraphShowerLeptonSelector_h
+
+#include "ExRootAnalysis/ExRootModule.h"
+
+class TClonesArray;
+class TObjArray;
+
+class ExRootFilter;
+class MadGraphParticleClassifier;
+
+class MadGraphShowerLeptonSelector: public ExRootModule
+{
+public:
+
+  MadGraphShowerLeptonSelector();
+  ~MadGraphShowerLeptonSelector();
+
+  void Init();
+  void Process();
+  void Finish();
+
+private:
+
+  ExRootFilter *fFilter; //!
+  MadGraphParticleClassifier *fClassifier; //!
+
+  TClonesArray *fBranchParticle; //!
+
+  TObjArray *fOutputArray; //!
+
+  ClassDef(MadGraphShowerLeptonSelector, 1)
+};
+
+#endif
Index: /trunk/modules/MadGraphShowerPartonSelector.cc
===================================================================
--- /trunk/modules/MadGraphShowerPartonSelector.cc	(revision 2)
+++ /trunk/modules/MadGraphShowerPartonSelector.cc	(revision 2)
@@ -0,0 +1,277 @@
+
+#include "modules/MadGraphShowerPartonSelector.h"
+
+
+#include "ExRootAnalysis/ExRootResult.h"
+#include "ExRootAnalysis/ExRootClasses.h"
+
+#include "ExRootAnalysis/ExRootFilter.h"
+#include "ExRootAnalysis/ExRootClassifier.h"
+
+#include "ExRootAnalysis/ExRootFactory.h"
+#include "ExRootAnalysis/ExRootCandidate.h"
+
+#include "TMath.h"
+#include "TString.h"
+#include "TLorentzVector.h"
+#include "TClonesArray.h"
+
+#include <iostream>
+#include <set>
+
+using namespace std;
+
+
+//------------------------------------------------------------------------------
+
+class MadGraphShowerPartonClassifier : public ExRootClassifier
+{
+public:
+
+  MadGraphShowerPartonClassifier(TClonesArray *branch);
+
+  Int_t GetCategory(TObject *object);
+
+  void SetEtaMax(Double_t eta);
+  void InsertParticleID(Int_t pid);
+  void InsertAncestorID(Int_t pid);
+  void SetHadronizationInfo(Bool_t info);
+
+private:
+
+  Bool_t hasBadAncestor(ExRootGenParticle *object);
+
+  Double_t fEtaMax;
+
+  TClonesArray *fBranchParticle;
+
+  set< Int_t > fParticleIDSet;
+  set< Int_t > fAncestorIDSet;
+};
+
+//------------------------------------------------------------------------------
+
+MadGraphShowerPartonClassifier::MadGraphShowerPartonClassifier(TClonesArray *branch) :
+  fBranchParticle(branch)
+{
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphShowerPartonClassifier::SetEtaMax(Double_t eta)
+{
+  fEtaMax = eta;
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphShowerPartonClassifier::InsertParticleID(Int_t pid)
+{
+  fParticleIDSet.insert(pid);
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphShowerPartonClassifier::InsertAncestorID(Int_t pid)
+{
+  fAncestorIDSet.insert(pid);
+}
+
+//------------------------------------------------------------------------------
+
+Bool_t MadGraphShowerPartonClassifier::hasBadAncestor(ExRootGenParticle *object)
+{
+  const int kMaxAncestors = 10;
+  Int_t i, pidAbs;
+  ExRootGenParticle *particle = object;
+  set< Int_t >::const_iterator itAncestorIDSet;
+
+  for(i = 0; i < kMaxAncestors && particle->Status != 3; ++i)
+  {
+    if(particle->M1 < 0) return kFALSE;
+
+    particle = static_cast<ExRootGenParticle*>(fBranchParticle->At(particle->M1));
+  }
+
+  if(particle->PID == 21) return kFALSE;
+
+  pidAbs = TMath::Abs(particle->PID);
+
+  // skip particles with pid included in list
+  itAncestorIDSet = fAncestorIDSet.find(pidAbs);
+
+  if(itAncestorIDSet != fAncestorIDSet.end()) return kTRUE;
+  if(particle->M2 > -1) return kFALSE;
+
+  for(i = 0; i < kMaxAncestors; ++i)
+  {
+    if(particle->M1 < 0) return kFALSE;
+
+    if(particle->PID == 21) return kFALSE;
+
+    particle = static_cast<ExRootGenParticle*>(fBranchParticle->At(particle->M1));
+
+    pidAbs = TMath::Abs(particle->PID);
+
+    // skip particles with pid included in list
+    itAncestorIDSet = fAncestorIDSet.find(pidAbs);
+
+    if(itAncestorIDSet != fAncestorIDSet.end()) return kTRUE;
+    if(particle->M2 > -1) return kFALSE;
+  }
+
+  return kFALSE;
+}
+
+//------------------------------------------------------------------------------
+
+Int_t MadGraphShowerPartonClassifier::GetCategory(TObject *object)
+{
+  ExRootGenParticle *particle = static_cast<ExRootGenParticle*>(object);
+  ExRootGenParticle *daughter;
+
+  set< Int_t >::const_iterator itParticleIDSet;
+
+  Int_t pidAbs = TMath::Abs(particle->PID);
+  Double_t etaAbs = TMath::Abs(particle->Eta);
+
+  // skip beam particles and initial state partons
+  if(particle->M1 < 2) return -1;
+
+  // skip particles with pid not included in list
+  itParticleIDSet = fParticleIDSet.find(pidAbs);
+
+  if(itParticleIDSet == fParticleIDSet.end() || etaAbs > fEtaMax) return -1;
+
+  // with hadronization
+  if(particle->Status == 2)
+  {
+    // skip particles if they do not form a string
+    if(particle->D1 > -1)
+    {
+      daughter = static_cast<ExRootGenParticle*>(fBranchParticle->At(particle->D1));
+      if(daughter->PID != 92) return -1;
+    }
+  }
+  // without hadronization
+  else if(particle->Status != 1) return -1;
+
+  if(hasBadAncestor(particle)) return -1;
+
+  return 0;
+}
+
+//------------------------------------------------------------------------------
+
+MadGraphShowerPartonSelector::MadGraphShowerPartonSelector() :
+  fFilter(0), fClassifier(0)
+{
+}
+
+//------------------------------------------------------------------------------
+
+MadGraphShowerPartonSelector::~MadGraphShowerPartonSelector()
+{
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphShowerPartonSelector::Init()
+{
+  ExRootConfParam param;
+
+  Int_t i, pid, sizeParam;
+
+  // import ROOT tree branch
+
+  fBranchParticle = UseBranch("GenParticle");
+
+  // create classifier and filter
+
+  fClassifier = new MadGraphShowerPartonClassifier(fBranchParticle);
+  fFilter = new ExRootFilter(fBranchParticle);
+
+  fEtaMax = GetDouble("EtaMax", 5.0);
+  fClassifier->SetEtaMax(fEtaMax);
+
+  // read particle IDs from configuration file and setup classifier
+
+  param = GetParam("PartonIDs");
+  sizeParam = param.GetSize();
+
+  for(i = 0; i < sizeParam; ++i)
+  {
+    pid = param[i].GetInt();
+    fClassifier->InsertParticleID(pid);
+  }
+
+  // read ancestor IDs from configuration file and setup classifier
+
+  param = GetParam("ExcludedAncestorIDs");
+  sizeParam = param.GetSize();
+
+  for(i = 0; i < sizeParam; ++i)
+  {
+    pid = param[i].GetInt();
+    fClassifier->InsertAncestorID(pid);
+  }
+
+  // create output arrays
+
+  fOutputArray = ExportArray("candidates");
+
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphShowerPartonSelector::Finish()
+{
+  if(fFilter) delete fFilter;
+  if(fClassifier) delete fClassifier;
+}
+
+//------------------------------------------------------------------------------
+
+void MadGraphShowerPartonSelector::Process()
+{
+  TObjArray *array = 0;
+  ExRootGenParticle *particle = 0;
+  ExRootCandidate *candidate = 0;
+  ExRootFactory *factory = GetFactory();
+
+  TLorentzVector momentum;
+
+  fFilter->Reset();
+  array = fFilter->GetSubArray(fClassifier, 0);
+
+  if(array == 0) return;
+
+  TIter itArray(array);
+
+  while(particle = static_cast<ExRootGenParticle*>(itArray.Next()))
+  {
+    momentum.SetPxPyPzE(particle->Px, particle->Py, particle->Pz, particle->E);
+
+    candidate = factory->NewCandidate();
+
+    candidate->SetP4(momentum);
+    candidate->SetType(particle->PID);
+
+    fOutputArray->Add(candidate);
+  }
+
+/*
+  cout << "==============================" << endl;
+  Int_t indexParticle = -1;
+  itArray.Reset();
+  while(particle = static_cast<ExRootGenParticle*>(itArray.Next()))
+  {
+    ++indexParticle;
+    cout << "--->\t" << particle->Status << "\t" << particle->PID << "\t";
+    cout << particle->M1 << "\t" << particle->M2 << "\t";
+    cout << particle->Px << "\t" << particle->Py << "\t" << particle->Pz << endl;
+  }
+*/
+}
+
+//------------------------------------------------------------------------------
Index: /trunk/modules/MadGraphShowerPartonSelector.h
===================================================================
--- /trunk/modules/MadGraphShowerPartonSelector.h	(revision 2)
+++ /trunk/modules/MadGraphShowerPartonSelector.h	(revision 2)
@@ -0,0 +1,37 @@
+#ifndef MadGraphShowerPartonSelector_h
+#define MadGraphShowerPartonSelector_h
+
+#include "ExRootAnalysis/ExRootModule.h"
+
+class TClonesArray;
+class TObjArray;
+
+class ExRootFilter;
+class MadGraphShowerPartonClassifier;
+
+class MadGraphShowerPartonSelector: public ExRootModule
+{
+public:
+
+  MadGraphShowerPartonSelector();
+  ~MadGraphShowerPartonSelector();
+
+  void Init();
+  void Process();
+  void Finish();
+
+private:
+
+  ExRootFilter *fFilter; //!
+  MadGraphShowerPartonClassifier *fClassifier; //!
+
+  TClonesArray *fBranchParticle; //!
+
+  TObjArray *fOutputArray; //!
+  
+  Double_t fEtaMax;
+
+  ClassDef(MadGraphShowerPartonSelector, 1)
+};
+
+#endif
Index: /trunk/modules/ModulesLinkDef.h
===================================================================
--- /trunk/modules/ModulesLinkDef.h	(revision 2)
+++ /trunk/modules/ModulesLinkDef.h	(revision 2)
@@ -0,0 +1,39 @@
+#include "modules/MadGraphParticleClassifier.h"
+#include "modules/MadGraphClassFilter.h"
+#include "modules/MadGraphClassMerger.h"
+#include "modules/MadGraphJetLeptonMerger.h"
+#include "modules/MadGraphAnalysis.h"
+#include "modules/MadGraphMatchingAnalysis.h"
+#include "modules/MadGraphMatchingTreeWriter.h"
+#include "modules/MadGraphKtJetFinder.h"
+#include "modules/MadGraphConeJetFinder.h"
+#include "modules/MadGraphIsolatedLeptonFinder.h"
+#include "modules/PythiaFix.h"
+#include "modules/MadGraphPartonSelector.h"
+#include "modules/MadGraphJetParticleSelector.h"
+#include "modules/MadGraphShowerPartonSelector.h"
+#include "modules/MadGraphShowerLeptonSelector.h"
+
+#ifdef __CINT__
+
+#pragma link off all globals;
+#pragma link off all classes;
+#pragma link off all functions;
+
+#pragma link C++ class MadGraphParticleClassifier+;
+#pragma link C++ class MadGraphClassFilter+;
+#pragma link C++ class MadGraphClassMerger+;
+#pragma link C++ class MadGraphJetLeptonMerger+;
+#pragma link C++ class MadGraphAnalysis+;
+#pragma link C++ class MadGraphMatchingAnalysis+;
+#pragma link C++ class MadGraphMatchingTreeWriter+;
+#pragma link C++ class MadGraphKtJetFinder+;
+#pragma link C++ class MadGraphConeJetFinder+;
+#pragma link C++ class MadGraphIsolatedLeptonFinder+;
+#pragma link C++ class PythiaFix+;
+#pragma link C++ class MadGraphPartonSelector+;
+#pragma link C++ class MadGraphJetParticleSelector+;
+#pragma link C++ class MadGraphShowerPartonSelector+;
+#pragma link C++ class MadGraphShowerLeptonSelector+;
+
+#endif
Index: /trunk/modules/PythiaFix.cc
===================================================================
--- /trunk/modules/PythiaFix.cc	(revision 2)
+++ /trunk/modules/PythiaFix.cc	(revision 2)
@@ -0,0 +1,140 @@
+
+#include "modules/PythiaFix.h"
+
+
+#include "ExRootAnalysis/ExRootResult.h"
+#include "ExRootAnalysis/ExRootClasses.h"
+
+#include "ExRootAnalysis/ExRootFilter.h"
+#include "ExRootAnalysis/ExRootClassifier.h"
+
+#include "ExRootAnalysis/ExRootFactory.h"
+#include "ExRootAnalysis/ExRootCandidate.h"
+
+#include "TMath.h"
+#include "TString.h"
+#include "TLorentzVector.h"
+#include "TDatabasePDG.h"
+#include "TClonesArray.h"
+
+#include <iostream>
+#include <set>
+
+using namespace std;
+
+//------------------------------------------------------------------------------
+
+PythiaFix::PythiaFix() :
+  fItBranchParticle(0)
+{
+}
+
+//------------------------------------------------------------------------------
+
+PythiaFix::~PythiaFix()
+{
+}
+
+//------------------------------------------------------------------------------
+
+void PythiaFix::Init()
+{
+  // import ROOT tree branch
+
+  fBranchParticle = UseBranch("GenParticle");
+  fItBranchParticle = fBranchParticle->MakeIterator();
+
+}
+
+//------------------------------------------------------------------------------
+
+void PythiaFix::Finish()
+{ 
+  if(fItBranchParticle) delete fItBranchParticle;
+}
+
+//------------------------------------------------------------------------------
+
+void PythiaFix::FixDaughters(Int_t indexParticle, Int_t indexMother)
+{
+  ExRootGenParticle *mother = 0;
+  mother = static_cast<ExRootGenParticle*>(fBranchParticle->At(indexMother));
+
+  if(!mother) return;
+
+  // skip beam particles
+  if(mother->M1 < 0 && mother->M2 < 0) return;
+
+  if(mother->D1 < 0 && mother->D2 < 0)
+  {
+    mother->D1 = indexParticle;
+		mother->D2 = indexParticle;
+  }
+  else if(mother->D1 < indexParticle && mother->D2 + 1 == indexParticle)
+  {
+		mother->D2 = indexParticle;
+  }
+  else if(mother->D1 < indexParticle)
+  {
+    mother->D1 = indexParticle;
+		mother->D2 = indexParticle;
+  }
+}
+
+//------------------------------------------------------------------------------
+
+void PythiaFix::Process()
+{
+  ExRootGenParticle *particle = 0;
+  Int_t indexParticle, indexMother;
+
+/*
+  TDatabasePDG *pdg = TDatabasePDG::Instance();
+
+  indexParticle = -1;
+  fItBranchParticle->Reset();
+  while(particle = static_cast<ExRootGenParticle*>(fItBranchParticle->Next()))
+  {
+    ++indexParticle;
+    cout << indexParticle << "\t" << pdg->GetParticle(particle->PID)->GetName() << "\t";
+    cout << particle->Status << "\t" << particle->M1 << "\t" << particle->M2 << "\t";
+    cout << particle->D1 << "\t" << particle->D2 << endl;
+  }
+*/
+
+  indexParticle = -1;
+  fItBranchParticle->Reset();
+  while(particle = static_cast<ExRootGenParticle*>(fItBranchParticle->Next()))
+  {
+		++indexParticle;
+
+		if(particle->M1 < 0) continue;
+		
+		if(particle->M2 < 0)
+		{
+      FixDaughters(indexParticle, particle->M1);
+    }
+    else
+    {
+      for(indexMother = particle->M1; indexMother <= particle->M2; ++indexMother)
+      {
+        FixDaughters(indexParticle, indexMother);
+      }
+    }
+  }
+
+/*
+  cout << "==============================" << endl;
+  indexParticle = -1;
+  fItBranchParticle->Reset();
+  while(particle = static_cast<ExRootGenParticle*>(fItBranchParticle->Next()))
+  {
+    ++indexParticle;
+    cout << indexParticle << "\t" << pdg->GetParticle(particle->PID)->GetName() << "\t";
+    cout << particle->Status << "\t" << particle->M1 << "\t" << particle->M2 << "\t";
+    cout << particle->D1 << "\t" << particle->D2 << endl;
+  }
+*/
+}
+
+//------------------------------------------------------------------------------
Index: /trunk/modules/PythiaFix.h
===================================================================
--- /trunk/modules/PythiaFix.h	(revision 2)
+++ /trunk/modules/PythiaFix.h	(revision 2)
@@ -0,0 +1,30 @@
+#ifndef PythiaFix_h
+#define PythiaFix_h
+
+#include "ExRootAnalysis/ExRootModule.h"
+
+class TClonesArray;
+class TIterator;
+
+class PythiaFix: public ExRootModule
+{
+public:
+
+  PythiaFix();
+  ~PythiaFix();
+
+  void Init();
+  void Process();
+  void Finish();
+
+private:
+
+  void FixDaughters(Int_t indexParticle, Int_t indexMother);
+
+  TClonesArray *fBranchParticle; //!
+  TIterator *fItBranchParticle; //!
+
+  ClassDef(PythiaFix, 1)
+};
+
+#endif
Index: /trunk/pgs/ExRootAnalysis.cc
===================================================================
--- /trunk/pgs/ExRootAnalysis.cc	(revision 2)
+++ /trunk/pgs/ExRootAnalysis.cc	(revision 2)
@@ -0,0 +1,637 @@
+#include <iostream>
+
+#include "TApplication.h"
+#include "TLorentzVector.h"
+
+#include "TFile.h"
+
+#include "ExRootAnalysis/ExRootClasses.h"
+#include "ExRootAnalysis/ExRootTreeBranch.h"
+#include "ExRootAnalysis/ExRootTreeWriter.h"
+
+using namespace std;
+
+// generated particle list
+
+const int nmxhep = 4000;
+
+typedef struct
+{
+  int nevhep;              // event number
+  int nhep;                // number of entries in record
+  int isthep[nmxhep];      // status code
+  int idhep[nmxhep];       // particle ID (PDG standard)
+  int jmohep[nmxhep][2];   // index to first and second particle mothers
+  int jdahep[nmxhep][2];   // index to first and last daughter particles
+  double phep[nmxhep][5];  // 4-vector and mass
+  double vhep[nmxhep][4];  // (x,y,z) of production, and production time (mm/c)
+} hepevtF77;
+
+extern hepevtF77 hepevt_;
+
+// PGS track list
+
+const int ntrkmx = 500;
+
+typedef struct
+{
+  int numtrk;              // number of tracks
+  int dumtrk;              // number of tracks
+  int indtrk[ntrkmx];      // index to HEPEVT particle
+  double ptrk[ntrkmx][3];  // track 3-vector
+  double qtrk[ntrkmx];     // track charge
+} pgstrkF77;
+
+extern pgstrkF77 pgstrk_;
+
+// PGS calorimeter tower arrays
+
+const int nphimax = 600;
+const int netamax = 600;
+
+typedef struct
+{
+  double ecal[nphimax][netamax];  // electromagnetic energy in each tower
+  double hcal[nphimax][netamax];  // hadronic energy in each tower
+  double met_cal;                 // calorimeter missing ET
+  double phi_met_cal;             // calorimeter missing ET phi
+} pgscalF77;
+
+extern pgscalF77 pgscal_;
+
+
+// PGS calorimeter cluster list
+
+const int nclumx = 50;
+
+typedef struct
+{
+  int cclu[nphimax][netamax];  // map of cluster indices
+  int numclu;                  // number of clusters in list
+  int dumclu;                  // number of clusters in list
+  double pclu[nclumx][5];      // cluster 4 vector and mass
+  int etaclu[nclumx];          // cluster seed tower eta
+  int phiclu[nclumx];          // cluster seed tower phi
+  double emclu[nclumx];        // cluster electromagnetic energy
+  double ehclu[nclumx];        // cluster hadronic energy
+  double efclu[nclumx];        // cluster electromagnetic fraction
+  double widclu[nclumx];       // cluster width sqrt(deta**2+dphi**2)
+  int mulclu[nclumx];          // cluster tower multiplicity
+} pgscluF77;
+
+extern pgscluF77 pgsclu_;
+
+// PGS trigger object list
+
+const int ntrgmx = 500;
+
+typedef struct
+{
+  int numtrg;                 // number of trigger objects
+  int dumtrg;                 // number of trigger objects
+  int indtrg[ntrgmx];         // index to HEPEVT particle (where relevant)
+  int typtrg[ntrgmx];         // reconstructed type:  0=photon
+                              //                      1=electron
+                              //                      2=muon
+                              //                      3=tau (hadronic)
+                              //                      4=jet
+                              //                      5=detached vertex
+                              //                      6=MET
+  double vectrg[ntrgmx][10];  // trigger object vector: 1 = eta
+                              //                        2 = phi
+                              //                        3 = ET of cluster
+                              //                        4 = cluster #
+                              //                        5 = pt of track (if any)
+                              //                        6 = track #
+} pgstrgF77;
+
+extern pgstrgF77 pgstrg_;
+
+// PGS reconstructed object list
+
+const int nobjmx = 500;
+
+typedef struct
+{
+  int numobj;                 // number of reconstructed objects
+  int dumobj;                 // number of reconstructed objects
+  int indobj[nobjmx];         // index to HEPEVT particle (where relevant)
+  int typobj[nobjmx];         // reconstructed type:  0 = photon
+                              //                      1 = electron
+                              //                      2 = muon
+                              //                      3 = tau (hadronic)
+                              //                      4 = jet
+                              //                      5 = heavy charged
+  double pobj[nobjmx][4];     // four vector of reconstructed object
+  double qobj[nobjmx];        // charge of reconstructed object
+  double vecobj[nobjmx][10];  // interesting object quantities
+} pgsrecF77;
+
+extern pgsrecF77 pgsrec_;
+
+//           --------------------------
+//           table of vecobj quantities
+//           --------------------------
+//
+//   -------------------------------------------------------------------------------------
+//    type            1           2          3        4        5        6        7
+//   -------------------------------------------------------------------------------------
+//   0  photon     EM energy  HAD energy  track E   N(trk)   width      -        -
+//   1  electron    "   "      "     "       "        "        -        -        -
+//   2  muon        "   "      "     "       "        "     trk iso E   -        -
+//   3  tau         "   "      "     "       "        "      width    mtau     ptmax
+//   4  jet         "   "      "     "       "        "        "      flavor   c,b tags ->
+//   -------------------------------------------------------------------------------------
+//
+// b, c tagging: vecobj(7,iobj) non-zero if charm tag (jet prob. alg.)
+//               vecobj(8,iobj) non-zero if b     tag ( "    "    "  )
+//               vecobj(9,iobj) non-zero if b     tag (impact method)
+//
+//   --> all algorithms include rates for gluon, uds, c and b jets
+//
+
+static TFile *outputFile;
+static ExRootTreeWriter *treeWriter;
+
+static ExRootTreeBranch *branchGenParticle;
+static ExRootTreeBranch *branchTrack;
+static ExRootTreeBranch *branchCalTower;
+static ExRootTreeBranch *branchMissingET;
+static ExRootTreeBranch *branchCalCluster;
+static ExRootTreeBranch *branchPhoton;
+static ExRootTreeBranch *branchElectron;
+static ExRootTreeBranch *branchMuon;
+static ExRootTreeBranch *branchTau;
+static ExRootTreeBranch *branchJet;
+static ExRootTreeBranch *branchHeavy;
+
+static void analyse_particle(Int_t number, ExRootTreeBranch *branch);
+static void analyse_track(Int_t number, ExRootTreeBranch *branch);
+static void analyse_tower(Int_t eta, Int_t phi, ExRootTreeBranch *branch);
+static void analyse_met(ExRootTreeBranch *branch);
+static void analyse_cluster(Int_t number, ExRootTreeBranch *branch);
+static void analyse_photon(Int_t number, ExRootTreeBranch *branch);
+static void analyse_electron(Int_t number, ExRootTreeBranch *branch);
+static void analyse_muon(Int_t number, ExRootTreeBranch *branch);
+static void analyse_tau(Int_t number, ExRootTreeBranch *branch);
+static void analyse_jet(Int_t number, ExRootTreeBranch *branch);
+static void analyse_heavy(Int_t number, ExRootTreeBranch *branch);
+
+extern "C"
+{
+  void test_cpp__(int *int_var)
+  {
+    cout << "int_var = " << *int_var << endl;
+
+    cout << "nevhep = " << hepevt_.nevhep << endl;
+    cout << "jmohep(1,2) = " << hepevt_.jmohep[1][0] << endl;
+    cout << "phep(1,1) = " << hepevt_.phep[0][0] << endl;
+
+    cout << "numtrk = " << pgstrk_.numtrk << endl;
+    cout << "ptrk(2,1) = " << pgstrk_.ptrk[0][1] << endl;
+
+    cout << "hcal(2,1) = " << pgscal_.hcal[0][1] << endl;
+    cout << "met_cal = " << pgscal_.met_cal << endl;
+
+    cout << "pclu(2,1) = " << pgsclu_.pclu[0][1] << endl;
+    cout << "mulclu(2) = " << pgsclu_.mulclu[1] << endl;
+
+    cout << "vectrg(9,2) = " << pgstrg_.vectrg[1][8] << endl;
+    cout << "indtrg(2) = " << pgstrg_.indtrg[1] << endl;
+
+    cout << "vecobj(10,3) = " << pgsrec_.vecobj[2][9] << endl;
+    cout << "indobj(3) = " << pgsrec_.indobj[2] << endl;
+  }
+
+//------------------------------------------------------------------------------
+
+  void pgs2root_ini__()
+  {
+    int appargc = 2;
+    char *appargv[] = {"pgs2root", "-b"};
+    TApplication app("pgs2root", &appargc, appargv);
+  
+    TString outputFileName("pgs.root");
+    TString treeName("PGS");
+  
+    outputFile = TFile::Open(outputFileName, "RECREATE");
+    treeWriter = new ExRootTreeWriter(outputFile, treeName);
+
+    // generated particles from HEPEVT
+    branchGenParticle = treeWriter->NewBranch("GenParticle", TRootGenParticle::Class());
+    // reconstructed tracks
+    branchTrack = treeWriter->NewBranch("Track", TRootTrack::Class());
+    // reconstructed calorimeter towers
+    branchCalTower = treeWriter->NewBranch("CalTower", TRootCalTower::Class());
+    // missing transverse energy
+    branchMissingET = treeWriter->NewBranch("MissingET", TRootMissingET::Class());
+    // reconstructed calorimeter clusters for jets and tau leptons
+    branchCalCluster = treeWriter->NewBranch("CalCluster", TRootCalCluster::Class());
+    // reconstructed photons
+    branchPhoton = treeWriter->NewBranch("Photon", TRootPhoton::Class());
+    // reconstructed electrons
+    branchElectron = treeWriter->NewBranch("Electron", TRootElectron::Class());
+    // reconstructed muons
+    branchMuon = treeWriter->NewBranch("Muon", TRootMuon::Class());
+    // reconstructed tau leptons
+    branchTau = treeWriter->NewBranch("Tau", TRootTau::Class());
+    // reconstructed jets
+    branchJet = treeWriter->NewBranch("Jet", TRootJet::Class());
+    // reconstructed heavy particles
+    branchHeavy = treeWriter->NewBranch("Heavy", TRootHeavy::Class());
+  }
+
+//---------------------------------------------------------------------------
+
+  void pgs2root_evt__()
+  {
+    Int_t particle, track, eta, phi, cluster, object;
+  
+    treeWriter->Clear();
+  
+    for(particle = 0; particle < hepevt_.nhep; ++particle)
+    {
+      analyse_particle(particle, branchGenParticle);
+    }
+  
+    for(track = 0; track < pgstrk_.numtrk; ++track)
+    {
+      analyse_track(track, branchTrack);
+    }
+  
+    for(eta = 0; eta < netamax; ++eta)
+    {
+      for(phi = 0; phi < nphimax; ++phi)
+      {
+        if(pgscal_.ecal[phi][eta] == 0.0 &&
+           pgscal_.hcal[phi][eta] == 0.0) continue;
+
+        analyse_tower(eta, phi, branchCalTower);
+      }
+    }
+
+    analyse_met(branchMissingET);
+    
+    for(cluster = 0; cluster < pgsclu_.numclu; ++ cluster)
+    {
+      analyse_cluster(cluster, branchCalCluster);
+    }
+  
+    for(object = 0; object < pgsrec_.numobj; ++object)
+    {
+      switch(pgsrec_.typobj[object])
+      {
+        case 0: analyse_photon(object, branchPhoton); break;
+        case 1: analyse_electron(object, branchElectron); break;
+        case 2: analyse_muon(object, branchMuon); break;
+        case 3: analyse_tau(object, branchTau); break;
+        case 4: analyse_jet(object, branchJet); break;
+        case 5: analyse_heavy(object, branchHeavy); break;
+      }
+    }
+    
+    treeWriter->Fill();
+  }
+
+//---------------------------------------------------------------------------
+
+  void pgs2root_end__()
+  {
+    treeWriter->Write();
+    
+    delete treeWriter;
+    delete outputFile;
+  }
+
+} // extern "C"
+
+//---------------------------------------------------------------------------
+
+static void analyse_particle(Int_t number, ExRootTreeBranch *branch)
+{
+  TRootGenParticle *entry;
+
+  Double_t signEta;
+
+  entry = static_cast<TRootGenParticle*>(branch->NewEntry());
+
+  entry->PID = hepevt_.idhep[number];
+  entry->Status = hepevt_.isthep[number];
+  entry->M1 = hepevt_.jmohep[number][0] - 1;
+  entry->M2 = hepevt_.jmohep[number][1] - 1;
+  entry->D1 = hepevt_.jdahep[number][0] - 1;
+  entry->D2 = hepevt_.jdahep[number][1] - 1;
+
+  entry->E = hepevt_.phep[number][3];
+  entry->Px = hepevt_.phep[number][0];
+  entry->Py = hepevt_.phep[number][1];
+  entry->Pz = hepevt_.phep[number][2];
+
+  TVector3 vector(entry->Px, entry->Py, entry->Pz);
+
+  entry->PT = vector.Perp();
+  signEta = (entry->Pz >= 0.0) ? 1.0 : -1.0;
+  entry->Eta = vector.CosTheta()*vector.CosTheta() == 1.0 ? signEta*999.9 : vector.Eta();
+  entry->Phi = vector.Phi();
+
+  entry->T = hepevt_.vhep[number][3];
+  entry->X = hepevt_.vhep[number][0];
+  entry->Y = hepevt_.vhep[number][1];
+  entry->Z = hepevt_.vhep[number][2];
+}
+
+//---------------------------------------------------------------------------
+
+static void analyse_track(Int_t number, ExRootTreeBranch *branch)
+{
+  TRootTrack *entry;
+
+  Double_t signEta;
+
+  entry = static_cast<TRootTrack*>(branch->NewEntry());
+
+  entry->Px = pgstrk_.ptrk[number][0];
+  entry->Py = pgstrk_.ptrk[number][1];
+  entry->Pz = pgstrk_.ptrk[number][2];
+
+  TVector3 vector(entry->Px, entry->Py, entry->Pz);
+
+  entry->PT = vector.Perp();
+  signEta = (entry->Pz >= 0.0) ? 1.0 : -1.0;
+  entry->Eta = vector.CosTheta()*vector.CosTheta() == 1.0 ? signEta*999.9 : vector.Eta();
+  entry->Phi = vector.Phi();
+
+  entry->Charge = pgstrk_.qtrk[number];
+
+  entry->ParticleIndex = pgstrk_.indtrk[number] - 1;  
+}
+
+//---------------------------------------------------------------------------
+
+static void analyse_tower(Int_t eta, Int_t phi, ExRootTreeBranch *branch)
+{
+  TRootCalTower *entry;
+
+  entry = static_cast<TRootCalTower*>(branch->NewEntry());
+
+  entry->Eem = pgscal_.ecal[phi][eta];
+  entry->Ehad = pgscal_.hcal[phi][eta];
+  entry->E = entry->Eem + entry->Ehad;
+}
+
+//---------------------------------------------------------------------------
+
+static void analyse_met(ExRootTreeBranch *branch)
+{
+  TRootMissingET *entry;
+
+  entry = static_cast<TRootMissingET*>(branch->NewEntry());
+
+  entry->MET = pgscal_.met_cal;
+  entry->Phi = pgscal_.phi_met_cal;
+}
+
+//---------------------------------------------------------------------------
+
+static void analyse_cluster(Int_t number, ExRootTreeBranch *branch)
+{
+  TRootCalCluster *entry;
+
+  entry = static_cast<TRootCalCluster*>(branch->NewEntry());
+
+  entry->E = pgsclu_.pclu[number][3];
+  entry->Px = pgsclu_.pclu[number][0];
+  entry->Py = pgsclu_.pclu[number][1];
+  entry->Pz = pgsclu_.pclu[number][2];
+
+  entry->Eta = pgsclu_.etaclu[number];
+  entry->Phi = pgsclu_.phiclu[number];
+
+  entry->Eem = pgsclu_.emclu[number];
+  entry->Ehad = pgsclu_.ehclu[number];
+  entry->EemOverEtot = pgsclu_.efclu[number];
+
+  entry->Ntwr = pgsclu_.mulclu[number];
+}
+
+//---------------------------------------------------------------------------
+
+static void analyse_photon(Int_t number, ExRootTreeBranch *branch)
+{
+  TRootPhoton *entry;
+
+  Double_t signEta;
+  
+  entry = static_cast<TRootPhoton*>(branch->NewEntry());
+
+  entry->E = pgsrec_.pobj[number][3];
+  entry->Px = pgsrec_.pobj[number][0];
+  entry->Py = pgsrec_.pobj[number][1];
+  entry->Pz = pgsrec_.pobj[number][2];
+
+  TVector3 vector(entry->Px, entry->Py, entry->Pz);
+
+  entry->PT = vector.Perp();
+  signEta = (entry->Pz >= 0.0) ? 1.0 : -1.0;
+  entry->Eta = vector.CosTheta()*vector.CosTheta() == 1.0 ? signEta*999.9 : vector.Eta();
+  entry->Phi = vector.Phi();
+
+  entry->Eem = pgsrec_.vecobj[number][0];
+  entry->Ehad = pgsrec_.vecobj[number][1];
+  entry->PTtrk = pgsrec_.vecobj[number][2];
+
+  entry->Niso = pgsrec_.vecobj[number][3];
+
+  entry->ET = pgsrec_.vecobj[number][5];
+  entry->ETiso = pgsrec_.vecobj[number][6];
+  entry->PTiso = pgsrec_.vecobj[number][7];
+
+  entry->EhadOverEem = pgsrec_.vecobj[number][8];
+  entry->EemOverPtrk = pgsrec_.vecobj[number][9];
+
+  entry->ParticleIndex = pgsrec_.indobj[number] - 1;  
+}
+
+//---------------------------------------------------------------------------
+
+static void analyse_electron(Int_t number, ExRootTreeBranch *branch)
+{
+  TRootElectron *entry;
+
+  Double_t signEta;
+
+  entry = static_cast<TRootElectron*>(branch->NewEntry());
+
+  entry->E = pgsrec_.pobj[number][3];
+  entry->Px = pgsrec_.pobj[number][0];
+  entry->Py = pgsrec_.pobj[number][1];
+  entry->Pz = pgsrec_.pobj[number][2];
+
+  TVector3 vector(entry->Px, entry->Py, entry->Pz);
+
+  entry->PT = vector.Perp();
+  signEta = (entry->Pz >= 0.0) ? 1.0 : -1.0;
+  entry->Eta = vector.CosTheta()*vector.CosTheta() == 1.0 ? signEta*999.9 : vector.Eta();
+  entry->Phi = vector.Phi();
+
+  entry->Charge = pgsrec_.qobj[number];
+
+  entry->Eem = pgsrec_.vecobj[number][0];
+  entry->Ehad = pgsrec_.vecobj[number][1];
+  entry->PTtrk = pgsrec_.vecobj[number][2];
+
+  entry->Niso = pgsrec_.vecobj[number][3];
+
+  entry->ET = pgsrec_.vecobj[number][5];
+  entry->ETiso = pgsrec_.vecobj[number][6];
+  entry->PTisoMinusPTtrk = pgsrec_.vecobj[number][7];
+
+  entry->EhadOverEem = pgsrec_.vecobj[number][8];
+  entry->EemOverPtrk = pgsrec_.vecobj[number][9];
+
+  entry->ParticleIndex = pgsrec_.indobj[number] - 1;
+}
+
+//---------------------------------------------------------------------------
+
+static void analyse_muon(Int_t number, ExRootTreeBranch *branch)
+{
+  TRootMuon *entry;
+
+  Double_t signEta;
+
+  entry = static_cast<TRootMuon*>(branch->NewEntry());
+
+  entry->E = pgsrec_.pobj[number][3];
+  entry->Px = pgsrec_.pobj[number][0];
+  entry->Py = pgsrec_.pobj[number][1];
+  entry->Pz = pgsrec_.pobj[number][2];
+
+  TVector3 vector(entry->Px, entry->Py, entry->Pz);
+
+  entry->PT = vector.Perp();
+  signEta = (entry->Pz >= 0.0) ? 1.0 : -1.0;
+  entry->Eta = vector.CosTheta()*vector.CosTheta() == 1.0 ? signEta*999.9 : vector.Eta();
+  entry->Phi = vector.Phi();
+
+  entry->Charge = pgsrec_.qobj[number];
+
+  entry->Eem = pgsrec_.vecobj[number][0];
+  entry->Ehad = pgsrec_.vecobj[number][1];
+  entry->Ptrk = pgsrec_.vecobj[number][2];
+
+  entry->Niso = pgsrec_.vecobj[number][3];
+
+  entry->Etrk = pgsrec_.vecobj[number][4];
+  entry->ETiso = pgsrec_.vecobj[number][5];
+  entry->PTiso = pgsrec_.vecobj[number][6];
+
+  entry->ParticleIndex = pgsrec_.indobj[number] - 1;
+}
+
+//---------------------------------------------------------------------------
+
+static void analyse_tau(Int_t number, ExRootTreeBranch *branch)
+{
+  TRootTau *entry;
+
+  Double_t signEta;
+
+  entry = static_cast<TRootTau*>(branch->NewEntry());
+
+  entry->E = pgsrec_.pobj[number][3];
+  entry->Px = pgsrec_.pobj[number][0];
+  entry->Py = pgsrec_.pobj[number][1];
+  entry->Pz = pgsrec_.pobj[number][2];
+
+  TVector3 vector(entry->Px, entry->Py, entry->Pz);
+
+  entry->PT = vector.Perp();
+  signEta = (entry->Pz >= 0.0) ? 1.0 : -1.0;
+  entry->Eta = vector.CosTheta()*vector.CosTheta() == 1.0 ? signEta*999.9 : vector.Eta();
+  entry->Phi = vector.Phi();
+
+  entry->Charge = pgsrec_.qobj[number];
+
+  entry->Eem = pgsrec_.vecobj[number][0];
+  entry->Ehad = pgsrec_.vecobj[number][1];
+  entry->Etrk = pgsrec_.vecobj[number][2];
+
+  entry->Ntrk = pgsrec_.vecobj[number][3];
+
+  entry->Width = pgsrec_.vecobj[number][4];
+  entry->Ecut = pgsrec_.vecobj[number][5];
+  entry->PTmax = pgsrec_.vecobj[number][6];
+
+  entry->SeedTrackIndex = pgsrec_.vecobj[number][7] - 1;
+  entry->ClusterIndex = pgsrec_.indobj[number] - 1;
+}
+
+//---------------------------------------------------------------------------
+
+static void analyse_jet(Int_t number, ExRootTreeBranch *branch)
+{
+  TRootJet *entry;
+
+  Double_t signEta;
+
+  entry = static_cast<TRootJet*>(branch->NewEntry());
+
+  entry->E = pgsrec_.pobj[number][3];
+  entry->Px = pgsrec_.pobj[number][0];
+  entry->Py = pgsrec_.pobj[number][1];
+  entry->Pz = pgsrec_.pobj[number][2];
+
+  TVector3 vector(entry->Px, entry->Py, entry->Pz);
+
+  entry->PT = vector.Perp();
+  signEta = (entry->Pz >= 0.0) ? 1.0 : -1.0;
+  entry->Eta = vector.CosTheta()*vector.CosTheta() == 1.0 ? signEta*999.9 : vector.Eta();
+  entry->Phi = vector.Phi();
+
+  entry->Charge = pgsrec_.qobj[number];
+
+  entry->Eem = pgsrec_.vecobj[number][0];
+  entry->Ehad = pgsrec_.vecobj[number][1];
+  entry->Etrk = pgsrec_.vecobj[number][2];
+
+  entry->Ntrk = pgsrec_.vecobj[number][3];
+
+  entry->Width = pgsrec_.vecobj[number][4];
+
+  entry->Type = pgsrec_.vecobj[number][5]; // type: 21=g, 1=d, 2=u, 3=s, 4=c, 5=b
+
+  entry->CTag = pgsrec_.vecobj[number][6];
+  entry->BTagVtx = pgsrec_.vecobj[number][7];
+  entry->BTagImp = pgsrec_.vecobj[number][8];
+
+  entry->ClusterIndex = pgsrec_.indobj[number] - 1;  
+}
+
+//---------------------------------------------------------------------------
+
+static void analyse_heavy(Int_t number, ExRootTreeBranch *branch)
+{
+  TRootHeavy *entry;
+
+  Double_t signEta;
+
+  entry = static_cast<TRootHeavy*>(branch->NewEntry());
+
+  entry->E = pgsrec_.pobj[number][3];
+  entry->Px = pgsrec_.pobj[number][0];
+  entry->Py = pgsrec_.pobj[number][1];
+  entry->Pz = pgsrec_.pobj[number][2];
+
+  TVector3 vector(entry->Px, entry->Py, entry->Pz);
+
+  entry->PT = vector.Perp();
+  signEta = (entry->Pz >= 0.0) ? 1.0 : -1.0;
+  entry->Eta = vector.CosTheta()*vector.CosTheta() == 1.0 ? signEta*999.9 : vector.Eta();
+  entry->Phi = vector.Phi();
+ 
+  entry->ParticleIndex = pgsrec_.indobj[number] - 1;
+}
+
+//---------------------------------------------------------------------------
+
Index: /trunk/pgs/ExRootAnalysisLinkDef.h
===================================================================
--- /trunk/pgs/ExRootAnalysisLinkDef.h	(revision 2)
+++ /trunk/pgs/ExRootAnalysisLinkDef.h	(revision 2)
@@ -0,0 +1,42 @@
+/** \class ExRootAnalysisLinkDef
+ *
+ *  Lists classes to be included in cint dicitonary
+ *
+ *  $Date: 2008-06-04 13:57:52 $
+ *  $Revision: 1.1 $
+ *
+ *  
+ *  \author P. Demin - UCL, Louvain-la-Neuve
+ *
+ */
+
+#include "ExRootAnalysis/ExRootClasses.h"
+#include "ExRootAnalysis/ExRootTreeWriter.h"
+#include "ExRootAnalysis/ExRootTreeBranch.h"
+
+#ifdef __CINT__
+
+#pragma link off all globals;
+#pragma link off all classes;
+#pragma link off all functions;
+
+#pragma link C++ class TSortableObject+;
+#pragma link C++ class TRootLHEFEvent+;
+#pragma link C++ class TRootLHEFParticle+;
+#pragma link C++ class TRootGenParticle+;
+#pragma link C++ class TRootTrack+;
+#pragma link C++ class TRootCalTower+;
+#pragma link C++ class TRootMissingET+;
+#pragma link C++ class TRootCalCluster+;
+#pragma link C++ class TRootPhoton+;
+#pragma link C++ class TRootElectron+;
+#pragma link C++ class TRootMuon+;
+#pragma link C++ class TRootTau+;
+#pragma link C++ class TRootJet+;
+#pragma link C++ class TRootHeavy+;
+
+#pragma link C++ class ExRootTreeBranch+;
+#pragma link C++ class ExRootTreeWriter+;
+
+#endif
+
Index: /trunk/src/ExRootAnalysis.cc
===================================================================
--- /trunk/src/ExRootAnalysis.cc	(revision 2)
+++ /trunk/src/ExRootAnalysis.cc	(revision 2)
@@ -0,0 +1,257 @@
+
+/** \class ExRootAnalysis
+ *
+ *  Analysis steering class.
+ *  Implements events loop and modules management.
+ *
+ *  $Date: 2008-06-04 13:57:53 $
+ *  $Revision: 1.1 $
+ *
+ *
+ *  \author P. Demin - UCL, Louvain-la-Neuve
+ *
+ */
+
+#include "ExRootAnalysis/ExRootAnalysis.h"
+#include "ExRootAnalysis/ExRootFactory.h"
+
+#include "ExRootAnalysis/ExRootConfReader.h"
+#include "ExRootAnalysis/ExRootTreeReader.h"
+#include "ExRootAnalysis/ExRootTreeWriter.h"
+
+#include "ExRootAnalysis/ExRootUtilities.h"
+#include "ExRootAnalysis/ExRootProgressBar.h"
+
+#include "TROOT.h"
+#include "TClass.h"
+#include "TSystem.h"
+#include "TFolder.h"
+#include "TObjArray.h"
+
+#include <iostream>
+
+#include <string.h>
+#include <stdio.h>
+
+using namespace std;
+
+ExRootAnalysis::ExRootAnalysis() :
+  fTreeFile(0), fInfoFile(0), fAllEntries(0)
+{
+  TFolder *folder = new TFolder("", "");
+  SetFolder(folder);
+
+  fChains = new TObjArray;
+  fChains->SetOwner();
+
+  ExRootConfReader *confReader = new ExRootConfReader;
+  SetConfReader(confReader);
+
+  fTreeReader = new ExRootTreeReader();
+
+  fTreeWriter = new ExRootTreeWriter();
+
+  fFactory = new ExRootFactory();
+
+}
+
+//------------------------------------------------------------------------------
+
+ExRootAnalysis::~ExRootAnalysis()
+{
+  delete fFactory;
+  delete fTreeWriter;
+  delete fTreeReader;
+  delete GetConfReader();
+  delete fChains;
+  delete GetFolder();
+}
+
+//------------------------------------------------------------------------------
+
+Long64_t ExRootAnalysis::GetEntries() const
+{
+  return fTreeReader ? fTreeReader->GetEntries() : 0;
+}
+
+//------------------------------------------------------------------------------
+
+Bool_t ExRootAnalysis::ReadEvent(Long64_t entry)
+{
+  return fTreeReader ? fTreeReader->ReadEntry(entry) : kFALSE;
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootAnalysis::ProcessTask()
+{
+  Clear();
+  ExRootTask::ProcessTask();
+  if(fTreeWriter) fTreeWriter->Fill();
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootAnalysis::Loop()
+{
+  Long64_t entry;
+
+  if(fAllEntries > 0)
+  {
+    ExRootProgressBar progressBar(fAllEntries);
+    // Loop over all events
+    for(entry = 0; entry < fAllEntries; ++entry)
+//    for(entry = 541; entry < 542; ++entry)
+    {
+      if(!ReadEvent(entry))
+      {
+        cout << "** ERROR: cannot read event " << entry << endl;
+        break;
+      }
+  
+      ProcessTask();
+
+      progressBar.Update(entry);
+    }
+    progressBar.Finish();
+  }
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootAnalysis::Init()
+{
+  ExRootConfReader *confReader = GetConfReader();
+
+  confReader->ReadFile(fTclFileName);
+
+  TString name = confReader->GetString("::AppName", "ExRootAnalysis");
+
+  TFolder *folder = GetFolder();
+  folder->SetName(name);
+  gROOT->GetListOfBrowsables()->Add(folder);
+
+  SetName(name);
+  folder->Add(this);
+
+  confReader->SetName("ConfReader");
+  folder->Add(confReader);
+
+  ExRootConfParam param = confReader->GetParam("::InputCollection");
+  Long_t i, size;
+  TChain *chain = 0, *firstChain = 0;
+  size = param.GetSize();
+  if(size > 0)
+  {
+    for(i = 0; i < size; ++i)
+    {
+      chain = new TChain("", "");
+      fChains->Add(chain);
+      name = param[i][0].GetString();
+      chain->SetName(name);
+      FillChain(chain, param[i][1].GetString());
+      if(i == 0)
+      {
+        firstChain = chain;
+      }
+      else
+      {
+        firstChain->AddFriend(chain, name + i);
+      }
+    }
+    fTreeReader->SetTree(firstChain);
+  }
+  fTreeReader->SetName("TreeReader");
+  folder->Add(fTreeReader);
+
+  cout << "** Calculating number of events to process. Please wait..." << endl;
+  fAllEntries = GetEntries();
+  cout << "** Chain contains " << fAllEntries << " events" << endl;
+
+  if(fAllEntries <= 0)
+  {
+    cout << "** ERROR: cannot read any event for analysis" << endl;
+    return;
+  }
+  
+  name = confReader->GetString("::OutputFile", "Analysis");
+  name.ReplaceAll(".root", "");
+  fTreeFile = TFile::Open(name + "Tree.root", "RECREATE");
+  if(!fTreeFile)
+  {
+    cout << "** ERROR: cannot create output tree file" << endl;
+    return;
+  }
+
+  fInfoFile = TFile::Open(name + "Info.root", "RECREATE");
+  if(!fInfoFile)
+  {
+    cout << "** ERROR: cannot create output info file" << endl;
+    return;
+  }
+  
+  name = confReader->GetString("::TreeName", "Analysis");
+
+  fTreeWriter->SetTreeFile(fTreeFile);
+  fTreeWriter->SetTreeName(name);
+  fTreeWriter->SetName("TreeWriter");
+  folder->Add(fTreeWriter);
+
+  fFactory->SetName("ObjectFactory");
+  folder->Add(fFactory);
+
+  ExRootTask *task;
+  const ExRootConfReader::ExRootTaskMap *modules = confReader->GetModules();
+  ExRootConfReader::ExRootTaskMap::const_iterator itModules;
+
+  param = confReader->GetParam("::ExecutionPath");
+  size = param.GetSize();
+
+  for(i = 0; i < size; ++i)
+  {
+    name = param[i].GetString();
+    itModules = modules->find(name);
+    if(itModules != modules->end())
+    {
+      cout << itModules->second << " \t " <<  itModules->first << endl;
+      task = NewTask(itModules->second, itModules->first);
+      if(task)
+      {
+        task->SetFolder(GetFolder());
+        Add(task);
+      }
+    }
+    else
+    {
+      cout << "** ERROR: module '" << name;
+      cout << "' is specified in ExecutionPath but not configured.";
+      return;
+    }
+
+  }
+
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootAnalysis::Process()
+{
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootAnalysis::Finish()
+{
+  if(fTreeWriter) fTreeWriter->Write();
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootAnalysis::Clear()
+{
+  if(fTreeWriter) fTreeWriter->Clear();
+  if(fFactory) fFactory->Clear();
+}
+
+//------------------------------------------------------------------------------
+
Index: /trunk/src/ExRootAnalysisLinkDef.h
===================================================================
--- /trunk/src/ExRootAnalysisLinkDef.h	(revision 2)
+++ /trunk/src/ExRootAnalysisLinkDef.h	(revision 2)
@@ -0,0 +1,79 @@
+
+/** \class ExRootAnalysisLinkDef
+ *
+ *  Lists classes to be included in cint dicitonary
+ *
+ *  $Date: 2008-06-04 13:57:53 $
+ *  $Revision: 1.1 $
+ *
+ *  
+ *  \author P. Demin - UCL, Louvain-la-Neuve
+ *
+ */
+
+#include "ExRootAnalysis/ExRootSortableObject.h"
+#include "ExRootAnalysis/ExRootClasses.h"
+#include "ExRootAnalysis/ExRootCandidate.h"
+#include "ExRootAnalysis/ExRootCandList.h"
+#include "ExRootAnalysis/ExRootTreeReader.h"
+#include "ExRootAnalysis/ExRootTreeWriter.h"
+#include "ExRootAnalysis/ExRootTreeBranch.h"
+#include "ExRootAnalysis/ExRootResult.h"
+#include "ExRootAnalysis/ExRootUtilities.h"
+#include "ExRootAnalysis/ExRootClassifier.h"
+#include "ExRootAnalysis/ExRootFilter.h"
+
+#include "ExRootAnalysis/ExRootProgressBar.h"
+#include "ExRootAnalysis/ExRootConfReader.h"
+#include "ExRootAnalysis/ExRootEventLoop.h"
+#include "ExRootAnalysis/ExRootAnalysisNew.h"
+#include "ExRootAnalysis/ExRootAnalysis.h"
+#include "ExRootAnalysis/ExRootFactory.h"
+#include "ExRootAnalysis/ExRootModule.h"
+#include "ExRootAnalysis/ExRootTask.h"
+
+#ifdef __CINT__
+
+#pragma link off all globals;
+#pragma link off all classes;
+#pragma link off all functions;
+
+#pragma link C++ class ExRootSortableObject+;
+#pragma link C++ class ExRootLHEFEvent+;
+#pragma link C++ class ExRootLHEFParticle+;
+#pragma link C++ class ExRootGenEvent+;
+#pragma link C++ class ExRootGenParticle+;
+#pragma link C++ class ExRootGenJet+;
+#pragma link C++ class ExRootGenMatch+;
+#pragma link C++ class ExRootMatching+;
+#pragma link C++ class ExRootEvent+;
+#pragma link C++ class ExRootMissingET+;
+#pragma link C++ class ExRootPhoton+;
+#pragma link C++ class ExRootElectron+;
+#pragma link C++ class ExRootMuon+;
+#pragma link C++ class ExRootTau+;
+#pragma link C++ class ExRootJet+;
+
+#pragma link C++ class ExRootCandidate+;
+#pragma link C++ class ExRootCandList+;
+#pragma link C++ class ExRootTreeReader+;
+#pragma link C++ class ExRootTreeBranch+;
+#pragma link C++ class ExRootTreeWriter+;
+#pragma link C++ class ExRootResult+;
+#pragma link C++ class ExRootClassifier+;
+#pragma link C++ class ExRootFilter+;
+
+#pragma link C++ class ExRootProgressBar+;
+#pragma link C++ class ExRootConfReader+;
+#pragma link C++ class ExRootEventLoop+;
+#pragma link C++ class ExRootAnalysisNew+;
+#pragma link C++ class ExRootAnalysis+;
+#pragma link C++ class ExRootFactory+;
+#pragma link C++ class ExRootModule+;
+#pragma link C++ class ExRootTask+;
+
+#pragma link C++ function HistStyle;
+#pragma link C++ function FillChain;
+
+#endif
+
Index: /trunk/src/ExRootCandList.cc
===================================================================
--- /trunk/src/ExRootCandList.cc	(revision 2)
+++ /trunk/src/ExRootCandList.cc	(revision 2)
@@ -0,0 +1,292 @@
+
+/** \class ExRootCandidate
+ *
+ *  A list of ExRootCandidates with iterators.
+ *
+ *  $Date: 2008-06-04 13:57:53 $
+ *  $Revision: 1.1 $
+ *
+ *
+ *  \author P. Demin - UCL, Louvain-la-Neuve
+ *
+ */
+
+#include "ExRootAnalysis/ExRootCandList.h"
+#include "ExRootAnalysis/ExRootCandidate.h"
+#include "ExRootAnalysis/ExRootFactory.h"
+
+#include "TObjArray.h"
+#include "TBrowser.h"
+
+ExRootCandList::ExRootCandList() :
+  TNamed("ExRootCandList", ""),
+  fFactory(0),
+  fArray(0)
+{
+}
+
+//------------------------------------------------------------------------------
+
+ExRootCandList::ExRootCandList(const ExRootCandList &object) :
+  TNamed("ExRootCandList", ""),
+  fFactory(0),
+  fArray(0)
+{
+  object.Copy(*this);
+}
+
+//------------------------------------------------------------------------------
+// Geneology functions, no longer in a separate class
+//------------------------------------------------------------------------------
+
+void ExRootCandList::Add(ExRootCandidate *object)
+{
+  if(!fArray) fArray = fFactory->NewArray();
+  fArray->Add(object);
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootCandList::Add(const ExRootCandidate *object)
+{
+  if(!fArray) fArray = fFactory->NewArray();
+  fArray->Add(object->Clone());
+}
+
+//------------------------------------------------------------------------------
+// Access functions
+//------------------------------------------------------------------------------
+
+const ExRootCandidate *ExRootCandList::At(Int_t i) const
+{
+  if(i >= 0 && i < Size())
+    return static_cast<ExRootCandidate *>(fArray->UncheckedAt(i));
+  else
+    return 0;
+}
+
+//------------------------------------------------------------------------------
+
+Int_t ExRootCandList::Size() const
+{
+  if(!fArray) return 0;
+  return fArray->GetEntriesFast();
+}
+
+//------------------------------------------------------------------------------
+
+TObject *ExRootCandList::Clone(const char *newname) const
+{
+  ExRootCandList *object = fFactory->NewCandList();
+  Copy(*object);
+  return object;
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootCandList::Copy(TObject &obj) const
+{
+  ExRootCandList &object = (ExRootCandList &) obj;
+
+  TNamed::Copy(obj);
+
+  object.fFactory = fFactory;
+  object.fArray = 0;
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootCandList::Clear()
+{
+  if(fArray) fArray->Clear();
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootCandList::Sort(ExRootCompare *compare)
+{
+  if(fArray)
+  {
+    ExRootCompare *backup = ExRootCandidate::fgCompare;
+    ExRootCandidate::fgCompare = compare;
+    fArray->Sort();
+    ExRootCandidate::fgCompare = backup;
+  }
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootCandList::Browse(TBrowser *b)
+{
+  if(fArray) fArray->Browse(b);
+}
+
+//------------------------------------------------------------------------------
+//------------------------------------------------------------------------------
+
+ExRootCandIter::ExRootCandIter(TObjArray *array)
+{
+  fArray = array;
+  Reset();
+}
+
+//------------------------------------------------------------------------------
+
+ExRootCandIter::ExRootCandIter(ExRootCandList *object)
+{
+  fArray = object->fArray;
+  Reset();
+}
+
+//------------------------------------------------------------------------------
+
+ExRootCandIter::ExRootCandIter(const ExRootCandIter &iter)
+{
+  fArray = iter.fArray;
+  fCursor = iter.fCursor;
+}
+
+//------------------------------------------------------------------------------
+
+ExRootCandIter &ExRootCandIter::operator=(const ExRootCandIter &rhs)
+{
+  if(this != &rhs)
+  {
+    fArray = rhs.fArray;
+    fCursor = rhs.fCursor;
+  }
+  return *this;
+}
+
+//------------------------------------------------------------------------------
+
+ExRootCandidate *ExRootCandIter::Next(Bool_t direction)
+{
+  // By default the iteration direction is kIterForward.
+  // To go backward use kIterBackward.
+  // Return next object in array. Returns 0 when no more objects in array.
+
+  if(!fArray) return 0;
+
+  if(direction == kIterForward)
+  {
+    Int_t size = fArray->Capacity();
+    while(fCursor < size && fArray->UncheckedAt(fCursor) == 0) { ++fCursor; }
+    if(fCursor < size) return static_cast<ExRootCandidate *>(fArray->UncheckedAt(fCursor++));
+  }
+  else
+  {
+    while(fCursor >= 0 && fArray->UncheckedAt(fCursor) == 0) { --fCursor; }
+    if(fCursor >= 0) return static_cast<ExRootCandidate *>(fArray->UncheckedAt(fCursor--));
+  }
+  return 0;
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootCandIter::Reset(Bool_t direction)
+{
+  if(direction == kIterForward)
+  {
+    fCursor = 0;
+  }
+  else
+  {
+    if(fArray) fCursor = fArray->Capacity() - 1;
+  }
+}
+
+//------------------------------------------------------------------------------
+//------------------------------------------------------------------------------
+
+ExRootCandConstIter::ExRootCandConstIter(const TObjArray *array)
+{
+  fArray = array;
+  Reset();
+}
+
+//------------------------------------------------------------------------------
+
+ExRootCandConstIter::ExRootCandConstIter(const ExRootCandList *object)
+{
+  fArray = object->fArray;
+  Reset();
+}
+
+//------------------------------------------------------------------------------
+
+ExRootCandConstIter::ExRootCandConstIter(const ExRootCandIter &iter)
+{
+  fArray = iter.fArray;
+  fCursor = iter.fCursor;
+}
+
+//------------------------------------------------------------------------------
+
+ExRootCandConstIter::ExRootCandConstIter(const ExRootCandConstIter &iter)
+{
+  fArray = iter.fArray;
+  fCursor = iter.fCursor;
+}
+
+//------------------------------------------------------------------------------
+
+ExRootCandConstIter &ExRootCandConstIter::operator=(const ExRootCandIter &rhs)
+{
+  fArray = rhs.fArray;
+  fCursor = rhs.fCursor;
+  return *this;
+}
+
+//------------------------------------------------------------------------------
+
+ExRootCandConstIter &ExRootCandConstIter::operator=(const ExRootCandConstIter &rhs)
+{
+  if(this != &rhs)
+  {
+    fArray = rhs.fArray;
+    fCursor = rhs.fCursor;
+  }
+  return *this;
+}
+
+//------------------------------------------------------------------------------
+
+const ExRootCandidate *ExRootCandConstIter::Next(Bool_t direction)
+{
+  // By default the iteration direction is kIterForward.
+  // To go backward use kIterBackward.
+  // Return next object in array. Returns 0 when no more objects in array.
+
+  if(!fArray) return 0;
+
+  if(direction == kIterForward)
+  {
+    Int_t size = fArray->Capacity();
+    while(fCursor < size && fArray->UncheckedAt(fCursor) == 0) { ++fCursor; }
+    if(fCursor < size) return static_cast<ExRootCandidate *>(fArray->UncheckedAt(fCursor++));
+  }
+  else
+  {
+    while(fCursor >= 0 && fArray->UncheckedAt(fCursor) == 0) { --fCursor; }
+    if(fCursor >= 0) return static_cast<ExRootCandidate *>(fArray->UncheckedAt(fCursor--));
+  }
+  return 0;
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootCandConstIter::Reset(Bool_t direction)
+{
+  if(direction == kIterForward)
+  {
+    fCursor = 0;
+  }
+  else
+  {
+    if(fArray) fCursor = fArray->Capacity() - 1;
+  }
+}
+
+//------------------------------------------------------------------------------
+
Index: /trunk/src/ExRootCandidate.cc
===================================================================
--- /trunk/src/ExRootCandidate.cc	(revision 2)
+++ /trunk/src/ExRootCandidate.cc	(revision 2)
@@ -0,0 +1,355 @@
+
+/** \class ExRootCandidate
+ *
+ *  Class implementing particle candidate model.
+ *
+ *  $Date: 2008-06-04 13:57:54 $
+ *  $Revision: 1.1 $
+ *
+ *
+ *  \author P. Demin - UCL, Louvain-la-Neuve
+ *
+ */
+
+#include "ExRootAnalysis/ExRootCandidate.h"
+#include "ExRootAnalysis/ExRootFactory.h"
+
+#include "TDatabasePDG.h"
+#include "TBrowser.h"
+#include "TClass.h"
+
+#include <map>
+#include <iostream>
+
+using namespace std;
+
+ExRootCompare *ExRootCandidate::fgCompare = 0;
+
+ExRootCandidate::ExRootCandidate() :
+  fIsResonance(kFALSE),
+  fCharge(0),
+  fLorentzVector(0.0, 0.0, 0.0, 0.0),
+  fMother(0)
+{
+}
+
+//------------------------------------------------------------------------------
+
+ExRootCandidate::ExRootCandidate(const ExRootCandidate &object) :
+  fIsResonance(kFALSE),
+  fCharge(0),
+  fLorentzVector(0.0, 0.0, 0.0, 0.0),
+  fMother(0)
+{
+  object.Copy(*this);
+}
+
+//------------------------------------------------------------------------------
+
+Bool_t ExRootCandidate::IsCloneOf(const ExRootCandidate *object, Bool_t checkType) const
+{
+  // Original behaviour of ExRootCandidate::IsCloneOf()
+  if(object->GetUniqueID() == GetUniqueID() && !checkType) return kTRUE;
+
+  if((IsComposite() && !object->IsComposite()) ||
+     (!IsComposite() && object->IsComposite())) return kFALSE;
+
+  // forsingle tracks and clusters, it is enough to compare
+  // UIDs and PDT types
+  if(!IsComposite() && !object->IsComposite())
+  {
+    return (object->GetUniqueID() == GetUniqueID() &&
+            (!checkType || GetType() == object->GetType()));
+  }
+
+  // if we got here, must be true
+  return kTRUE;
+}
+
+//------------------------------------------------------------------------------
+
+const ExRootCandidate *ExRootCandidate::FindCloneInTree(const ExRootCandidate *object) const
+{
+  if(IsCloneOf(object)) return this;
+  const ExRootCandidate *daughter;
+  ExRootCandConstIter itDaughters(Iterator());
+  while((daughter = itDaughters.Next()))
+  {
+    daughter = daughter->FindCloneInTree(object);
+    if(daughter) return daughter;
+  }
+  return 0;
+}
+
+//------------------------------------------------------------------------------
+
+Bool_t ExRootCandidate::Overlaps(const ExRootCandidate *object) const
+{
+  if(object->GetUniqueID() == GetUniqueID()) return kTRUE;
+
+  const ExRootCandidate *daughter;
+
+  ExRootCandConstIter itDaughters(Iterator());
+  while((daughter = itDaughters.Next()))
+  {
+    if(daughter->Overlaps(object)) return kTRUE;
+  }
+
+  itDaughters = object->Iterator();
+  while((daughter = itDaughters.Next()))
+  {
+    if(daughter->Overlaps(this)) return kTRUE;
+  }
+
+  return kFALSE;
+}
+
+//------------------------------------------------------------------------------
+
+Bool_t ExRootCandidate::Equals(const ExRootCandidate *object) const
+{
+  if(object->GetUniqueID() != GetUniqueID()) return kFALSE;
+
+  const ExRootCandidate *daughter;
+
+  ExRootCandConstIter itDaughters(Iterator());
+  while((daughter = itDaughters.Next()))
+  {
+    if(!daughter->Equals(object)) return kFALSE;
+  }
+
+  itDaughters = object->Iterator();
+  while((daughter = itDaughters.Next()))
+  {
+    if(!daughter->Equals(this)) return kFALSE;
+  }
+
+  return kTRUE;
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootCandidate::SetMass(Double_t mass)
+{
+  fLorentzVector.SetVectM(fLorentzVector.Vect(), mass);
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootCandidate::SetP4(const TLorentzVector &p4)
+{
+  fLorentzVector = p4;
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootCandidate::SetMomentum(Double_t momentum)
+{
+  // this implementation leaves mass unchanged; subclasses may differ
+  Double_t scale = 0.0;
+  Double_t p = fLorentzVector.P();
+  if(p != 0.0) scale = momentum / p;
+  fLorentzVector.SetVect(scale*fLorentzVector.Vect());
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootCandidate::SetType(TParticlePDG *particle)
+{
+  const TParticlePDG *pdg = GetType();
+
+  if(pdg == particle || particle == 0) return;
+
+  SetInfo(particle);
+  SetName(particle->GetName());
+
+  //
+  // by default:
+  //   if the proper lifetime multiplied by light velocity is less
+  //   than a nanometer, the object is considered a resonance
+  //   (a state that does not fly)
+  //
+  fIsResonance = kFALSE;
+  if(particle->Width() > 1.0e-15) fIsResonance = kTRUE; // Lifetime() < 1.0e-08
+
+  if(!IsComposite())
+  {
+    // the mass has changed since the type has changed
+    SetMass(GetMass());
+
+    // set the charge
+    SetCharge(particle->Charge());
+  }
+  else
+  {
+    if(GetCharge() != particle->Charge())
+    {
+      cout
+      << "** ERROR: attempt to call ExRootCandidate::SetType(\""
+      << particle->ParticleClass() << "\") for a composite" << endl
+      << " ExRootCandidate whose daughters have total charge "
+      << GetCharge() << endl;
+    }
+  }
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootCandidate::SetType(const char *name)
+{
+  TDatabasePDG *pdg = TDatabasePDG::Instance();
+  TParticlePDG *particle;
+  if((particle = pdg->GetParticle(name))) SetType(particle);
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootCandidate::SetType(Int_t pdgCode)
+{
+  TDatabasePDG *pdg = TDatabasePDG::Instance();
+  TParticlePDG *particle;
+  if((particle = pdg->GetParticle(pdgCode))) SetType(particle);
+}
+
+//------------------------------------------------------------------------------
+// Geneology functions, no longer in a separate class
+//------------------------------------------------------------------------------
+
+void ExRootCandidate::AddDaughter(const ExRootCandidate *object)
+{
+  Add(object);
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootCandidate::AddDaughter(ExRootCandidate *object)
+{
+  Add(object);
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootCandidate::Add(const ExRootCandidate *object)
+{
+  Add(static_cast<ExRootCandidate *>(object->Clone()));
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootCandidate::Add(ExRootCandidate *object)
+{
+  ExRootCandList::Add(object);
+
+  // as soon as there are daughters, the charge is
+  // given by the sum of the daughter charges
+  if(Size() == 0) fCharge = 0;
+
+  fCharge += object->fCharge;
+  fLorentzVector += object->fLorentzVector;
+
+  // set the daughter's mother link
+  object->fMother = this;
+}
+
+//------------------------------------------------------------------------------
+// Access functions
+//------------------------------------------------------------------------------
+
+Double_t ExRootCandidate::GetMass() const
+{
+  const TParticlePDG *pdg = GetType();
+  if(!IsComposite() && pdg)
+    return pdg->Mass();
+  else
+    return fLorentzVector.M();
+}
+
+//------------------------------------------------------------------------------
+
+TObject *ExRootCandidate::Clone(const char *newname) const
+{
+  ExRootCandidate *object = fFactory->NewCandidate();
+  Copy(*object);
+  return object;
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootCandidate::Copy(TObject &obj) const
+{
+  ExRootCandidate &object = (ExRootCandidate &) obj;
+
+  ExRootCandList::Copy(obj);
+
+  object.fIsResonance = fIsResonance;
+  object.fCharge = fCharge;
+  object.fLorentzVector = fLorentzVector;
+
+  object.fMother = 0;
+
+  const ExRootCandidate *daughterOld;
+  ExRootCandidate *daughterNew;
+  ExRootCandConstIter itDaughters(Iterator());
+  while((daughterOld = itDaughters.Next()))
+  {
+    daughterNew = static_cast<ExRootCandidate *>(daughterOld->Clone());
+    object.ExRootCandList::Add(daughterNew);
+    daughterNew->fMother = static_cast<ExRootCandidate *>(&object);
+  }
+
+  map<const TClass *, TObject *>::const_iterator it;
+  for(it = fInfo.begin(); it != fInfo.end(); ++it)
+  {
+    object.SetInfo(it->second->Clone());
+  }
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootCandidate::Clear()
+{
+  SetUniqueID(0);
+  fCharge = 0;
+  fLorentzVector.SetXYZT(0.0, 0.0, 0.0, 0.0);
+  fInfo.clear();
+  ExRootCandList::Clear();
+}
+
+//------------------------------------------------------------------------------
+
+const TObject *ExRootCandidate::GetInfo(const TClass *cl) const
+{
+  map<const TClass *, TObject *>::const_iterator it = fInfo.find(cl);
+
+  return (it != fInfo.end() ? it->second : 0);
+}
+
+//------------------------------------------------------------------------------
+
+TObject *ExRootCandidate::GetInfo(const TClass *cl)
+{
+  map<const TClass *, TObject *>::const_iterator it = fInfo.find(cl);
+
+  return (it != fInfo.end() ? it->second : 0);
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootCandidate::SetInfo(TObject *info)
+{
+  fInfo[info->IsA()] = info;
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootCandidate::Browse(TBrowser *b)
+{
+/*
+  map<const TClass *, TObject *>::const_iterator it = fInfo.find(ExRootDSTInfo::Class());
+
+  if(it != fInfo.end()) b->Add(it->second);
+*/
+  ExRootCandList::Browse(b);
+}
+
+//------------------------------------------------------------------------------
Index: /trunk/src/ExRootClasses.cc
===================================================================
--- /trunk/src/ExRootClasses.cc	(revision 2)
+++ /trunk/src/ExRootClasses.cc	(revision 2)
@@ -0,0 +1,25 @@
+
+/** \class ExRootClasses
+ *
+ *  See header classes for a description of this file
+ *
+ *  $Date: 2008-06-04 13:57:54 $
+ *  $Revision: 1.1 $
+ *
+ *  
+ *  \author P. Demin - UCL, Louvain-la-Neuve
+ *
+ */
+
+#include "ExRootAnalysis/ExRootClasses.h"
+#include "ExRootAnalysis/ExRootSortableObject.h"
+
+ExRootCompare *ExRootLHEFParticle::fgCompare = 0;
+ExRootCompare *ExRootGenParticle::fgCompare = 0;
+ExRootCompare *ExRootGenJet::fgCompare = ExRootComparePT<ExRootGenJet>::Instance();
+ExRootCompare *ExRootPhoton::fgCompare = ExRootComparePT<ExRootPhoton>::Instance();
+ExRootCompare *ExRootElectron::fgCompare = ExRootComparePT<ExRootElectron>::Instance();
+ExRootCompare *ExRootMuon::fgCompare = ExRootComparePT<ExRootMuon>::Instance();
+ExRootCompare *ExRootTau::fgCompare = ExRootComparePT<ExRootTau>::Instance();
+ExRootCompare *ExRootJet::fgCompare = ExRootComparePT<ExRootJet>::Instance();
+
Index: /trunk/src/ExRootConfReader.cc
===================================================================
--- /trunk/src/ExRootConfReader.cc	(revision 2)
+++ /trunk/src/ExRootConfReader.cc	(revision 2)
@@ -0,0 +1,311 @@
+
+/** \class ExRootConfReader
+ *
+ *  Class handling output ROOT tree
+ *
+ *  $Date: 2008-06-04 13:57:54 $
+ *  $Revision: 1.1 $
+ *
+ *
+ *  \author P. Demin - UCL, Louvain-la-Neuve
+ *
+ */
+
+#include "ExRootAnalysis/ExRootConfReader.h"
+
+#include "tcl/tcl.h"
+
+#include <iostream>
+#include <fstream>
+#include <string>
+
+using namespace std;
+
+static Tcl_ObjCmdProc ModuleObjCmdProc;
+
+//------------------------------------------------------------------------------
+
+ExRootConfReader::ExRootConfReader() :
+  fTclInterp(0)
+{
+  fTclInterp = Tcl_CreateInterp();
+
+  Tcl_CreateObjCommand(fTclInterp, "module", ModuleObjCmdProc, this, 0);
+}
+
+//------------------------------------------------------------------------------
+
+ExRootConfReader::~ExRootConfReader()
+{
+  Tcl_DeleteInterp(fTclInterp);
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootConfReader::ReadFile(const char *fileName)
+{
+/*
+  ifstream infile(fileName);
+  string cmdBuffer = string(istreambuf_iterator<char>(infile), istreambuf_iterator<char>());
+
+  Tcl_Obj *cmdObjPtr = Tcl_NewObj();
+  cmdObjPtr->bytes = const_cast<char *>(cmdBuffer.c_str());
+  cmdObjPtr->length = cmdBuffer.size();
+*/
+
+  ifstream infile(fileName, ios::in | ios::ate);
+  int file_length = infile.tellg();
+  infile.seekg(0, ios::beg);
+  infile.clear();
+  char *cmdBuffer = new char[file_length];
+  infile.read(cmdBuffer, file_length);
+
+  Tcl_Obj *cmdObjPtr = Tcl_NewObj();
+  cmdObjPtr->bytes = cmdBuffer;
+  cmdObjPtr->length = file_length;
+
+  Tcl_IncrRefCount(cmdObjPtr);
+
+  if(Tcl_EvalObj(fTclInterp, cmdObjPtr) != TCL_OK)
+  {
+    cerr << endl;
+    cerr << "** ERROR: cannot read configuration file" << endl;
+    cerr << Tcl_GetStringResult(fTclInterp) << endl;
+  }
+
+  cmdObjPtr->bytes = 0;
+  cmdObjPtr->length = 0;
+
+  Tcl_DecrRefCount(cmdObjPtr);
+
+  delete[] cmdBuffer;
+}
+
+//------------------------------------------------------------------------------
+
+ExRootConfParam ExRootConfReader::GetParam(const char *name)
+{
+  Tcl_Obj *object;
+  Tcl_Obj *variableName = Tcl_NewStringObj(const_cast<char *>(name),-1);
+  object = Tcl_ObjGetVar2(fTclInterp, variableName, 0, TCL_GLOBAL_ONLY);
+  return ExRootConfParam(name, object, fTclInterp);
+}
+
+//------------------------------------------------------------------------------
+
+int ExRootConfReader::GetInt(const char *name, int defaultValue, int index)
+{
+  ExRootConfParam object = GetParam(name);
+  if(index >= 0)
+  {
+    object = object[index];
+  }
+
+  return object.GetInt(defaultValue);
+}
+
+//------------------------------------------------------------------------------
+
+long ExRootConfReader::GetLong(const char *name, long defaultValue, int index)
+{
+  ExRootConfParam object = GetParam(name);
+  if(index >= 0)
+  {
+    object = object[index];
+  }
+
+  return object.GetLong(defaultValue);
+}
+
+//------------------------------------------------------------------------------
+
+double ExRootConfReader::GetDouble(const char *name, double defaultValue, int index)
+{
+  ExRootConfParam object = GetParam(name);
+  if(index >= 0)
+  {
+    object = object[index];
+  }
+
+  return object.GetDouble(defaultValue);
+}
+
+//------------------------------------------------------------------------------
+
+bool ExRootConfReader::GetBool(const char *name, bool defaultValue, int index)
+{
+  ExRootConfParam object = GetParam(name);
+  if(index >= 0)
+  {
+    object = object[index];
+  }
+
+  return object.GetBool(defaultValue);
+}
+
+//------------------------------------------------------------------------------
+
+const char *ExRootConfReader::GetString(const char *name, const char *defaultValue, int index)
+{
+  ExRootConfParam object = GetParam(name);
+  if(index >= 0)
+  {
+    object = object[index];
+  }
+
+  return object.GetString(defaultValue);
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootConfReader::AddModule(const char *className, const char *moduleName)
+{
+  ExRootTaskMap::iterator itMoudles = fModules.find(moduleName);
+
+  if(itMoudles != fModules.end())
+  {
+    cout << "** WARNING: module '" << moduleName << "' is already configured.";
+    cout << " Only first entry will be used." << endl;
+  }
+  else
+  {
+    fModules.insert(make_pair(moduleName, className));
+    cout << "** INFO: adding module ";
+    cout << className << " \t ";
+    cout << moduleName << endl;
+  }
+}
+
+//------------------------------------------------------------------------------
+
+int ModuleObjCmdProc(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+  if(objc < 3)
+  {
+/*
+    Tcl_SetResult(interp, "wrong # args: should be \"module className moduleName arg ?arg...?\"", 0);
+*/
+    Tcl_WrongNumArgs(interp, 1, objv, "className moduleName ?arg...?");
+		return TCL_ERROR;
+  }
+
+  ExRootConfReader *test = (ExRootConfReader*) clientData;
+
+  // add module to a list of modules to be created
+
+  test->AddModule(Tcl_GetStringFromObj(objv[1], 0), Tcl_GetStringFromObj(objv[2], 0));
+
+  if(objc > 3)
+  {
+    Tcl_Obj *object = Tcl_NewListObj(0, 0);
+    Tcl_ListObjAppendElement(interp, object, Tcl_NewStringObj("namespace", -1));
+    Tcl_ListObjAppendElement(interp, object, Tcl_NewStringObj("eval", -1));
+    Tcl_ListObjAppendList(interp, object, Tcl_NewListObj(objc-2, objv+2));
+
+    return Tcl_GlobalEvalObj(interp, object);
+  }
+
+  return TCL_OK;
+}
+
+//------------------------------------------------------------------------------
+
+ExRootConfParam::ExRootConfParam(const char *name, Tcl_Obj *object, Tcl_Interp *interp) :
+  fName(name), fObject(object), fTclInterp(interp)
+{
+}
+
+//------------------------------------------------------------------------------
+
+int ExRootConfParam::GetInt(int defaultValue)
+{
+  int result = defaultValue;
+  if(fObject && TCL_OK != Tcl_GetIntFromObj(fTclInterp, fObject, &result))
+  {
+    cerr << endl;
+    cerr << "** ERROR: parameter '"<< fName << "' is not an integer." << endl;
+    cerr << "** ERROR: " << fName << " = " << Tcl_GetStringFromObj(fObject, 0) << endl;
+  }
+  return result;
+}
+
+//------------------------------------------------------------------------------
+
+long ExRootConfParam::GetLong(long defaultValue)
+{
+  long result = defaultValue;
+  if(fObject && TCL_OK != Tcl_GetLongFromObj(fTclInterp, fObject, &result))
+  {
+    cerr << endl;
+    cerr << "** ERROR: parameter '"<< fName << "' is not a long integer." << endl;
+    cerr << "** ERROR: " << fName << " = " << Tcl_GetStringFromObj(fObject, 0) << endl;
+  }
+  return result;
+}
+
+//------------------------------------------------------------------------------
+
+double ExRootConfParam::GetDouble(double defaultValue)
+{
+  double result = defaultValue;
+  if(fObject && TCL_OK != Tcl_GetDoubleFromObj(fTclInterp, fObject, &result))
+  {
+    cerr << endl;
+    cerr << "** ERROR: parameter '"<< fName << "' is not a number." << endl;
+    cerr << "** ERROR: " << fName << " = " << Tcl_GetStringFromObj(fObject, 0) << endl;
+  }
+  return result;
+}
+
+//------------------------------------------------------------------------------
+
+bool ExRootConfParam::GetBool(bool defaultValue)
+{
+  int result = defaultValue;
+  if(fObject && TCL_OK != Tcl_GetBooleanFromObj(fTclInterp, fObject, &result))
+  {
+    cerr << endl;
+    cerr << "** ERROR: parameter '"<< fName << "' is not a boolean." << endl;
+    cerr << "** ERROR: " << fName << " = " << Tcl_GetStringFromObj(fObject, 0) << endl;
+  }
+  return result;
+}
+
+//------------------------------------------------------------------------------
+
+const char *ExRootConfParam::GetString(const char *defaultValue)
+{
+  const char *result = defaultValue;
+  if(fObject) result = Tcl_GetStringFromObj(fObject, 0);
+  return result;  
+}
+
+//------------------------------------------------------------------------------
+
+int ExRootConfParam::GetSize()
+{
+  int length = 0;
+  if(fObject && TCL_OK != Tcl_ListObjLength(fTclInterp, fObject, &length))
+  {
+    cerr << endl;
+    cerr << "** ERROR: parameter '"<< fName << "' is not a list." << endl;
+    cerr << "** ERROR: " << fName << " = " << Tcl_GetStringFromObj(fObject, 0) << endl;
+  }
+  return length;  
+}
+
+//------------------------------------------------------------------------------
+
+ExRootConfParam ExRootConfParam::operator[](int index)
+{
+  Tcl_Obj *object = 0;
+  if(fObject && TCL_OK != Tcl_ListObjIndex(fTclInterp, fObject, index, &object))
+  {
+    cerr << endl;
+    cerr << "** ERROR: parameter '"<< fName << "' is not a list." << endl;
+    cerr << "** ERROR: " << fName << " = " << Tcl_GetStringFromObj(fObject, 0) << endl;
+  }
+  return ExRootConfParam(fName, object, fTclInterp);
+}
+
+
Index: /trunk/src/ExRootEventLoop.cc
===================================================================
--- /trunk/src/ExRootEventLoop.cc	(revision 2)
+++ /trunk/src/ExRootEventLoop.cc	(revision 2)
@@ -0,0 +1,192 @@
+
+/** \class ExRootEventLoop
+ *
+ *  Analysis steering class.
+ *  Implements events loop and modules management.
+ *
+ *  $Date: 2008-06-04 13:57:55 $
+ *  $Revision: 1.1 $
+ *
+ *
+ *  \author P. Demin - UCL, Louvain-la-Neuve
+ *
+ */
+
+#include "ExRootAnalysis/ExRootEventLoop.h"
+#include "ExRootAnalysis/ExRootFactory.h"
+
+#include "ExRootAnalysis/ExRootConfReader.h"
+#include "ExRootAnalysis/ExRootTreeReader.h"
+#include "ExRootAnalysis/ExRootTreeWriter.h"
+
+#include "ExRootAnalysis/ExRootUtilities.h"
+#include "ExRootAnalysis/ExRootProgressBar.h"
+
+#include "TROOT.h"
+#include "TClass.h"
+#include "TSystem.h"
+#include "TFolder.h"
+#include "TObjArray.h"
+
+#include <iostream>
+
+#include <string.h>
+#include <stdio.h>
+
+using namespace std;
+
+ExRootEventLoop::ExRootEventLoop() :
+  fAllEntries(0), fEventLoop(0)
+{
+  fChains = new TObjArray;
+  fChains->SetOwner();
+}
+
+//------------------------------------------------------------------------------
+
+ExRootEventLoop::~ExRootEventLoop()
+{
+  delete fChains;
+  if(fEventLoop) delete fEventLoop;
+}
+
+//------------------------------------------------------------------------------
+
+Long64_t ExRootEventLoop::GetEntries()
+{
+  ExRootTreeReader *reader = GetTreeReader();
+  return reader ? reader->GetEntries() : 0;
+}
+
+//------------------------------------------------------------------------------
+
+Bool_t ExRootEventLoop::ReadEvent(Long64_t entry)
+{
+  ExRootTreeReader *reader = GetTreeReader();
+  return reader ? reader->ReadEntry(entry) : kFALSE;
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootEventLoop::Init()
+{
+  fEventLoop = NewTask(ExRootTask::Class(), "EventLoop");
+
+  ExRootTask *task;
+  const ExRootConfReader::ExRootTaskMap *modules = GetModules();
+  ExRootConfReader::ExRootTaskMap::const_iterator itModules;
+
+  ExRootConfParam param = GetParam("TaskList");
+  Long_t i, size;
+  TString name;
+
+  size = param.GetSize();
+
+  for(i = 0; i < size; ++i)
+  {
+    name = param[i].GetString();
+    itModules = modules->find(name);
+    if(itModules != modules->end())
+    {
+      cout << itModules->second << " \t " <<  itModules->first << endl;
+      task = NewTask(itModules->second, itModules->first);
+      fEventLoop->Add(task);
+    }
+    else
+    {
+      cout << "** ERROR: module '" << name;
+      cout << "' is specified in TaskList but not configured.";
+      return;
+    }
+
+  }
+
+  param = GetParam("InputCollection");
+  TChain *chain = 0, *firstChain = 0;
+  size = param.GetSize();
+  if(size > 0)
+  {
+    for(i = 0; i < size; ++i)
+    {
+      chain = new TChain("", "");
+      fChains->Add(chain);
+      name = param[i][0].GetString();
+      chain->SetName(name);
+      FillChain(chain, param[i][1].GetString());
+      if(i == 0)
+      {
+        firstChain = chain;
+      }
+      else
+      {
+        firstChain->AddFriend(chain, name + i);
+      }
+    }
+    GetTreeReader()->SetTree(firstChain);
+  }
+
+  cout << "** Calculating number of events to process. Please wait..." << endl;
+  fAllEntries = GetEntries();
+  cout << "** Chain contains " << fAllEntries << " events" << endl;
+
+  if(fAllEntries <= 0)
+  {
+    cout << "** ERROR: cannot read any event for analysis" << endl;
+    return;
+  }
+
+  fEventLoop->CleanTasks();
+  fEventLoop->InitSubTasks();
+
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootEventLoop::Process()
+{
+  Long64_t entry;
+
+  if(fAllEntries > 0)
+  {
+    ExRootProgressBar progressBar(fAllEntries);
+    // Loop over all events
+    for(entry = 0; entry < fAllEntries; ++entry)
+    {
+      if(!ReadEvent(entry))
+      {
+        cout << "** ERROR: cannot read event " << entry << endl;
+        break;
+      }
+      
+      Clear();
+
+      fEventLoop->CleanTasks();
+      fEventLoop->ProcessSubTasks();
+
+      if(fTreeWriter) fTreeWriter->Fill();
+
+      progressBar.Update(entry);
+    }
+    progressBar.Finish();
+  }
+
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootEventLoop::Finish()
+{
+  fEventLoop->CleanTasks();
+  fEventLoop->FinishSubTasks();
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootEventLoop::Clear()
+{
+  if(fTreeWriter) fTreeWriter->Clear();
+  if(fFactory) fFactory->Clear();
+}
+
+//------------------------------------------------------------------------------
+
Index: /trunk/src/ExRootFactory.cc
===================================================================
--- /trunk/src/ExRootFactory.cc	(revision 2)
+++ /trunk/src/ExRootFactory.cc	(revision 2)
@@ -0,0 +1,138 @@
+
+/** \class ExRootFactory
+ *
+ *  Class handling creation of ExRootCandidate,
+ *  ExRootCandList and all other objects.
+ *
+ *  $Date: 2008-06-04 13:57:55 $
+ *  $Revision: 1.1 $
+ *
+ *
+ *  \author P. Demin - UCL, Louvain-la-Neuve
+ *
+ */
+
+#include "ExRootAnalysis/ExRootTreeWriter.h"
+#include "ExRootAnalysis/ExRootTreeBranch.h"
+
+#include "ExRootAnalysis/ExRootFactory.h"
+
+#include "ExRootAnalysis/ExRootCandidate.h"
+#include "ExRootAnalysis/ExRootCandList.h"
+
+#include "TClass.h"
+#include "TObjArray.h"
+
+using namespace std;
+
+//------------------------------------------------------------------------------
+
+ExRootFactory::ExRootFactory() :
+  fTreeWriter(0), fPermanentObjArrays(0)
+{
+  fTreeWriter = new ExRootTreeWriter();
+  fPermanentObjArrays = fTreeWriter->NewFactory("PermanentObjArrays", TObjArray::Class());
+}
+
+//------------------------------------------------------------------------------
+
+ExRootFactory::~ExRootFactory()
+{
+  if(fTreeWriter) delete fTreeWriter;
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootFactory::Clear()
+{
+  map<const TClass *, ExRootTreeBranch *>::iterator it_map;
+  for(it_map = fMakers.begin(); it_map != fMakers.end(); ++it_map)
+  {
+    it_map->second->Clear();
+  }
+
+  set<TObject *>::iterator it_set;
+  for(it_set = fPool.begin(); it_set != fPool.end(); ++it_set)
+  {
+    (*it_set)->Clear();
+  }
+}
+
+//------------------------------------------------------------------------------
+
+TObjArray *ExRootFactory::NewArray()
+{
+  return New<TObjArray>();
+}
+
+//------------------------------------------------------------------------------
+
+TObjArray *ExRootFactory::NewPermanentArray()
+{
+  TObjArray *array = static_cast<TObjArray *>(fPermanentObjArrays->NewEntry());
+  fPool.insert(array);
+  return array;
+}
+
+//------------------------------------------------------------------------------
+
+ExRootCandList *ExRootFactory::NewCandList()
+{
+  ExRootCandList *object = New<ExRootCandList>();
+  object->SetFactory(this);
+  return object;
+}
+
+//------------------------------------------------------------------------------
+
+ExRootCandidate *ExRootFactory::NewCandidate()
+{
+  ExRootCandidate *object = New<ExRootCandidate>();
+  object->SetFactory(this);
+  TProcessID::AssignID(object);
+  return object;
+}
+
+//------------------------------------------------------------------------------
+
+ExRootCandList *ExRootFactory::NewPermanentCandList()
+{
+  ExRootCandList *object = static_cast<ExRootCandList *>(fPermanentCandLists->NewEntry());
+  object->SetFactory(this);
+  fPool.insert(object);
+  return object;
+}
+
+//------------------------------------------------------------------------------
+
+ExRootCandidate *ExRootFactory::NewPermanentCandidate()
+{
+  ExRootCandidate *object = static_cast<ExRootCandidate *>(fPermanentCandidates->NewEntry());
+  object->SetFactory(this);
+  TProcessID::AssignID(object);
+  fPool.insert(object);
+  return object;
+}
+
+//------------------------------------------------------------------------------
+
+TObject *ExRootFactory::New(TClass *cl)
+{
+  ExRootTreeBranch *maker = 0;
+  map<const TClass *, ExRootTreeBranch *>::iterator it = fMakers.find(cl);
+
+  if(it != fMakers.end())
+  {
+    maker = it->second;
+  }
+  else
+  {
+    maker = fTreeWriter->NewFactory(cl->GetName(), cl);
+    fMakers.insert(make_pair(cl, maker));
+  }
+
+  return maker->NewEntry();
+}
+
+//------------------------------------------------------------------------------
+
Index: /trunk/src/ExRootFilter.cc
===================================================================
--- /trunk/src/ExRootFilter.cc	(revision 2)
+++ /trunk/src/ExRootFilter.cc	(revision 2)
@@ -0,0 +1,125 @@
+
+/** \class ExRootFilter
+ *
+ *  Class simplifying classification and subarrays handling
+ *
+ *  $Date: 2008-06-04 13:57:55 $
+ *  $Revision: 1.1 $
+ *
+ *
+ *  \author P. Demin - UCL, Louvain-la-Neuve
+ *
+ */
+
+#include "ExRootAnalysis/ExRootFilter.h"
+#include "ExRootAnalysis/ExRootClassifier.h"
+
+#include "TSeqCollection.h"
+#include "TObjArray.h"
+
+using namespace std;
+
+ExRootFilter::ExRootFilter(const TSeqCollection *collection) :
+  fCollection(collection)
+{
+  fIter = fCollection->MakeIterator();
+}
+
+//------------------------------------------------------------------------------
+
+ExRootFilter::~ExRootFilter()
+{
+  TClassifierMap::iterator it_map;
+  TCategoryMap::iterator it_submap;
+  for(it_map = fMap.begin(); it_map != fMap.end(); ++it_map)
+  {
+    for(it_submap = it_map->second.second.begin();
+        it_submap != it_map->second.second.end(); ++it_submap)
+    {
+      delete (it_submap->second);
+    }
+  }
+
+  delete fIter;
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootFilter::Reset(ExRootClassifier *classifier)
+{
+  TClassifierMap::iterator it_map;
+  TCategoryMap::iterator it_submap;
+  if(classifier)
+  {
+    it_map = fMap.find(classifier);
+    if(it_map != fMap.end())
+    {
+      it_map->second.first = kTRUE;
+      for(it_submap = it_map->second.second.begin();
+          it_submap != it_map->second.second.end(); ++it_submap)
+      {
+        it_submap->second->Clear();
+      }
+    }
+  }
+  else
+  {
+    for(it_map = fMap.begin(); it_map != fMap.end(); ++it_map)
+    {
+      it_map->second.first = kTRUE;
+      for(it_submap = it_map->second.second.begin();
+          it_submap != it_map->second.second.end(); ++it_submap)
+      {
+        it_submap->second->Clear();
+      }
+    }
+  }  
+}
+
+//------------------------------------------------------------------------------
+
+TObjArray *ExRootFilter::GetSubArray(ExRootClassifier *classifier, Int_t category)
+{
+  Int_t result;
+  TObject *element;
+  TObjArray *array;
+  TCategoryMap::iterator it_submap;
+  pair<TCategoryMap::iterator, bool> pair_submap;
+  pair<TClassifierMap::iterator, bool> pair_map;
+
+  TClassifierMap::iterator it_map = fMap.find(classifier);
+  if(it_map == fMap.end())
+  {
+    pair_map = fMap.insert(make_pair(classifier, make_pair(kTRUE, TCategoryMap())));
+    if(!pair_map.second) throw FilterExeption();
+
+    it_map = pair_map.first;
+  }
+
+  if(it_map->second.first)
+  {
+    it_map->second.first = kFALSE;
+    fIter->Reset();
+    while((element = fIter->Next()) != 0)
+    {
+      result = classifier->GetCategory(element);
+      if(result < 0) continue;
+      it_submap = it_map->second.second.find(result);
+      if(it_submap == it_map->second.second.end())
+      {
+        array = new TObjArray(fCollection->GetSize());
+        pair_submap = it_map->second.second.insert(make_pair(result, array));
+        if(!pair_submap.second) throw FilterExeption();
+
+        it_submap = pair_submap.first;
+      }
+      it_submap->second->Add(element);
+    }
+  }
+
+  it_submap = it_map->second.second.find(category);
+  return (it_submap != it_map->second.second.end()) ? it_submap->second : 0;  
+}
+
+//------------------------------------------------------------------------------
+
Index: /trunk/src/ExRootModule.cc
===================================================================
--- /trunk/src/ExRootModule.cc	(revision 2)
+++ /trunk/src/ExRootModule.cc	(revision 2)
@@ -0,0 +1,201 @@
+
+/** \class ExRootModule
+ *
+ *  Base class for analysis modules
+ *
+ *  $Date: 2008-06-04 13:57:55 $
+ *  $Revision: 1.1 $
+ *
+ *
+ *  \author P. Demin - UCL, Louvain-la-Neuve
+ *
+ */
+
+#include "ExRootAnalysis/ExRootTreeReader.h"
+#include "ExRootAnalysis/ExRootTreeBranch.h"
+#include "ExRootAnalysis/ExRootTreeWriter.h"
+#include "ExRootAnalysis/ExRootResult.h"
+
+#include "ExRootAnalysis/ExRootModule.h"
+#include "ExRootAnalysis/ExRootFactory.h"
+
+#include "TROOT.h"
+#include "TClass.h"
+#include "TFolder.h"
+#include "TObjArray.h"
+
+#include <iostream>
+
+using namespace std;
+
+ExRootModule::ExRootModule() :
+  fTreeReader(0), fTreeWriter(0),
+  fFactory(0), fPlots(0),
+  fPlotFolder(0), fExportFolder(0)
+
+{
+}
+
+//------------------------------------------------------------------------------
+
+ExRootModule::~ExRootModule()
+{
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootModule::Init()
+{
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootModule::Process()
+{
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootModule::Finish()
+{
+}
+
+//------------------------------------------------------------------------------
+
+const TObjArray *ExRootModule::ImportArray(const char *name)
+{
+  TObjArray *object;
+
+  object = static_cast<TObjArray *>(GetObject(Form("Export/%s", name), TObjArray::Class()));
+  if(!object)
+  {
+    cout << "** ERROR: cannot access input list '" << name << "'" << endl;
+    return 0;
+  }
+
+  return object;
+}
+
+//------------------------------------------------------------------------------
+
+TObjArray *ExRootModule::ExportArray(const char *name)
+{
+  TObjArray *array;
+  if(!fExportFolder)
+  {
+    fExportFolder = NewFolder("Export");
+  }
+
+  array = GetFactory()->NewPermanentArray();
+
+  array->SetName(name);
+  fExportFolder->Add(array);
+
+  return array;
+}
+
+//------------------------------------------------------------------------------
+
+ExRootTreeBranch *ExRootModule::NewBranch(const char *name, TClass *cl)
+{
+  if(!fTreeWriter)
+  {
+    fTreeWriter = static_cast<ExRootTreeWriter *>(GetObject("TreeWriter", ExRootTreeWriter::Class()));
+    if(!fTreeWriter)
+    {
+      cout << "** ERROR: cannot access tree writer" << endl;
+      return 0;
+    }
+  }
+  return fTreeWriter->NewBranch(name, cl);
+}
+
+//------------------------------------------------------------------------------
+
+TClonesArray *ExRootModule::UseBranch(const char *name)
+{
+  ExRootTreeReader *reader = GetTreeReader();
+  return reader ? reader->UseBranch(name) : 0;
+}
+
+//------------------------------------------------------------------------------
+
+TFolder *ExRootModule::NewFolder(const char *name)
+{
+  TFolder *folder;
+  folder = static_cast<TFolder *>(GetObject(name, TFolder::Class()));
+  if(!folder) folder = GetFolder()->AddFolder(name, "");
+  if(!folder)
+  {
+    cout << "** ERROR: cannot create folder '" << name << "'" << endl;
+    return 0;
+  }
+  folder = folder->AddFolder(GetName(), GetTitle());
+  if(!folder)
+  {
+    cout << "** ERROR: cannot create folder '";
+    cout << name << "/" << GetName() << "'" << endl;
+    return 0;
+  }
+  return folder;
+}
+
+//------------------------------------------------------------------------------
+
+TObject *ExRootModule::GetObject(const char *name, TClass *cl)
+{
+  TObject *object = GetFolder()->FindObject(name);
+  if(object && object->IsA() != cl)
+  {
+    cout << "** ERROR: object '" << name;
+    cout << "' is not of class '" << cl->GetName() << "'" << endl;
+    return 0;
+  }
+  return object;
+}
+
+//------------------------------------------------------------------------------
+
+ExRootResult *ExRootModule::GetPlots()
+{
+  if(!fPlots)
+  {
+    fPlots = new ExRootResult();
+    fPlots->SetFolder(GetFolder());
+  }
+  return fPlots;
+}
+
+//------------------------------------------------------------------------------
+
+ExRootFactory *ExRootModule::GetFactory()
+{
+  if(!fFactory)
+  {
+    fFactory = static_cast<ExRootFactory *>(GetObject("ObjectFactory", ExRootFactory::Class()));
+    if(!fFactory)
+    {
+      cout << "** ERROR: cannot access factory" << endl;
+      return 0;
+    }
+  }
+  return fFactory;
+}
+
+//------------------------------------------------------------------------------
+
+ExRootTreeReader *ExRootModule::GetTreeReader()
+{
+  if(!fTreeReader)
+  {
+    fTreeReader = static_cast<ExRootTreeReader *>(GetObject("TreeReader", ExRootTreeReader::Class()));
+    if(!fTreeReader)
+    {
+      cout << "** ERROR: cannot access tree reader" << endl;
+      return 0;
+    }
+  }
+  return fTreeReader;
+}
+
+
Index: /trunk/src/ExRootProgressBar.cc
===================================================================
--- /trunk/src/ExRootProgressBar.cc	(revision 2)
+++ /trunk/src/ExRootProgressBar.cc	(revision 2)
@@ -0,0 +1,82 @@
+
+/** \class ExRootProgressBar
+ *
+ *  Class showing progress bar
+ *
+ *  $Date: 2008-06-04 13:57:55 $
+ *  $Revision: 1.1 $
+ *
+ *
+ *  \author P. Demin - UCL, Louvain-la-Neuve
+ *
+ */
+
+#include "ExRootAnalysis/ExRootProgressBar.h"
+
+#include "TSystem.h"
+
+#include <iostream>
+
+#include <string.h>
+#include <stdio.h>
+
+using namespace std;
+
+ExRootProgressBar::ExRootProgressBar(Long64_t entries, Int_t width) :
+  fEntries(entries), fWidth(width), fTime(0), fHashes(0), fBar(0)
+{
+  fBar = new char[width + 1];
+  memset(fBar, '-', width);
+  fBar[width] = 0;
+
+}
+
+//------------------------------------------------------------------------------
+
+ExRootProgressBar::~ExRootProgressBar()
+{
+  if(fBar) delete[] fBar;
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootProgressBar::Update(Long64_t entry)
+{
+  ULong_t time = gSystem->Now();
+
+  if(time < fTime + 1000 && entry < fEntries - 1) return;
+
+  fTime = time;
+
+  Int_t hashes = Int_t((entry + 1.0)/fEntries*fWidth);
+
+  if(hashes > fHashes)
+  {
+    memset(fBar + fHashes, '#', hashes - fHashes);
+    fHashes = hashes;
+  }
+
+/*
+  cerr << "[" << fBar << "] (";
+  cerr.setf(ios::fixed);
+  cerr.precision(2);
+  cerr << (entry + 1.0)/fEntries*100.0 << "%) : ";
+  cerr << entry + 1 << "/" << fEntries;
+  cerr << " events processed\r" << flush;
+*/
+
+  fprintf(stderr, "[%s] (%.2f%%) : %lli/%lli entries processed\r", fBar,
+          (entry + 1.0)/fEntries*100.0, entry + 1, fEntries);
+  fflush(stderr);
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootProgressBar::Finish()
+{
+  fprintf(stderr, "\n");
+  fflush(stderr);
+}
+
+//------------------------------------------------------------------------------
+
Index: /trunk/src/ExRootResult.cc
===================================================================
--- /trunk/src/ExRootResult.cc	(revision 2)
+++ /trunk/src/ExRootResult.cc	(revision 2)
@@ -0,0 +1,426 @@
+
+/** \class ExRootResult
+ *
+ *  Class simplifying work with histograms
+ *
+ *  $Date: 2008-06-04 13:57:56 $
+ *  $Revision: 1.1 $
+ *
+ *
+ *  \author P. Demin - UCL, Louvain-la-Neuve
+ *
+ */
+
+#include "ExRootAnalysis/ExRootResult.h"
+
+#include "ExRootAnalysis/ExRootUtilities.h"
+
+#include "TROOT.h"
+#include "TFile.h"
+#include "TClass.h"
+#include "TStyle.h"
+#include "TCanvas.h"
+#include "TLegend.h"
+#include "TPaveText.h"
+#include "TPaveStats.h"
+#include "TList.h"
+#include "TH2.h"
+#include "THStack.h"
+#include "TProfile.h"
+#include "TObjArray.h"
+#include "TFolder.h"
+
+#include <algorithm>
+#include <iostream>
+
+using namespace std;
+
+const Font_t kExRootFont = 42;
+const Float_t kExRootFontSize = 0.04;
+const Color_t kExRootBackgroundColor = 10;
+
+//------------------------------------------------------------------------------
+
+static void DeleteTObjectPtr(TObject *x)
+{
+  delete x;
+}
+
+//------------------------------------------------------------------------------
+
+ExRootResult::ExRootResult() : fCanvas(0), fFolder(0)
+{
+
+}
+
+//------------------------------------------------------------------------------
+
+ExRootResult::~ExRootResult()
+{
+  for_each(fPool.begin(), fPool.end(), DeleteTObjectPtr);
+
+  if(fCanvas) delete fCanvas;
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootResult::Reset()
+{
+
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootResult::Write(const char *fileName)
+{
+  TObject *object;
+  TDirectory *currentDirectory = gDirectory; 
+  TFile *file = new TFile(fileName, "RECREATE");
+  file->cd();
+  map<TObject*, TObjArray*>::iterator it_plots;
+  for(it_plots = fPlots.begin(); it_plots != fPlots.end(); ++it_plots)
+  {
+    object = it_plots->first;
+    object->Write();    
+  }
+  currentDirectory->cd();
+  delete file;
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootResult::CreateCanvas()
+{
+  TDirectory *currentDirectory = gDirectory;
+
+  // Graphics style parameters to avoid grey background on figures
+  gStyle->SetCanvasColor(kExRootBackgroundColor);
+  gStyle->SetStatColor(kExRootBackgroundColor);
+  //  gStyle->SetTitleColor(kExRootBackgroundColor);
+  gStyle->SetPadColor(kExRootBackgroundColor);
+
+  gStyle->SetPadTopMargin(0.10);
+  gStyle->SetPadRightMargin(0.05);
+  gStyle->SetPadBottomMargin(0.15);
+  gStyle->SetPadLeftMargin(0.15);
+
+  gStyle->SetStatFont(kExRootFont);
+  gStyle->SetStatFontSize(kExRootFontSize);
+
+  gStyle->SetTitleFont(kExRootFont, "");
+  gStyle->SetTitleFont(kExRootFont, "X");
+  gStyle->SetTitleFont(kExRootFont, "Y");
+  gStyle->SetTitleFont(kExRootFont, "Z");
+  gStyle->SetTitleSize(kExRootFontSize, "");
+  gStyle->SetTitleSize(kExRootFontSize, "X");
+  gStyle->SetTitleSize(kExRootFontSize, "Y");
+  gStyle->SetTitleSize(kExRootFontSize, "Z");
+
+  gStyle->SetLabelFont(kExRootFont, "X");
+  gStyle->SetLabelFont(kExRootFont, "Y");
+  gStyle->SetLabelFont(kExRootFont, "Z");
+  gStyle->SetLabelSize(kExRootFontSize, "X");
+  gStyle->SetLabelSize(kExRootFontSize, "Y");
+  gStyle->SetLabelSize(kExRootFontSize, "Z");
+
+  gStyle->SetPadTickX(1);
+  gStyle->SetPadTickY(1);
+
+  gStyle->SetTextFont(kExRootFont);
+  gStyle->SetTextSize(kExRootFontSize);
+
+  gStyle->SetOptStat(111110);
+  // gStyle->SetOptFit(101);
+  
+  fCanvas = static_cast<TCanvas*>(gROOT->FindObject("c1"));
+  if(fCanvas)
+  {
+    fCanvas->Clear();
+    fCanvas->UseCurrentStyle();
+    fCanvas->SetWindowSize(800, 650);
+  }
+  else
+  {
+    fCanvas = new TCanvas("c1", "c1", 800, 650);
+  }
+  fCanvas->SetLogy(0);
+  fCanvas->SetHighLightColor(kExRootBackgroundColor);
+
+  currentDirectory->cd();
+}
+
+//------------------------------------------------------------------------------
+
+TCanvas *ExRootResult::GetCanvas()
+{
+  if(!fCanvas) CreateCanvas();
+  return fCanvas;
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootResult::Attach(TObject *plot, TObject *object)
+{
+  if(!plot) return;
+
+  map<TObject*, TObjArray*>::iterator it_plots = fPlots.find(plot);
+  if(it_plots != fPlots.end())
+  {
+    TObjArray *attachment = it_plots->second;
+    if(!attachment)
+    {
+      attachment = new TObjArray();
+      it_plots->second = attachment;
+    }
+    attachment->Add(object);
+  }
+}
+
+
+//------------------------------------------------------------------------------
+
+void ExRootResult::PrintPlot(TObject *plot, const char *sufix, const char *format)
+{
+  if(!plot) return;
+
+  TCanvas *canvas = GetCanvas();
+  TH1 *histogram = 0;
+
+  if(plot->IsA()->InheritsFrom(TH1::Class()))
+  {
+    histogram = static_cast<TH1*>(plot);
+  }
+
+  map<TObject*, PlotSettings>::iterator it_settings = fSettings.find(plot);
+  if(it_settings != fSettings.end())
+  {
+    canvas->SetLogx(it_settings->second.logx);
+    if(histogram == 0 || histogram->Integral() > 0.0)
+    {
+      canvas->SetLogy(it_settings->second.logy);
+    }
+    else
+    {
+      canvas->SetLogy(0);
+    }
+  }
+  
+  map<TObject*, TObjArray*>::iterator it_plots = fPlots.find(plot);
+  if(it_plots != fPlots.end())
+  {
+    TObjArray *attachment = it_plots->second;
+    if(attachment)
+    {
+      TIter iterator(attachment);
+      TObject *object;
+      while((object = iterator()))
+      {
+        object->Draw();
+      }
+    }
+  }
+
+  TString name = plot->GetName();
+  canvas->Print(name + sufix + "." + format);
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootResult::Print(const char *format)
+{
+  TObjArray *attachment;
+  TObject *object;
+  TH1 *histogram;
+  TPaveStats *stats;
+  TString name;
+
+  TCanvas *canvas = GetCanvas();
+
+  map<TObject*, TObjArray*>::iterator it_plots;
+  map<TObject*, PlotSettings>::iterator it_settings;
+
+  for(it_plots = fPlots.begin(); it_plots != fPlots.end(); ++it_plots)
+  {
+    object = it_plots->first;
+    attachment = it_plots->second;
+    name = object->GetName();
+    histogram = 0;
+
+    if(object->IsA()->InheritsFrom(TH1::Class()))
+    {
+      histogram = static_cast<TH1*>(object);
+    }
+
+    it_settings = fSettings.find(object);
+    if(it_settings != fSettings.end())
+    {
+      canvas->SetLogx(it_settings->second.logx);
+      if(histogram == 0 || histogram->Integral() > 0.0)
+      {
+        canvas->SetLogy(it_settings->second.logy);
+      }
+      else
+      {
+        canvas->SetLogy(0);
+      }
+    }
+
+    object->Draw();
+    canvas->Update();
+
+    if(histogram)
+    {
+      stats = static_cast<TPaveStats*>(histogram->GetListOfFunctions()->FindObject("stats"));
+      if(stats)
+      {
+        stats->SetX1NDC(0.67);
+        stats->SetX2NDC(0.99);
+        stats->SetY1NDC(0.77);
+        stats->SetY2NDC(0.99);
+        stats->SetTextFont(kExRootFont);
+        stats->SetTextSize(kExRootFontSize);
+        canvas->Draw();
+      }
+    }
+    if(attachment)
+    {
+      TIter iterator(attachment);
+      while((object = iterator()))
+      {
+        object->Draw();
+      }
+    }
+    canvas->Print(name + "." + format);
+  }
+}
+
+//------------------------------------------------------------------------------
+
+TH1 *ExRootResult::AddHist1D(const char *name, const char *title,
+                             const char *xlabel, const char *ylabel,
+                             Int_t nxbins, Axis_t xmin, Axis_t xmax,
+                             Int_t logx, Int_t logy)
+{
+  TH1F *hist = new TH1F(name, title, nxbins, xmin, xmax);
+  PlotSettings settings;
+  settings.logx = logx;
+  settings.logy = logy;
+  
+  fPool.insert(hist);
+  hist->GetXaxis()->SetTitle(xlabel);
+  hist->GetYaxis()->SetTitle(ylabel);
+  fPlots[hist] = 0;
+  fSettings[hist] = settings;
+  HistStyle(hist, kFALSE);
+  return hist;
+}
+
+//------------------------------------------------------------------------------
+
+TH1 *ExRootResult::AddHist1D(const char *name, const char *title,
+                             const char *xlabel, const char *ylabel,
+                             Int_t nxbins, const Float_t *bins,
+                             Int_t logx, Int_t logy)
+{
+  TH1F *hist = new TH1F(name, title, nxbins, bins);
+  PlotSettings settings;
+  settings.logx = logx;
+  settings.logy = logy;
+
+  fPool.insert(hist);
+  hist->GetXaxis()->SetTitle(xlabel);
+  hist->GetYaxis()->SetTitle(ylabel);
+  fPlots[hist] = 0;
+  fSettings[hist] = settings;
+  HistStyle(hist, kFALSE);
+  if(fFolder) fFolder->Add(hist);
+  return hist;
+}
+
+//------------------------------------------------------------------------------
+
+TProfile *ExRootResult::AddProfile(const char *name, const char *title,
+                                   const char *xlabel, const char *ylabel,
+                                   Int_t nxbins, Axis_t xmin, Axis_t xmax,
+                                   Int_t logx, Int_t logy)
+{
+  TProfile *profile = new TProfile(name, title, nxbins, xmin, xmax);
+  PlotSettings settings;
+  settings.logx = logx;
+  settings.logy = logy;
+
+  fPool.insert(profile);
+  profile->GetXaxis()->SetTitle(xlabel);
+  profile->GetYaxis()->SetTitle(ylabel);
+  fPlots[profile] = 0;
+  fSettings[profile] = settings;
+  HistStyle(profile, kFALSE);
+  if(fFolder) fFolder->Add(profile);
+  return profile;
+}
+
+//------------------------------------------------------------------------------
+
+TH2 *ExRootResult::AddHist2D(const char *name, const char *title,
+                             const char *xlabel, const char *ylabel,
+                             Int_t nxbins, Axis_t xmin, Axis_t xmax,
+                             Int_t nybins, Axis_t ymin, Axis_t ymax,
+                             Int_t logx, Int_t logy)
+{
+  TH2F *hist = new TH2F(name, title, nxbins, xmin, xmax, nybins, ymin, ymax);
+  PlotSettings settings;
+  settings.logx = logx;
+  settings.logy = logy;
+
+  fPool.insert(hist);
+  hist->GetXaxis()->SetTitle(xlabel);
+  hist->GetYaxis()->SetTitle(ylabel);
+  fPlots[hist] = 0;
+  fSettings[hist] = settings;
+  HistStyle(hist, kFALSE);
+  if(fFolder) fFolder->Add(hist);
+  return hist;
+}
+
+//------------------------------------------------------------------------------
+
+THStack *ExRootResult::AddHistStack(const char *name, const char *title)
+{
+  THStack *stack = new THStack(name, title);
+//  segmentaion violation when deleting stack in ~ExRootResult()
+//  fPool.insert(stack);
+  fPlots[stack] = 0;
+  if(fFolder) fFolder->Add(stack);
+  return stack;
+}
+
+//------------------------------------------------------------------------------
+
+TPaveText *ExRootResult::AddComment(Double_t x1, Double_t y1, Double_t x2, Double_t y2)
+{
+  TPaveText *comment = new TPaveText(x1, y1, x2, y2, "brNDC");
+  fPool.insert(comment);
+  comment->SetTextSize(kExRootFontSize);
+  comment->SetTextFont(kExRootFont);
+  comment->SetTextAlign(22);
+  comment->SetFillColor(kExRootBackgroundColor);
+  comment->SetBorderSize(2);
+  return comment;
+}
+
+//------------------------------------------------------------------------------
+
+TLegend *ExRootResult::AddLegend(Double_t x1, Double_t y1, Double_t x2, Double_t y2)
+{
+  TLegend *legend = new TLegend(x1, y1, x2, y2);
+  fPool.insert(legend);
+  legend->SetTextSize(kExRootFontSize);
+  legend->SetTextFont(kExRootFont);
+  legend->SetFillColor(kExRootBackgroundColor);
+  legend->SetBorderSize(2);
+  return legend;
+}
+
+//------------------------------------------------------------------------------
+
+
Index: /trunk/src/ExRootTask.cc
===================================================================
--- /trunk/src/ExRootTask.cc	(revision 2)
+++ /trunk/src/ExRootTask.cc	(revision 2)
@@ -0,0 +1,267 @@
+
+/** \class ExRootTask
+ *
+ *  Class handling output ROOT tree
+ *
+ *  $Date: 2008-06-04 13:57:56 $
+ *  $Revision: 1.1 $
+ *
+ *
+ *  \author P. Demin - UCL, Louvain-la-Neuve
+ *
+ */
+
+#include "ExRootAnalysis/ExRootTask.h"
+#include "ExRootAnalysis/ExRootConfReader.h"
+
+#include "TROOT.h"
+#include "TClass.h"
+#include "TString.h"
+
+#include <iostream>
+
+const char *const kINIT = "0";
+const char *const kPROCESS = "1";
+const char *const kFINISH = "2";
+
+using namespace std;
+
+ExRootTask::ExRootTask() :
+  TTask("", ""), fFolder(0), fConfReader(0)
+{
+}
+
+//------------------------------------------------------------------------------
+
+ExRootTask::~ExRootTask()
+{
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootTask::Init()
+{
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootTask::Process()
+{
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootTask::Finish()
+{
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootTask::Exec(Option_t *option)
+{
+  if(option == kINIT)
+  {
+    Init();
+  }
+  else if(option == kPROCESS)
+  {
+    Process();
+  }
+  else if(option == kFINISH)
+  {
+    Finish();
+  }
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootTask::InitTask()
+{
+  ExecuteTask(kINIT);
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootTask::ProcessTask()
+{
+  ExecuteTask(kPROCESS);
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootTask::FinishTask()
+{
+  ExecuteTask(kFINISH);
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootTask::InitSubTasks()
+{
+  ExecuteTasks(kINIT);
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootTask::ProcessSubTasks()
+{
+  ExecuteTasks(kPROCESS);
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootTask::FinishSubTasks()
+{
+  ExecuteTasks(kFINISH);
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootTask::Add(TTask *task)
+{
+  if(!task) return;
+
+  if(!task->IsA()->InheritsFrom(ExRootTask::Class()))
+  {
+    cout << "** ERROR: task '" << task->IsA()->GetName();
+    cout << "' does not inherit from ExRootTask" << endl;
+    return;
+  }
+
+  TTask::Add(task);
+}
+
+//------------------------------------------------------------------------------
+
+ExRootTask *ExRootTask::NewTask(TClass *cl, const char *taskName)
+{
+  if(!cl) return 0;
+ 
+  if(!cl->InheritsFrom(ExRootTask::Class()))
+  {
+    cout << "** ERROR: task '" << cl->GetName();
+    cout << "' does not inherit from ExRootTask" << endl;
+    return 0;
+  }
+
+  ExRootTask *task = static_cast<ExRootTask *>(cl->New());
+  task->SetName(taskName);
+  task->SetFolder(fFolder);
+  task->SetConfReader(fConfReader);
+
+  return task;
+}
+
+//------------------------------------------------------------------------------
+
+ExRootTask *ExRootTask::NewTask(const char *className, const char *taskName)
+{
+  TClass *cl = gROOT->GetClass(className);
+  if(!cl)
+  {
+    cout << "** ERROR: cannot find class '" << className << "'" << endl;
+    return 0;
+  }
+
+  return NewTask(cl, taskName);
+}
+
+//------------------------------------------------------------------------------
+
+const ExRootConfReader::ExRootTaskMap *ExRootTask::GetModules()
+{
+  if(fConfReader)
+  {
+    return fConfReader->GetModules();
+  }
+  else
+  {
+    return 0;
+  }
+}
+
+//------------------------------------------------------------------------------
+
+ExRootConfParam ExRootTask::GetParam(const char *name)
+{
+  if(fConfReader)
+  {
+    return fConfReader->GetParam(TString(GetName()) + "::" + name);
+  }
+  else
+  {
+    return ExRootConfParam(TString(GetName()) + "::" + name, 0, 0);
+  }
+}
+
+//------------------------------------------------------------------------------
+
+int ExRootTask::GetInt(const char *name, int defaultValue, int index)
+{
+  if(fConfReader)
+  {
+    return fConfReader->GetInt(TString(GetName()) + "::" + name, defaultValue, index);
+  }
+  else
+  {
+    return defaultValue;
+  }
+}
+
+//------------------------------------------------------------------------------
+
+long ExRootTask::GetLong(const char *name, long defaultValue, int index)
+{
+  if(fConfReader)
+  {
+    return fConfReader->GetLong(TString(GetName()) + "::" + name, defaultValue, index);
+  }
+  else
+  {
+    return defaultValue;
+  }
+}
+
+//------------------------------------------------------------------------------
+
+double ExRootTask::GetDouble(const char *name, double defaultValue, int index)
+{
+  if(fConfReader)
+  {
+    return fConfReader->GetDouble(TString(GetName()) + "::" + name, defaultValue, index);
+  }
+  else
+  {
+    return defaultValue;
+  }
+}
+
+//------------------------------------------------------------------------------
+
+bool ExRootTask::GetBool(const char *name, bool defaultValue, int index)
+{
+  if(fConfReader)
+  {
+    return fConfReader->GetBool(TString(GetName()) + "::" + name, defaultValue, index);
+  }
+  else
+  {
+    return defaultValue;
+  }
+}
+
+//------------------------------------------------------------------------------
+
+const char *ExRootTask::GetString(const char *name, const char *defaultValue, int index)
+{
+  if(fConfReader)
+  {
+    return fConfReader->GetString(TString(GetName()) + "::" + name, defaultValue, index);
+  }
+  else
+  {
+    return defaultValue;
+  }
+}
+
+
Index: /trunk/src/ExRootTreeBranch.cc
===================================================================
--- /trunk/src/ExRootTreeBranch.cc	(revision 2)
+++ /trunk/src/ExRootTreeBranch.cc	(revision 2)
@@ -0,0 +1,90 @@
+
+/** \class ExRootTreeBranch
+*
+*  Class handling object creation
+*  It is also used for output ROOT tree branches
+*
+*  $Date: 2008-06-04 13:57:56 $
+*  $Revision: 1.1 $
+*
+*
+*  \author P. Demin - UCL, Louvain-la-Neuve
+*
+*/
+
+#include "ExRootAnalysis/ExRootTreeBranch.h"
+
+#include "TFile.h"
+#include "TTree.h"
+#include "TString.h"
+#include "TClonesArray.h"
+
+#include <iostream>
+
+using namespace std;
+
+//------------------------------------------------------------------------------
+
+ExRootTreeBranch::ExRootTreeBranch(const char *name, TClass *cl, TTree *tree) :
+  fSize(0), fCapacity(1), fData(0)
+{
+//  cl->IgnoreTObjectStreamer();
+  fData = new TClonesArray(cl, fCapacity);
+
+  if(fData)
+  {
+    fData->SetName(name);
+    fData->ExpandCreateFast(fCapacity);
+    fData->Clear();
+    if(tree)
+    {
+      tree->Branch(name, &fData, 64000);
+      tree->Branch(TString(name) + "_size", &fSize, TString(name) + "_size/I");
+    }
+  }
+  else
+  {
+    throw MemoryAllocationExeption();
+  }
+}
+
+//------------------------------------------------------------------------------
+
+ExRootTreeBranch::~ExRootTreeBranch()
+{
+  if(fData) delete fData;
+}
+
+//------------------------------------------------------------------------------
+
+TObject *ExRootTreeBranch::NewEntry()
+{
+  if(!fData) return 0;
+
+  if(fSize >= fCapacity)
+  {
+    if(fCapacity < 10) fCapacity = 10;
+    else if(fCapacity < 30) fCapacity = 30;
+    else if(fCapacity < 100) fCapacity = 100;
+    else if(fCapacity < 250) fCapacity = 250;
+    else fCapacity *= 2;
+
+    fData->ExpandCreateFast(fCapacity);
+
+    fData->Clear();
+    fData->ExpandCreateFast(fSize);
+  }
+  
+  return fData->AddrAt(fSize++);
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootTreeBranch::Clear()
+{
+  fSize = 0;
+  if(fData) fData->Clear();
+}
+
+//------------------------------------------------------------------------------
+
Index: /trunk/src/ExRootTreeReader.cc
===================================================================
--- /trunk/src/ExRootTreeReader.cc	(revision 2)
+++ /trunk/src/ExRootTreeReader.cc	(revision 2)
@@ -0,0 +1,162 @@
+
+/** \class ExRootTreeReader
+ *
+ *  Class simplifying access to ROOT tree branches
+ *
+ *  $Date: 2008-06-04 13:57:57 $
+ *  $Revision: 1.1 $
+ *
+ *
+ *  \author P. Demin - UCL, Louvain-la-Neuve
+ *
+ */
+
+#include "ExRootAnalysis/ExRootTreeReader.h"
+
+#include "TH2.h"
+#include "TStyle.h"
+#include "TFolder.h"
+#include "TCanvas.h"
+#include "TBrowser.h"
+#include "TClonesArray.h"
+#include "TBranchElement.h"
+
+#include <iostream>
+
+using namespace std;
+
+//------------------------------------------------------------------------------
+
+ExRootTreeReader::ExRootTreeReader(TTree *tree) :
+  fChain(tree), fCurrentTree(-1)
+{
+  fFolder = new TFolder("branches", "branches");
+}
+
+//------------------------------------------------------------------------------
+
+ExRootTreeReader::~ExRootTreeReader()
+{
+  TBranchMap::iterator it_map;
+
+  for(it_map = fBranchMap.begin(); it_map != fBranchMap.end(); ++it_map)
+  {
+    delete it_map->second.second;
+  }
+
+  delete fFolder;
+}
+
+//------------------------------------------------------------------------------
+
+Bool_t ExRootTreeReader::ReadEntry(Long64_t entry)
+{
+  // Read contents of entry.
+  if(!fChain) return kFALSE;
+
+  Int_t treeEntry = fChain->LoadTree(entry);
+  if(treeEntry < 0) return kFALSE;
+  
+  if(fChain->IsA() == TChain::Class())
+  {
+    TChain *chain = static_cast<TChain*>(fChain);
+    if(chain->GetTreeNumber() != fCurrentTree)
+    {
+      fCurrentTree = chain->GetTreeNumber();
+      Notify();
+    }
+  }
+
+  TBranchMap::iterator it_map;
+  TBranch *branch;
+
+  for(it_map = fBranchMap.begin(); it_map != fBranchMap.end(); ++it_map)
+  {
+    branch = it_map->second.first;
+    if(branch)
+    {
+      branch->GetEntry(treeEntry);
+    }
+  }
+
+  return kTRUE;
+}
+
+//------------------------------------------------------------------------------
+
+TClonesArray *ExRootTreeReader::UseBranch(const char *branchName)
+{
+  TClonesArray *array = 0;
+
+  TBranchMap::iterator it_map = fBranchMap.find(branchName);
+
+  if(it_map != fBranchMap.end())
+  {
+    cout << "** WARNING: branch '" << branchName << "' is already in use" << endl;
+    array = it_map->second.second;
+  }
+  else
+  {
+    TBranch *branch = fChain->GetBranch(branchName);
+    if(branch)
+    {
+      if(branch->IsA() == TBranchElement::Class())
+      {
+        TBranchElement *element = static_cast<TBranchElement*>(branch);
+        const char *className = element->GetClonesName();
+        Int_t size = element->GetMaximum();
+        TClass *cl = gROOT->GetClass(className);
+        if(cl)
+        {
+          array = new TClonesArray(cl, size);
+          array->SetName(branchName);
+          fFolder->Add(array);
+          fBranchMap.insert(make_pair(branchName, make_pair(branch, array)));
+          branch->SetAddress(&array);
+        }
+      }
+    }
+  }
+
+  if(!array)
+  {
+    cout << "** WARNING: cannot access branch '" << branchName << "', return NULL pointer" << endl;
+  }
+
+  return array;
+}
+
+//------------------------------------------------------------------------------
+
+Bool_t ExRootTreeReader::Notify()
+{
+  // Called when loading a new file.
+  // Get branch pointers.
+  if(!fChain) return kFALSE;
+
+  TBranchMap::iterator it_map;
+  TBranch *branch;
+
+  for(it_map = fBranchMap.begin(); it_map != fBranchMap.end(); ++it_map)
+  {
+    branch = fChain->GetBranch(it_map->first);
+    if(branch)
+    {
+      it_map->second.first = branch;
+      branch->SetAddress(&(it_map->second.second));
+    }
+    else
+    {
+      cout << "** WARNING: cannot get branch '" << it_map->first << "'" << endl;
+    }
+  }
+  return kTRUE;
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootTreeReader::Browse(TBrowser *b)
+{
+  TObject::Browse(b);
+}
+
Index: /trunk/src/ExRootTreeWriter.cc
===================================================================
--- /trunk/src/ExRootTreeWriter.cc	(revision 2)
+++ /trunk/src/ExRootTreeWriter.cc	(revision 2)
@@ -0,0 +1,112 @@
+
+/** \class ExRootTreeWriter
+ *
+ *  Class handling output ROOT tree
+ *
+ *  $Date: 2008-06-04 13:57:57 $
+ *  $Revision: 1.1 $
+ *
+ *
+ *  \author P. Demin - UCL, Louvain-la-Neuve
+ *
+ */
+
+#include "ExRootAnalysis/ExRootTreeWriter.h"
+#include "ExRootAnalysis/ExRootTreeBranch.h"
+
+#include "TROOT.h"
+#include "TFile.h"
+#include "TTree.h"
+#include "TClonesArray.h"
+
+#include <iostream>
+
+using namespace std;
+
+ExRootTreeWriter::ExRootTreeWriter(TFile *file, const char *treeName) :
+  fFile(file), fTree(0), fTreeName(treeName)
+{
+}
+
+//------------------------------------------------------------------------------
+
+ExRootTreeWriter::~ExRootTreeWriter()
+{
+  set<ExRootTreeBranch*>::iterator it_set;
+  for(it_set = fBranches.begin(); it_set != fBranches.end(); ++it_set)
+  {
+    delete (*it_set);
+  }
+  
+  if(fTree) delete fTree;
+}
+
+//------------------------------------------------------------------------------
+
+ExRootTreeBranch *ExRootTreeWriter::NewBranch(const char *name, TClass *cl)
+{
+  if(!fTree) fTree = NewTree();
+  ExRootTreeBranch *branch = new ExRootTreeBranch(name, cl, fTree);
+  fBranches.insert(branch);
+  return branch;
+}
+
+//------------------------------------------------------------------------------
+
+ExRootTreeBranch *ExRootTreeWriter::NewFactory(const char *name, TClass *cl)
+{
+  ExRootTreeBranch *branch = new ExRootTreeBranch(name, cl, 0);
+  fBranches.insert(branch);
+  return branch;
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootTreeWriter::Fill()
+{
+  if(fTree) fTree->Fill();
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootTreeWriter::Write()
+{
+  fFile = fTree ? fTree->GetCurrentFile() : 0;
+  if(fFile) fFile->Write();
+}
+
+//------------------------------------------------------------------------------
+
+void ExRootTreeWriter::Clear()
+{
+  set<ExRootTreeBranch*>::iterator it_set;
+  for(it_set = fBranches.begin(); it_set != fBranches.end(); ++it_set)
+  {
+    (*it_set)->Clear();
+  }
+}
+
+//------------------------------------------------------------------------------
+
+TTree *ExRootTreeWriter::NewTree()
+{
+  if(!fFile) return 0;
+
+  TTree *tree = 0;
+  TDirectory *dir = gDirectory;
+
+  fFile->cd();
+  tree = new TTree(fTreeName, "Analysis tree");
+  dir->cd();
+  
+  if(!tree)
+  {
+    cout << "** ERROR: cannot create tree" << endl;
+    return 0;
+  }
+
+  tree->SetDirectory(fFile);
+  tree->SetAutoSave(10000000);  // autosave when 10 MB written
+
+  return tree;
+}
Index: /trunk/src/ExRootUtilities.cc
===================================================================
--- /trunk/src/ExRootUtilities.cc	(revision 2)
+++ /trunk/src/ExRootUtilities.cc	(revision 2)
@@ -0,0 +1,80 @@
+
+/** \class ExRootUtilities
+ *
+ *  Functions simplifying ROOT tree analysis
+ *
+ *  $Date: 2008-06-04 13:57:57 $
+ *  $Revision: 1.1 $
+ *
+ *
+ *  \author P. Demin - UCL, Louvain-la-Neuve
+ *
+ */
+
+#include "ExRootAnalysis/ExRootUtilities.h"
+
+#include "TROOT.h"
+#include "TH1.h"
+#include "TChain.h"
+
+#include <iostream>
+#include <fstream>
+
+using namespace std;
+
+const Font_t kExRootFont = 42;
+const Float_t kExRootFontSize = 0.04; 
+
+void HistStyle(TH1 *hist, Bool_t stats)
+{
+  hist->SetLineWidth(2);
+  hist->SetLineColor(kBlack);
+  hist->SetMarkerStyle(kFullSquare);
+  hist->SetMarkerColor(kBlack);
+
+  hist->GetXaxis()->SetTitleOffset(1.5);
+  hist->GetYaxis()->SetTitleOffset(1.75);
+  hist->GetZaxis()->SetTitleOffset(1.5);
+
+  hist->GetXaxis()->SetTitleFont(kExRootFont);
+  hist->GetYaxis()->SetTitleFont(kExRootFont);
+  hist->GetZaxis()->SetTitleFont(kExRootFont);
+  hist->GetXaxis()->SetTitleSize(kExRootFontSize);
+  hist->GetYaxis()->SetTitleSize(kExRootFontSize);
+  hist->GetZaxis()->SetTitleSize(kExRootFontSize);
+  
+  hist->GetXaxis()->SetLabelFont(kExRootFont);
+  hist->GetYaxis()->SetLabelFont(kExRootFont);
+  hist->GetZaxis()->SetLabelFont(kExRootFont);
+  hist->GetXaxis()->SetLabelSize(kExRootFontSize);
+  hist->GetYaxis()->SetLabelSize(kExRootFontSize);
+  hist->GetZaxis()->SetLabelSize(kExRootFontSize);
+
+  hist->SetStats(stats);
+}
+
+//------------------------------------------------------------------------------
+
+Bool_t FillChain(TChain *chain, const char *inputFileList)
+{
+  ifstream infile(inputFileList);
+  string buffer;
+
+  if(!infile.is_open())
+  {
+    cerr << "** ERROR: Can't open '" << inputFileList << "' for input" << endl;
+    return kFALSE;
+  }
+
+  while(1)
+  {
+    infile >> buffer;
+    if(!infile.good()) break;
+    chain->Add(buffer.c_str());
+  }
+
+  return kTRUE;
+}
+
+//------------------------------------------------------------------------------
+
Index: /trunk/stdhep/hepeup.h
===================================================================
--- /trunk/stdhep/hepeup.h	(revision 2)
+++ /trunk/stdhep/hepeup.h	(revision 2)
@@ -0,0 +1,21 @@
+/*
+C...User process event common block.
+*/
+
+#define MAXNUP 500
+struct hepeup {
+  int nup;		/* number of particles */
+  int idprup;
+  double xwgtup;
+  double scalup;
+  double aqedup;
+  double aqcdup;
+  int idup[MAXNUP];
+  int istup[MAXNUP];
+  int mothup[MAXNUP][2];
+  int icolup[MAXNUP][2];
+  double pup[MAXNUP][5];
+  double vtimup[MAXNUP];
+  double spinup[MAXNUP];
+};
+
Index: /trunk/stdhep/hepev4.h
===================================================================
--- /trunk/stdhep/hepev4.h	(revision 2)
+++ /trunk/stdhep/hepev4.h	(revision 2)
@@ -0,0 +1,22 @@
+/* Hepev4 holds Les Houches information */
+/*  note that to avoid alignment problems, structures and common blocks
+    should be in the order: double precision, real, integer.
+*/
+struct hepev4 {
+  double eventweightlh;			/* event weight */
+  double alphaqedlh; 			/* QED coupling alpha_em */
+  double alphaqcdlh;			/* QCD coupling alpha_s */
+  double scalelh[10]; 			/* Scale Q of the event */
+  double spinlh[NMXHEP][3]; 		/* spin information */
+  int    icolorflowlh[NMXHEP][2]; 	/* (Anti-)Colour flow */
+  int    idruplh;			/* ID, as given by LPRUP codes */
+};
+
+struct hepev5 {
+  double eventweightmulti[NMXMLT];	/* original event weight */
+  double alphaqedmulti[NMXMLT]; 	/* original QED coupling alpha_em */
+  double alphaqcdmulti[NMXMLT];		/* original QCD coupling alpha_s */
+  double scalemulti[NMXMLT][10]; 	/* original Scale Q of the event */
+  int    idrupmulti[NMXMLT];		/* original ID, as given by LPRUP codes */
+};
+
Index: /trunk/stdhep/heprup.h
===================================================================
--- /trunk/stdhep/heprup.h	(revision 2)
+++ /trunk/stdhep/heprup.h	(revision 2)
@@ -0,0 +1,17 @@
+/*
+C...User process initialization commonblock.
+*/
+
+#define MAXPUP 100
+struct heprup {
+  int idbmup[2];
+  double ebmup[2];
+  int pdfgup[2];
+  int pdfsup[2];
+  int idwtup;
+  int nprup;
+  double xsecup[MAXPUP];
+  double xerrup[MAXPUP];
+  double xmaxup[MAXPUP];
+  int lprup[MAXPUP];
+};
Index: /trunk/stdhep/mcf_Stdhep_xdr.c
===================================================================
--- /trunk/stdhep/mcf_Stdhep_xdr.c	(revision 2)
+++ /trunk/stdhep/mcf_Stdhep_xdr.c	(revision 2)
@@ -0,0 +1,238 @@
+/*******************************************************************************
+*									       *
+* mcf_Stdhep_xdr.c -- XDR Utility routines for the Block Stdhep filters        *
+*									       *
+* Copyright (c) 1994 Universities Research Association, Inc.		       *
+* All rights reserved.							       *
+* 									       *
+* This material resulted from work developed under a Government Contract and   *
+* is subject to the following license:  The Government retains a paid-up,      *
+* nonexclusive, irrevocable worldwide license to reproduce, prepare derivative *
+* works, perform publicly and display publicly by or for the Government,       *
+* including the right to distribute to other Government contractors.  Neither  *
+* the United States nor the United States Department of Energy, nor any of     *
+* their employees, makes any warranty, express or implied, or assumes any      *
+* legal liability or responsibility for the accuracy, completeness, or         *
+* usefulness of any information, apparatus, product, or process disclosed, or  *
+* represents that its use would not infringe privately owned rights.           *
+*                                        				       *
+*									       *
+* Written by Paul Lebrun, Lynn Garren					       *
+*									       *
+*									       *
+*******************************************************************************/
+#include <stdio.h>
+#include <string.h>
+#include <sys/param.h>
+#include <rpc/types.h>
+#include <sys/types.h>
+#include <rpc/xdr.h>
+#include <limits.h>
+#ifdef SUNOS
+#include <floatingpoint.h>
+#else /* SUNOS */
+#include <float.h>
+#endif /* SUNOS */
+#include <stdlib.h>
+#include <time.h>
+#include "mcfio_Dict.h"
+#include "mcf_xdr.h"
+#include "stdhep.h"
+#include "stdtmp.h"
+#include "stdver.h"
+#ifndef FALSE
+#define FALSE 0
+#endif
+#ifndef TRUE
+#define TRUE 1
+#endif
+
+extern struct stdver stdver_;
+extern struct hepevt myhepevt;
+extern struct hepev2 hepev2_;
+extern struct hepev3 hepev3_;
+extern struct stdtmp stdtmp_;
+
+bool_t xdr_stdhep_(XDR *xdrs, int *blockid,
+ 				 int *ntot, char** version)
+
+{
+/*  Translate the HEPEVT temporary COMMON block from the STDHEP package to/from
+    an XDR stream. Note that we do not allocate memory, because we fill
+    directly the COMMON.  Also, mcfio will allocate the space for the 
+    string version.  */
+    
+    unsigned int nn, nn2, nn4, nn5, nnw, nnw2, nnw4, nnw5;
+    int *idat;
+    double *dat;
+    
+    if ((xdrs->x_op == XDR_ENCODE) || (xdrs->x_op == XDR_MCFIOCODE))  {
+       if (*blockid != MCFIO_STDHEP) {
+          fprintf (stderr, "mcf_Stdhep_xdr: Inconsistent Blockid %d \n ", 
+           (*blockid));
+          return FALSE;
+       }
+
+       nn =  (unsigned int) stdtmp_.nhept;   /* Number of elements in isthep or idhep     */
+       nn2 = 2*(unsigned int) stdtmp_.nhept; /* Number of elements in jmohep or jdahep    */
+       nn4 = 4*(unsigned int) stdtmp_.nhept; /* Number of elements in vhep                */
+       nn5 = 5*(unsigned int) stdtmp_.nhept; /* Number of elements in phep                */
+       nnw = (unsigned int) stdtmp_.nhept;
+       nnw2 = 2 * nnw;
+       nnw4 = 4 * nnw;
+       nnw5 = 5 * nnw;
+
+       /* Total length in bytes include blockid, ntot, version, nevhept and nhept as well
+          as the arrays remembering doubles are longer than ints.                         */
+       *ntot = 5*sizeof(int) + sizeof(int)*(2*nn + 2*nn2) + sizeof(double)*(nn4 + nn5);
+
+       if (xdrs->x_op == XDR_MCFIOCODE) return TRUE;
+       strncpy(version[0],stdver_.stdhep_ver, 4);
+       } 
+      
+     if     ( (xdr_int(xdrs, blockid) &&
+     	      xdr_int(xdrs, ntot) &&
+     	      xdr_string(xdrs, version, MCF_XDR_VERSION_LENGTH) &&
+     	      xdr_int(xdrs, &(stdtmp_.nevhept)) &&
+              xdr_int(xdrs, &(stdtmp_.nhept))) == FALSE) return FALSE;
+              
+     if ((xdrs->x_op == XDR_DECODE) && ( *blockid != MCFIO_STDHEP) ) {
+          fprintf (stderr, "mcf_Stdhep_xdr: Inconsistent Blockid %d \n ", 
+           (*blockid));
+          return FALSE;
+     }
+     idat = stdtmp_.isthept;
+     if     ( xdr_array(xdrs, (char **)  &idat,
+         &nnw, NMXHEP, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     idat = stdtmp_.idhept;
+     if     ( xdr_array(xdrs, (char **)   &idat,
+         &nnw, NMXHEP, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     idat = (int *) stdtmp_.jmohept;
+     if     ( xdr_array(xdrs, (char **)   &idat,
+                &nnw2, 2*NMXHEP, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     idat = (int *) stdtmp_.jdahept;
+     if     ( xdr_array(xdrs,  (char **)   &idat,
+                &nnw2, 2*NMXHEP, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     dat = (double *)  stdtmp_.phept;
+     if     ( xdr_array(xdrs,  (char **)   &dat,
+                &nnw5, 5*NMXHEP, sizeof(double), (void *) xdr_double) == FALSE) return FALSE; 
+     dat = (double *) stdtmp_.vhept;
+     if     ( xdr_array(xdrs, (char **)    &dat,
+                &nnw4, 4*NMXHEP, sizeof(double), (void *) xdr_double) == FALSE) return FALSE;
+     return TRUE;
+}   
+
+bool_t xdr_stdhep_multi_(XDR *xdrs, int *blockid,
+ 				 int *ntot, char** version)
+
+{
+/*  Translate the HEPEVT COMMON block from the STDHEP package to/from
+    an XDR stream. Note that we do not allocate memory, because we fill
+    directly the COMMON.  Also, mcfio will allocate the space for the 
+    string version. 
+    Also translate the HEPEV2 COMMON block from the STDHEP package to/from
+    an XDR stream. HEPEV2 contains multiple interaction information */
+    
+    unsigned int nn, nn2, nn4, nn5, nnw, nnw2, nnw4, nnw5, nmlt, nnmlt;
+    int i;
+    int *idat;
+    char *vers;
+    double *dat;
+    
+    if ((xdrs->x_op == XDR_ENCODE) || (xdrs->x_op == XDR_MCFIOCODE))  {
+       if (*blockid != MCFIO_STDHEPM) {
+          fprintf (stderr, "mcf_Stdhep_xdr: Inconsistent Blockid %d \n ", 
+           (*blockid));
+          return FALSE;
+       }
+       nn = sizeof(int) * myhepevt.nhep;
+       nn2 = 2 * sizeof(int) * myhepevt.nhep;
+       nn4 = 4 * sizeof(double) * myhepevt.nhep;
+       nn5 = 5 * sizeof(double) * myhepevt.nhep;
+       nmlt = sizeof(int) * hepev2_.nmulti;
+       nnw = (unsigned int) myhepevt.nhep;
+       nnw2 = 2 * nnw;
+       nnw4 = 4 * nnw;
+       nnw5 = 5 * nnw;
+       nnmlt = (unsigned int) hepev2_.nmulti;
+       *ntot = 6 * sizeof(int) + 3 * nn + 2 * nn2 + nn4 + nn5 + 3 * nmlt;
+       if (xdrs->x_op == XDR_MCFIOCODE) return TRUE;
+       strncpy(version[0],stdver_.stdhep_ver, 4);
+       } 
+      
+     if     ( (xdr_int(xdrs, blockid) &&
+     	      xdr_int(xdrs, ntot) &&
+     	      xdr_string(xdrs, version, MCF_XDR_VERSION_LENGTH) &&
+     	      xdr_int(xdrs, &(myhepevt.nevhep)) &&
+              xdr_int(xdrs, &(myhepevt.nhep))) == FALSE) return FALSE;
+              
+     if ((xdrs->x_op == XDR_DECODE) && ( *blockid != MCFIO_STDHEPM) ) {
+          fprintf (stderr, "mcf_Stdhep_xdr: Inconsistent Blockid %d \n ", 
+           (*blockid));
+          return FALSE;
+     }
+     idat = myhepevt.isthep;
+     if     ( xdr_array(xdrs, (char **)  &idat,
+            &nnw, NMXHEP, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     idat = myhepevt.idhep;
+     if     ( xdr_array(xdrs, (char **)   &idat,
+            &nnw, NMXHEP, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     idat = (int *) myhepevt.jmohep;
+     if     ( xdr_array(xdrs, (char **)   &idat,
+                &nnw2, 2*NMXHEP, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     idat = (int *) myhepevt.jdahep;
+     if     ( xdr_array(xdrs,  (char **)   &idat,
+                &nnw2, 2*NMXHEP, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     dat = (double *)  myhepevt.phep;
+     if     ( xdr_array(xdrs,  (char **)   &dat,
+                &nnw5, 5*NMXHEP, sizeof(double), (void *) xdr_double) == FALSE) return FALSE; 
+     dat = (double *) myhepevt.vhep;
+     if     ( xdr_array(xdrs, (char **)    &dat,
+                &nnw4, 4*NMXHEP, sizeof(double), (void *) xdr_double) == FALSE) return FALSE;
+     /*
+     ** V2.02 Upgrade : adding Multiple interactions. 
+     */ 
+     vers = *version;          
+     if ((strcmp(vers,"1.05") == 0)  && (xdrs->x_op == XDR_DECODE)) {
+           hepev2_.nmulti = -1;
+           return TRUE;
+     }      
+     if ( xdr_int(xdrs, &(hepev2_.nmulti)) == FALSE) return FALSE;
+     idat = hepev2_.jmulti;
+     if     ( xdr_array(xdrs, (char **)   &idat,
+         &nnw, NMXHEP, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     /*
+     ** V4.04 Upgrade : adding more Multiple interaction information
+     */ 
+     if (((strcmp(vers,"2.") > 0) || (strcmp(vers,"3.") > 0)) 
+            && (xdrs->x_op == XDR_DECODE)) {
+	   for (i = 0; i <= NMXMLT; i++) {
+	       hepev3_.nevmulti[i] = 0;
+	       hepev3_.itrkmulti[i] = 0;
+	       hepev3_.mltstr[i] = 0;
+	   }
+           return TRUE;
+     }      
+     if (((strcmp(vers,"4.00") == 0) || (strcmp(vers,"4.01") == 0) ||
+          (strcmp(vers,"4.02") == 0) || (strcmp(vers,"4.03") == 0) )  
+            && (xdrs->x_op == XDR_DECODE)) {
+	   for (i = 0; i <= NMXMLT; i++) {
+	       hepev3_.nevmulti[i] = 0;
+	       hepev3_.itrkmulti[i] = 0;
+	       hepev3_.mltstr[i] = 0;
+	   }
+           return TRUE;
+     }      
+     idat = hepev3_.nevmulti;
+     if     ( xdr_array(xdrs, (char **)   &idat,
+            &nnmlt, NMXMLT, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     idat = hepev3_.itrkmulti;
+     if     ( xdr_array(xdrs, (char **)   &idat,
+            &nnmlt, NMXMLT, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     idat = hepev3_.mltstr;
+     if     ( xdr_array(xdrs, (char **)   &idat,
+            &nnmlt, NMXMLT, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     return TRUE;
+}   
+
+
Index: /trunk/stdhep/mcf_hepev4_xdr.c
===================================================================
--- /trunk/stdhep/mcf_hepev4_xdr.c	(revision 2)
+++ /trunk/stdhep/mcf_hepev4_xdr.c	(revision 2)
@@ -0,0 +1,273 @@
+/*******************************************************************************
+*									       *
+* mcf_hepev4_xdr.c -- XDR Utility routines for the Block Stdhep filters        *
+*		      hepevt and hepev4 (and optionally hepev2 and hepev3)     *
+*									       *
+* Copyright (c) 1994 Universities Research Association, Inc.		       *
+* All rights reserved.							       *
+* 									       *
+* This material resulted from work developed under a Government Contract and   *
+* is subject to the following license:  The Government retains a paid-up,      *
+* nonexclusive, irrevocable worldwide license to reproduce, prepare derivative *
+* works, perform publicly and display publicly by or for the Government,       *
+* including the right to distribute to other Government contractors.  Neither  *
+* the United States nor the United States Department of Energy, nor any of     *
+* their employees, makes any warranty, express or implied, or assumes any      *
+* legal liability or responsibility for the accuracy, completeness, or         *
+* usefulness of any information, apparatus, product, or process disclosed, or  *
+* represents that its use would not infringe privately owned rights.           *
+*                                        				       *
+*									       *
+* Written by Paul Lebrun, Lynn Garren					       *
+*									       *
+*									       *
+*******************************************************************************/
+#include <stdio.h>
+#include <string.h>
+#include <sys/param.h>
+#include <rpc/types.h>
+#include <sys/types.h>
+#include <rpc/xdr.h>
+#include <limits.h>
+#ifdef SUNOS
+#include <floatingpoint.h>
+#else /* SUNOS */
+#include <float.h>
+#endif /* SUNOS */
+#include <stdlib.h>
+#include <time.h>
+#include "mcfio_Dict.h"
+#include "mcf_xdr.h"
+#include "stdhep.h"
+#include "hepev4.h"
+#include "stdtmp.h"
+#include "stdver.h"
+#ifndef FALSE
+#define FALSE 0
+#endif
+#ifndef TRUE
+#define TRUE 1
+#endif
+
+extern struct stdver stdver_;
+extern struct hepevt myhepevt;
+extern struct hepev2 hepev2_;
+extern struct hepev3 hepev3_;
+extern struct hepev4 hepev4_;
+extern struct hepev5 hepev5_;
+extern struct stdtmp stdtmp_;
+extern struct tmpev4 tmpev4_;
+
+bool_t xdr_stdhep_4_(XDR *xdrs, int *blockid,
+ 				 int *ntot, char** version)
+
+{
+/*  Translate the HEPEVT temporary COMMON block from the STDHEP package to/from
+    an XDR stream. Note that we do not allocate memory, because we fill
+    directly the COMMON.  Also, mcfio will allocate the space for the 
+    string version.  */
+    
+    unsigned int nn, nn2, nn3, nn4, nn5, nnw, nnw2, nnw3, nnw4, nnw5;
+    int *idat;
+    double *dat;
+    unsigned int n5 = 5;	/* for scale */
+    
+    if ((xdrs->x_op == XDR_ENCODE) || (xdrs->x_op == XDR_MCFIOCODE))  {
+       if (*blockid != MCFIO_STDHEP4) {
+          fprintf (stderr, "mcf_hepev4_xdr: Inconsistent Blockid %d \n ", 
+           (*blockid));
+          return FALSE;
+       }
+
+       nn =  (unsigned int) stdtmp_.nhept;   /* Number of elements in isthep or idhep     */
+       nn2 = 2*(unsigned int) stdtmp_.nhept; /* Number of elements in jmohep or jdahep    */
+       nn3 = 3*(unsigned int) stdtmp_.nhept; /* Number of elements in spinlh              */
+       nn4 = 4*(unsigned int) stdtmp_.nhept; /* Number of elements in vhep                */
+       nn5 = 5*(unsigned int) stdtmp_.nhept; /* Number of elements in phep                */
+       nnw = (unsigned int) stdtmp_.nhept;
+       nnw2 = 2 * nnw;
+       nnw3 = 3 * nnw;
+       nnw4 = 4 * nnw;
+       nnw5 = 5 * nnw;
+
+       /* Total length in bytes include blockid, ntot, version, nevhept and nhept as well
+          as the arrays remembering doubles are longer than ints.                         */
+       *ntot = 5*sizeof(int) + sizeof(int)*(2*nn + 2*nn2) 
+               + sizeof(double)*(nn4 + nn5) 
+	       + (8 + nn3)*sizeof(double) + (1 + nn2)*sizeof(int);
+
+       if (xdrs->x_op == XDR_MCFIOCODE) return TRUE;
+       strncpy(version[0],stdver_.stdhep_ver, 4);
+       } 
+      
+     if     ( (xdr_int(xdrs, blockid) &&
+     	      xdr_int(xdrs, ntot) &&
+     	      xdr_string(xdrs, version, MCF_XDR_VERSION_LENGTH) &&
+     	      xdr_int(xdrs, &(stdtmp_.nevhept)) &&
+              xdr_int(xdrs, &(stdtmp_.nhept))) == FALSE) return FALSE;
+              
+     if ((xdrs->x_op == XDR_DECODE) && ( *blockid != MCFIO_STDHEP4) ) {
+          fprintf (stderr, "mcf_hepev4_xdr: Inconsistent Blockid %d \n ", 
+           (*blockid));
+          return FALSE;
+     }
+     idat = stdtmp_.isthept;
+     if     ( xdr_array(xdrs, (char **)  &idat,
+         &nnw, NMXHEP, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     idat = stdtmp_.idhept;
+     if     ( xdr_array(xdrs, (char **)   &idat,
+         &nnw, NMXHEP, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     idat = (int *) stdtmp_.jmohept;
+     if     ( xdr_array(xdrs, (char **)   &idat,
+                &nnw2, 2*NMXHEP, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     idat = (int *) stdtmp_.jdahept;
+     if     ( xdr_array(xdrs,  (char **)   &idat,
+                &nnw2, 2*NMXHEP, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     dat = (double *)  stdtmp_.phept;
+     if     ( xdr_array(xdrs,  (char **)   &dat,
+                &nnw5, 5*NMXHEP, sizeof(double), (void *) xdr_double) == FALSE) return FALSE; 
+     dat = (double *) stdtmp_.vhept;
+     if     ( xdr_array(xdrs, (char **)    &dat,
+                &nnw4, 4*NMXHEP, sizeof(double), (void *) xdr_double) == FALSE) return FALSE;
+     /* valid for stdhep 5.01 and later */
+     if ( xdr_double(xdrs, &(tmpev4_.eventweightt) ) == FALSE) return FALSE;
+     if ( xdr_double(xdrs, &(tmpev4_.alphaqedt) ) == FALSE) return FALSE;
+     if ( xdr_double(xdrs, &(tmpev4_.alphaqcdt) ) == FALSE) return FALSE;
+     dat = (double *) tmpev4_.scalet;
+     if     ( xdr_array(xdrs, (char **)    &dat,
+                &n5, 10, sizeof(double), (void *) xdr_double) == FALSE) return FALSE;
+     dat = (double *) tmpev4_.spint;
+     if     ( xdr_array(xdrs, (char **)    &dat,
+                &nnw3, 3*NMXHEP, sizeof(double), (void *) xdr_double) == FALSE) return FALSE;
+     idat = (int *) tmpev4_.icolorflowt;
+     if     ( xdr_array(xdrs, (char **)   &idat,
+                &nnw2, 2*NMXHEP, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     if ( xdr_int(xdrs, &(tmpev4_.idrupt) ) == FALSE) return FALSE;
+     return TRUE;
+}   
+
+bool_t xdr_stdhep_4_multi_(XDR *xdrs, int *blockid,
+ 				 int *ntot, char** version)
+
+{
+/*  Translate the HEPEVT COMMON block from the STDHEP package to/from
+    an XDR stream. Note that we do not allocate memory, because we fill
+    directly the COMMON.  Also, mcfio will allocate the space for the 
+    string version. 
+    Also translate the HEPEV2 COMMON block from the STDHEP package to/from
+    an XDR stream. HEPEV2 contains multiple interaction information */
+    
+    unsigned int nn, nn2, nn3, nn4, nn5, nnw, nnw2, nnw3, nnw4, nnw5;
+    unsigned int nmlt, nnmlt, nmltd, nnmlt5;
+    int *idat;
+    double *dat;
+    unsigned int n5 = 10;	/* for scale */
+    
+    if ((xdrs->x_op == XDR_ENCODE) || (xdrs->x_op == XDR_MCFIOCODE))  {
+       if (*blockid != MCFIO_STDHEP4M) {
+          fprintf (stderr, "mcf_hepev4_xdr: Inconsistent Blockid %d \n ", 
+           (*blockid));
+          return FALSE;
+       }
+       nn = sizeof(int) * myhepevt.nhep;
+       nn2 = 2 * sizeof(int) * myhepevt.nhep;
+       nn3 = 3 * sizeof(double) * myhepevt.nhep;
+       nn4 = 4 * sizeof(double) * myhepevt.nhep;
+       nn5 = 10 * sizeof(double) * myhepevt.nhep;
+       nmlt = sizeof(int) * hepev2_.nmulti;
+       nmltd = sizeof(double) * hepev2_.nmulti;
+       nnw = (unsigned int) myhepevt.nhep;
+       nnw2 = 2 * nnw;
+       nnw3 = 3 * nnw;
+       nnw4 = 4 * nnw;
+       nnw5 = 5 * nnw;
+       nnmlt = (unsigned int) hepev2_.nmulti;
+       nnmlt5 = 5 * nnmlt;
+       *ntot = 6 * sizeof(int) + 3 * nn + 2 * nn2 + nn4 + nn5 + 3 * nmlt
+              + nn3 + 8 * sizeof(double) + nn2 + sizeof(int)
+	      + 8 * nmltd + nmlt;
+       if (xdrs->x_op == XDR_MCFIOCODE) return TRUE;
+       strncpy(version[0],stdver_.stdhep_ver, 4);
+       } 
+      
+     if     ( (xdr_int(xdrs, blockid) &&
+     	      xdr_int(xdrs, ntot) &&
+     	      xdr_string(xdrs, version, MCF_XDR_VERSION_LENGTH) &&
+     	      xdr_int(xdrs, &(myhepevt.nevhep)) &&
+              xdr_int(xdrs, &(myhepevt.nhep))) == FALSE) return FALSE;
+              
+     if ((xdrs->x_op == XDR_DECODE) && ( *blockid != MCFIO_STDHEP4M) ) {
+          fprintf (stderr, "mcf_hepev4_xdr: Inconsistent Blockid %d \n ", 
+           (*blockid));
+          return FALSE;
+     }
+     idat = myhepevt.isthep;
+     if     ( xdr_array(xdrs, (char **)  &idat,
+            &nnw, NMXHEP, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     idat = myhepevt.idhep;
+     if     ( xdr_array(xdrs, (char **)   &idat,
+            &nnw, NMXHEP, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     idat = (int *) myhepevt.jmohep;
+     if     ( xdr_array(xdrs, (char **)   &idat,
+                &nnw2, 2*NMXHEP, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     idat = (int *) myhepevt.jdahep;
+     if     ( xdr_array(xdrs,  (char **)   &idat,
+                &nnw2, 2*NMXHEP, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     dat = (double *)  myhepevt.phep;
+     if     ( xdr_array(xdrs,  (char **)   &dat,
+                &nnw5, 5*NMXHEP, sizeof(double), (void *) xdr_double) == FALSE) return FALSE; 
+     dat = (double *) myhepevt.vhep;
+     if     ( xdr_array(xdrs, (char **)    &dat,
+                &nnw4, 4*NMXHEP, sizeof(double), (void *) xdr_double) == FALSE) return FALSE;
+     /*
+     ** V2.02 Upgrade : adding Multiple interactions. 
+     */ 
+     if ( xdr_int(xdrs, &(hepev2_.nmulti)) == FALSE) return FALSE;
+     idat = hepev2_.jmulti;
+     if     ( xdr_array(xdrs, (char **)   &idat,
+         &nnw, NMXHEP, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     /*
+     ** V4.04 Upgrade : adding more Multiple interaction information
+     */ 
+     idat = hepev3_.nevmulti;
+     if     ( xdr_array(xdrs, (char **)   &idat,
+            &nnmlt, NMXMLT, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     idat = hepev3_.itrkmulti;
+     if     ( xdr_array(xdrs, (char **)   &idat,
+            &nnmlt, NMXMLT, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     idat = hepev3_.mltstr;
+     if     ( xdr_array(xdrs, (char **)   &idat,
+            &nnmlt, NMXMLT, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     /* valid for stdhep 5.01 and later */
+     if ( xdr_double(xdrs, &(hepev4_.eventweightlh) ) == FALSE) return FALSE;
+     if ( xdr_double(xdrs, &(hepev4_.alphaqedlh) ) == FALSE) return FALSE;
+     if ( xdr_double(xdrs, &(hepev4_.alphaqcdlh) ) == FALSE) return FALSE;
+     dat = (double *) hepev4_.scalelh;
+     if     ( xdr_array(xdrs, (char **)    &dat,
+                &n5, 10, sizeof(double), (void *) xdr_double) == FALSE) return FALSE;
+     dat = (double *) hepev4_.spinlh;
+     if     ( xdr_array(xdrs, (char **)    &dat,
+                &nnw3, 3*NMXHEP, sizeof(double), (void *) xdr_double) == FALSE) return FALSE;
+     idat = (int *) hepev4_.icolorflowlh;
+     if     ( xdr_array(xdrs, (char **)   &idat,
+                &nnw2, 2*NMXHEP, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     if ( xdr_int(xdrs, &(hepev4_.idruplh) ) == FALSE) return FALSE;
+     dat = (double *) hepev5_.eventweightmulti;
+     if     ( xdr_array(xdrs, (char **)    &dat,
+                &nnmlt, NMXMLT, sizeof(double), (void *) xdr_double) == FALSE) return FALSE;
+     dat = (double *) hepev5_.alphaqedmulti;
+     if     ( xdr_array(xdrs, (char **)    &dat,
+                &nnmlt, NMXMLT, sizeof(double), (void *) xdr_double) == FALSE) return FALSE;
+     dat = (double *) hepev5_.alphaqcdmulti;
+     if     ( xdr_array(xdrs, (char **)    &dat,
+                &nnmlt, NMXMLT, sizeof(double), (void *) xdr_double) == FALSE) return FALSE;
+     dat = (double *) hepev5_.scalemulti;
+     if     ( xdr_array(xdrs, (char **)    &dat,
+                &nnmlt5, 10*NMXMLT, sizeof(double), (void *) xdr_double) == FALSE) return FALSE;
+     idat = hepev5_.idrupmulti;
+     if     ( xdr_array(xdrs, (char **)   &idat,
+            &nnmlt, NMXMLT, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     return TRUE;
+}   
+
+
Index: /trunk/stdhep/mcf_hepup_xdr.c
===================================================================
--- /trunk/stdhep/mcf_hepup_xdr.c	(revision 2)
+++ /trunk/stdhep/mcf_hepup_xdr.c	(revision 2)
@@ -0,0 +1,196 @@
+/*******************************************************************************
+*									       *
+* mcf_hepup_xdr.c -- XDR Utility routines for the Block Stdhep filters        *
+*									       *
+* Copyright (c) 1994 Universities Research Association, Inc.		       *
+* All rights reserved.							       *
+* 									       *
+* This material resulted from work developed under a Government Contract and   *
+* is subject to the following license:  The Government retains a paid-up,      *
+* nonexclusive, irrevocable worldwide license to reproduce, prepare derivative *
+* works, perform publicly and display publicly by or for the Government,       *
+* including the right to distribute to other Government contractors.  Neither  *
+* the United States nor the United States Department of Energy, nor any of     *
+* their employees, makes any warranty, express or implied, or assumes any      *
+* legal liability or responsibility for the accuracy, completeness, or         *
+* usefulness of any information, apparatus, product, or process disclosed, or  *
+* represents that its use would not infringe privately owned rights.           *
+*                                        				       *
+*									       *
+* Written by Paul Lebrun, Lynn Garren					       *
+*									       *
+*									       *
+*******************************************************************************/
+#include <stdio.h>
+#include <string.h>
+#include <sys/param.h>
+#include <rpc/types.h>
+#include <sys/types.h>
+#include <rpc/xdr.h>
+#include <limits.h>
+#ifdef SUNOS
+#include <floatingpoint.h>
+#else /* SUNOS */
+#include <float.h>
+#endif /* SUNOS */
+#include <stdlib.h>
+#include <time.h>
+#include "mcfio_Dict.h"
+#include "mcf_xdr.h"
+#include "hepeup.h"
+#include "heprup.h"
+#include "stdver.h"
+#ifndef FALSE
+#define FALSE 0
+#endif
+#ifndef TRUE
+#define TRUE 1
+#endif
+
+extern struct stdver stdver_;
+extern struct hepeup hepeup_;
+extern struct heprup heprup_;
+
+bool_t xdr_hepeup_(XDR *xdrs, int *blockid,
+ 				 int *ntot, char** version)
+
+{
+/*  Translate the HEPEUP COMMON block from the STDHEP package to/from
+    an XDR stream. Note that we do not allocate memory, because we fill
+    directly the COMMON.  Also, mcfio will allocate the space for the 
+    string version.  */
+    
+    unsigned int nn, nn2, nn5;
+    int *idat;
+    double *dat;
+    
+    if ((xdrs->x_op == XDR_ENCODE) || (xdrs->x_op == XDR_MCFIOCODE))  {
+       if (*blockid != MCFIO_HEPEUP) {
+          fprintf (stderr, "mcf_hepup_xdr: Inconsistent Blockid %d \n ", 
+           (*blockid));
+          return FALSE;
+       }
+
+       nn =  (unsigned int) hepeup_.nup;   /* Number of elements in idup, istup, vtimup, spinup */
+       nn2 = 2*(unsigned int) hepeup_.nup; /* Number of elements in mothup, icolup    */
+       nn5 = 5*(unsigned int) hepeup_.nup; /* Number of elements in pup               */
+
+       /* Total length in bytes include blockid, ntot, version, as well
+          as the common block entries                                     */
+       *ntot = sizeof(int)*(5 + 2*nn + 2*nn2) + sizeof(double)*(4 + 2*nn + nn5);
+
+       if (xdrs->x_op == XDR_MCFIOCODE) return TRUE;
+       strncpy(version[0],stdver_.stdhep_ver, 4);
+       } 
+      
+     if     ( (xdr_int(xdrs, blockid) &&
+     	      xdr_int(xdrs, ntot) &&
+     	      xdr_string(xdrs, version, MCF_XDR_VERSION_LENGTH) &&
+     	      xdr_int(xdrs, &(hepeup_.nup)) &&
+              xdr_int(xdrs, &(hepeup_.idprup))) == FALSE) return FALSE;
+              
+     if ((xdrs->x_op == XDR_DECODE) && ( *blockid != MCFIO_HEPEUP) ) {
+          fprintf (stderr, "mcf_hepup_xdr: Inconsistent Blockid %d \n ", 
+           (*blockid));
+          return FALSE;
+     }
+
+     if ( xdr_double(xdrs, &(hepeup_.xwgtup) ) == FALSE) return FALSE;
+     if ( xdr_double(xdrs, &(hepeup_.scalup) ) == FALSE) return FALSE;
+     if ( xdr_double(xdrs, &(hepeup_.aqedup) ) == FALSE) return FALSE;
+     if ( xdr_double(xdrs, &(hepeup_.aqcdup) ) == FALSE) return FALSE;
+     idat = hepeup_.idup;
+     if     ( xdr_array(xdrs, (char **)  &idat,
+         &nn, MAXNUP, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     idat = hepeup_.istup;
+     if     ( xdr_array(xdrs, (char **)  &idat,
+         &nn, MAXNUP, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     idat = (int *) hepeup_.mothup;
+     if     ( xdr_array(xdrs, (char **)  &idat,
+         &nn2, 2*MAXNUP, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     idat = (int *) hepeup_.icolup;
+     if     ( xdr_array(xdrs, (char **)  &idat,
+         &nn2, 2*MAXNUP, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     dat = (double *)  hepeup_.pup;
+     if     ( xdr_array(xdrs,  (char **)   &dat,
+         &nn5, 5*MAXNUP, sizeof(double), (void *) xdr_double) == FALSE) return FALSE; 
+     dat = (double *)  hepeup_.vtimup;
+     if     ( xdr_array(xdrs,  (char **)   &dat,
+         &nn, MAXNUP, sizeof(double), (void *) xdr_double) == FALSE) return FALSE; 
+     dat = (double *)  hepeup_.spinup;
+     if     ( xdr_array(xdrs,  (char **)   &dat,
+         &nn, MAXNUP, sizeof(double), (void *) xdr_double) == FALSE) return FALSE; 
+     return TRUE;
+}   
+
+bool_t xdr_heprup_(XDR *xdrs, int *blockid,
+ 				 int *ntot, char** version)
+
+{
+/*  Translate the HEPRUP COMMON block from the STDHEP package to/from
+    an XDR stream. Note that we do not allocate memory, because we fill
+    directly the COMMON.  Also, mcfio will allocate the space for the 
+    string version.        */
+    
+    unsigned int nn, n2;
+    int *idat;
+    double *dat;
+    
+    if ((xdrs->x_op == XDR_ENCODE) || (xdrs->x_op == XDR_MCFIOCODE))  {
+       if (*blockid != MCFIO_HEPRUP) {
+          fprintf (stderr, "mcf_hepup_xdr: Inconsistent Blockid %d \n ", 
+           (*blockid));
+          return FALSE;
+       }
+
+       nn =  (unsigned int) heprup_.nprup;   /* Number of elements in xsecup, xerrup, xmaxup, lprup */
+       n2 =  (unsigned int) 2;   /* Number of elements in idbmup, ebmup, pdfgup, pdfsup */
+
+       /* Total length in bytes include blockid, ntot, version, as well
+          as the common block entries                                     */
+       *ntot = sizeof(int)*(5 + 3*n2 + nn) + sizeof(double)*(n2 + 3*nn);
+
+       if (xdrs->x_op == XDR_MCFIOCODE) return TRUE;
+       strncpy(version[0],stdver_.stdhep_ver, 4);
+       } 
+      
+     if     ( (xdr_int(xdrs, blockid) &&
+     	      xdr_int(xdrs, ntot) &&
+     	      xdr_string(xdrs, version, MCF_XDR_VERSION_LENGTH) &&
+     	      xdr_int(xdrs, &(heprup_.idwtup)) &&
+              xdr_int(xdrs, &(heprup_.nprup))) == FALSE) return FALSE;
+              
+     if ((xdrs->x_op == XDR_DECODE) && ( *blockid != MCFIO_HEPRUP) ) {
+          fprintf (stderr, "mcf_hepup_xdr: Inconsistent Blockid %d \n ", 
+           (*blockid));
+          return FALSE;
+     }
+     idat = heprup_.idbmup;
+     if     ( xdr_array(xdrs, (char **)  &idat,
+            &n2, 2, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     dat = (double *)  heprup_.ebmup;
+     if     ( xdr_array(xdrs,  (char **)   &dat,
+                &n2, 2, sizeof(double), (void *) xdr_double) == FALSE) return FALSE; 
+     idat = heprup_.pdfgup;
+     if     ( xdr_array(xdrs, (char **)  &idat,
+            &n2, 2, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     idat = heprup_.pdfsup;
+     if     ( xdr_array(xdrs, (char **)  &idat,
+            &n2, 2, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     dat = (double *)  heprup_.xsecup;
+     if     ( xdr_array(xdrs,  (char **)   &dat,
+                &nn, MAXPUP, sizeof(double), (void *) xdr_double) == FALSE) return FALSE; 
+     dat = (double *)  heprup_.xerrup;
+     if     ( xdr_array(xdrs,  (char **)   &dat,
+                &nn, MAXPUP, sizeof(double), (void *) xdr_double) == FALSE) return FALSE; 
+     dat = (double *)  heprup_.xmaxup;
+     if     ( xdr_array(xdrs,  (char **)   &dat,
+                &nn, MAXPUP, sizeof(double), (void *) xdr_double) == FALSE) return FALSE; 
+     idat = heprup_.lprup;
+     if     ( xdr_array(xdrs, (char **)  &idat,
+            &nn, MAXPUP, sizeof(int), (void *) xdr_int) == FALSE) return FALSE;
+     
+     return TRUE;
+}   
+
+
Index: /trunk/stdhep/mcf_stdcm1_xdr.c
===================================================================
--- /trunk/stdhep/mcf_stdcm1_xdr.c	(revision 2)
+++ /trunk/stdhep/mcf_stdcm1_xdr.c	(revision 2)
@@ -0,0 +1,147 @@
+/*******************************************************************************
+*									       *
+* mcf_stdcm1_xdr.c -- XDR Utility routines for the Block stdcm1 filters        *
+*									       *
+* Copyright (c) 1994 Universities Research Association, Inc.		       *
+* All rights reserved.							       *
+* 									       *
+* This material resulted from work developed under a Government Contract and   *
+* is subject to the following license:  The Government retains a paid-up,      *
+* nonexclusive, irrevocable worldwide license to reproduce, prepare derivative *
+* works, perform publicly and display publicly by or for the Government,       *
+* including the right to distribute to other Government contractors.  Neither  *
+* the United States nor the United States Department of Energy, nor any of     *
+* their employees, makes any warranty, express or implied, or assumes any      *
+* legal liability or responsibility for the accuracy, completeness, or         *
+* usefulness of any information, apparatus, product, or process disclosed, or  *
+* represents that its use would not infringe privately owned rights.           *
+*                                        				       *
+*									       *
+* Written by Paul Lebrun, Lynn Garren					       *
+*									       *
+*									       *
+*******************************************************************************/
+#include <stdio.h>
+#include <string.h>
+#include <sys/param.h>
+#include <rpc/types.h>
+#include <sys/types.h>
+#include <rpc/xdr.h>
+#include <limits.h>
+#ifdef SUNOS
+#include <floatingpoint.h>
+#else /* SUNOS */
+#include <float.h>
+#endif /* SUNOS */
+#include <stdlib.h>
+#include <time.h>
+#include "mcfio_Dict.h"
+#include "mcf_xdr.h"
+#include "stdcm1.h"
+#include "stdver.h"
+#ifndef FALSE
+#define FALSE 0
+#endif
+#ifndef TRUE
+#define TRUE 1
+#endif
+
+extern struct stdver stdver_;
+extern struct stdcm1 stdcm1_;
+extern struct stdcm2 stdcm2_;
+
+bool_t xdr_stdhep_cm1_(XDR *xdrs, int *blockid,
+ 				 int *ntot, char** version)
+
+{
+/*  Translate the STDCM1 COMMON block from the STDHEP package to/from
+    an XDR stream. Note that we do not allocate memory, because we fill
+    directly the COMMON.  Also, mcfio will allocate the space for the 
+    string version.  */
+    
+    unsigned int nn, nn1, nn2;
+    char *vers;
+    char *cdat;
+    
+    if ((xdrs->x_op == XDR_ENCODE) || (xdrs->x_op == XDR_MCFIOCODE))  {
+       if (( *blockid != MCFIO_STDHEPEND)&&( *blockid != MCFIO_STDHEPBEG)) {
+          fprintf (stderr, "mcf_Stdhep_cm1_xdr: Inconsistent Blockid %d \n ", 
+           (*blockid));
+          return FALSE;
+       }
+       nn = sizeof(int) * stdcm1_.nevtreq;
+       nn1 = sizeof(float) * stdcm1_.nevtreq;
+       nn2 = sizeof(double) * stdcm1_.nevtreq;
+       *ntot = 3 * sizeof(int) + 3 * nn + 2 * nn1 +  2 * nn2
+               + 2 * sizeof(char) * ( MCF_XDR_STDCM2_LENGTH + 1 );
+       if (xdrs->x_op == XDR_MCFIOCODE) return TRUE;
+       strncpy(version[0],stdver_.stdhep_ver, 4);
+     } 
+      
+     if     ( (xdr_int(xdrs, blockid) &&
+     	      xdr_int(xdrs, ntot) &&
+     	      xdr_string(xdrs, version, MCF_XDR_VERSION_LENGTH) )
+              == FALSE) return FALSE;
+              
+     if ((xdrs->x_op == XDR_DECODE) && 
+          (( *blockid != MCFIO_STDHEPEND)&&( *blockid != MCFIO_STDHEPBEG))) {
+          fprintf (stderr, "mcf_Stdhep_cm1_xdr: Inconsistent Blockid %d \n ", 
+           (*blockid));
+          return FALSE;
+     }
+     if ( xdr_int(xdrs, &(stdcm1_.nevtreq) ) == FALSE) return FALSE;
+     if ( xdr_int(xdrs, &(stdcm1_.nevtgen) ) == FALSE) return FALSE;
+     if ( xdr_int(xdrs, &(stdcm1_.nevtwrt) ) == FALSE) return FALSE;
+     if ( xdr_float(xdrs, &(stdcm1_.stdecom) ) == FALSE) return FALSE;
+     if ( xdr_float(xdrs, &(stdcm1_.stdxsec) ) == FALSE) return FALSE;
+     if ( xdr_double(xdrs, &(stdcm1_.stdseed1) ) == FALSE) return FALSE;
+     if ( xdr_double(xdrs, &(stdcm1_.stdseed2) ) == FALSE) return FALSE;
+     /*
+     ** V5.01 Upgrade : adding stdcm2 
+     */ 
+     vers = *version;          
+     if (((strcmp(vers,"1.") == 0) || (strcmp(vers,"2.") == 0) ||
+          (strcmp(vers,"3.") == 0) || (strcmp(vers,"4.") == 0) ||
+	  (strcmp(vers,"5.00") == 0) ) && (xdrs->x_op == XDR_DECODE)) {
+	   strncpy(stdcm2_.generatorname, " ", MCF_XDR_STDCM2_LENGTH);
+	   strncpy(stdcm2_.pdfname, " ", MCF_XDR_STDCM2_LENGTH);
+           return TRUE;
+     }
+/* 
+  allocate memory and deal with encoding and decoding separately
+*/
+     cdat = malloc(MCF_XDR_STDCM2_LENGTH+1);
+     if( (xdrs->x_op == XDR_DECODE) ) {
+	 strncpy(stdcm2_.generatorname, " ", MCF_XDR_STDCM2_LENGTH);
+	 strncpy(stdcm2_.pdfname, " ", MCF_XDR_STDCM2_LENGTH);
+	 cdat = NULL;
+	 if ( xdr_string(xdrs, &cdat, MCF_XDR_STDCM2_LENGTH+1 ) == FALSE) return FALSE;
+         strncpy(stdcm2_.generatorname,cdat,MCF_XDR_STDCM2_LENGTH);
+	 cdat = NULL;
+	 if ( xdr_string(xdrs, &cdat, MCF_XDR_STDCM2_LENGTH+1 ) == FALSE) return FALSE;
+         strncpy(stdcm2_.pdfname,cdat,MCF_XDR_STDCM2_LENGTH);
+     } else {
+	 strncpy(cdat, stdcm2_.generatorname, MCF_XDR_STDCM2_LENGTH);
+         /* some compilers do not properly append the null terminator */
+	 cdat[MCF_XDR_STDCM2_LENGTH]='\0';
+	 if ( xdr_string(xdrs, &cdat, MCF_XDR_STDCM2_LENGTH+1 ) == FALSE) return FALSE;
+	 strncpy(cdat, stdcm2_.pdfname, MCF_XDR_STDCM2_LENGTH);
+	 cdat[MCF_XDR_STDCM2_LENGTH]='\0';
+	 if ( xdr_string(xdrs, &cdat, MCF_XDR_STDCM2_LENGTH+1 ) == FALSE) return FALSE;
+     }
+     free(cdat);
+
+     /*
+     ** V5.02 Upgrade : add nevtlh to stdcm1 
+     ** note that we cannot get here unless the version is 5.00 or greater
+     */ 
+     if (((strcmp(vers,"5.00") == 0) || (strcmp(vers,"5.01") == 0))
+	  && (xdrs->x_op == XDR_DECODE)) {
+	   stdcm1_.nevtlh = 0;
+           return TRUE;
+     }
+     if ( xdr_int(xdrs, &(stdcm1_.nevtlh) ) == FALSE) return FALSE;
+
+     return TRUE;
+}   
+
Index: /trunk/stdhep/stdcm1.h
===================================================================
--- /trunk/stdhep/stdcm1.h	(revision 2)
+++ /trunk/stdhep/stdcm1.h	(revision 2)
@@ -0,0 +1,19 @@
+/*
+** STDHEP begin/end run COMMON block
+** See product StDhep
+*/
+struct stdcm1 {
+float stdecom;   /*   STDECOM  - center-of-mass energy */
+float stdxsec;   /*   STDXSEC  - cross-section */
+double stdseed1; /*   STDSEED1 - random number seed */
+double stdseed2; /*   STDSEED2 - random number seed */
+int nevtreq;     /*   NEVTREQ  - number of events to be generated */
+int nevtgen;     /*   NEVTGEN  - number of events actually generated */
+int nevtwrt;     /*   NEVTWRT  - number of events written to output file */
+int nevtlh;      /*   NEVTLH  - number of Les Houches events written to output file */
+};
+
+struct stdcm2 {
+char generatorname[20];		/* name of Monte Carlo generator */
+char pdfname[20];     		/* name of PDF method used */
+};
Index: /trunk/stdhep/stdcnt.h
===================================================================
--- /trunk/stdhep/stdcnt.h	(revision 2)
+++ /trunk/stdhep/stdcnt.h	(revision 2)
@@ -0,0 +1,9 @@
+/*
+    StdHep counting common block
+*/
+struct stdcnt {
+    int nstdwrt;	/* number of events written */
+    int nstdrd;		/* number of events read */
+    int nlhwrt;		/* number of Les Houches events written */
+    int nlhrd;		/* number of Les Houches events read */
+};
Index: /trunk/stdhep/stdhd.h
===================================================================
--- /trunk/stdhep/stdhd.h	(revision 2)
+++ /trunk/stdhep/stdhd.h	(revision 2)
@@ -0,0 +1,19 @@
+/* 
+----------------------------------------------------------------
+   This header collects the mcfio initial information
+----------------------------------------------------------------
+*/
+
+struct stdhd1 {
+char date[255];		/* MCFIO_CREATIONDATE: creation date */
+char title[255];	/* MCFIO_TITLE: title */
+char comment[255];	/* MCFIO_COMMENT: comment */
+};
+
+struct stdhd2 {
+int dlen;         /* actual lenght of date */
+int tlen;         /* actual lenght of title */
+int clen;         /* actual lenght of comment */
+int numblocks;    /* MCFIO_NUMBLOCKS: number of blocks per event */
+int blkids[50];   /* MCFIO_BLOCKIDS: list of block types */
+};
Index: /trunk/stdhep/stdhep.h
===================================================================
--- /trunk/stdhep/stdhep.h	(revision 2)
+++ /trunk/stdhep/stdhep.h	(revision 2)
@@ -0,0 +1,42 @@
+#ifndef STDHEP_H
+#define STDHEP_H
+/*
+** Basic COMMON block from STDHEP: the HEPEVT COMMON block 
+** See product StDhep
+*/
+/*  note that to avoid alignment problems, structures and common blocks
+    should be in the order: double precision, real, integer.
+*/
+
+#if defined(c_plusplus) || defined(__cplusplus)
+extern "C" {
+#endif
+
+#define NMXHEP 4000
+#define NMXMLT 16
+struct hepevt {
+int nevhep;		/* The event number */
+int nhep;		/* The number of entries in this event */
+int isthep[NMXHEP]; 	/* The Particle id */
+int idhep[NMXHEP];      /* The particle id */
+int jmohep[NMXHEP][2];    /* The position of the mother particle */
+int jdahep[NMXHEP][2];    /* Position of the first daughter... */
+double phep[NMXHEP][5];    /* 4-Momentum, mass */
+double vhep[NMXHEP][4];    /* Vertex information */
+};
+struct hepev2 {
+int nmulti;		/* number of interactions in the list */
+int jmulti[NMXHEP];     /* multiple interaction number */
+};
+struct hepev3 {
+int nevmulti[NMXMLT];     /* event number of original interaction */
+int itrkmulti[NMXMLT];     /* first particle in the original interaction */
+int mltstr[NMXMLT];     /* stream this event is from */
+};
+
+#if defined(c_plusplus) || defined(__cplusplus)
+}
+#endif
+
+#endif /* STDHEP_H */
+
Index: /trunk/stdhep/stdhep_declarations.h
===================================================================
--- /trunk/stdhep/stdhep_declarations.h	(revision 2)
+++ /trunk/stdhep/stdhep_declarations.h	(revision 2)
@@ -0,0 +1,40 @@
+#ifndef STDHEP_DECLARATIONS_H
+#define STDHEP_DECLARATIONS_H
+
+/* declare the struct instances */
+
+#include "stdhep.h"
+#include "hepev4.h"
+#include "hepeup.h"
+#include "heprup.h"
+#include "stdtmp.h"
+#include "stdhd.h"
+#include "stdcnt.h"
+#include "stdcm1.h"
+#include "stdver.h"
+
+#if defined(c_plusplus) || defined(__cplusplus)
+extern "C" {
+#endif
+
+struct hepevt myhepevt;
+struct hepev2 hepev2_;
+struct hepev3 hepev3_;
+struct hepev4 hepev4_;
+struct hepev5 hepev5_;
+struct hepeup hepeup_;
+struct heprup heprup_;
+struct stdcnt stdcnt_;
+struct stdhd1 stdhd1_;
+struct stdhd2 stdhd2_;
+struct stdtmp stdtmp_;
+struct tmpev4 tmpev4_;
+struct stdcm1 stdcm1_;
+struct stdcm2 stdcm2_;
+struct stdver stdver_;
+
+#if defined(c_plusplus) || defined(__cplusplus)
+}
+#endif
+
+#endif /* STDHEP_DECLARATIONS_H */
Index: /trunk/stdhep/stdhep_internal_utils.c
===================================================================
--- /trunk/stdhep/stdhep_internal_utils.c	(revision 2)
+++ /trunk/stdhep/stdhep_internal_utils.c	(revision 2)
@@ -0,0 +1,215 @@
+/*******************************************************************************
+*									       *
+* stdhep_internal_utils.c -- C version of stdhep internal utility routines     *
+*									       *
+* Copyright (c) 1995 Universities Research Association, Inc.		       *
+* All rights reserved.							       *
+* 									       *
+* This material resulted from work developed under a Government Contract and   *
+* is subject to the following license:  The Government retains a paid-up,      *
+* nonexclusive, irrevocable worldwide license to reproduce, prepare derivative *
+* works, perform publicly and display publicly by or for the Government,       *
+* including the right to distribute to other Government contractors.  Neither  *
+* the United States nor the United States Department of Energy, nor any of     *
+* their employees, makes any warranty, express or implied, or assumes any      *
+* legal liability or responsibility for the accuracy, completeness, or         *
+* usefulness of any information, apparatus, product, or process disclosed, or  *
+* represents that its use would not infringe privately owned rights.           *
+*                                        				       *
+*									       *
+* Written by Lynn Garren    					       	       *
+*									       *
+*									       *
+*******************************************************************************/
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+#ifndef FALSE
+#define FALSE 0
+#endif
+#ifndef TRUE
+#define TRUE 1
+#endif
+/* 
+*   StdHep definitions and include files
+*/
+#include "stdhep.h"
+#include "hepev4.h"
+#include "stdtmp.h"
+#include "hepeup.h"
+
+extern struct stdtmp stdtmp_;
+extern struct tmpev4 tmpev4_;
+
+extern struct hepevt myhepevt;
+extern struct hepev2 hepev2_;
+extern struct hepev3 hepev3_;
+extern struct hepev4 hepev4_;
+extern struct hepev5 hepev5_;
+extern struct hepeup hepeup_;
+
+/* Purpose: copy an event to/from the standard common block */
+int StdHepTempCopy(int idir, int istr)
+{
+    int nh, i, k;
+    if (idir == 1) {        /* copy from hepevt to stdtmp */
+        stdtmp_.nevhept = myhepevt.nevhep;
+        stdtmp_.nhept = myhepevt.nhep;
+	tmpev4_.eventweightt = hepev4_.eventweightlh;
+	tmpev4_.alphaqedt = hepev4_.alphaqedlh;
+	tmpev4_.alphaqcdt = hepev4_.alphaqcdlh;
+        for (i = 0; i < 10; i++) {
+	    tmpev4_.scalet[i] = hepev4_.scalelh[i];
+	}
+	tmpev4_.idrupt = hepev4_.idruplh;
+        for (i = 0; i < myhepevt.nhep; i++) {
+            stdtmp_.isthept[i] = myhepevt.isthep[i];
+            stdtmp_.idhept[i] = myhepevt.idhep[i];
+            for (k = 0; k < 2; k++) {
+                stdtmp_.jmohept[i][k] = myhepevt.jmohep[i][k];
+                stdtmp_.jdahept[i][k] = myhepevt.jdahep[i][k];
+		tmpev4_.icolorflowt[i][k] = hepev4_.icolorflowlh[i][k];
+                }
+            for (k = 0; k < 5; k++)
+                stdtmp_.phept[i][k] = myhepevt.phep[i][k];
+            for (k = 0; k < 4; k++)
+                stdtmp_.vhept[i][k] = myhepevt.vhep[i][k];
+            for (k = 0; k < 3; k++)
+                tmpev4_.spint[i][k] = hepev4_.spinlh[i][k];
+            }
+    } else if (idir == 2) {    /* copy from stdtmp to hepevt */
+        if (myhepevt.nhep + stdtmp_.nhept > NMXHEP) {
+            fprintf(stderr,
+              "     StdHepTempCopy: event would overflow HEPEVT array size\n");
+            fprintf(stderr,"     StdHepTempCopy: event %d has been lost\n",
+                   stdtmp_.nevhept);
+            return 5;
+            }
+        myhepevt.nevhep = stdtmp_.nevhept;
+        nh = myhepevt.nhep;
+	hepev4_.eventweightlh = tmpev4_.eventweightt;
+	hepev4_.alphaqedlh = tmpev4_.alphaqedt;
+	hepev4_.alphaqcdlh = tmpev4_.alphaqcdt;
+        for (i = 0; i < 10; i++) {
+	    hepev4_.scalelh[i] = tmpev4_.scalet[i];
+	}
+	hepev4_.idruplh = tmpev4_.idrupt;
+        for (i = 0; i < stdtmp_.nhept; i++) {
+            myhepevt.isthep[nh+i] = stdtmp_.isthept[i];
+            myhepevt.idhep[nh+i] = stdtmp_.idhept[i];
+            for (k = 0; k < 2; k++) {
+                myhepevt.jmohep[nh+i][k] = stdtmp_.jmohept[i][k];
+                myhepevt.jdahep[nh+i][k] = stdtmp_.jdahept[i][k];
+		hepev4_.icolorflowlh[nh+i][k] = tmpev4_.icolorflowt[i][k];
+                }
+            for (k = 0; k < 5; k++)
+                myhepevt.phep[nh+i][k] = stdtmp_.phept[i][k];
+            for (k = 0; k < 4; k++)
+                myhepevt.vhep[nh+i][k] = stdtmp_.vhept[i][k];
+            for (k = 0; k < 3; k++)
+                hepev4_.spinlh[nh+i][k] = tmpev4_.spint[i][k];
+            }
+        hepev2_.nmulti += 1;
+	if (hepev2_.nmulti <= NMXMLT ) {
+	    hepev3_.nevmulti[hepev2_.nmulti] = stdtmp_.nevhept;
+	    hepev3_.itrkmulti[hepev2_.nmulti] = stdtmp_.nhept + 1;
+	    hepev3_.mltstr[hepev2_.nmulti] = istr;
+	    hepev5_.eventweightmulti[i] = tmpev4_.eventweightt;
+	    hepev5_.alphaqedmulti[i] = tmpev4_.alphaqedt;
+	    hepev5_.alphaqcdmulti[i] = tmpev4_.alphaqcdt;
+	    for( k = 0; k < 10; ++k) {
+		hepev5_.scalemulti[i][k] = tmpev4_.scalet[k];
+	    }
+	    hepev5_.idrupmulti[i] = tmpev4_.idrupt;
+	} else {
+	    fprintf(stderr," StdHepTempCopy: %d multiple interactions in this event\n",
+	         hepev2_.nmulti );  
+	    fprintf(stderr," StdHepTempCopy: only %d multiple interactions are allowed\n",
+	         NMXMLT );  
+	}
+        for (i = 0; i < stdtmp_.nhept; i++) {
+            hepev2_.jmulti[nh+i] = hepev2_.nmulti;
+            for (k = 0; k < 2; k++) {
+                if (myhepevt.jmohep[nh+i][k] != 0) {
+		   myhepevt.jmohep[nh+i][k] += myhepevt.nhep;
+		   }
+                if (myhepevt.jdahep[nh+i][k] != 0) {
+		   myhepevt.jdahep[nh+i][k] += myhepevt.nhep;
+		   }
+                if (hepev4_.icolorflowlh[nh+i][k] != 0) {
+		   hepev4_.icolorflowlh[nh+i][k] += myhepevt.nhep;
+		   }
+                }
+        }
+        myhepevt.nhep += stdtmp_.nhept;
+    } else {
+        fprintf(stderr," StdHepTempCopy: improper calling flag\n");
+    }
+    return 0;
+}
+
+void StdHepZero(void)
+{
+    int i, k;
+    myhepevt.nhep = 0;
+    hepev2_.nmulti = 0;
+    for (i = 0; i < NMXHEP; i++) {
+        myhepevt.isthep[i] = 0;
+        myhepevt.idhep[i] = 0;
+        hepev2_.jmulti[i] = 0;
+        for (k = 0; k < 2; k++) {
+            myhepevt.jmohep[i][k] = 0;
+            myhepevt.jdahep[i][k] = 0;
+	    hepev4_.icolorflowlh[i][k] = 0;
+            }
+        for (k = 0; k < 5; k++)
+            myhepevt.phep[i][k] = 0.;
+        for (k = 0; k < 4; k++)
+            myhepevt.vhep[i][k] = 0.;
+        for (k = 0; k < 3; k++)
+            hepev4_.spinlh[i][k] = 0.;
+        }
+    for (i = 0; i < NMXMLT; i++) {
+        hepev3_.nevmulti[i] = 0;
+        hepev3_.itrkmulti[i] = 0;
+        hepev3_.mltstr[i] = 0;
+	hepev5_.eventweightmulti[i] = 0.;
+	hepev5_.alphaqedmulti[i] = 0.;
+	hepev5_.alphaqcdmulti[i] = 0.;
+	for( k = 0; k < 10; ++k) {
+	    hepev5_.scalemulti[i][k] = 0.;
+	}
+	hepev5_.idrupmulti[i] = 0;
+    }
+    hepev4_.eventweightlh = 0.;
+    hepev4_.alphaqedlh = 0.;
+    hepev4_.alphaqcdlh = 0.;
+    for (i = 0; i < 10; i++) {
+        hepev4_.scalelh[i] = 0.;
+    }
+    hepev4_.idruplh = 0;
+}
+
+void StdHepZeroHEPEUP(void)
+{
+   int i, k;
+   hepeup_.nup = 0;
+   hepeup_.idprup = 0;
+   hepeup_.xwgtup = 0;
+   hepeup_.scalup = 0;
+   hepeup_.aqedup = 0;
+   hepeup_.aqcdup = 0;
+   for (i = 0; i < MAXNUP; ++i) {
+      hepeup_.idup[i] = 0;
+      hepeup_.istup[i] = 0;
+      for (k = 0; k < 2; ++k) {
+         hepeup_.mothup[i][k] = 0;
+         hepeup_.icolup[i][k] = 0;
+      }
+      for (k = 0; k < 5; ++k) {
+         hepeup_.pup[i][k] = 0;
+      }
+      hepeup_.vtimup[i] = 0;
+      hepeup_.spinup[i] = 0;
+   }
+}
Index: /trunk/stdhep/stdhep_mcfio.c
===================================================================
--- /trunk/stdhep/stdhep_mcfio.c	(revision 2)
+++ /trunk/stdhep/stdhep_mcfio.c	(revision 2)
@@ -0,0 +1,563 @@
+/*******************************************************************************
+*									       *
+* stdhep_mcfio.c -- C version of mcfio interface routines                      *
+*									       *
+* Copyright (c) 1995 Universities Research Association, Inc.		       *
+* All rights reserved.							       *
+* 									       *
+* This material resulted from work developed under a Government Contract and   *
+* is subject to the following license:  The Government retains a paid-up,      *
+* nonexclusive, irrevocable worldwide license to reproduce, prepare derivative *
+* works, perform publicly and display publicly by or for the Government,       *
+* including the right to distribute to other Government contractors.  Neither  *
+* the United States nor the United States Department of Energy, nor any of     *
+* their employees, makes any warranty, express or implied, or assumes any      *
+* legal liability or responsibility for the accuracy, completeness, or         *
+* usefulness of any information, apparatus, product, or process disclosed, or  *
+* represents that its use would not infringe privately owned rights.           *
+*                                        				       *
+*									       *
+* Written by Lynn Garren    					       	       *
+*									       *
+*									       *
+*******************************************************************************/
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+#include <rpc/types.h>
+#include <rpc/xdr.h>
+#ifndef FALSE
+#define FALSE 0
+#endif
+#ifndef TRUE
+#define TRUE 1
+#endif
+/* 
+*   mcfio/StdHep definitions and include files
+*/
+#include "mcf_xdr.h"
+#include "mcfio_Block.h"
+#include "mcfio_Dict.h"
+#include "mcfio_Direct.h"
+#include "mcfio_Util1.h"
+#include "stdhep.h"
+#include "hepev4.h"
+#include "hepeup.h"
+#include "heprup.h"
+#include "stdtmp.h"
+#include "stdhd.h"
+#include "stdcnt.h"
+#include "stdhep_mcfio.h"
+
+#define LUN_ARRAY 16	/* I/O array size */
+struct stdstr {
+    int ixdrstr[LUN_ARRAY];	/* array of xdr stream addresses */
+} stdstr_;
+
+/* extern struct hepevt hepevt_; */
+extern struct hepevt myhepevt;
+extern struct hepev2 hepev2_;
+extern struct hepev3 hepev3_;
+extern struct hepev4 hepev4_;
+extern struct hepev5 hepev5_;
+extern struct hepeup hepeup_;
+extern struct heprup heprup_;
+extern struct stdcnt stdcnt_;
+extern struct stdhd1 stdhd1_;
+extern struct stdhd2 stdhd2_;
+extern struct stdtmp stdtmp_;
+extern struct tmpev4 tmpev4_;
+
+extern int xdr_stdhep_();
+extern int xdr_stdhep_multi_();
+extern int xdr_stdhep_4_();
+extern int xdr_stdhep_4_multi_();
+extern int xdr_stdhep_cm1_();
+extern int xdr_hepeup_();
+extern int xdr_heprup_();
+
+int StdHepXdrReadInit(char *filename, int *ntries, int ist)
+{
+    int ierr;
+    
+    mcfioC_Init();
+    ierr = StdHepXdrReadOpen(filename, ntries, ist);
+    return ierr;
+}
+int StdHepXdrReadOpen(char *filename, int *ntries, int ist)
+{
+    int istream, iblk;
+    int numblocks, blkids[50];
+
+    istream =  mcfioC_OpenReadDirect(filename);
+    stdstr_.ixdrstr[ist] = istream;
+    if (istream == -1) {
+        fprintf(stderr," StdHepXdrReadOpen: cannot open output file \n");
+        return -1;
+        }
+    mcfioC_InfoStreamChar(istream, MCFIO_CREATIONDATE, stdhd1_.date, &stdhd2_.dlen);
+    mcfioC_InfoStreamChar(istream, MCFIO_TITLE, stdhd1_.title, &stdhd2_.tlen);
+    mcfioC_InfoStreamChar(istream, MCFIO_COMMENT, stdhd1_.comment, &stdhd2_.clen);
+    mcfioC_InfoStreamInt(istream, MCFIO_NUMEVTS, ntries);
+    mcfioC_InfoStreamInt(istream, MCFIO_NUMBLOCKS, &numblocks);
+    mcfioC_InfoStreamInt(istream, MCFIO_BLOCKIDS, blkids);
+
+    stdhd2_.numblocks = numblocks; 
+    for ( iblk=0; iblk < numblocks; ++iblk ) {
+        stdhd2_.blkids[iblk] = blkids[iblk];
+    }
+
+    stdcnt_.nstdrd = 0;
+    stdcnt_.nlhrd = 0;
+/*
+    fprintf(stdout,
+       " StdHepXdrReadOpen: successfully opened input stream %d\n", istream);
+    fprintf(stdout,"          title: %s\n", stdhd1_.title);
+    fprintf(stdout,"          date: %s\n", stdhd1_.date);
+    fprintf(stdout,"                    %d events\n", *ntries);
+    fprintf(stdout,"                    %d blocks per event\n", stdhd2_.numblocks);
+*/
+    return 0;
+}
+int StdHepXdrRead(int *ilbl, int ist)
+{
+/* Purpose: to read a buffer or an event from the standard common block.
+C
+C       returns ilbl
+C
+C		ilbl = 1   - standard HEPEVT common block
+C		ilbl = 2   - standard HEPEVT common block and HEPEV2
+C		ilbl = 3   - stdevent struct
+C	        ilbl = 4   - standard HEPEVT common block with Les Houches
+C	        ilbl = 5   - standard HEPEVT common block with Les Houches
+C                               and multiple collisions
+C		ilbl = 11  -  HEPEUP common block
+C		ilbl = 12  -  HEPRUP common block
+C		ilbl = 100 - STDHEP begin run record
+C		ilbl = 200 - STDHEP end run record
+C   */
+
+    int istat;
+    int istream;
+    int i, numblocks, blkids[50];
+
+    istream = stdstr_.ixdrstr[ist];
+    if(mcfioC_NextEvent(istream) != MCFIO_RUNNING) {
+        mcfioC_InfoStreamInt(istream, MCFIO_STATUS, &istat);
+        if(istat == MCFIO_EOF) {
+            fprintf(stderr,"     StdHepXdrRead: end of file found\n");
+            return 1;
+            }
+        else {
+            fprintf(stderr,"     StdHepXdrRead: unrecognized status - stop\n");
+            return 2;
+            }
+        }
+    mcfioC_InfoStreamInt(istream, MCFIO_NUMBLOCKS, &numblocks);
+    mcfioC_InfoStreamInt(istream, MCFIO_BLOCKIDS, blkids);
+
+    for (i = 0; i < numblocks; i++) {
+        if (blkids[i] == MCFIO_STDHEP) {
+            StdHepZero();
+            if (mcfioC_Block(istream,MCFIO_STDHEP,xdr_stdhep_) != -1) {
+                *ilbl = 1;
+                if (StdHepTempCopy(2,istream) == 0)
+                    stdcnt_.nstdrd = stdcnt_.nstdrd + 1;
+                return 0;
+                }
+            }
+        else if (blkids[i] == MCFIO_STDHEPM) {
+            StdHepZero();
+            if (mcfioC_Block(istream,MCFIO_STDHEPM,xdr_stdhep_multi_) != -1) {
+                *ilbl = 2;
+                stdcnt_.nstdrd = stdcnt_.nstdrd + 1;
+                return 0;
+                }
+            }
+        else if (blkids[i] == MCFIO_STDHEP4) {
+            StdHepZero();
+            if (mcfioC_Block(istream,MCFIO_STDHEP4,xdr_stdhep_4_) != -1) {
+                *ilbl = 4;
+                if (StdHepTempCopy(2,istream) == 0)
+                    stdcnt_.nstdrd = stdcnt_.nstdrd + 1;
+                return 0;
+                }
+            }
+        else if (blkids[i] == MCFIO_STDHEP4M) {
+            StdHepZero();
+            if (mcfioC_Block(istream,MCFIO_STDHEP4M,xdr_stdhep_4_multi_) != -1) {
+                *ilbl = 5;
+                stdcnt_.nstdrd = stdcnt_.nstdrd + 1;
+                return 0;
+                }
+            }
+        else if (blkids[i] == MCFIO_STDHEPBEG) {
+            if (mcfioC_Block(istream,MCFIO_STDHEPBEG,xdr_stdhep_cm1_) != -1) {
+                *ilbl = 100;
+                return 0;
+                }
+            }
+        else if (blkids[i] == MCFIO_STDHEPEND) {
+            if (mcfioC_Block(istream,MCFIO_STDHEPEND,xdr_stdhep_cm1_) != -1) {
+                *ilbl = 200;
+                return 0;
+                }
+            }
+        else if (blkids[i] == MCFIO_HEPEUP) {
+            if (mcfioC_Block(istream,MCFIO_HEPEUP,xdr_hepeup_) != -1) {
+                *ilbl = 11;
+                stdcnt_.nlhrd = stdcnt_.nlhrd + 1;
+                return 0;
+                }
+            }
+        else if (blkids[i] == MCFIO_HEPRUP) {
+            if (mcfioC_Block(istream,MCFIO_HEPRUP,xdr_heprup_) != -1) {
+                *ilbl = 12;
+                stdcnt_.nlhrd = stdcnt_.nlhrd + 1;
+                return 0;
+                }
+            }
+        }
+    return 1;
+}
+int StdHepXdrReadMulti(int *ilbl, int ist)
+{
+/* Purpose: to read a buffer or an event from the standard common block
+            this routine handles multiple input streams
+C
+C       return ilbl
+C
+C		ilbl = 1   - standard HEPEVT common block
+C		ilbl = 2   - standard HEPEVT common block and HEPEV2
+C		ilbl = 100 - STDHEP begin run record
+C		ilbl = 200 - STDHEP end run record
+C   */
+
+    int istat;
+    int istream;
+    int i, numblocks, blkids[50];
+
+    istream = stdstr_.ixdrstr[ist];
+    if(mcfioC_NextEvent(istream) != MCFIO_RUNNING) {
+        mcfioC_InfoStreamInt(istream, MCFIO_STATUS, &istat);
+        if(istat == MCFIO_EOF) {
+            fprintf(stderr,"     StdHepXdrReadMulti: end of file found\n");
+            return 1;
+            }
+        else {
+            fprintf(stderr,
+              "     StdHepXdrReadMulti: unrecognized status - stop\n");
+            return 2;
+            }
+        }
+    mcfioC_InfoStreamInt(istream, MCFIO_NUMBLOCKS, &numblocks);
+    mcfioC_InfoStreamInt(istream, MCFIO_BLOCKIDS, blkids);
+    for (i = 0; i < numblocks; i++) {
+        if (blkids[i] == MCFIO_STDHEP) {
+           if (mcfioC_Block(istream,MCFIO_STDHEP,xdr_stdhep_) == -1) {
+                fprintf(stderr,
+                  "     StdHepXdrReadMulti: unable to read xdr block\n");
+                return 1;
+                }
+            *ilbl = 1;
+            if (StdHepTempCopy(2,istream) == 0)
+                stdcnt_.nstdrd = stdcnt_.nstdrd + 1;
+            }
+        else if (blkids[i] == MCFIO_STDHEPM) {
+            fprintf(stderr,
+          "    StdHepXdrRead: multiple interaction event - HEPEVT is zeroed\n");
+            StdHepZero();
+            if (mcfioC_Block(istream,MCFIO_STDHEPM,xdr_stdhep_multi_) == -1) {
+                fprintf(stderr,
+                  "     StdHepXdrReadMulti: unable to read xdr block\n");
+                return 1;
+                }
+            *ilbl = 2;
+            stdcnt_.nstdrd = stdcnt_.nstdrd + 1;
+            }
+        else if (blkids[i] == MCFIO_STDHEP4) {
+           if (mcfioC_Block(istream,MCFIO_STDHEP4,xdr_stdhep_4_) == -1) {
+                fprintf(stderr,
+                  "     StdHepXdrReadMulti: unable to read xdr block\n");
+                return 1;
+                }
+            *ilbl = 4;
+            if (StdHepTempCopy(2,istream) == 0)
+                stdcnt_.nstdrd = stdcnt_.nstdrd + 1;
+            }
+        else if (blkids[i] == MCFIO_STDHEP4M) {
+            fprintf(stderr,
+          "    StdHepXdrRead: multiple interaction event - HEPEVT is zeroed\n");
+            StdHepZero();
+            if (mcfioC_Block(istream,MCFIO_STDHEP4M,xdr_stdhep_4_multi_) == -1) {
+                fprintf(stderr,
+                  "     StdHepXdrReadMulti: unable to read xdr block\n");
+                return 1;
+                }
+            *ilbl = 5;
+            stdcnt_.nstdrd = stdcnt_.nstdrd + 1;
+            }
+        }
+    return 0;
+}
+int StdHepXdrWriteInit(char *filename, char *title, int ntries, int ist)
+{
+    int ierr;
+
+    mcfioC_Init();
+    ierr = StdHepXdrWriteOpen(filename, title, ntries, ist);
+    return ierr;
+}
+int StdHepXdrWriteOpen(char *filename, char *title, int ntries, int ist)
+{
+    int istream, iblk;
+    int numblocks = 8;
+    int blkids[50];
+    char *comment = '\0';
+
+    blkids[0] = MCFIO_STDHEP;
+    blkids[1] = MCFIO_STDHEPM;
+    blkids[2] = MCFIO_STDHEPBEG;
+    blkids[3] = MCFIO_STDHEPEND;
+    blkids[4] = MCFIO_STDHEP4;
+    blkids[5] = MCFIO_STDHEP4M;
+    blkids[6] = MCFIO_HEPEUP;
+    blkids[7] = MCFIO_HEPRUP;
+
+    strncpy(stdhd1_.title,title,255);
+    stdhd2_.numblocks = numblocks;
+    for ( iblk=0; iblk < numblocks; ++iblk ) {
+        stdhd2_.blkids[iblk] = blkids[iblk];
+    }
+ 
+    istream =  mcfioC_OpenWriteDirect(filename, title, comment,
+                    ntries, blkids, numblocks);
+    stdstr_.ixdrstr[ist] = istream;
+    if (istream == -1) {
+        fprintf(stderr," StdHepXdrWriteOpen: cannot open output file \n");
+        return -1;
+        }
+    fprintf(stdout," StdHepXdrWriteOpen: I/O initialized for StdHep only\n");
+    return 0;
+}
+int StdHepXdrWrite(int ilbl, int ist)
+{
+    int iret = 0;
+
+    if ((ilbl == 1) || (ilbl == 2))
+        iret = StdHepXdrWriteEvent(ilbl, ist);
+    else if ((ilbl == 4) || (ilbl == 5))
+        iret = StdHepXdrWriteEventLH(ilbl, ist);
+    else if (ilbl == 11) 
+        iret = StdHepXdrWriteEventEUP(ilbl, ist);
+    else if (ilbl == 12)
+        iret = StdHepXdrWriteEventRUP(ilbl, ist);
+    else if ((ilbl == 100) || (ilbl == 200))
+        iret = StdHepXdrWriteCM(ilbl, ist);
+    else
+        fprintf(stderr,
+      "     StdHepXdrWrite: don't know what to do with record type %d\n", ilbl);
+    return iret;
+}
+int StdHepXdrWriteCM(int ilbl, int ist)
+{
+    int istream;
+
+    istream = stdstr_.ixdrstr[ist];
+    if (ilbl == 100) {
+        if (mcfioC_Block(istream, MCFIO_STDHEPBEG, xdr_stdhep_cm1_) == -1) {
+            fprintf(stderr,
+              "     StdHepXdrWriteCM: error filling stdhep cm1 common block\n");
+            return 2;
+            }
+        }
+    else if (ilbl == 200) {
+        if (mcfioC_Block(istream, MCFIO_STDHEPEND, xdr_stdhep_cm1_) == -1) {
+            fprintf(stderr,
+              "     StdHepXdrWriteCM: error filling stdhep cm1 common block\n");
+            return 2;
+            }
+        }
+    else {
+        fprintf(stderr,
+           "     StdHepXdrWriteCM: called with improper label %d\n",ilbl);
+        return 3;
+        }
+    if (mcfioC_NextEvent(istream) == -1) {
+        fprintf(stderr,
+          "     StdHepXdrWriteCM: error writing stdhep cm1 xdr block\n");
+        return 1;
+        }
+    return 0;
+}
+int StdHepXdrWriteEvent(int ilbl, int ist)
+{
+    int istream;
+
+    istream = stdstr_.ixdrstr[ist];
+    if ((ilbl != 1) && (ilbl != 2)) {
+        fprintf(stderr,
+          "     StdHepXdrWriteEvent: called with illegal label %d\n",
+                            ilbl);
+        return 3;
+        }
+    else if (myhepevt.nhep <= 0) {
+        fprintf(stderr,
+          "     StdHepXdrWriteEvent: event %d is empty\n", myhepevt.nevhep);
+        return 0;
+        }
+    else if (ilbl == 1) {
+        if (StdHepTempCopy(1,istream) != 0) {
+            fprintf(stderr,
+              "     StdHepXdrWriteEvent: copy failed - event not written\n");
+            return 4;
+            }
+        if (mcfioC_Block(istream, MCFIO_STDHEP, xdr_stdhep_) == -1) {
+            fprintf(stderr,
+          "     StdHepXdrWriteEvent: error filling stdhep block for event %d\n",
+                     myhepevt.nevhep);
+            return 2;
+            }
+        mcfioC_SetEventInfo(istream, MCFIO_STORENUMBER, &myhepevt.nevhep);
+        }
+    else if (ilbl == 2) {
+        if (mcfioC_Block(istream, MCFIO_STDHEPM, xdr_stdhep_multi_) == -1) {
+            fprintf(stderr,
+          "     StdHepXdrWriteEvent: error filling stdhep block for event %d\n",
+                     myhepevt.nevhep);
+            return 2;
+            }
+        mcfioC_SetEventInfo(istream, MCFIO_STORENUMBER, &myhepevt.nevhep);
+        }
+    if (mcfioC_NextEvent(istream) == -1) {
+        fprintf(stderr,"     StdHepXdrWriteCM: error writing event %d\n",
+                         myhepevt.nevhep);
+        return 1;
+        }
+    stdcnt_.nstdwrt = stdcnt_.nstdwrt + 1;
+    return 0;
+}
+int StdHepXdrWriteEventLH(int ilbl, int ist)
+{
+    int istream;
+
+    istream = stdstr_.ixdrstr[ist];
+    if ((ilbl != 4) && (ilbl != 5)) {
+        fprintf(stderr,
+          "     StdHepXdrWriteEventLH: called with illegal label %d\n",
+                            ilbl);
+        return 3;
+        }
+    else if (myhepevt.nhep <= 0) {
+        fprintf(stderr,
+          "     StdHepXdrWriteEventLH: event %d is empty\n", myhepevt.nevhep);
+        return 0;
+        }
+    else if (ilbl == 4) {
+        if (StdHepTempCopy(1,istream) != 0) {
+            fprintf(stderr,
+              "     StdHepXdrWriteEventLH: copy failed - event not written\n");
+            return 4;
+            }
+        if (mcfioC_Block(istream, MCFIO_STDHEP4, xdr_stdhep_4_) == -1) {
+            fprintf(stderr,
+          "     StdHepXdrWriteEventLH: error filling stdhep block for event %d\n",
+                     myhepevt.nevhep);
+            return 2;
+            }
+        mcfioC_SetEventInfo(istream, MCFIO_STORENUMBER, &myhepevt.nevhep);
+        }
+    else if (ilbl == 5) {
+        if (mcfioC_Block(istream, MCFIO_STDHEP4M, xdr_stdhep_4_multi_) == -1) {
+            fprintf(stderr,
+          "     StdHepXdrWriteEventLH: error filling stdhep block for event %d\n",
+                     myhepevt.nevhep);
+            return 2;
+            }
+        mcfioC_SetEventInfo(istream, MCFIO_STORENUMBER, &myhepevt.nevhep);
+        }
+    if (mcfioC_NextEvent(istream) == -1) {
+        fprintf(stderr,"     StdHepXdrWriteLH: error writing event %d\n",
+                         myhepevt.nevhep);
+        return 1;
+        }
+    stdcnt_.nstdwrt = stdcnt_.nstdwrt + 1;
+    return 0;
+}
+int StdHepXdrWriteEventEUP(int ilbl, int ist)
+{
+    int istream;
+
+    istream = stdstr_.ixdrstr[ist];
+    if ( ilbl != 11 ) {
+        fprintf(stderr,
+          "     StdHepXdrWriteEventEUP: called with illegal label %d\n",
+                            ilbl);
+        return 3;
+        }
+    else if (hepeup_.nup <= 0) {
+        fprintf(stderr,
+          "     StdHepXdrWriteEventEUP: event is empty\n");
+        return 0;
+        }
+    else if (ilbl == 11) {
+        if (mcfioC_Block(istream, MCFIO_HEPEUP, xdr_hepeup_) == -1) {
+            fprintf(stderr,
+          "     StdHepXdrWriteEventEUP: error filling stdhep block for event\n");
+            return 2;
+            }
+        }
+    if (mcfioC_NextEvent(istream) == -1) {
+        fprintf(stderr,"     StdHepXdrWriteEUP: error writing event\n");
+        return 1;
+        }
+    stdcnt_.nlhwrt = stdcnt_.nlhwrt + 1;
+    return 0;
+}
+int StdHepXdrWriteEventRUP(int ilbl, int ist)
+{
+    int istream;
+
+    istream = stdstr_.ixdrstr[ist];
+    if ( ilbl != 12 ) {
+        fprintf(stderr,
+          "     StdHepXdrWriteEventRUP: called with illegal label %d\n",
+                            ilbl);
+        return 3;
+        }
+    else if (ilbl == 12) {
+        if (mcfioC_Block(istream, MCFIO_HEPRUP, xdr_heprup_) == -1) {
+            fprintf(stderr,
+          "     StdHepXdrWriteEventRUP: error filling stdhep block for event\n");
+            return 2;
+            }
+        }
+    if (mcfioC_NextEvent(istream) == -1) {
+        fprintf(stderr,"     StdHepXdrWriteRUP: error writing event\n");
+        return 1;
+        }
+    stdcnt_.nlhwrt = stdcnt_.nlhwrt + 1;
+    return 0;
+}
+void StdHepXdrEnd(int ist)
+{
+    int istream;
+    int inum, ieff;
+
+    istream = stdstr_.ixdrstr[ist];
+    mcfioC_InfoStreamInt(istream, MCFIO_NUMWORDS, &inum);
+    mcfioC_InfoStreamInt(istream, MCFIO_EFFICIENCY, &ieff);
+    mcfioC_Close(istream);
+/*
+    fprintf(stdout,
+       "          StdHepXdrEnd: %d words i/o with %d efficiency\n",inum,ieff);
+*/
+}
+void StdHepPrintHeader( )
+{
+    fprintf(stdout," StdHep MCFio header information:\n");
+    fprintf(stdout,"          title: %s\n",stdhd1_.title);
+    fprintf(stdout,"          date:  %s\n",stdhd1_.date);
+    fprintf(stdout,"          %s\n",stdhd1_.comment);
+    fprintf(stdout,"                    %d blocks per event\n",stdhd2_.numblocks);
+}
Index: /trunk/stdhep/stdhep_mcfio.h
===================================================================
--- /trunk/stdhep/stdhep_mcfio.h	(revision 2)
+++ /trunk/stdhep/stdhep_mcfio.h	(revision 2)
@@ -0,0 +1,53 @@
+#ifndef STDHEP_MCFIO_H
+#define STDHEP_MCFIO_H
+
+/*******************************************************************************
+*									       *
+* stdhep_mcfio.h -- header for C version of mcfio interface routines                      *
+*									       *
+* Copyright (c) 1995 Universities Research Association, Inc.		       *
+* All rights reserved.							       *
+* 									       *
+* This material resulted from work developed under a Government Contract and   *
+* is subject to the following license:  The Government retains a paid-up,      *
+* nonexclusive, irrevocable worldwide license to reproduce, prepare derivative *
+* works, perform publicly and display publicly by or for the Government,       *
+* including the right to distribute to other Government contractors.  Neither  *
+* the United States nor the United States Department of Energy, nor any of     *
+* their employees, makes any warranty, express or implied, or assumes any      *
+* legal liability or responsibility for the accuracy, completeness, or         *
+* usefulness of any information, apparatus, product, or process disclosed, or  *
+* represents that its use would not infringe privately owned rights.           *
+*                                        				       *
+*									       *
+* Written by Lynn Garren    					       	       *
+*									       *
+*									       *
+*******************************************************************************/
+
+/*   prototypes */
+#if defined(c_plusplus) || defined(__cplusplus)
+extern "C" {
+#endif
+
+
+int StdHepXdrReadInit(char *filename, int *ntries, int ist);
+int StdHepXdrReadOpen(char *filename, int *ntries, int ist);
+int StdHepXdrRead(int *ilbl, int ist);
+int StdHepXdrReadMulti(int *ilbl, int ist);
+int StdHepXdrWriteInit(char *filename, char *title, int ntries, int ist);
+int StdHepXdrWriteOpen(char *filename, char *title, int ntries, int ist);
+int StdHepXdrWrite(int ilbl, int ist);
+int StdHepXdrWriteCM(int ilbl, int ist);
+int StdHepXdrWriteEvent(int ilbl, int ist);
+int StdHepXdrWriteEventLH(int ilbl, int ist);
+int StdHepXdrWriteEventEUP(int ilbl, int ist);
+int StdHepXdrWriteEventRUP(int ilbl, int ist);
+void StdHepXdrEnd(int ist);
+void StdHepPrintHeader( );
+
+#if defined(c_plusplus) || defined(__cplusplus)
+}
+#endif
+
+#endif /* STDHEP_MCFIO_H */
Index: /trunk/stdhep/stdtmp.h
===================================================================
--- /trunk/stdhep/stdtmp.h	(revision 2)
+++ /trunk/stdhep/stdtmp.h	(revision 2)
@@ -0,0 +1,27 @@
+/*
+** Basic COMMON block from STDHEP: the temporary COMMON block
+** This is a copy of the HEPEVT COMMON block
+*/
+/*  note that to avoid alignment problems, structures and common blocks
+    should be in the order: double precision, real, integer.
+*/
+struct stdtmp {
+double phept[NMXHEP][5];    /* 4-Momentum, mass */
+double vhept[NMXHEP][4];    /* Vertex information */
+int nevhept;		/* The event number */
+int nhept;		/* The number of entries in this event */
+int isthept[NMXHEP]; 	/* The Particle id */
+int idhept[NMXHEP];      /* The particle id */
+int jmohept[NMXHEP][2];    /* The position of the mother particle */
+int jdahept[NMXHEP][2];    /* Position of the first daughter... */
+};
+
+struct tmpev4 {
+  double eventweightt;			/* event weight */
+  double alphaqedt; 			/* QED coupling alpha_em */
+  double alphaqcdt;			/* QCD coupling alpha_s */
+  double scalet[10]; 			/* Scale Q of the event */
+  double spint[NMXHEP][3]; 		/* spin information */
+  int    icolorflowt[NMXHEP][2]; 	/* (Anti-)Colour flow */
+  int    idrupt;			/* ID, as given by LPRUP codes */
+};
Index: /trunk/stdhep/stdver.h
===================================================================
--- /trunk/stdhep/stdver.h	(revision 2)
+++ /trunk/stdhep/stdver.h	(revision 2)
@@ -0,0 +1,5 @@
+/*   stdhep version common block */
+struct stdver {
+char stdhep_ver[10];      /* stdhep version numver */
+char stdhep_date[20];     /* date of this stdhep version */
+};
Index: /trunk/tcl/panic.c
===================================================================
--- /trunk/tcl/panic.c	(revision 2)
+++ /trunk/tcl/panic.c	(revision 2)
@@ -0,0 +1,101 @@
+/* 
+ * panic.c --
+ *
+ *	Source code for the "panic" library procedure for Tcl;
+ *	individual applications will probably override this with
+ *	an application-specific panic procedure.
+ *
+ * Copyright (c) 1988-1993 The Regents of the University of California.
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: panic.c,v 1.1 2008-06-04 13:58:02 demin Exp $
+ */
+
+#include <stdio.h>
+#ifdef NO_STDLIB_H
+#   include "../compat/stdlib.h"
+#else
+#   include <stdlib.h>
+#endif
+
+#define panic panicDummy
+#include "tcl.h"
+#undef panic
+
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+
+EXTERN void		panic _ANSI_ARGS_((char *format, char *arg1,
+			    char *arg2, char *arg3, char *arg4, char *arg5,
+			    char *arg6, char *arg7, char *arg8));
+
+/*
+ * The panicProc variable contains a pointer to an application
+ * specific panic procedure.
+ */
+
+void (*panicProc) _ANSI_ARGS_(TCL_VARARGS(char *,format)) = NULL;
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetPanicProc --
+ *
+ *	Replace the default panic behavior with the specified functiion.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Sets the panicProc variable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetPanicProc(proc)
+    void (*proc) _ANSI_ARGS_(TCL_VARARGS(char *,format));
+{
+    panicProc = proc;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * panic --
+ *
+ *	Print an error message and kill the process.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The process dies, entering the debugger if possible.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* VARARGS ARGSUSED */
+void
+panic(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8)
+    char *format;		/* Format string, suitable for passing to
+				 * fprintf. */
+    char *arg1, *arg2, *arg3;	/* Additional arguments (variable in number)
+				 * to pass to fprintf. */
+    char *arg4, *arg5, *arg6, *arg7, *arg8;
+{
+    if (panicProc != NULL) {
+	(void) (*panicProc)(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
+    } else {
+	(void) fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6,
+		arg7, arg8);
+	(void) fprintf(stderr, "\n");
+	(void) fflush(stderr);
+	abort();
+    }
+}
Index: /trunk/tcl/tcl.h
===================================================================
--- /trunk/tcl/tcl.h	(revision 2)
+++ /trunk/tcl/tcl.h	(revision 2)
@@ -0,0 +1,1564 @@
+/*
+ * tcl.h --
+ *
+ *	This header file describes the externally-visible facilities
+ *	of the Tcl interpreter.
+ *
+ * Copyright (c) 1987-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1993-1996 Lucent Technologies.
+ * Copyright (c) 1998-1999 Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tcl.h,v 1.1 2008-06-04 13:58:02 demin Exp $
+ */
+
+#ifndef _TCL
+#define _TCL
+
+/*
+ * When version numbers change here, must also go into the following files
+ * and update the version numbers:
+ *
+ * README
+ * library/init.tcl	(only if major.minor changes, not patchlevel)
+ * unix/configure.in
+ * win/makefile.bc	(only if major.minor changes, not patchlevel)
+ * win/makefile.vc	(only if major.minor changes, not patchlevel)
+ * win/README
+ * win/README.binary
+ * mac/README
+ *
+ * The release level should be  0 for alpha, 1 for beta, and 2 for
+ * final/patch.  The release serial value is the number that follows the
+ * "a", "b", or "p" in the patch level; for example, if the patch level
+ * is 7.6b2, TCL_RELEASE_SERIAL is 2.  It restarts at 1 whenever the
+ * release level is changed, except for the final release which is 0
+ * (the first patch will start at 1).
+ */
+
+#define TCL_MAJOR_VERSION   8
+#define TCL_MINOR_VERSION   0
+#define TCL_RELEASE_LEVEL   2
+#define TCL_RELEASE_SERIAL  5
+
+#define TCL_VERSION	    "8.0"
+#define TCL_PATCH_LEVEL	    "8.0.5"
+
+/*
+ * The following definitions set up the proper options for Windows
+ * compilers.  We use this method because there is no autoconf equivalent.
+ */
+
+#ifndef __WIN32__
+#   if defined(_WIN32) || defined(WIN32)
+#	define __WIN32__
+#   endif
+#endif
+
+#ifdef __WIN32__
+#   ifndef STRICT
+#	define STRICT
+#   endif
+#   ifndef USE_PROTOTYPE
+#	define USE_PROTOTYPE 1
+#   endif
+#   ifndef HAS_STDARG
+#	define HAS_STDARG 1
+#   endif
+#   ifndef USE_PROTOTYPE
+#	define USE_PROTOTYPE 1
+#   endif
+
+/*
+ * Under Windows we need to call Tcl_Alloc in all cases to avoid competing
+ * C run-time library issues.
+ */
+
+#   ifndef USE_TCLALLOC
+#	define USE_TCLALLOC 1
+#   endif
+#endif /* __WIN32__ */
+
+/*
+ * The following definitions set up the proper options for Macintosh
+ * compilers.  We use this method because there is no autoconf equivalent.
+ */
+
+#ifdef MAC_TCL
+#   ifndef HAS_STDARG
+#	define HAS_STDARG 1
+#   endif
+#   ifndef USE_TCLALLOC
+#	define USE_TCLALLOC 1
+#   endif
+#   ifndef NO_STRERROR
+#	define NO_STRERROR 1
+#   endif
+#endif
+
+/*
+ * Utility macros: STRINGIFY takes an argument and wraps it in "" (double
+ * quotation marks), JOIN joins two arguments.
+ */
+
+#define VERBATIM(x) x
+#ifdef _MSC_VER
+# define STRINGIFY(x) STRINGIFY1(x)
+# define STRINGIFY1(x) #x
+# define JOIN(a,b) JOIN1(a,b)
+# define JOIN1(a,b) a##b
+#else
+# ifdef RESOURCE_INCLUDED
+#  define STRINGIFY(x) STRINGIFY1(x)
+#  define STRINGIFY1(x) #x
+#  define JOIN(a,b) JOIN1(a,b)
+#  define JOIN1(a,b) a##b
+# else
+#  ifdef __STDC__
+#   define STRINGIFY(x) #x
+#   define JOIN(a,b) a##b
+#  else
+#   define STRINGIFY(x) "x"
+#   define JOIN(a,b) VERBATIM(a)VERBATIM(b)
+#  endif
+# endif
+#endif
+
+/* 
+ * A special definition used to allow this header file to be included 
+ * in resource files so that they can get obtain version information from
+ * this file.  Resource compilers don't like all the C stuff, like typedefs
+ * and procedure declarations, that occur below.
+ */
+
+#ifndef RESOURCE_INCLUDED
+
+#ifndef BUFSIZ
+#include <stdio.h>
+#endif
+
+/*
+ * Definitions that allow Tcl functions with variable numbers of
+ * arguments to be used with either varargs.h or stdarg.h.  TCL_VARARGS
+ * is used in procedure prototypes.  TCL_VARARGS_DEF is used to declare
+ * the arguments in a function definiton: it takes the type and name of
+ * the first argument and supplies the appropriate argument declaration
+ * string for use in the function definition.  TCL_VARARGS_START
+ * initializes the va_list data structure and returns the first argument.
+ */
+
+#if defined(__STDC__) || defined(HAS_STDARG)
+#   define TCL_VARARGS(type, name) (type name, ...)
+#   define TCL_VARARGS_DEF(type, name) (type name, ...)
+#   define TCL_VARARGS_START(type, name, list) (va_start(list, name), name)
+#else
+#   ifdef __cplusplus
+#	define TCL_VARARGS(type, name) (type name, ...)
+#	define TCL_VARARGS_DEF(type, name) (type va_alist, ...)
+#   else
+#	define TCL_VARARGS(type, name) ()
+#	define TCL_VARARGS_DEF(type, name) (va_alist)
+#   endif
+#   define TCL_VARARGS_START(type, name, list) \
+	(va_start(list), va_arg(list, type))
+#endif
+
+/*
+ * Macros used to declare a function to be exported by a DLL.
+ * Used by Windows, maps to no-op declarations on non-Windows systems.
+ * The default build on windows is for a DLL, which causes the DLLIMPORT
+ * and DLLEXPORT macros to be nonempty. To build a static library, the
+ * macro STATIC_BUILD should be defined.
+ * The support follows the convention that a macro called BUILD_xxxx, where
+ * xxxx is the name of a library we are building, is set on the compile line
+ * for sources that are to be placed in the library. See BUILD_tcl in this
+ * file for an example of how the macro is to be used.
+ */
+
+#ifdef __WIN32__
+# ifdef STATIC_BUILD
+#  define DLLIMPORT
+#  define DLLEXPORT
+# else
+#  if defined(_MSC_VER) || (defined(__GNUC__) && defined(__declspec))
+#   define DLLIMPORT __declspec(dllimport)
+#   define DLLEXPORT __declspec(dllexport)
+#  else
+#   define DLLIMPORT
+#   define DLLEXPORT
+#  endif
+# endif
+#else
+# define DLLIMPORT
+# define DLLEXPORT
+#endif
+
+#ifdef TCL_STORAGE_CLASS
+# undef TCL_STORAGE_CLASS
+#endif
+#ifdef BUILD_tcl
+# define TCL_STORAGE_CLASS DLLEXPORT
+#else
+# define TCL_STORAGE_CLASS DLLIMPORT
+#endif
+
+/*
+ * Definitions that allow this header file to be used either with or
+ * without ANSI C features like function prototypes.
+ */
+
+#undef _ANSI_ARGS_
+#undef CONST
+
+#if ((defined(__STDC__) || defined(SABER)) && !defined(NO_PROTOTYPE)) || defined(__cplusplus) || defined(USE_PROTOTYPE)
+#   define _USING_PROTOTYPES_ 1
+#   define _ANSI_ARGS_(x)	x
+#   define CONST const
+#else
+#   define _ANSI_ARGS_(x)	()
+#   define CONST
+#endif
+
+#ifdef __cplusplus
+#   define EXTERN extern "C" TCL_STORAGE_CLASS
+#else
+#   define EXTERN extern TCL_STORAGE_CLASS
+#endif
+
+/*
+ * Macro to use instead of "void" for arguments that must have
+ * type "void *" in ANSI C;  maps them to type "char *" in
+ * non-ANSI systems.
+ */
+#ifndef __WIN32__
+#ifndef VOID
+#   ifdef __STDC__
+#       define VOID void
+#   else
+#       define VOID char
+#   endif
+#endif
+#else /* __WIN32__ */
+/*
+ * The following code is copied from winnt.h
+ */
+#ifndef VOID
+#define VOID void
+typedef char CHAR;
+typedef short SHORT;
+typedef long LONG;
+#endif
+#endif /* __WIN32__ */
+
+/*
+ * Miscellaneous declarations.
+ */
+
+#ifndef NULL
+#define NULL 0
+#endif
+
+#ifndef _CLIENTDATA
+#   if defined(__STDC__) || defined(__cplusplus)
+    typedef void *ClientData;
+#   else
+    typedef int *ClientData;
+#   endif /* __STDC__ */
+#define _CLIENTDATA
+#endif
+
+/*
+ * Data structures defined opaquely in this module. The definitions below
+ * just provide dummy types. A few fields are made visible in Tcl_Interp
+ * structures, namely those used for returning a string result from
+ * commands. Direct access to the result field is discouraged in Tcl 8.0.
+ * The interpreter result is either an object or a string, and the two
+ * values are kept consistent unless some C code sets interp->result
+ * directly. Programmers should use either the procedure Tcl_GetObjResult()
+ * or Tcl_GetStringResult() to read the interpreter's result. See the
+ * SetResult man page for details.
+ * 
+ * Note: any change to the Tcl_Interp definition below must be mirrored
+ * in the "real" definition in tclInt.h.
+ *
+ * Note: Tcl_ObjCmdProc procedures do not directly set result and freeProc.
+ * Instead, they set a Tcl_Obj member in the "real" structure that can be
+ * accessed with Tcl_GetObjResult() and Tcl_SetObjResult().
+ */
+
+typedef struct Tcl_Interp {
+    char *result;		/* If the last command returned a string
+				 * result, this points to it. */
+    void (*freeProc) _ANSI_ARGS_((char *blockPtr));
+				/* Zero means the string result is
+				 * statically allocated. TCL_DYNAMIC means
+				 * it was allocated with ckalloc and should
+				 * be freed with ckfree. Other values give
+				 * the address of procedure to invoke to
+				 * free the result. Tcl_Eval must free it
+				 * before executing next command. */
+    int errorLine;              /* When TCL_ERROR is returned, this gives
+                                 * the line number within the command where
+                                 * the error occurred (1 if first line). */
+} Tcl_Interp;
+
+typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
+typedef struct Tcl_Channel_ *Tcl_Channel;
+typedef struct Tcl_Command_ *Tcl_Command;
+typedef struct Tcl_Event Tcl_Event;
+typedef struct Tcl_Pid_ *Tcl_Pid;
+typedef struct Tcl_RegExp_ *Tcl_RegExp;
+typedef struct Tcl_TimerToken_ *Tcl_TimerToken;
+typedef struct Tcl_Trace_ *Tcl_Trace;
+typedef struct Tcl_Var_ *Tcl_Var;
+
+/*
+ * When a TCL command returns, the interpreter contains a result from the
+ * command. Programmers are strongly encouraged to use one of the
+ * procedures Tcl_GetObjResult() or Tcl_GetStringResult() to read the
+ * interpreter's result. See the SetResult man page for details. Besides
+ * this result, the command procedure returns an integer code, which is 
+ * one of the following:
+ *
+ * TCL_OK		Command completed normally; the interpreter's
+ *			result contains	the command's result.
+ * TCL_ERROR		The command couldn't be completed successfully;
+ *			the interpreter's result describes what went wrong.
+ * TCL_RETURN		The command requests that the current procedure
+ *			return; the interpreter's result contains the
+ *			procedure's return value.
+ * TCL_BREAK		The command requests that the innermost loop
+ *			be exited; the interpreter's result is meaningless.
+ * TCL_CONTINUE		Go on to the next iteration of the current loop;
+ *			the interpreter's result is meaningless.
+ */
+
+#define TCL_OK		0
+#define TCL_ERROR	1
+#define TCL_RETURN	2
+#define TCL_BREAK	3
+#define TCL_CONTINUE	4
+
+#define TCL_RESULT_SIZE 200
+
+/*
+ * Argument descriptors for math function callbacks in expressions:
+ */
+
+typedef enum {TCL_INT, TCL_DOUBLE, TCL_EITHER} Tcl_ValueType;
+typedef struct Tcl_Value {
+    Tcl_ValueType type;		/* Indicates intValue or doubleValue is
+				 * valid, or both. */
+    long intValue;		/* Integer value. */
+    double doubleValue;		/* Double-precision floating value. */
+} Tcl_Value;
+
+/*
+ * Forward declaration of Tcl_Obj to prevent an error when the forward
+ * reference to Tcl_Obj is encountered in the procedure types declared 
+ * below.
+ */
+
+struct Tcl_Obj;
+
+/*
+ * Procedure types defined by Tcl:
+ */
+
+typedef int (Tcl_AppInitProc) _ANSI_ARGS_((Tcl_Interp *interp));
+typedef int (Tcl_AsyncProc) _ANSI_ARGS_((ClientData clientData,
+	Tcl_Interp *interp, int code));
+typedef void (Tcl_ChannelProc) _ANSI_ARGS_((ClientData clientData, int mask));
+typedef void (Tcl_CloseProc) _ANSI_ARGS_((ClientData data));
+typedef void (Tcl_CmdDeleteProc) _ANSI_ARGS_((ClientData clientData));
+typedef int (Tcl_CmdProc) _ANSI_ARGS_((ClientData clientData,
+	Tcl_Interp *interp, int argc, char *argv[]));
+typedef void (Tcl_CmdTraceProc) _ANSI_ARGS_((ClientData clientData,
+	Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *proc,
+	ClientData cmdClientData, int argc, char *argv[]));
+typedef void (Tcl_DupInternalRepProc) _ANSI_ARGS_((struct Tcl_Obj *srcPtr, 
+        struct Tcl_Obj *dupPtr));
+typedef int (Tcl_EventProc) _ANSI_ARGS_((Tcl_Event *evPtr, int flags));
+typedef void (Tcl_EventCheckProc) _ANSI_ARGS_((ClientData clientData,
+	int flags));
+typedef int (Tcl_EventDeleteProc) _ANSI_ARGS_((Tcl_Event *evPtr,
+        ClientData clientData));
+typedef void (Tcl_EventSetupProc) _ANSI_ARGS_((ClientData clientData,
+	int flags));
+typedef void (Tcl_ExitProc) _ANSI_ARGS_((ClientData clientData));
+typedef void (Tcl_FileProc) _ANSI_ARGS_((ClientData clientData, int mask));
+typedef void (Tcl_FileFreeProc) _ANSI_ARGS_((ClientData clientData));
+typedef void (Tcl_FreeInternalRepProc) _ANSI_ARGS_((struct Tcl_Obj *objPtr));
+typedef void (Tcl_FreeProc) _ANSI_ARGS_((char *blockPtr));
+typedef void (Tcl_IdleProc) _ANSI_ARGS_((ClientData clientData));
+typedef void (Tcl_InterpDeleteProc) _ANSI_ARGS_((ClientData clientData,
+	Tcl_Interp *interp));
+typedef int (Tcl_MathProc) _ANSI_ARGS_((ClientData clientData,
+	Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr));
+typedef void (Tcl_NamespaceDeleteProc) _ANSI_ARGS_((ClientData clientData));
+typedef int (Tcl_ObjCmdProc) _ANSI_ARGS_((ClientData clientData,
+	Tcl_Interp *interp, int objc, struct Tcl_Obj * CONST objv[]));
+typedef int (Tcl_PackageInitProc) _ANSI_ARGS_((Tcl_Interp *interp));
+typedef void (Tcl_TcpAcceptProc) _ANSI_ARGS_((ClientData callbackData,
+        Tcl_Channel chan, char *address, int port));
+typedef void (Tcl_TimerProc) _ANSI_ARGS_((ClientData clientData));
+typedef int (Tcl_SetFromAnyProc) _ANSI_ARGS_((Tcl_Interp *interp,
+	struct Tcl_Obj *objPtr));
+typedef void (Tcl_UpdateStringProc) _ANSI_ARGS_((struct Tcl_Obj *objPtr));
+typedef char *(Tcl_VarTraceProc) _ANSI_ARGS_((ClientData clientData,
+	Tcl_Interp *interp, char *part1, char *part2, int flags));
+
+/*
+ * The following structure represents a type of object, which is a
+ * particular internal representation for an object plus a set of
+ * procedures that provide standard operations on objects of that type.
+ */
+
+typedef struct Tcl_ObjType {
+    char *name;			/* Name of the type, e.g. "int". */
+    Tcl_FreeInternalRepProc *freeIntRepProc;
+				/* Called to free any storage for the type's
+				 * internal rep. NULL if the internal rep
+				 * does not need freeing. */
+    Tcl_DupInternalRepProc *dupIntRepProc;
+    				/* Called to create a new object as a copy
+				 * of an existing object. */
+    Tcl_UpdateStringProc *updateStringProc;
+    				/* Called to update the string rep from the
+				 * type's internal representation. */
+    Tcl_SetFromAnyProc *setFromAnyProc;
+    				/* Called to convert the object's internal
+				 * rep to this type. Frees the internal rep
+				 * of the old type. Returns TCL_ERROR on
+				 * failure. */
+} Tcl_ObjType;
+
+/*
+ * One of the following structures exists for each object in the Tcl
+ * system. An object stores a value as either a string, some internal
+ * representation, or both.
+ */
+
+typedef struct Tcl_Obj {
+    int refCount;		/* When 0 the object will be freed. */
+    char *bytes;		/* This points to the first byte of the
+				 * object's string representation. The array
+				 * must be followed by a null byte (i.e., at
+				 * offset length) but may also contain
+				 * embedded null characters. The array's
+				 * storage is allocated by ckalloc. NULL
+				 * means the string rep is invalid and must
+				 * be regenerated from the internal rep.
+				 * Clients should use Tcl_GetStringFromObj
+				 * to get a pointer to the byte array as a
+				 * readonly value. */
+    int length;			/* The number of bytes at *bytes, not
+				 * including the terminating null. */
+    Tcl_ObjType *typePtr;	/* Denotes the object's type. Always
+				 * corresponds to the type of the object's
+				 * internal rep. NULL indicates the object
+				 * has no internal rep (has no type). */
+    union {			/* The internal representation: */
+	long longValue;		/*   - an long integer value */
+	double doubleValue;	/*   - a double-precision floating value */
+	VOID *otherValuePtr;	/*   - another, type-specific value */
+	struct {		/*   - internal rep as two pointers */
+	    VOID *ptr1;
+	    VOID *ptr2;
+	} twoPtrValue;
+    } internalRep;
+} Tcl_Obj;
+
+/*
+ * Macros to increment and decrement a Tcl_Obj's reference count, and to
+ * test whether an object is shared (i.e. has reference count > 1).
+ * Note: clients should use Tcl_DecrRefCount() when they are finished using
+ * an object, and should never call TclFreeObj() directly. TclFreeObj() is
+ * only defined and made public in tcl.h to support Tcl_DecrRefCount's macro
+ * definition. Note also that Tcl_DecrRefCount() refers to the parameter
+ * "obj" twice. This means that you should avoid calling it with an
+ * expression that is expensive to compute or has side effects.
+ */
+
+EXTERN void		Tcl_IncrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr));
+EXTERN void		Tcl_DecrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr));
+EXTERN int		Tcl_IsShared _ANSI_ARGS_((Tcl_Obj *objPtr));
+
+#ifdef TCL_MEM_DEBUG
+#   define Tcl_IncrRefCount(objPtr) \
+	Tcl_DbIncrRefCount(objPtr, __FILE__, __LINE__)
+#   define Tcl_DecrRefCount(objPtr) \
+	Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__)
+#   define Tcl_IsShared(objPtr) \
+	Tcl_DbIsShared(objPtr, __FILE__, __LINE__)
+#else
+#   define Tcl_IncrRefCount(objPtr) \
+	++(objPtr)->refCount
+#   define Tcl_DecrRefCount(objPtr) \
+	if (--(objPtr)->refCount <= 0) TclFreeObj(objPtr)
+#   define Tcl_IsShared(objPtr) \
+	((objPtr)->refCount > 1)
+#endif
+
+/*
+ * Macros and definitions that help to debug the use of Tcl objects.
+ * When TCL_MEM_DEBUG is defined, the Tcl_New* declarations are 
+ * overridden to call debugging versions of the object creation procedures.
+ */
+
+EXTERN Tcl_Obj *	Tcl_NewBooleanObj _ANSI_ARGS_((int boolValue));
+EXTERN Tcl_Obj *	Tcl_NewDoubleObj _ANSI_ARGS_((double doubleValue));
+EXTERN Tcl_Obj *	Tcl_NewIntObj _ANSI_ARGS_((int intValue));
+EXTERN Tcl_Obj *	Tcl_NewListObj _ANSI_ARGS_((int objc,
+			    Tcl_Obj *CONST objv[]));
+EXTERN Tcl_Obj *	Tcl_NewLongObj _ANSI_ARGS_((long longValue));
+EXTERN Tcl_Obj *	Tcl_NewObj _ANSI_ARGS_((void));
+EXTERN Tcl_Obj *	Tcl_NewStringObj _ANSI_ARGS_((char *bytes,
+			    int length));
+
+#ifdef TCL_MEM_DEBUG
+#  define Tcl_NewBooleanObj(val) \
+     Tcl_DbNewBooleanObj(val, __FILE__, __LINE__)
+#  define Tcl_NewDoubleObj(val) \
+     Tcl_DbNewDoubleObj(val, __FILE__, __LINE__)
+#  define Tcl_NewIntObj(val) \
+     Tcl_DbNewLongObj(val, __FILE__, __LINE__)
+#  define Tcl_NewListObj(objc, objv) \
+     Tcl_DbNewListObj(objc, objv, __FILE__, __LINE__)
+#  define Tcl_NewLongObj(val) \
+     Tcl_DbNewLongObj(val, __FILE__, __LINE__)
+#  define Tcl_NewObj() \
+     Tcl_DbNewObj(__FILE__, __LINE__)
+#  define Tcl_NewStringObj(bytes, len) \
+     Tcl_DbNewStringObj(bytes, len, __FILE__, __LINE__)
+#endif /* TCL_MEM_DEBUG */
+
+/*
+ * The following definitions support Tcl's namespace facility.
+ * Note: the first five fields must match exactly the fields in a
+ * Namespace structure (see tcl.h). 
+ */
+
+typedef struct Tcl_Namespace {
+    char *name;                 /* The namespace's name within its parent
+				 * namespace. This contains no ::'s. The
+				 * name of the global namespace is ""
+				 * although "::" is an synonym. */
+    char *fullName;             /* The namespace's fully qualified name.
+				 * This starts with ::. */
+    ClientData clientData;      /* Arbitrary value associated with this
+				 * namespace. */
+    Tcl_NamespaceDeleteProc* deleteProc;
+                                /* Procedure invoked when deleting the
+				 * namespace to, e.g., free clientData. */
+    struct Tcl_Namespace* parentPtr;
+                                /* Points to the namespace that contains
+				 * this one. NULL if this is the global
+				 * namespace. */
+} Tcl_Namespace;
+
+/*
+ * The following structure represents a call frame, or activation record.
+ * A call frame defines a naming context for a procedure call: its local
+ * scope (for local variables) and its namespace scope (used for non-local
+ * variables; often the global :: namespace). A call frame can also define
+ * the naming context for a namespace eval or namespace inscope command:
+ * the namespace in which the command's code should execute. The
+ * Tcl_CallFrame structures exist only while procedures or namespace
+ * eval/inscope's are being executed, and provide a Tcl call stack.
+ * 
+ * A call frame is initialized and pushed using Tcl_PushCallFrame and
+ * popped using Tcl_PopCallFrame. Storage for a Tcl_CallFrame must be
+ * provided by the Tcl_PushCallFrame caller, and callers typically allocate
+ * them on the C call stack for efficiency. For this reason, Tcl_CallFrame
+ * is defined as a structure and not as an opaque token. However, most
+ * Tcl_CallFrame fields are hidden since applications should not access
+ * them directly; others are declared as "dummyX".
+ *
+ * WARNING!! The structure definition must be kept consistent with the
+ * CallFrame structure in tclInt.h. If you change one, change the other.
+ */
+
+typedef struct Tcl_CallFrame {
+    Tcl_Namespace *nsPtr;
+    int dummy1;
+    int dummy2;
+    char *dummy3;
+    char *dummy4;
+    char *dummy5;
+    int dummy6;
+    char *dummy7;
+    char *dummy8;
+    int dummy9;
+    char* dummy10;
+} Tcl_CallFrame;
+
+/*
+ * Information about commands that is returned by Tcl_GetCommandInfo and
+ * passed to Tcl_SetCommandInfo. objProc is an objc/objv object-based
+ * command procedure while proc is a traditional Tcl argc/argv
+ * string-based procedure. Tcl_CreateObjCommand and Tcl_CreateCommand
+ * ensure that both objProc and proc are non-NULL and can be called to
+ * execute the command. However, it may be faster to call one instead of
+ * the other. The member isNativeObjectProc is set to 1 if an
+ * object-based procedure was registered by Tcl_CreateObjCommand, and to
+ * 0 if a string-based procedure was registered by Tcl_CreateCommand.
+ * The other procedure is typically set to a compatibility wrapper that
+ * does string-to-object or object-to-string argument conversions then
+ * calls the other procedure.
+ */
+     
+typedef struct Tcl_CmdInfo {
+    int isNativeObjectProc;	 /* 1 if objProc was registered by a call to
+				  * Tcl_CreateObjCommand; 0 otherwise.
+				  * Tcl_SetCmdInfo does not modify this
+				  * field. */
+    Tcl_ObjCmdProc *objProc;	 /* Command's object-based procedure. */
+    ClientData objClientData;	 /* ClientData for object proc. */
+    Tcl_CmdProc *proc;		 /* Command's string-based procedure. */
+    ClientData clientData;	 /* ClientData for string proc. */
+    Tcl_CmdDeleteProc *deleteProc;
+                                 /* Procedure to call when command is
+                                  * deleted. */
+    ClientData deleteData;	 /* Value to pass to deleteProc (usually
+				  * the same as clientData). */
+    Tcl_Namespace *namespacePtr; /* Points to the namespace that contains
+				  * this command. Note that Tcl_SetCmdInfo
+				  * will not change a command's namespace;
+				  * use Tcl_RenameCommand to do that. */
+
+} Tcl_CmdInfo;
+
+/*
+ * The structure defined below is used to hold dynamic strings.  The only
+ * field that clients should use is the string field, and they should
+ * never modify it.
+ */
+
+#define TCL_DSTRING_STATIC_SIZE 200
+typedef struct Tcl_DString {
+    char *string;		/* Points to beginning of string:  either
+				 * staticSpace below or a malloced array. */
+    int length;			/* Number of non-NULL characters in the
+				 * string. */
+    int spaceAvl;		/* Total number of bytes available for the
+				 * string and its terminating NULL char. */
+    char staticSpace[TCL_DSTRING_STATIC_SIZE];
+				/* Space to use in common case where string
+				 * is small. */
+} Tcl_DString;
+
+#define Tcl_DStringLength(dsPtr) ((dsPtr)->length)
+#define Tcl_DStringValue(dsPtr) ((dsPtr)->string)
+#define Tcl_DStringTrunc Tcl_DStringSetLength
+
+/*
+ * Definitions for the maximum number of digits of precision that may
+ * be specified in the "tcl_precision" variable, and the number of
+ * characters of buffer space required by Tcl_PrintDouble.
+ */
+ 
+#define TCL_MAX_PREC 17
+#define TCL_DOUBLE_SPACE (TCL_MAX_PREC+10)
+
+/*
+ * Flag that may be passed to Tcl_ConvertElement to force it not to
+ * output braces (careful!  if you change this flag be sure to change
+ * the definitions at the front of tclUtil.c).
+ */
+
+#define TCL_DONT_USE_BRACES	1
+
+/*
+ * Flag that may be passed to Tcl_GetIndexFromObj to force it to disallow
+ * abbreviated strings.
+ */
+
+#define TCL_EXACT	1
+
+/*
+ * Flag values passed to Tcl_RecordAndEval.
+ * WARNING: these bit choices must not conflict with the bit choices
+ * for evalFlag bits in tclInt.h!!
+ */
+
+#define TCL_NO_EVAL		0x10000
+#define TCL_EVAL_GLOBAL		0x20000
+
+/*
+ * Special freeProc values that may be passed to Tcl_SetResult (see
+ * the man page for details):
+ */
+
+#define TCL_VOLATILE	((Tcl_FreeProc *) 1)
+#define TCL_STATIC	((Tcl_FreeProc *) 0)
+#define TCL_DYNAMIC	((Tcl_FreeProc *) 3)
+
+/*
+ * Flag values passed to variable-related procedures.
+ */
+
+#define TCL_GLOBAL_ONLY		 1
+#define TCL_NAMESPACE_ONLY	 2
+#define TCL_APPEND_VALUE	 4
+#define TCL_LIST_ELEMENT	 8
+#define TCL_TRACE_READS		 0x10
+#define TCL_TRACE_WRITES	 0x20
+#define TCL_TRACE_UNSETS	 0x40
+#define TCL_TRACE_DESTROYED	 0x80
+#define TCL_INTERP_DESTROYED	 0x100
+#define TCL_LEAVE_ERR_MSG	 0x200
+#define TCL_PARSE_PART1		 0x400
+
+/*
+ * Types for linked variables:
+ */
+
+#define TCL_LINK_INT		1
+#define TCL_LINK_DOUBLE		2
+#define TCL_LINK_BOOLEAN	3
+#define TCL_LINK_STRING		4
+#define TCL_LINK_READ_ONLY	0x80
+
+/*
+ * The following declarations either map ckalloc and ckfree to
+ * malloc and free, or they map them to procedures with all sorts
+ * of debugging hooks defined in tclCkalloc.c.
+ */
+
+EXTERN char *		Tcl_Alloc _ANSI_ARGS_((unsigned int size));
+EXTERN void		Tcl_Free _ANSI_ARGS_((char *ptr));
+EXTERN char *		Tcl_Realloc _ANSI_ARGS_((char *ptr,
+			    unsigned int size));
+
+#ifdef TCL_MEM_DEBUG
+
+#  define Tcl_Alloc(x) Tcl_DbCkalloc(x, __FILE__, __LINE__)
+#  define Tcl_Free(x)  Tcl_DbCkfree(x, __FILE__, __LINE__)
+#  define Tcl_Realloc(x,y) Tcl_DbCkrealloc((x), (y),__FILE__, __LINE__)
+#  define ckalloc(x) Tcl_DbCkalloc(x, __FILE__, __LINE__)
+#  define ckfree(x)  Tcl_DbCkfree(x, __FILE__, __LINE__)
+#  define ckrealloc(x,y) Tcl_DbCkrealloc((x), (y),__FILE__, __LINE__)
+
+EXTERN int		Tcl_DumpActiveMemory _ANSI_ARGS_((char *fileName));
+EXTERN void		Tcl_ValidateAllMemory _ANSI_ARGS_((char *file,
+			    int line));
+
+#else
+
+/*
+ * If USE_TCLALLOC is true, then we need to call Tcl_Alloc instead of
+ * the native malloc/free.  The only time USE_TCLALLOC should not be
+ * true is when compiling the Tcl/Tk libraries on Unix systems.  In this
+ * case we can safely call the native malloc/free directly as a performance
+ * optimization.
+ */
+
+#  if USE_TCLALLOC
+#     define ckalloc(x) Tcl_Alloc(x)
+#     define ckfree(x) Tcl_Free(x)
+#     define ckrealloc(x,y) Tcl_Realloc(x,y)
+#  else
+#     define ckalloc(x) malloc(x)
+#     define ckfree(x)  free(x)
+#     define ckrealloc(x,y) realloc(x,y)
+#  endif
+#  define Tcl_DumpActiveMemory(x)
+#  define Tcl_ValidateAllMemory(x,y)
+
+#endif /* TCL_MEM_DEBUG */
+
+/*
+ * Forward declaration of Tcl_HashTable.  Needed by some C++ compilers
+ * to prevent errors when the forward reference to Tcl_HashTable is
+ * encountered in the Tcl_HashEntry structure.
+ */
+
+#ifdef __cplusplus
+struct Tcl_HashTable;
+#endif
+
+/*
+ * Structure definition for an entry in a hash table.  No-one outside
+ * Tcl should access any of these fields directly;  use the macros
+ * defined below.
+ */
+
+typedef struct Tcl_HashEntry {
+    struct Tcl_HashEntry *nextPtr;	/* Pointer to next entry in this
+					 * hash bucket, or NULL for end of
+					 * chain. */
+    struct Tcl_HashTable *tablePtr;	/* Pointer to table containing entry. */
+    struct Tcl_HashEntry **bucketPtr;	/* Pointer to bucket that points to
+					 * first entry in this entry's chain:
+					 * used for deleting the entry. */
+    ClientData clientData;		/* Application stores something here
+					 * with Tcl_SetHashValue. */
+    union {				/* Key has one of these forms: */
+	char *oneWordValue;		/* One-word value for key. */
+	int words[1];			/* Multiple integer words for key.
+					 * The actual size will be as large
+					 * as necessary for this table's
+					 * keys. */
+	char string[4];			/* String for key.  The actual size
+					 * will be as large as needed to hold
+					 * the key. */
+    } key;				/* MUST BE LAST FIELD IN RECORD!! */
+} Tcl_HashEntry;
+
+/*
+ * Structure definition for a hash table.  Must be in tcl.h so clients
+ * can allocate space for these structures, but clients should never
+ * access any fields in this structure.
+ */
+
+#define TCL_SMALL_HASH_TABLE 4
+typedef struct Tcl_HashTable {
+    Tcl_HashEntry **buckets;		/* Pointer to bucket array.  Each
+					 * element points to first entry in
+					 * bucket's hash chain, or NULL. */
+    Tcl_HashEntry *staticBuckets[TCL_SMALL_HASH_TABLE];
+					/* Bucket array used for small tables
+					 * (to avoid mallocs and frees). */
+    int numBuckets;			/* Total number of buckets allocated
+					 * at **bucketPtr. */
+    int numEntries;			/* Total number of entries present
+					 * in table. */
+    int rebuildSize;			/* Enlarge table when numEntries gets
+					 * to be this large. */
+    int downShift;			/* Shift count used in hashing
+					 * function.  Designed to use high-
+					 * order bits of randomized keys. */
+    int mask;				/* Mask value used in hashing
+					 * function. */
+    int keyType;			/* Type of keys used in this table. 
+					 * It's either TCL_STRING_KEYS,
+					 * TCL_ONE_WORD_KEYS, or an integer
+					 * giving the number of ints that
+                                         * is the size of the key.
+					 */
+    Tcl_HashEntry *(*findProc) _ANSI_ARGS_((struct Tcl_HashTable *tablePtr,
+	    CONST char *key));
+    Tcl_HashEntry *(*createProc) _ANSI_ARGS_((struct Tcl_HashTable *tablePtr,
+	    CONST char *key, int *newPtr));
+} Tcl_HashTable;
+
+/*
+ * Structure definition for information used to keep track of searches
+ * through hash tables:
+ */
+
+typedef struct Tcl_HashSearch {
+    Tcl_HashTable *tablePtr;		/* Table being searched. */
+    int nextIndex;			/* Index of next bucket to be
+					 * enumerated after present one. */
+    Tcl_HashEntry *nextEntryPtr;	/* Next entry to be enumerated in the
+					 * the current bucket. */
+} Tcl_HashSearch;
+
+/*
+ * Acceptable key types for hash tables:
+ */
+
+#define TCL_STRING_KEYS		0
+#define TCL_ONE_WORD_KEYS	1
+
+/*
+ * Macros for clients to use to access fields of hash entries:
+ */
+
+#define Tcl_GetHashValue(h) ((h)->clientData)
+#define Tcl_SetHashValue(h, value) ((h)->clientData = (ClientData) (value))
+#define Tcl_GetHashKey(tablePtr, h) \
+    ((char *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS) ? (h)->key.oneWordValue \
+						: (h)->key.string))
+
+/*
+ * Macros to use for clients to use to invoke find and create procedures
+ * for hash tables:
+ */
+
+#define Tcl_FindHashEntry(tablePtr, key) \
+	(*((tablePtr)->findProc))(tablePtr, key)
+#define Tcl_CreateHashEntry(tablePtr, key, newPtr) \
+	(*((tablePtr)->createProc))(tablePtr, key, newPtr)
+
+/*
+ * Flag values to pass to Tcl_DoOneEvent to disable searches
+ * for some kinds of events:
+ */
+
+#define TCL_DONT_WAIT		(1<<1)
+#define TCL_WINDOW_EVENTS	(1<<2)
+#define TCL_FILE_EVENTS		(1<<3)
+#define TCL_TIMER_EVENTS	(1<<4)
+#define TCL_IDLE_EVENTS		(1<<5)	/* WAS 0x10 ???? */
+#define TCL_ALL_EVENTS		(~TCL_DONT_WAIT)
+
+/*
+ * The following structure defines a generic event for the Tcl event
+ * system.  These are the things that are queued in calls to Tcl_QueueEvent
+ * and serviced later by Tcl_DoOneEvent.  There can be many different
+ * kinds of events with different fields, corresponding to window events,
+ * timer events, etc.  The structure for a particular event consists of
+ * a Tcl_Event header followed by additional information specific to that
+ * event.
+ */
+
+struct Tcl_Event {
+    Tcl_EventProc *proc;	/* Procedure to call to service this event. */
+    struct Tcl_Event *nextPtr;	/* Next in list of pending events, or NULL. */
+};
+
+/*
+ * Positions to pass to Tcl_QueueEvent:
+ */
+
+typedef enum {
+    TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, TCL_QUEUE_MARK
+} Tcl_QueuePosition;
+
+/*
+ * Values to pass to Tcl_SetServiceMode to specify the behavior of notifier
+ * event routines.
+ */
+
+#define TCL_SERVICE_NONE 0
+#define TCL_SERVICE_ALL 1
+
+/*
+ * The following structure keeps is used to hold a time value, either as
+ * an absolute time (the number of seconds from the epoch) or as an
+ * elapsed time. On Unix systems the epoch is Midnight Jan 1, 1970 GMT.
+ * On Macintosh systems the epoch is Midnight Jan 1, 1904 GMT.
+ */
+
+typedef struct Tcl_Time {
+    long sec;			/* Seconds. */
+    long usec;			/* Microseconds. */
+} Tcl_Time;
+
+/*
+ * Bits to pass to Tcl_CreateFileHandler and Tcl_CreateChannelHandler
+ * to indicate what sorts of events are of interest:
+ */
+
+#define TCL_READABLE	(1<<1)
+#define TCL_WRITABLE	(1<<2)
+#define TCL_EXCEPTION	(1<<3)
+
+/*
+ * Flag values to pass to Tcl_OpenCommandChannel to indicate the
+ * disposition of the stdio handles.  TCL_STDIN, TCL_STDOUT, TCL_STDERR,
+ * are also used in Tcl_GetStdChannel.
+ */
+
+#define TCL_STDIN		(1<<1)	
+#define TCL_STDOUT		(1<<2)
+#define TCL_STDERR		(1<<3)
+#define TCL_ENFORCE_MODE	(1<<4)
+
+/*
+ * Typedefs for the various operations in a channel type:
+ */
+
+typedef int	(Tcl_DriverBlockModeProc) _ANSI_ARGS_((
+		    ClientData instanceData, int mode));
+typedef int	(Tcl_DriverCloseProc) _ANSI_ARGS_((ClientData instanceData,
+		    Tcl_Interp *interp));
+typedef int	(Tcl_DriverInputProc) _ANSI_ARGS_((ClientData instanceData,
+		    char *buf, int toRead, int *errorCodePtr));
+typedef int	(Tcl_DriverOutputProc) _ANSI_ARGS_((ClientData instanceData,
+		    char *buf, int toWrite, int *errorCodePtr));
+typedef int	(Tcl_DriverSeekProc) _ANSI_ARGS_((ClientData instanceData,
+		    long offset, int mode, int *errorCodePtr));
+typedef int	(Tcl_DriverSetOptionProc) _ANSI_ARGS_((
+		    ClientData instanceData, Tcl_Interp *interp,
+	            char *optionName, char *value));
+typedef int	(Tcl_DriverGetOptionProc) _ANSI_ARGS_((
+		    ClientData instanceData, Tcl_Interp *interp,
+		    char *optionName, Tcl_DString *dsPtr));
+typedef void	(Tcl_DriverWatchProc) _ANSI_ARGS_((
+		    ClientData instanceData, int mask));
+typedef int	(Tcl_DriverGetHandleProc) _ANSI_ARGS_((
+		    ClientData instanceData, int direction,
+		    ClientData *handlePtr));
+
+/*
+ * Enum for different end of line translation and recognition modes.
+ */
+
+typedef enum Tcl_EolTranslation {
+    TCL_TRANSLATE_AUTO,			/* Eol == \r, \n and \r\n. */
+    TCL_TRANSLATE_CR,			/* Eol == \r. */
+    TCL_TRANSLATE_LF,			/* Eol == \n. */
+    TCL_TRANSLATE_CRLF			/* Eol == \r\n. */
+} Tcl_EolTranslation;
+
+/*
+ * struct Tcl_ChannelType:
+ *
+ * One such structure exists for each type (kind) of channel.
+ * It collects together in one place all the functions that are
+ * part of the specific channel type.
+ */
+
+typedef struct Tcl_ChannelType {
+    char *typeName;			/* The name of the channel type in Tcl
+                                         * commands. This storage is owned by
+                                         * channel type. */
+    Tcl_DriverBlockModeProc *blockModeProc;
+    					/* Set blocking mode for the
+                                         * raw channel. May be NULL. */
+    Tcl_DriverCloseProc *closeProc;	/* Procedure to call to close
+                                         * the channel. */
+    Tcl_DriverInputProc *inputProc;	/* Procedure to call for input
+                                         * on channel. */
+    Tcl_DriverOutputProc *outputProc;	/* Procedure to call for output
+                                         * on channel. */
+    Tcl_DriverSeekProc *seekProc;	/* Procedure to call to seek
+                                         * on the channel. May be NULL. */
+    Tcl_DriverSetOptionProc *setOptionProc;
+    					/* Set an option on a channel. */
+    Tcl_DriverGetOptionProc *getOptionProc;
+    					/* Get an option from a channel. */
+    Tcl_DriverWatchProc *watchProc;	/* Set up the notifier to watch
+                                         * for events on this channel. */
+    Tcl_DriverGetHandleProc *getHandleProc;
+					/* Get an OS handle from the channel
+                                         * or NULL if not supported. */
+    VOID *reserved;			/* reserved for future expansion */
+} Tcl_ChannelType;
+
+/*
+ * The following flags determine whether the blockModeProc above should
+ * set the channel into blocking or nonblocking mode. They are passed
+ * as arguments to the blockModeProc procedure in the above structure.
+ */
+
+#define TCL_MODE_BLOCKING 0		/* Put channel into blocking mode. */
+#define TCL_MODE_NONBLOCKING 1		/* Put channel into nonblocking
+					 * mode. */
+
+/*
+ * Enum for different types of file paths.
+ */
+
+typedef enum Tcl_PathType {
+    TCL_PATH_ABSOLUTE,
+    TCL_PATH_RELATIVE,
+    TCL_PATH_VOLUME_RELATIVE
+} Tcl_PathType;
+
+/*
+ * Exported Tcl procedures:
+ */
+
+EXTERN void		Tcl_AddErrorInfo _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *message));
+EXTERN void		Tcl_AddObjErrorInfo _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *message, int length));
+EXTERN void		Tcl_AllowExceptions _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int		Tcl_AppendAllObjTypes _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_Obj *objPtr));
+EXTERN void		Tcl_AppendElement _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string));
+EXTERN void		Tcl_AppendResult _ANSI_ARGS_(
+			    TCL_VARARGS(Tcl_Interp *,interp));
+EXTERN void		Tcl_AppendToObj _ANSI_ARGS_((Tcl_Obj *objPtr,
+			    char *bytes, int length));
+EXTERN void		Tcl_AppendStringsToObj _ANSI_ARGS_(
+			    TCL_VARARGS(Tcl_Obj *,interp));
+EXTERN Tcl_AsyncHandler	Tcl_AsyncCreate _ANSI_ARGS_((Tcl_AsyncProc *proc,
+			    ClientData clientData));
+EXTERN void		Tcl_AsyncDelete _ANSI_ARGS_((Tcl_AsyncHandler async));
+EXTERN int		Tcl_AsyncInvoke _ANSI_ARGS_((Tcl_Interp *interp,
+			    int code));
+EXTERN void		Tcl_AsyncMark _ANSI_ARGS_((Tcl_AsyncHandler async));
+EXTERN int		Tcl_AsyncReady _ANSI_ARGS_((void));
+EXTERN char		Tcl_Backslash _ANSI_ARGS_((CONST char *src,
+			    int *readPtr));
+EXTERN int		Tcl_BadChannelOption _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *optionName, char *optionList));
+EXTERN void		Tcl_CallWhenDeleted _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_InterpDeleteProc *proc,
+			    ClientData clientData));
+EXTERN void		Tcl_CancelIdleCall _ANSI_ARGS_((Tcl_IdleProc *idleProc,
+			    ClientData clientData));
+#define Tcl_Ckalloc Tcl_Alloc
+#define Tcl_Ckfree Tcl_Free
+#define Tcl_Ckrealloc Tcl_Realloc
+EXTERN int		Tcl_Close _ANSI_ARGS_((Tcl_Interp *interp,
+        		    Tcl_Channel chan));
+EXTERN int		Tcl_CommandComplete _ANSI_ARGS_((char *cmd));
+EXTERN char *		Tcl_Concat _ANSI_ARGS_((int argc, char **argv));
+EXTERN Tcl_Obj *	Tcl_ConcatObj _ANSI_ARGS_((int objc,
+			    Tcl_Obj *CONST objv[]));
+EXTERN int		Tcl_ConvertCountedElement _ANSI_ARGS_((CONST char *src,
+			    int length, char *dst, int flags));
+EXTERN int		Tcl_ConvertElement _ANSI_ARGS_((CONST char *src,
+			    char *dst, int flags));
+EXTERN int		Tcl_ConvertToType _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr, Tcl_ObjType *typePtr));
+EXTERN int		Tcl_CreateAlias _ANSI_ARGS_((Tcl_Interp *slave,
+			    char *slaveCmd, Tcl_Interp *target,
+        		    char *targetCmd, int argc, char **argv));
+EXTERN int		Tcl_CreateAliasObj _ANSI_ARGS_((Tcl_Interp *slave,
+			    char *slaveCmd, Tcl_Interp *target,
+        		    char *targetCmd, int objc,
+		            Tcl_Obj *CONST objv[]));
+EXTERN Tcl_Channel	Tcl_CreateChannel _ANSI_ARGS_((
+    			    Tcl_ChannelType *typePtr, char *chanName,
+                            ClientData instanceData, int mask));
+EXTERN void		Tcl_CreateChannelHandler _ANSI_ARGS_((
+			    Tcl_Channel chan, int mask,
+                            Tcl_ChannelProc *proc, ClientData clientData));
+EXTERN void		Tcl_CreateCloseHandler _ANSI_ARGS_((
+			    Tcl_Channel chan, Tcl_CloseProc *proc,
+                            ClientData clientData));
+EXTERN Tcl_Command	Tcl_CreateCommand _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *cmdName, Tcl_CmdProc *proc,
+			    ClientData clientData,
+			    Tcl_CmdDeleteProc *deleteProc));
+EXTERN void		Tcl_CreateEventSource _ANSI_ARGS_((
+			    Tcl_EventSetupProc *setupProc,
+			    Tcl_EventCheckProc *checkProc,
+			    ClientData clientData));
+EXTERN void		Tcl_CreateFileHandler _ANSI_ARGS_((
+    			    int fd, int mask, Tcl_FileProc *proc,
+			    ClientData clientData));
+EXTERN Tcl_Interp *	Tcl_CreateInterp _ANSI_ARGS_((void));
+EXTERN void		Tcl_CreateMathFunc _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *name, int numArgs, Tcl_ValueType *argTypes,
+			    Tcl_MathProc *proc, ClientData clientData));
+EXTERN Tcl_Command	Tcl_CreateObjCommand _ANSI_ARGS_((
+			    Tcl_Interp *interp, char *cmdName,
+			    Tcl_ObjCmdProc *proc, ClientData clientData,
+			    Tcl_CmdDeleteProc *deleteProc));
+EXTERN Tcl_Interp *	Tcl_CreateSlave _ANSI_ARGS_((Tcl_Interp *interp,
+		            char *slaveName, int isSafe));
+EXTERN Tcl_TimerToken	Tcl_CreateTimerHandler _ANSI_ARGS_((int milliseconds,
+			    Tcl_TimerProc *proc, ClientData clientData));
+EXTERN Tcl_Trace	Tcl_CreateTrace _ANSI_ARGS_((Tcl_Interp *interp,
+			    int level, Tcl_CmdTraceProc *proc,
+			    ClientData clientData));
+EXTERN char *		Tcl_DbCkalloc _ANSI_ARGS_((unsigned int size,
+			    char *file, int line));
+EXTERN int		Tcl_DbCkfree _ANSI_ARGS_((char *ptr,
+			    char *file, int line));
+EXTERN char *		Tcl_DbCkrealloc _ANSI_ARGS_((char *ptr,
+			    unsigned int size, char *file, int line));
+EXTERN void		Tcl_DbDecrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr,
+			    char *file, int line));
+EXTERN void		Tcl_DbIncrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr,
+			    char *file, int line));
+EXTERN int		Tcl_DbIsShared _ANSI_ARGS_((Tcl_Obj *objPtr,
+			    char *file, int line));
+EXTERN Tcl_Obj *	Tcl_DbNewBooleanObj _ANSI_ARGS_((int boolValue,
+                            char *file, int line));
+EXTERN Tcl_Obj *	Tcl_DbNewDoubleObj _ANSI_ARGS_((double doubleValue,
+                            char *file, int line));
+EXTERN Tcl_Obj *	Tcl_DbNewListObj _ANSI_ARGS_((int objc,
+			    Tcl_Obj *CONST objv[], char *file, int line));
+EXTERN Tcl_Obj *	Tcl_DbNewLongObj _ANSI_ARGS_((long longValue,
+                            char *file, int line));
+EXTERN Tcl_Obj *	Tcl_DbNewObj _ANSI_ARGS_((char *file, int line));
+EXTERN Tcl_Obj *	Tcl_DbNewStringObj _ANSI_ARGS_((char *bytes,
+			    int length, char *file, int line));
+EXTERN void		Tcl_DeleteAssocData _ANSI_ARGS_((Tcl_Interp *interp,
+                            char *name));
+EXTERN int		Tcl_DeleteCommand _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *cmdName));
+EXTERN int		Tcl_DeleteCommandFromToken _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_Command command));
+EXTERN void		Tcl_DeleteChannelHandler _ANSI_ARGS_((
+    			    Tcl_Channel chan, Tcl_ChannelProc *proc,
+                            ClientData clientData));
+EXTERN void		Tcl_DeleteCloseHandler _ANSI_ARGS_((
+			    Tcl_Channel chan, Tcl_CloseProc *proc,
+                            ClientData clientData));
+EXTERN void		Tcl_DeleteEvents _ANSI_ARGS_((
+			    Tcl_EventDeleteProc *proc,
+                            ClientData clientData));
+EXTERN void		Tcl_DeleteEventSource _ANSI_ARGS_((
+			    Tcl_EventSetupProc *setupProc,
+			    Tcl_EventCheckProc *checkProc,
+			    ClientData clientData));
+EXTERN void		Tcl_DeleteExitHandler _ANSI_ARGS_((Tcl_ExitProc *proc,
+			    ClientData clientData));
+EXTERN void		Tcl_DeleteFileHandler _ANSI_ARGS_((int fd));
+EXTERN void		Tcl_DeleteHashEntry _ANSI_ARGS_((
+			    Tcl_HashEntry *entryPtr));
+EXTERN void		Tcl_DeleteHashTable _ANSI_ARGS_((
+			    Tcl_HashTable *tablePtr));
+EXTERN void		Tcl_DeleteInterp _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void		Tcl_DeleteTimerHandler _ANSI_ARGS_((
+			    Tcl_TimerToken token));
+EXTERN void		Tcl_DeleteTrace _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Trace trace));
+EXTERN void		Tcl_DetachPids _ANSI_ARGS_((int numPids, Tcl_Pid *pidPtr));
+EXTERN void		Tcl_DontCallWhenDeleted _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_InterpDeleteProc *proc,
+			    ClientData clientData));
+EXTERN int		Tcl_DoOneEvent _ANSI_ARGS_((int flags));
+EXTERN void		Tcl_DoWhenIdle _ANSI_ARGS_((Tcl_IdleProc *proc,
+			    ClientData clientData));
+EXTERN char *		Tcl_DStringAppend _ANSI_ARGS_((Tcl_DString *dsPtr,
+			    CONST char *string, int length));
+EXTERN char *		Tcl_DStringAppendElement _ANSI_ARGS_((
+			    Tcl_DString *dsPtr, CONST char *string));
+EXTERN void		Tcl_DStringEndSublist _ANSI_ARGS_((Tcl_DString *dsPtr));
+EXTERN void		Tcl_DStringFree _ANSI_ARGS_((Tcl_DString *dsPtr));
+EXTERN void		Tcl_DStringGetResult _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_DString *dsPtr));
+EXTERN void		Tcl_DStringInit _ANSI_ARGS_((Tcl_DString *dsPtr));
+EXTERN void		Tcl_DStringResult _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_DString *dsPtr));
+EXTERN void		Tcl_DStringSetLength _ANSI_ARGS_((Tcl_DString *dsPtr,
+			    int length));
+EXTERN void		Tcl_DStringStartSublist _ANSI_ARGS_((
+			    Tcl_DString *dsPtr));
+EXTERN Tcl_Obj *	Tcl_DuplicateObj _ANSI_ARGS_((Tcl_Obj *objPtr));
+EXTERN int		Tcl_Eof _ANSI_ARGS_((Tcl_Channel chan));
+EXTERN char *		Tcl_ErrnoId _ANSI_ARGS_((void));
+EXTERN char *		Tcl_ErrnoMsg _ANSI_ARGS_((int err));
+EXTERN int		Tcl_Eval _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string));
+EXTERN int		Tcl_EvalFile _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *fileName));
+EXTERN void		Tcl_EventuallyFree _ANSI_ARGS_((ClientData clientData,
+			    Tcl_FreeProc *freeProc));
+EXTERN int		Tcl_EvalObj _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr));
+EXTERN int		Tcl_ExposeCommand _ANSI_ARGS_((Tcl_Interp *interp,
+        		    char *hiddenCmdToken, char *cmdName));
+EXTERN int		Tcl_ExprBoolean _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, int *ptr));
+EXTERN int		Tcl_ExprBooleanObj _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr, int *ptr));
+EXTERN int		Tcl_ExprDouble _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, double *ptr));
+EXTERN int		Tcl_ExprDoubleObj _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr, double *ptr));
+EXTERN int		Tcl_ExprLong _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, long *ptr));
+EXTERN int		Tcl_ExprLongObj _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr, long *ptr));
+EXTERN int		Tcl_ExprObj _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr));
+EXTERN int		Tcl_ExprString _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string));
+EXTERN void		Tcl_Finalize _ANSI_ARGS_((void));
+EXTERN void		Tcl_FindExecutable _ANSI_ARGS_((char *argv0));
+EXTERN Tcl_HashEntry *	Tcl_FirstHashEntry _ANSI_ARGS_((
+			    Tcl_HashTable *tablePtr,
+			    Tcl_HashSearch *searchPtr));
+EXTERN int		Tcl_Flush _ANSI_ARGS_((Tcl_Channel chan));
+EXTERN void		TclFreeObj _ANSI_ARGS_((Tcl_Obj *objPtr));
+EXTERN void		Tcl_FreeResult _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int		Tcl_GetAlias _ANSI_ARGS_((Tcl_Interp *interp,
+       			    char *slaveCmd, Tcl_Interp **targetInterpPtr,
+                            char **targetCmdPtr, int *argcPtr,
+			    char ***argvPtr));
+EXTERN int		Tcl_GetAliasObj _ANSI_ARGS_((Tcl_Interp *interp,
+       			    char *slaveCmd, Tcl_Interp **targetInterpPtr,
+                            char **targetCmdPtr, int *objcPtr,
+			    Tcl_Obj ***objv));
+EXTERN ClientData	Tcl_GetAssocData _ANSI_ARGS_((Tcl_Interp *interp,
+                            char *name, Tcl_InterpDeleteProc **procPtr));
+EXTERN int		Tcl_GetBoolean _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, int *boolPtr));
+EXTERN int		Tcl_GetBooleanFromObj _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_Obj *objPtr,
+			    int *boolPtr));
+EXTERN int		Tcl_GetChannelHandle _ANSI_ARGS_((Tcl_Channel chan,
+	        	    int direction, ClientData *handlePtr));
+EXTERN ClientData	Tcl_GetChannelInstanceData _ANSI_ARGS_((
+    			    Tcl_Channel chan));
+EXTERN int		Tcl_GetChannelMode _ANSI_ARGS_((Tcl_Channel chan));
+EXTERN char *		Tcl_GetChannelName _ANSI_ARGS_((Tcl_Channel chan));
+EXTERN int		Tcl_GetChannelOption _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Channel chan, char *optionName,
+			    Tcl_DString *dsPtr));
+EXTERN Tcl_ChannelType * Tcl_GetChannelType _ANSI_ARGS_((Tcl_Channel chan));
+EXTERN int		Tcl_GetCommandInfo _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *cmdName, Tcl_CmdInfo *infoPtr));
+EXTERN char *		Tcl_GetCommandName _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Command command));
+EXTERN int		Tcl_GetDouble _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, double *doublePtr));
+EXTERN int		Tcl_GetDoubleFromObj _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_Obj *objPtr,
+			    double *doublePtr));
+EXTERN int		Tcl_GetErrno _ANSI_ARGS_((void));
+EXTERN char *		Tcl_GetHostName _ANSI_ARGS_((void));
+EXTERN int		Tcl_GetIndexFromObj _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr, char **tablePtr, char *msg,
+			    int flags, int *indexPtr));
+EXTERN int		Tcl_GetInt _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, int *intPtr));
+EXTERN int		Tcl_GetInterpPath _ANSI_ARGS_((Tcl_Interp *askInterp,
+			    Tcl_Interp *slaveInterp));
+EXTERN int		Tcl_GetIntFromObj _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr, int *intPtr));
+EXTERN int		Tcl_GetLongFromObj _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr, long *longPtr));
+EXTERN Tcl_Interp *	Tcl_GetMaster _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN CONST char *	Tcl_GetNameOfExecutable _ANSI_ARGS_((void));
+EXTERN Tcl_Obj *	Tcl_GetObjResult _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN Tcl_ObjType *	Tcl_GetObjType _ANSI_ARGS_((char *typeName));
+EXTERN int		Tcl_GetOpenFile _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, int write, int checkUsage,
+			    ClientData *filePtr));
+EXTERN Tcl_PathType	Tcl_GetPathType _ANSI_ARGS_((char *path));
+EXTERN int		Tcl_Gets _ANSI_ARGS_((Tcl_Channel chan,
+        		    Tcl_DString *dsPtr));
+EXTERN int		Tcl_GetsObj _ANSI_ARGS_((Tcl_Channel chan,
+        		    Tcl_Obj *objPtr));
+EXTERN int		Tcl_GetServiceMode _ANSI_ARGS_((void));
+EXTERN Tcl_Interp *	Tcl_GetSlave _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *slaveName));
+EXTERN char *		Tcl_GetStringFromObj _ANSI_ARGS_((Tcl_Obj *objPtr,
+			    int *lengthPtr));
+EXTERN char *		Tcl_GetStringResult _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN char *		Tcl_GetVar _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *varName, int flags));
+EXTERN char *		Tcl_GetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *part1, char *part2, int flags));
+EXTERN int		Tcl_GlobalEval _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *command));
+EXTERN int		Tcl_GlobalEvalObj _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr));
+EXTERN char *		Tcl_HashStats _ANSI_ARGS_((Tcl_HashTable *tablePtr));
+EXTERN int		Tcl_HideCommand _ANSI_ARGS_((Tcl_Interp *interp,
+		            char *cmdName, char *hiddenCmdToken));
+EXTERN void		Tcl_InitHashTable _ANSI_ARGS_((Tcl_HashTable *tablePtr,
+			    int keyType));
+EXTERN void		Tcl_InitMemory _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int		Tcl_InputBlocked _ANSI_ARGS_((Tcl_Channel chan));
+EXTERN int		Tcl_InputBuffered _ANSI_ARGS_((Tcl_Channel chan));
+EXTERN int		Tcl_InterpDeleted _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int		Tcl_IsSafe _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void		Tcl_InvalidateStringRep _ANSI_ARGS_((
+			    Tcl_Obj *objPtr));
+EXTERN char *		Tcl_JoinPath _ANSI_ARGS_((int argc, char **argv,
+			    Tcl_DString *resultPtr));
+EXTERN int		Tcl_LinkVar _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *varName, char *addr, int type));
+EXTERN int		Tcl_ListObjAppendList _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_Obj *listPtr, 
+			    Tcl_Obj *elemListPtr));
+EXTERN int		Tcl_ListObjAppendElement _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_Obj *listPtr,
+			    Tcl_Obj *objPtr));
+EXTERN int		Tcl_ListObjGetElements _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_Obj *listPtr,
+			    int *objcPtr, Tcl_Obj ***objvPtr));
+EXTERN int		Tcl_ListObjIndex _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *listPtr, int index, 
+			    Tcl_Obj **objPtrPtr));
+EXTERN int		Tcl_ListObjLength _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *listPtr, int *intPtr));
+EXTERN int		Tcl_ListObjReplace _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *listPtr, int first, int count,
+			    int objc, Tcl_Obj *CONST objv[]));
+EXTERN void		Tcl_Main _ANSI_ARGS_((int argc, char **argv,
+			    Tcl_AppInitProc *appInitProc));
+EXTERN Tcl_Channel	Tcl_MakeFileChannel _ANSI_ARGS_((ClientData handle,
+			    int mode));
+EXTERN int		Tcl_MakeSafe _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN Tcl_Channel	Tcl_MakeTcpClientChannel _ANSI_ARGS_((
+    			    ClientData tcpSocket));
+EXTERN char *		Tcl_Merge _ANSI_ARGS_((int argc, char **argv));
+EXTERN Tcl_HashEntry *	Tcl_NextHashEntry _ANSI_ARGS_((
+			    Tcl_HashSearch *searchPtr));
+EXTERN void		Tcl_NotifyChannel _ANSI_ARGS_((Tcl_Channel channel,
+			    int mask));
+EXTERN Tcl_Obj *	Tcl_ObjGetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
+			    int flags));
+EXTERN Tcl_Obj *	Tcl_ObjSetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
+			    Tcl_Obj *newValuePtr, int flags));
+EXTERN Tcl_Channel	Tcl_OpenCommandChannel _ANSI_ARGS_((
+    			    Tcl_Interp *interp, int argc, char **argv,
+			    int flags));
+EXTERN Tcl_Channel	Tcl_OpenFileChannel _ANSI_ARGS_((Tcl_Interp *interp,
+        		    char *fileName, char *modeString,
+                            int permissions));
+EXTERN Tcl_Channel	Tcl_OpenTcpClient _ANSI_ARGS_((Tcl_Interp *interp,
+			    int port, char *address, char *myaddr,
+		            int myport, int async));
+EXTERN Tcl_Channel	Tcl_OpenTcpServer _ANSI_ARGS_((Tcl_Interp *interp,
+		            int port, char *host,
+        		    Tcl_TcpAcceptProc *acceptProc,
+			    ClientData callbackData));
+EXTERN char *		Tcl_ParseVar _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, char **termPtr));
+EXTERN int		Tcl_PkgProvide _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *name, char *version));
+EXTERN char *		Tcl_PkgRequire _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *name, char *version, int exact));
+EXTERN char *		Tcl_PosixError _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void		Tcl_Preserve _ANSI_ARGS_((ClientData data));
+EXTERN void		Tcl_PrintDouble _ANSI_ARGS_((Tcl_Interp *interp,
+			    double value, char *dst));
+EXTERN int		Tcl_PutEnv _ANSI_ARGS_((CONST char *string));
+EXTERN void		Tcl_QueueEvent _ANSI_ARGS_((Tcl_Event *evPtr,
+			    Tcl_QueuePosition position));
+EXTERN int		Tcl_Read _ANSI_ARGS_((Tcl_Channel chan,
+	        	    char *bufPtr, int toRead));
+EXTERN void		Tcl_ReapDetachedProcs _ANSI_ARGS_((void));
+EXTERN int		Tcl_RecordAndEval _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *cmd, int flags));
+EXTERN int		Tcl_RecordAndEvalObj _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *cmdPtr, int flags));
+EXTERN Tcl_RegExp	Tcl_RegExpCompile _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string));
+EXTERN int		Tcl_RegExpExec _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_RegExp regexp, char *string, char *start));
+EXTERN int		Tcl_RegExpMatch _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, char *pattern));
+EXTERN void		Tcl_RegExpRange _ANSI_ARGS_((Tcl_RegExp regexp,
+			    int index, char **startPtr, char **endPtr));
+EXTERN void		Tcl_RegisterObjType _ANSI_ARGS_((
+			    Tcl_ObjType *typePtr));
+EXTERN void		Tcl_Release _ANSI_ARGS_((ClientData clientData));
+EXTERN void		Tcl_ResetResult _ANSI_ARGS_((Tcl_Interp *interp));
+#define Tcl_Return Tcl_SetResult
+EXTERN int		Tcl_ScanCountedElement _ANSI_ARGS_((CONST char *string,
+			    int length, int *flagPtr));
+EXTERN int		Tcl_ScanElement _ANSI_ARGS_((CONST char *string,
+			    int *flagPtr));
+EXTERN int		Tcl_Seek _ANSI_ARGS_((Tcl_Channel chan,
+        		    int offset, int mode));
+EXTERN int		Tcl_ServiceAll _ANSI_ARGS_((void));
+EXTERN int		Tcl_ServiceEvent _ANSI_ARGS_((int flags));
+EXTERN void		Tcl_SetAssocData _ANSI_ARGS_((Tcl_Interp *interp,
+                            char *name, Tcl_InterpDeleteProc *proc,
+                            ClientData clientData));
+EXTERN void		Tcl_SetBooleanObj _ANSI_ARGS_((Tcl_Obj *objPtr, 
+			    int boolValue));
+EXTERN void		Tcl_SetChannelBufferSize _ANSI_ARGS_((
+			    Tcl_Channel chan, int sz));
+EXTERN int		Tcl_SetChannelOption _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_Channel chan,
+	        	    char *optionName, char *newValue));
+EXTERN int		Tcl_SetCommandInfo _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *cmdName, Tcl_CmdInfo *infoPtr));
+EXTERN void		Tcl_SetDoubleObj _ANSI_ARGS_((Tcl_Obj *objPtr, 
+			    double doubleValue));
+EXTERN void		Tcl_SetErrno _ANSI_ARGS_((int err));
+EXTERN void		Tcl_SetErrorCode _ANSI_ARGS_(
+    			    TCL_VARARGS(Tcl_Interp *,arg1));
+EXTERN void		Tcl_SetIntObj _ANSI_ARGS_((Tcl_Obj *objPtr, 
+			    int intValue));
+EXTERN void		Tcl_SetListObj _ANSI_ARGS_((Tcl_Obj *objPtr, 
+			    int objc, Tcl_Obj *CONST objv[]));
+EXTERN void		Tcl_SetLongObj _ANSI_ARGS_((Tcl_Obj *objPtr, 
+			    long longValue));
+EXTERN void		Tcl_SetMaxBlockTime _ANSI_ARGS_((Tcl_Time *timePtr));
+EXTERN void		Tcl_SetObjErrorCode _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *errorObjPtr));
+EXTERN void		Tcl_SetObjLength _ANSI_ARGS_((Tcl_Obj *objPtr,
+			    int length));
+EXTERN void		Tcl_SetObjResult _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *resultObjPtr));
+EXTERN void		Tcl_SetPanicProc _ANSI_ARGS_((void (*proc)
+			    _ANSI_ARGS_(TCL_VARARGS(char *, format))));
+EXTERN int		Tcl_SetRecursionLimit _ANSI_ARGS_((Tcl_Interp *interp,
+			    int depth));
+EXTERN void		Tcl_SetResult _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, Tcl_FreeProc *freeProc));
+EXTERN int		Tcl_SetServiceMode _ANSI_ARGS_((int mode));
+EXTERN void		Tcl_SetStdChannel _ANSI_ARGS_((Tcl_Channel channel,
+			    int type));
+EXTERN void		Tcl_SetStringObj _ANSI_ARGS_((Tcl_Obj *objPtr, 
+			    char *bytes, int length));
+EXTERN void		Tcl_SetTimer _ANSI_ARGS_((Tcl_Time *timePtr));
+EXTERN char *		Tcl_SetVar _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *varName, char *newValue, int flags));
+EXTERN char *		Tcl_SetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *part1, char *part2, char *newValue,
+			    int flags));
+EXTERN char *		Tcl_SignalId _ANSI_ARGS_((int sig));
+EXTERN char *		Tcl_SignalMsg _ANSI_ARGS_((int sig));
+EXTERN void		Tcl_SourceRCFile _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int		Tcl_SplitList _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *list, int *argcPtr, char ***argvPtr));
+EXTERN void		Tcl_SplitPath _ANSI_ARGS_((char *path,
+			    int *argcPtr, char ***argvPtr));
+EXTERN void		Tcl_StaticPackage _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *pkgName, Tcl_PackageInitProc *initProc,
+			    Tcl_PackageInitProc *safeInitProc));
+EXTERN int		Tcl_StringMatch _ANSI_ARGS_((char *string,
+			    char *pattern));
+EXTERN int		Tcl_Tell _ANSI_ARGS_((Tcl_Channel chan));
+#define Tcl_TildeSubst Tcl_TranslateFileName
+EXTERN int		Tcl_TraceVar _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *varName, int flags, Tcl_VarTraceProc *proc,
+			    ClientData clientData));
+EXTERN int		Tcl_TraceVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *part1, char *part2, int flags,
+			    Tcl_VarTraceProc *proc, ClientData clientData));
+EXTERN char *		Tcl_TranslateFileName _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *name, Tcl_DString *bufferPtr));
+EXTERN int		Tcl_Ungets _ANSI_ARGS_((Tcl_Channel chan, char *str,
+			    int len, int atHead));
+EXTERN void		Tcl_UnlinkVar _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *varName));
+EXTERN int		Tcl_UnsetVar _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *varName, int flags));
+EXTERN int		Tcl_UnsetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *part1, char *part2, int flags));
+EXTERN void		Tcl_UntraceVar _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *varName, int flags, Tcl_VarTraceProc *proc,
+			    ClientData clientData));
+EXTERN void		Tcl_UntraceVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *part1, char *part2, int flags,
+			    Tcl_VarTraceProc *proc, ClientData clientData));
+EXTERN void		Tcl_UpdateLinkedVar _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *varName));
+EXTERN int		Tcl_UpVar _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *frameName, char *varName,
+			    char *localName, int flags));
+EXTERN int		Tcl_UpVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *frameName, char *part1, char *part2,
+			    char *localName, int flags));
+EXTERN int		Tcl_VarEval _ANSI_ARGS_(
+    			    TCL_VARARGS(Tcl_Interp *,interp));
+EXTERN ClientData	Tcl_VarTraceInfo _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *varName, int flags,
+			    Tcl_VarTraceProc *procPtr,
+			    ClientData prevClientData));
+EXTERN ClientData	Tcl_VarTraceInfo2 _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *part1, char *part2, int flags,
+			    Tcl_VarTraceProc *procPtr,
+			    ClientData prevClientData));
+EXTERN Tcl_Pid		Tcl_WaitPid _ANSI_ARGS_((Tcl_Pid pid, int *statPtr, 
+			    int options));
+EXTERN int		Tcl_Write _ANSI_ARGS_((Tcl_Channel chan,
+			    char *s, int slen));
+EXTERN void		Tcl_WrongNumArgs _ANSI_ARGS_((Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[], char *message));
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS
+
+/*
+ * Convenience declaration of Tcl_AppInit for backwards compatibility.
+ * This function is not *implemented* by the tcl library, so the storage
+ * class is neither DLLEXPORT nor DLLIMPORT
+ */
+
+EXTERN int             Tcl_AppInit _ANSI_ARGS_((Tcl_Interp *interp));
+
+#endif /* RESOURCE_INCLUDED */
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TCL */
Index: /trunk/tcl/tclAlloc.c
===================================================================
--- /trunk/tcl/tclAlloc.c	(revision 2)
+++ /trunk/tcl/tclAlloc.c	(revision 2)
@@ -0,0 +1,219 @@
+/* 
+ * tclAlloc.c --
+ *
+ *	This is a very fast storage allocator.  It allocates blocks of a
+ *	small number of different sizes, and keeps free lists of each size.
+ *	Blocks that don't exactly fit are passed up to the next larger size.
+ *	Blocks over a certain size are directly allocated from the system.
+ *
+ * Copyright (c) 1983 Regents of the University of California.
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ *
+ * Portions contributed by Chris Kingsley, Jack Jansen and Ray Johnson.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclAlloc.c,v 1.1 2008-06-04 13:58:03 demin Exp $
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+#ifdef TCL_DEBUG
+#   define DEBUG
+/* #define MSTATS */
+#   define RCHECK
+#endif
+
+//typedef unsigned long caddr_t;
+
+/*
+ * The overhead on a block is at least 4 bytes.  When free, this space
+ * contains a pointer to the next free block, and the bottom two bits must
+ * be zero.  When in use, the first byte is set to MAGIC, and the second
+ * byte is the size index.  The remaining bytes are for alignment.
+ * If range checking is enabled then a second word holds the size of the
+ * requested block, less 1, rounded up to a multiple of sizeof(RMAGIC).
+ * The order of elements is critical: ov_magic must overlay the low order
+ * bits of ov_next, and ov_magic can not be a valid ov_next bit pattern.
+ */
+
+union overhead {
+    union overhead *ov_next;	/* when free */
+    struct {
+	unsigned char	ovu_magic0;	/* magic number */
+	unsigned char	ovu_index;	/* bucket # */
+	unsigned char	ovu_unused;	/* unused */
+	unsigned char	ovu_magic1;	/* other magic number */
+#ifdef RCHECK
+	unsigned short	ovu_rmagic;	/* range magic number */
+	unsigned long	ovu_size;	/* actual block size */
+#endif
+    } ovu;
+#define ov_magic0	ovu.ovu_magic0
+#define ov_magic1	ovu.ovu_magic1
+#define ov_index	ovu.ovu_index
+#define ov_rmagic	ovu.ovu_rmagic
+#define ov_size	ovu.ovu_size
+};
+
+
+#define MAGIC		0xef		/* magic # on accounting info */
+#define RMAGIC		0x5555		/* magic # on range info */
+
+#ifdef RCHECK
+#define	RSLOP		sizeof (unsigned short)
+#else
+#define	RSLOP		0
+#endif
+
+#define OVERHEAD (sizeof(union overhead) + RSLOP)
+
+/*
+ * nextf[i] is the pointer to the next free block of size 2^(i+3).  The
+ * smallest allocatable block is 8 bytes.  The overhead information
+ * precedes the data area returned to the user.
+ */
+
+#define NBUCKETS	13
+#define MAXMALLOC	(1<<(NBUCKETS+2))
+
+#ifdef MSTATS
+
+/*
+ * nmalloc[i] is the difference between the number of mallocs and frees
+ * for a given block size.
+ */
+
+static	unsigned int nmalloc[NBUCKETS+1];
+#include <stdio.h>
+#endif
+
+#if defined(DEBUG) || defined(RCHECK)
+#define	ASSERT(p)   if (!(p)) panic(# p)
+#define RANGE_ASSERT(p) if (!(p)) panic(# p)
+#else
+#define	ASSERT(p)
+#define RANGE_ASSERT(p)
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpAlloc --
+ *
+ *	Allocate more memory.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclpAlloc(
+    unsigned int nbytes)	/* Number of bytes to allocate. */
+{
+    return (char*) malloc(nbytes);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpFree --
+ *
+ *	Free memory.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpFree(
+    char *cp)		/* Pointer to memory to free. */
+{   
+    free(cp);
+    return;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpRealloc --
+ *
+ *	Reallocate memory.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclpRealloc(
+    char *cp,			/* Pointer to alloced block. */
+    unsigned int nbytes)	/* New size of memory. */
+{   
+    return (char*) realloc(cp, nbytes);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * mstats --
+ *
+ *	Prints two lines of numbers, one showing the length of the 
+ *	free list for each size category, the second showing the 
+ *	number of mallocs - frees for each size category.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef MSTATS
+void
+mstats(
+    char *s)	/* Where to write info. */
+{
+    register int i, j;
+    register union overhead *p;
+    int totfree = 0,
+	totused = 0;
+
+    fprintf(stderr, "Memory allocation statistics %s\nTclpFree:\t", s);
+    for (i = 0; i < NBUCKETS; i++) {
+	for (j = 0, p = nextf[i]; p; p = p->ov_next, j++)
+	    fprintf(stderr, " %d", j);
+	totfree += j * (1 << (i + 3));
+    }
+    fprintf(stderr, "\nused:\t");
+    for (i = 0; i < NBUCKETS; i++) {
+	fprintf(stderr, " %d", nmalloc[i]);
+	totused += nmalloc[i] * (1 << (i + 3));
+    }
+    fprintf(stderr, "\n\tTotal small in use: %d, total free: %d\n",
+	    totused, totfree);
+    fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %d\n", 
+	    MAXMALLOC, nmalloc[NBUCKETS]);
+}
+#endif
+
Index: /trunk/tcl/tclAsync.c
===================================================================
--- /trunk/tcl/tclAsync.c	(revision 2)
+++ /trunk/tcl/tclAsync.c	(revision 2)
@@ -0,0 +1,270 @@
+/* 
+ * tclAsync.c --
+ *
+ *	This file provides low-level support needed to invoke signal
+ *	handlers in a safe way.  The code here doesn't actually handle
+ *	signals, though.  This code is based on proposals made by
+ *	Mark Diekhans and Don Libes.
+ *
+ * Copyright (c) 1993 The Regents of the University of California.
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclAsync.c,v 1.1 2008-06-04 13:58:03 demin Exp $
+ */
+
+#include "tclInt.h"
+
+/*
+ * One of the following structures exists for each asynchronous
+ * handler:
+ */
+
+typedef struct AsyncHandler {
+    int ready;				/* Non-zero means this handler should
+					 * be invoked in the next call to
+					 * Tcl_AsyncInvoke. */
+    struct AsyncHandler *nextPtr;	/* Next in list of all handlers for
+					 * the process. */
+    Tcl_AsyncProc *proc;		/* Procedure to call when handler
+					 * is invoked. */
+    ClientData clientData;		/* Value to pass to handler when it
+					 * is invoked. */
+} AsyncHandler;
+
+/*
+ * The variables below maintain a list of all existing handlers.
+ */
+
+static AsyncHandler *firstHandler;	/* First handler defined for process,
+					 * or NULL if none. */
+static AsyncHandler *lastHandler;	/* Last handler or NULL. */
+
+/*
+ * The variable below is set to 1 whenever a handler becomes ready and
+ * it is cleared to zero whenever Tcl_AsyncInvoke is called.  It can be
+ * checked elsewhere in the application by calling Tcl_AsyncReady to see
+ * if Tcl_AsyncInvoke should be invoked.
+ */
+
+static int asyncReady = 0;
+
+/*
+ * The variable below indicates whether Tcl_AsyncInvoke is currently
+ * working.  If so then we won't set asyncReady again until
+ * Tcl_AsyncInvoke returns.
+ */
+
+static int asyncActive = 0;
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AsyncCreate --
+ *
+ *	This procedure creates the data structures for an asynchronous
+ *	handler, so that no memory has to be allocated when the handler
+ *	is activated.
+ *
+ * Results:
+ *	The return value is a token for the handler, which can be used
+ *	to activate it later on.
+ *
+ * Side effects:
+ *	Information about the handler is recorded.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_AsyncHandler
+Tcl_AsyncCreate(proc, clientData)
+    Tcl_AsyncProc *proc;		/* Procedure to call when handler
+					 * is invoked. */
+    ClientData clientData;		/* Argument to pass to handler. */
+{
+    AsyncHandler *asyncPtr;
+
+    asyncPtr = (AsyncHandler *) ckalloc(sizeof(AsyncHandler));
+    asyncPtr->ready = 0;
+    asyncPtr->nextPtr = NULL;
+    asyncPtr->proc = proc;
+    asyncPtr->clientData = clientData;
+    if (firstHandler == NULL) {
+	firstHandler = asyncPtr;
+    } else {
+	lastHandler->nextPtr = asyncPtr;
+    }
+    lastHandler = asyncPtr;
+    return (Tcl_AsyncHandler) asyncPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AsyncMark --
+ *
+ *	This procedure is called to request that an asynchronous handler
+ *	be invoked as soon as possible.  It's typically called from
+ *	an interrupt handler, where it isn't safe to do anything that
+ *	depends on or modifies application state.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The handler gets marked for invocation later.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AsyncMark(async)
+    Tcl_AsyncHandler async;		/* Token for handler. */
+{
+    ((AsyncHandler *) async)->ready = 1;
+    if (!asyncActive) {
+	asyncReady = 1;
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AsyncInvoke --
+ *
+ *	This procedure is called at a "safe" time at background level
+ *	to invoke any active asynchronous handlers.
+ *
+ * Results:
+ *	The return value is a normal Tcl result, which is intended to
+ *	replace the code argument as the current completion code for
+ *	interp.
+ *
+ * Side effects:
+ *	Depends on the handlers that are active.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_AsyncInvoke(interp, code)
+    Tcl_Interp *interp;			/* If invoked from Tcl_Eval just after
+					 * completing a command, points to
+					 * interpreter.  Otherwise it is
+					 * NULL. */
+    int code; 				/* If interp is non-NULL, this gives
+					 * completion code from command that
+					 * just completed. */
+{
+    AsyncHandler *asyncPtr;
+
+    if (asyncReady == 0) {
+	return code;
+    }
+    asyncReady = 0;
+    asyncActive = 1;
+    if (interp == NULL) {
+	code = 0;
+    }
+
+    /*
+     * Make one or more passes over the list of handlers, invoking
+     * at most one handler in each pass.  After invoking a handler,
+     * go back to the start of the list again so that (a) if a new
+     * higher-priority handler gets marked while executing a lower
+     * priority handler, we execute the higher-priority handler
+     * next, and (b) if a handler gets deleted during the execution
+     * of a handler, then the list structure may change so it isn't
+     * safe to continue down the list anyway.
+     */
+
+    while (1) {
+	for (asyncPtr = firstHandler; asyncPtr != NULL;
+		asyncPtr = asyncPtr->nextPtr) {
+	    if (asyncPtr->ready) {
+		break;
+	    }
+	}
+	if (asyncPtr == NULL) {
+	    break;
+	}
+	asyncPtr->ready = 0;
+	code = (*asyncPtr->proc)(asyncPtr->clientData, interp, code);
+    }
+    asyncActive = 0;
+    return code;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AsyncDelete --
+ *
+ *	Frees up all the state for an asynchronous handler.  The handler
+ *	should never be used again.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The state associated with the handler is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AsyncDelete(async)
+    Tcl_AsyncHandler async;		/* Token for handler to delete. */
+{
+    AsyncHandler *asyncPtr = (AsyncHandler *) async;
+    AsyncHandler *prevPtr;
+
+    if (firstHandler == asyncPtr) {
+	firstHandler = asyncPtr->nextPtr;
+	if (firstHandler == NULL) {
+	    lastHandler = NULL;
+	}
+    } else {
+	prevPtr = firstHandler;
+	while (prevPtr->nextPtr != asyncPtr) {
+	    prevPtr = prevPtr->nextPtr;
+	}
+	prevPtr->nextPtr = asyncPtr->nextPtr;
+	if (lastHandler == asyncPtr) {
+	    lastHandler = prevPtr;
+	}
+    }
+    ckfree((char *) asyncPtr);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AsyncReady --
+ *
+ *	This procedure can be used to tell whether Tcl_AsyncInvoke
+ *	needs to be called.  This procedure is the external interface
+ *	for checking the internal asyncReady variable.
+ *
+ * Results:
+ * 	The return value is 1 whenever a handler is ready and is 0
+ *	when no handlers are ready.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_AsyncReady()
+{
+    return asyncReady;
+}
Index: /trunk/tcl/tclBasic.c
===================================================================
--- /trunk/tcl/tclBasic.c	(revision 2)
+++ /trunk/tcl/tclBasic.c	(revision 2)
@@ -0,0 +1,3814 @@
+/* 
+ * tclBasic.c --
+ *
+ *	Contains the basic facilities for TCL command interpretation,
+ *	including interpreter creation and deletion, command creation
+ *	and deletion, and command parsing and execution.
+ *
+ * Copyright (c) 1987-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclBasic.c,v 1.1 2008-06-04 13:58:03 demin Exp $
+ */
+
+#include "tclInt.h"
+#include "tclCompile.h"
+#ifndef TCL_GENERIC_ONLY
+#   include "tclPort.h"
+#endif
+
+/*
+ * Static procedures in this file:
+ */
+
+static void		DeleteInterpProc _ANSI_ARGS_((Tcl_Interp *interp));
+static void		HiddenCmdsDeleteProc _ANSI_ARGS_((
+			    ClientData clientData, Tcl_Interp *interp));
+
+/*
+ * The following structure defines the commands in the Tcl core.
+ */
+
+typedef struct {
+    char *name;			/* Name of object-based command. */
+    Tcl_CmdProc *proc;		/* String-based procedure for command. */
+    Tcl_ObjCmdProc *objProc;	/* Object-based procedure for command. */
+    CompileProc *compileProc;	/* Procedure called to compile command. */
+    int isSafe;			/* If non-zero, command will be present
+                                 * in safe interpreter. Otherwise it will
+                                 * be hidden. */
+} CmdInfo;
+
+/*
+ * The built-in commands, and the procedures that implement them:
+ */
+
+static CmdInfo builtInCmds[] = {
+    /*
+     * Commands in the generic core. Note that at least one of the proc or
+     * objProc members should be non-NULL. This avoids infinitely recursive
+     * calls between TclInvokeObjectCommand and TclInvokeStringCommand if a
+     * command name is computed at runtime and results in the name of a
+     * compiled command.
+     */
+
+    {"append",		(Tcl_CmdProc *) NULL,	Tcl_AppendObjCmd,
+        (CompileProc *) NULL,		1},
+    {"array",		(Tcl_CmdProc *) NULL,	Tcl_ArrayObjCmd,
+        (CompileProc *) NULL,		1},
+    {"break",		Tcl_BreakCmd,		(Tcl_ObjCmdProc *) NULL,
+        TclCompileBreakCmd,		1},
+    {"case",		(Tcl_CmdProc *) NULL,	Tcl_CaseObjCmd,
+        (CompileProc *) NULL,		1},
+    {"catch",		(Tcl_CmdProc *) NULL,	Tcl_CatchObjCmd,	
+        TclCompileCatchCmd,		1},
+    {"concat",		(Tcl_CmdProc *) NULL,	Tcl_ConcatObjCmd,
+        (CompileProc *) NULL,		1},
+    {"continue",	Tcl_ContinueCmd,	(Tcl_ObjCmdProc *) NULL,
+        TclCompileContinueCmd,		1},
+    {"error",		(Tcl_CmdProc *) NULL,	Tcl_ErrorObjCmd,
+        (CompileProc *) NULL,		1},
+    {"eval",		(Tcl_CmdProc *) NULL,	Tcl_EvalObjCmd,
+        (CompileProc *) NULL,		1},
+    {"expr",		(Tcl_CmdProc *) NULL,	Tcl_ExprObjCmd,
+        TclCompileExprCmd,		1},
+    {"for",		Tcl_ForCmd,		(Tcl_ObjCmdProc *) NULL,
+        TclCompileForCmd,		1},
+    {"foreach",		(Tcl_CmdProc *) NULL,	Tcl_ForeachObjCmd,
+        TclCompileForeachCmd,		1},
+    {"format",		(Tcl_CmdProc *) NULL,	Tcl_FormatObjCmd,
+        (CompileProc *) NULL,		1},
+    {"global",		(Tcl_CmdProc *) NULL,	Tcl_GlobalObjCmd,
+        (CompileProc *) NULL,		1},
+    {"if",		Tcl_IfCmd,		(Tcl_ObjCmdProc *) NULL,
+        TclCompileIfCmd,		1},
+    {"incr",		Tcl_IncrCmd,		(Tcl_ObjCmdProc *) NULL,
+        TclCompileIncrCmd,		1},
+    {"info",		(Tcl_CmdProc *) NULL,	Tcl_InfoObjCmd,
+        (CompileProc *) NULL,		1},
+    {"join",		(Tcl_CmdProc *) NULL,	Tcl_JoinObjCmd,
+        (CompileProc *) NULL,		1},
+    {"lappend",		(Tcl_CmdProc *) NULL,	Tcl_LappendObjCmd,
+        (CompileProc *) NULL,		1},
+    {"add",		(Tcl_CmdProc *) NULL,	Tcl_LappendObjCmd,
+        (CompileProc *) NULL,		1},
+    {"lindex",		(Tcl_CmdProc *) NULL,	Tcl_LindexObjCmd,
+        (CompileProc *) NULL,		1},
+    {"linsert",		(Tcl_CmdProc *) NULL,	Tcl_LinsertObjCmd,
+        (CompileProc *) NULL,		1},
+    {"list",		(Tcl_CmdProc *) NULL,	Tcl_ListObjCmd,
+        (CompileProc *) NULL,		1},
+    {"llength",		(Tcl_CmdProc *) NULL,	Tcl_LlengthObjCmd,
+        (CompileProc *) NULL,		1},
+    {"lrange",		(Tcl_CmdProc *) NULL,	Tcl_LrangeObjCmd,
+        (CompileProc *) NULL,		1},
+    {"lreplace",	(Tcl_CmdProc *) NULL,	Tcl_LreplaceObjCmd,
+        (CompileProc *) NULL,		1},
+    {"lsort",		(Tcl_CmdProc *) NULL,	Tcl_LsortObjCmd,
+        (CompileProc *) NULL,		1},
+    {"namespace",	(Tcl_CmdProc *) NULL,	Tcl_NamespaceObjCmd,
+        (CompileProc *) NULL,		1},
+    {"proc",		(Tcl_CmdProc *) NULL,	Tcl_ProcObjCmd,	
+        (CompileProc *) NULL,		1},
+    {"return",		(Tcl_CmdProc *) NULL,	Tcl_ReturnObjCmd,	
+        (CompileProc *) NULL,		1},
+    {"scan",		Tcl_ScanCmd,		(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		1},
+    {"set",		Tcl_SetCmd,		(Tcl_ObjCmdProc *) NULL,    
+        TclCompileSetCmd,		1},
+    {"split",		(Tcl_CmdProc *) NULL,	Tcl_SplitObjCmd,
+        (CompileProc *) NULL,		1},
+    {"string",		(Tcl_CmdProc *) NULL,	Tcl_StringObjCmd,
+        (CompileProc *) NULL,		1},
+    {"subst",		Tcl_SubstCmd,		(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		1},
+    {"trace",		Tcl_TraceCmd,		(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		1},
+    {"unset",		(Tcl_CmdProc *) NULL,	Tcl_UnsetObjCmd,	
+        (CompileProc *) NULL,		1},
+    {"uplevel",		(Tcl_CmdProc *) NULL,	Tcl_UplevelObjCmd,	
+        (CompileProc *) NULL,		1},
+    {"upvar",		(Tcl_CmdProc *) NULL,	Tcl_UpvarObjCmd,	
+        (CompileProc *) NULL,		1},
+    {"variable",	(Tcl_CmdProc *) NULL,	Tcl_VariableObjCmd,
+        (CompileProc *) NULL,		1},
+    {"while",		Tcl_WhileCmd,		(Tcl_ObjCmdProc *) NULL,    
+        TclCompileWhileCmd,		1},
+
+    {NULL,		(Tcl_CmdProc *) NULL,	(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		0}
+};
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateInterp --
+ *
+ *	Create a new TCL command interpreter.
+ *
+ * Results:
+ *	The return value is a token for the interpreter, which may be
+ *	used in calls to procedures like Tcl_CreateCmd, Tcl_Eval, or
+ *	Tcl_DeleteInterp.
+ *
+ * Side effects:
+ *	The command interpreter is initialized with an empty variable
+ *	table and the built-in commands.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Interp *
+Tcl_CreateInterp()
+{
+    register Interp *iPtr;
+    register Command *cmdPtr;
+    register CmdInfo *cmdInfoPtr;
+    union {
+	char c[sizeof(short)];
+	short s;
+    } order;
+
+    /*
+     * Panic if someone updated the CallFrame structure without
+     * also updating the Tcl_CallFrame structure (or vice versa).
+     */  
+
+    if (sizeof(Tcl_CallFrame) != sizeof(CallFrame)) {
+	/*NOTREACHED*/
+        panic("Tcl_CallFrame and CallFrame are not the same size");
+    }
+
+    /*
+     * Initialize support for namespaces and create the global namespace
+     * (whose name is ""; an alias is "::"). This also initializes the
+     * Tcl object type table and other object management code.
+     */
+
+    TclInitNamespaces();
+    
+    iPtr = (Interp *) ckalloc(sizeof(Interp));
+    iPtr->result = iPtr->resultSpace;
+    iPtr->freeProc = 0;
+    iPtr->objResultPtr = Tcl_NewObj(); /* an empty object */
+    Tcl_IncrRefCount(iPtr->objResultPtr);
+    iPtr->errorLine = 0;
+    Tcl_InitHashTable(&iPtr->mathFuncTable, TCL_STRING_KEYS);
+    iPtr->numLevels = 0;
+    iPtr->maxNestingDepth = 1000;
+    iPtr->framePtr = NULL;
+    iPtr->varFramePtr = NULL;
+    iPtr->activeTracePtr = NULL;
+    iPtr->returnCode = TCL_OK;
+    iPtr->errorInfo = NULL;
+    iPtr->errorCode = NULL;
+    iPtr->appendResult = NULL;
+    iPtr->appendAvl = 0;
+    iPtr->appendUsed = 0;
+    iPtr->cmdCount = 0;
+    iPtr->termOffset = 0;
+    iPtr->compileEpoch = 0;
+    iPtr->compiledProcPtr = NULL;
+    iPtr->resolverPtr = NULL;
+    iPtr->evalFlags = 0;
+    iPtr->scriptFile = NULL;
+    iPtr->flags = 0;
+    iPtr->tracePtr = NULL;
+    iPtr->assocData = (Tcl_HashTable *) NULL;
+    iPtr->execEnvPtr = NULL;	      /* set after namespaces initialized */
+    iPtr->emptyObjPtr = Tcl_NewObj(); /* another empty object */
+    Tcl_IncrRefCount(iPtr->emptyObjPtr);
+    iPtr->resultSpace[0] = 0;
+
+    iPtr->globalNsPtr = NULL;	/* force creation of global ns below */
+    iPtr->globalNsPtr = (Namespace *) Tcl_CreateNamespace(
+	    (Tcl_Interp *) iPtr, "", (ClientData) NULL,
+	    (Tcl_NamespaceDeleteProc *) NULL);
+    if (iPtr->globalNsPtr == NULL) {
+        panic("Tcl_CreateInterp: can't create global namespace");
+    }
+
+    /*
+     * Initialize support for code compilation. Do this after initializing
+     * namespaces since TclCreateExecEnv will try to reference a Tcl
+     * variable (it links to the Tcl "tcl_traceExec" variable).
+     */
+    
+    iPtr->execEnvPtr = TclCreateExecEnv((Tcl_Interp *) iPtr);
+
+    /*
+     * Create the core commands. Do it here, rather than calling
+     * Tcl_CreateCommand, because it's faster (there's no need to check for
+     * a pre-existing command by the same name). If a command has a
+     * Tcl_CmdProc but no Tcl_ObjCmdProc, set the Tcl_ObjCmdProc to
+     * TclInvokeStringCommand. This is an object-based wrapper procedure
+     * that extracts strings, calls the string procedure, and creates an
+     * object for the result. Similarly, if a command has a Tcl_ObjCmdProc
+     * but no Tcl_CmdProc, set the Tcl_CmdProc to TclInvokeObjectCommand.
+     */
+
+    for (cmdInfoPtr = builtInCmds;  cmdInfoPtr->name != NULL;
+	    cmdInfoPtr++) {
+	int new;
+	Tcl_HashEntry *hPtr;
+
+	if ((cmdInfoPtr->proc == (Tcl_CmdProc *) NULL)
+	        && (cmdInfoPtr->objProc == (Tcl_ObjCmdProc *) NULL)
+	        && (cmdInfoPtr->compileProc == (CompileProc *) NULL)) {
+	    panic("Tcl_CreateInterp: builtin command with NULL string and object command procs and a NULL compile proc\n");
+	}
+	
+	hPtr = Tcl_CreateHashEntry(&iPtr->globalNsPtr->cmdTable,
+	        cmdInfoPtr->name, &new);
+	if (new) {
+	    cmdPtr = (Command *) ckalloc(sizeof(Command));
+	    cmdPtr->hPtr = hPtr;
+	    cmdPtr->nsPtr = iPtr->globalNsPtr;
+	    cmdPtr->refCount = 1;
+	    cmdPtr->cmdEpoch = 0;
+	    cmdPtr->compileProc = cmdInfoPtr->compileProc;
+	    if (cmdInfoPtr->proc == (Tcl_CmdProc *) NULL) {
+		cmdPtr->proc = TclInvokeObjectCommand;
+		cmdPtr->clientData = (ClientData) cmdPtr;
+	    } else {
+		cmdPtr->proc = cmdInfoPtr->proc;
+		cmdPtr->clientData = (ClientData) NULL;
+	    }
+	    if (cmdInfoPtr->objProc == (Tcl_ObjCmdProc *) NULL) {
+		cmdPtr->objProc = TclInvokeStringCommand;
+		cmdPtr->objClientData = (ClientData) cmdPtr;
+	    } else {
+		cmdPtr->objProc = cmdInfoPtr->objProc;
+		cmdPtr->objClientData = (ClientData) NULL;
+	    }
+	    cmdPtr->deleteProc = NULL;
+	    cmdPtr->deleteData = (ClientData) NULL;
+	    cmdPtr->deleted = 0;
+	    cmdPtr->importRefPtr = NULL;
+	    Tcl_SetHashValue(hPtr, cmdPtr);
+	}
+    }
+
+    /*
+     *  Initialize/Create "errorInfo" and "errorCode" global vars
+     *  (because some part of the C code assume they exists
+     *   and we can get a seg fault otherwise (in multiple 
+     *   interps loading of extensions for instance) --dl)
+     */
+     /*
+      *  We can't assume that because we initialize 
+      *  the variables here, they won't be unset later.
+      *  so we had 2 choices:
+      *    + Check every place where a GetVar of those is used 
+      *      and the NULL result is not checked (like in tclLoad.c)
+      *    + Make SetVar,... NULL friendly
+      *  We choosed the second option because :
+      *    + It is easy and low cost to check for NULL pointer before
+      *      calling strlen()
+      *    + It can be helpfull to other people using those API
+      *    + Passing a NULL value to those closest 'meaning' is empty string
+      *      (specially with the new objects where 0 bytes strings are ok)
+      * So the following init is commented out:              -- dl
+      */
+    /*
+      (void)Tcl_SetVar2((Tcl_Interp *)iPtr, "errorInfo", (char *) NULL, "",
+         TCL_GLOBAL_ONLY);
+      (void)Tcl_SetVar2((Tcl_Interp *)iPtr, "errorCode", (char *) NULL, "NONE",
+	    TCL_GLOBAL_ONLY);
+     */
+
+    /*
+     * Set up variables such as tcl_version.
+     */
+
+    Tcl_SetVar((Tcl_Interp *) iPtr, "tcl_patchLevel", TCL_PATCH_LEVEL,
+	    TCL_GLOBAL_ONLY);
+    Tcl_SetVar((Tcl_Interp *) iPtr, "tcl_version", TCL_VERSION,
+	    TCL_GLOBAL_ONLY);
+    Tcl_TraceVar2((Tcl_Interp *) iPtr, "tcl_precision", (char *) NULL,
+	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+	    TclPrecTraceProc, (ClientData) NULL);
+
+    /*
+     * Compute the byte order of this machine.
+     */
+
+    order.s = 1;
+    Tcl_SetVar2((Tcl_Interp *) iPtr, "tcl_platform", "byteOrder",
+	    (order.c[0] == 1) ? "littleEndian" : "bigEndian",
+	    TCL_GLOBAL_ONLY);
+    
+    return (Tcl_Interp *) iPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tcl_CallWhenDeleted --
+ *
+ *	Arrange for a procedure to be called before a given
+ *	interpreter is deleted. The procedure is called as soon
+ *	as Tcl_DeleteInterp is called; if Tcl_CallWhenDeleted is
+ *	called on an interpreter that has already been deleted,
+ *	the procedure will be called when the last Tcl_Release is
+ *	done on the interpreter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	When Tcl_DeleteInterp is invoked to delete interp,
+ *	proc will be invoked.  See the manual entry for
+ *	details.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tcl_CallWhenDeleted(interp, proc, clientData)
+    Tcl_Interp *interp;		/* Interpreter to watch. */
+    Tcl_InterpDeleteProc *proc;	/* Procedure to call when interpreter
+				 * is about to be deleted. */
+    ClientData clientData;	/* One-word value to pass to proc. */
+{
+    Interp *iPtr = (Interp *) interp;
+    static int assocDataCounter = 0;
+    int new;
+    char buffer[128];
+    AssocData *dPtr = (AssocData *) ckalloc(sizeof(AssocData));
+    Tcl_HashEntry *hPtr;
+
+    sprintf(buffer, "Assoc Data Key #%d", assocDataCounter);
+    assocDataCounter++;
+
+    if (iPtr->assocData == (Tcl_HashTable *) NULL) {
+        iPtr->assocData = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+        Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
+    }
+    hPtr = Tcl_CreateHashEntry(iPtr->assocData, buffer, &new);
+    dPtr->proc = proc;
+    dPtr->clientData = clientData;
+    Tcl_SetHashValue(hPtr, dPtr);
+}
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tcl_DontCallWhenDeleted --
+ *
+ *	Cancel the arrangement for a procedure to be called when
+ *	a given interpreter is deleted.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	If proc and clientData were previously registered as a
+ *	callback via Tcl_CallWhenDeleted, they are unregistered.
+ *	If they weren't previously registered then nothing
+ *	happens.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tcl_DontCallWhenDeleted(interp, proc, clientData)
+    Tcl_Interp *interp;		/* Interpreter to watch. */
+    Tcl_InterpDeleteProc *proc;	/* Procedure to call when interpreter
+				 * is about to be deleted. */
+    ClientData clientData;	/* One-word value to pass to proc. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_HashTable *hTablePtr;
+    Tcl_HashSearch hSearch;
+    Tcl_HashEntry *hPtr;
+    AssocData *dPtr;
+
+    hTablePtr = iPtr->assocData;
+    if (hTablePtr == (Tcl_HashTable *) NULL) {
+        return;
+    }
+    for (hPtr = Tcl_FirstHashEntry(hTablePtr, &hSearch); hPtr != NULL;
+	    hPtr = Tcl_NextHashEntry(&hSearch)) {
+        dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
+        if ((dPtr->proc == proc) && (dPtr->clientData == clientData)) {
+            ckfree((char *) dPtr);
+            Tcl_DeleteHashEntry(hPtr);
+            return;
+        }
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetAssocData --
+ *
+ *	Creates a named association between user-specified data, a delete
+ *	function and this interpreter. If the association already exists
+ *	the data is overwritten with the new data. The delete function will
+ *	be invoked when the interpreter is deleted.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Sets the associated data, creates the association if needed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetAssocData(interp, name, proc, clientData)
+    Tcl_Interp *interp;		/* Interpreter to associate with. */
+    char *name;			/* Name for association. */
+    Tcl_InterpDeleteProc *proc;	/* Proc to call when interpreter is
+                                 * about to be deleted. */
+    ClientData clientData;	/* One-word value to pass to proc. */
+{
+    Interp *iPtr = (Interp *) interp;
+    AssocData *dPtr;
+    Tcl_HashEntry *hPtr;
+    int new;
+
+    if (iPtr->assocData == (Tcl_HashTable *) NULL) {
+        iPtr->assocData = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+        Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
+    }
+    hPtr = Tcl_CreateHashEntry(iPtr->assocData, name, &new);
+    if (new == 0) {
+        dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
+    } else {
+        dPtr = (AssocData *) ckalloc(sizeof(AssocData));
+    }
+    dPtr->proc = proc;
+    dPtr->clientData = clientData;
+
+    Tcl_SetHashValue(hPtr, dPtr);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteAssocData --
+ *
+ *	Deletes a named association of user-specified data with
+ *	the specified interpreter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Deletes the association.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DeleteAssocData(interp, name)
+    Tcl_Interp *interp;			/* Interpreter to associate with. */
+    char *name;				/* Name of association. */
+{
+    Interp *iPtr = (Interp *) interp;
+    AssocData *dPtr;
+    Tcl_HashEntry *hPtr;
+
+    if (iPtr->assocData == (Tcl_HashTable *) NULL) {
+        return;
+    }
+    hPtr = Tcl_FindHashEntry(iPtr->assocData, name);
+    if (hPtr == (Tcl_HashEntry *) NULL) {
+        return;
+    }
+    dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
+    if (dPtr->proc != NULL) {
+        (dPtr->proc) (dPtr->clientData, interp);
+    }
+    ckfree((char *) dPtr);
+    Tcl_DeleteHashEntry(hPtr);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetAssocData --
+ *
+ *	Returns the client data associated with this name in the
+ *	specified interpreter.
+ *
+ * Results:
+ *	The client data in the AssocData record denoted by the named
+ *	association, or NULL.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ClientData
+Tcl_GetAssocData(interp, name, procPtr)
+    Tcl_Interp *interp;			/* Interpreter associated with. */
+    char *name;				/* Name of association. */
+    Tcl_InterpDeleteProc **procPtr;	/* Pointer to place to store address
+					 * of current deletion callback. */
+{
+    Interp *iPtr = (Interp *) interp;
+    AssocData *dPtr;
+    Tcl_HashEntry *hPtr;
+
+    if (iPtr->assocData == (Tcl_HashTable *) NULL) {
+        return (ClientData) NULL;
+    }
+    hPtr = Tcl_FindHashEntry(iPtr->assocData, name);
+    if (hPtr == (Tcl_HashEntry *) NULL) {
+        return (ClientData) NULL;
+    }
+    dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
+    if (procPtr != (Tcl_InterpDeleteProc **) NULL) {
+        *procPtr = dPtr->proc;
+    }
+    return dPtr->clientData;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteInterpProc --
+ *
+ *	Helper procedure to delete an interpreter. This procedure is
+ *	called when the last call to Tcl_Preserve on this interpreter
+ *	is matched by a call to Tcl_Release. The procedure cleans up
+ *	all resources used in the interpreter and calls all currently
+ *	registered interpreter deletion callbacks.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Whatever the interpreter deletion callbacks do. Frees resources
+ *	used by the interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteInterpProc(interp)
+    Tcl_Interp *interp;			/* Interpreter to delete. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_HashEntry *hPtr;
+    Tcl_HashSearch search;
+    Tcl_HashTable *hTablePtr;
+    AssocData *dPtr;
+    ResolverScheme *resPtr, *nextResPtr;
+
+    /*
+     * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup.
+     */
+    
+    if (iPtr->numLevels > 0) {
+        panic("DeleteInterpProc called with active evals");
+    }
+
+    /*
+     * The interpreter should already be marked deleted; otherwise how
+     * did we get here?
+     */
+
+    if (!(iPtr->flags & DELETED)) {
+        panic("DeleteInterpProc called on interpreter not marked deleted");
+    }
+
+    /*
+     * Dismantle everything in the global namespace except for the
+     * "errorInfo" and "errorCode" variables. These remain until the
+     * namespace is actually destroyed, in case any errors occur.
+     *   
+     * Dismantle the namespace here, before we clear the assocData. If any
+     * background errors occur here, they will be deleted below.
+     */
+    
+    TclTeardownNamespace(iPtr->globalNsPtr);
+
+    /*
+     * Tear down the math function table.
+     */
+
+    for (hPtr = Tcl_FirstHashEntry(&iPtr->mathFuncTable, &search);
+	     hPtr != NULL;
+             hPtr = Tcl_NextHashEntry(&search)) {
+	ckfree((char *) Tcl_GetHashValue(hPtr));
+    }
+    Tcl_DeleteHashTable(&iPtr->mathFuncTable);
+
+    /*
+     * Invoke deletion callbacks; note that a callback can create new
+     * callbacks, so we iterate.
+     */
+
+    while (iPtr->assocData != (Tcl_HashTable *) NULL) {
+        hTablePtr = iPtr->assocData;
+        iPtr->assocData = (Tcl_HashTable *) NULL;
+        for (hPtr = Tcl_FirstHashEntry(hTablePtr, &search);
+                 hPtr != NULL;
+                 hPtr = Tcl_FirstHashEntry(hTablePtr, &search)) {
+            dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
+            Tcl_DeleteHashEntry(hPtr);
+            if (dPtr->proc != NULL) {
+                (*dPtr->proc)(dPtr->clientData, interp);
+            }
+            ckfree((char *) dPtr);
+        }
+        Tcl_DeleteHashTable(hTablePtr);
+        ckfree((char *) hTablePtr);
+    }
+
+    /*
+     * Finish deleting the global namespace.
+     */
+    
+    Tcl_DeleteNamespace((Tcl_Namespace *) iPtr->globalNsPtr);
+
+    /*
+     * Free up the result *after* deleting variables, since variable
+     * deletion could have transferred ownership of the result string
+     * to Tcl.
+     */
+
+    Tcl_FreeResult(interp);
+    interp->result = NULL;
+    Tcl_DecrRefCount(iPtr->objResultPtr);
+    iPtr->objResultPtr = NULL;
+    if (iPtr->errorInfo != NULL) {
+	ckfree(iPtr->errorInfo);
+        iPtr->errorInfo = NULL;
+    }
+    if (iPtr->errorCode != NULL) {
+	ckfree(iPtr->errorCode);
+        iPtr->errorCode = NULL;
+    }
+    if (iPtr->appendResult != NULL) {
+	ckfree(iPtr->appendResult);
+        iPtr->appendResult = NULL;
+    }
+    while (iPtr->tracePtr != NULL) {
+	Trace *nextPtr = iPtr->tracePtr->nextPtr;
+
+	ckfree((char *) iPtr->tracePtr);
+	iPtr->tracePtr = nextPtr;
+    }
+    if (iPtr->execEnvPtr != NULL) {
+	TclDeleteExecEnv(iPtr->execEnvPtr);
+    }
+    Tcl_DecrRefCount(iPtr->emptyObjPtr);
+    iPtr->emptyObjPtr = NULL;
+
+    resPtr = iPtr->resolverPtr;
+    while (resPtr) {
+	nextResPtr = resPtr->nextPtr;
+	ckfree(resPtr->name);
+	ckfree((char *) resPtr);
+        resPtr = nextResPtr;
+    }
+    
+    ckfree((char *) iPtr);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_InterpDeleted --
+ *
+ *	Returns nonzero if the interpreter has been deleted with a call
+ *	to Tcl_DeleteInterp.
+ *
+ * Results:
+ *	Nonzero if the interpreter is deleted, zero otherwise.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_InterpDeleted(interp)
+    Tcl_Interp *interp;
+{
+    return (((Interp *) interp)->flags & DELETED) ? 1 : 0;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteInterp --
+ *
+ *	Ensures that the interpreter will be deleted eventually. If there
+ *	are no Tcl_Preserve calls in effect for this interpreter, it is
+ *	deleted immediately, otherwise the interpreter is deleted when
+ *	the last Tcl_Preserve is matched by a call to Tcl_Release. In either
+ *	case, the procedure runs the currently registered deletion callbacks. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The interpreter is marked as deleted. The caller may still use it
+ *	safely if there are calls to Tcl_Preserve in effect for the
+ *	interpreter, but further calls to Tcl_Eval etc in this interpreter
+ *	will fail.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DeleteInterp(interp)
+    Tcl_Interp *interp;		/* Token for command interpreter (returned
+				 * by a previous call to Tcl_CreateInterp). */
+{
+    Interp *iPtr = (Interp *) interp;
+
+    /*
+     * If the interpreter has already been marked deleted, just punt.
+     */
+
+    if (iPtr->flags & DELETED) {
+        return;
+    }
+    
+    /*
+     * Mark the interpreter as deleted. No further evals will be allowed.
+     */
+
+    iPtr->flags |= DELETED;
+
+    /*
+     * Ensure that the interpreter is eventually deleted.
+     */
+
+    Tcl_EventuallyFree((ClientData) interp,
+            (Tcl_FreeProc *) DeleteInterpProc);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * HiddenCmdsDeleteProc --
+ *
+ *	Called on interpreter deletion to delete all the hidden
+ *	commands in an interpreter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Frees up memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+HiddenCmdsDeleteProc(clientData, interp)
+    ClientData clientData;		/* The hidden commands hash table. */
+    Tcl_Interp *interp;			/* The interpreter being deleted. */
+{
+    Tcl_HashTable *hiddenCmdTblPtr;
+    Tcl_HashEntry *hPtr;
+    Tcl_HashSearch hSearch;
+    Command *cmdPtr;
+
+    hiddenCmdTblPtr = (Tcl_HashTable *) clientData;
+    for (hPtr = Tcl_FirstHashEntry(hiddenCmdTblPtr, &hSearch);
+	     hPtr != NULL;
+             hPtr = Tcl_FirstHashEntry(hiddenCmdTblPtr, &hSearch)) {
+
+        /*
+         * Cannot use Tcl_DeleteCommand because (a) the command is not
+         * in the command hash table, and (b) that table has already been
+         * deleted above. Hence we emulate what it does, below.
+         */
+        
+        cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+
+	/*
+         * The code here is tricky.  We can't delete the hash table entry
+         * before invoking the deletion callback because there are cases
+         * where the deletion callback needs to invoke the command (e.g.
+         * object systems such as OTcl).  However, this means that the
+         * callback could try to delete or rename the command.  The deleted
+         * flag allows us to detect these cases and skip nested deletes.
+         */
+
+        if (cmdPtr->deleted) {
+
+	    /*
+             * Another deletion is already in progress.  Remove the hash
+             * table entry now, but don't invoke a callback or free the
+             * command structure.
+             */
+
+            Tcl_DeleteHashEntry(cmdPtr->hPtr);
+            cmdPtr->hPtr = NULL;
+            continue;
+        }
+        cmdPtr->deleted = 1;
+        if (cmdPtr->deleteProc != NULL) {
+            (*cmdPtr->deleteProc)(cmdPtr->deleteData);
+        }
+
+	/*
+	 * Bump the command epoch counter. This will invalidate all cached
+         * references that refer to this command.
+	 */
+	
+        cmdPtr->cmdEpoch++;
+
+	/*
+         * Don't use hPtr to delete the hash entry here, because it's
+         * possible that the deletion callback renamed the command.
+         * Instead, use cmdPtr->hptr, and make sure that no-one else
+         * has already deleted the hash entry.
+         */
+
+        if (cmdPtr->hPtr != NULL) {
+            Tcl_DeleteHashEntry(cmdPtr->hPtr);
+        }
+	
+        /*
+	 * Now free the Command structure, unless there is another reference
+	 * to it from a CmdName Tcl object in some ByteCode code
+	 * sequence. In that case, delay the cleanup until all references
+	 * are either discarded (when a ByteCode is freed) or replaced by a
+	 * new reference (when a cached CmdName Command reference is found
+	 * to be invalid and TclExecuteByteCode looks up the command in the
+	 * command hashtable).
+	 */
+	
+	TclCleanupCommand(cmdPtr);
+    }
+    Tcl_DeleteHashTable(hiddenCmdTblPtr);
+    ckfree((char *) hiddenCmdTblPtr);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_HideCommand --
+ *
+ *	Makes a command hidden so that it cannot be invoked from within
+ *	an interpreter, only from within an ancestor.
+ *
+ * Results:
+ *	A standard Tcl result; also leaves a message in interp->result
+ *	if an error occurs.
+ *
+ * Side effects:
+ *	Removes a command from the command table and create an entry
+ *      into the hidden command table under the specified token name.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_HideCommand(interp, cmdName, hiddenCmdToken)
+    Tcl_Interp *interp;		/* Interpreter in which to hide command. */
+    char *cmdName;		/* Name of command to hide. */
+    char *hiddenCmdToken;	/* Token name of the to-be-hidden command. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_Command cmd;
+    Command *cmdPtr;
+    Tcl_HashTable *hTblPtr;
+    Tcl_HashEntry *hPtr;
+    int new;
+
+    if (iPtr->flags & DELETED) {
+
+        /*
+         * The interpreter is being deleted. Do not create any new
+         * structures, because it is not safe to modify the interpreter.
+         */
+        
+        return TCL_ERROR;
+    }
+
+    /*
+     * Disallow hiding of commands that are currently in a namespace or
+     * renaming (as part of hiding) into a namespace.
+     *
+     * (because the current implementation with a single global table
+     *  and the needed uniqueness of names cause problems with namespaces)
+     *
+     * we don't need to check for "::" in cmdName because the real check is
+     * on the nsPtr below.
+     *
+     * hiddenCmdToken is just a string which is not interpreted in any way.
+     * It may contain :: but the string is not interpreted as a namespace
+     * qualifier command name. Thus, hiding foo::bar to foo::bar and then
+     * trying to expose or invoke ::foo::bar will NOT work; but if the
+     * application always uses the same strings it will get consistent
+     * behaviour.
+     *
+     * But as we currently limit ourselves to the global namespace only
+     * for the source, in order to avoid potential confusion,
+     * lets prevent "::" in the token too.  --dl
+     */
+
+    if (strstr(hiddenCmdToken, "::") != NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "cannot use namespace qualifiers as hidden command",
+		"token (rename)", (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    /*
+     * Find the command to hide. An error is returned if cmdName can't
+     * be found. Look up the command only from the global namespace.
+     * Full path of the command must be given if using namespaces.
+     */
+
+    cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
+	    /*flags*/ TCL_LEAVE_ERR_MSG | TCL_GLOBAL_ONLY);
+    if (cmd == (Tcl_Command) NULL) {
+	return TCL_ERROR;
+    }
+    cmdPtr = (Command *) cmd;
+
+    /*
+     * Check that the command is really in global namespace
+     */
+
+    if ( cmdPtr->nsPtr != iPtr->globalNsPtr ) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "can only hide global namespace commands",
+		" (use rename then hide)", (char *) NULL);
+        return TCL_ERROR;
+    }
+    
+    /*
+     * Initialize the hidden command table if necessary.
+     */
+
+    hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclHiddenCmds",
+            NULL);
+    if (hTblPtr == (Tcl_HashTable *) NULL) {
+        hTblPtr = (Tcl_HashTable *)
+	        ckalloc((unsigned) sizeof(Tcl_HashTable));
+        Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);
+        Tcl_SetAssocData(interp, "tclHiddenCmds", HiddenCmdsDeleteProc,
+                (ClientData) hTblPtr);
+    }
+
+    /*
+     * It is an error to move an exposed command to a hidden command with
+     * hiddenCmdToken if a hidden command with the name hiddenCmdToken already
+     * exists.
+     */
+    
+    hPtr = Tcl_CreateHashEntry(hTblPtr, hiddenCmdToken, &new);
+    if (!new) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "hidden command named \"", hiddenCmdToken, "\" already exists",
+                (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    /*
+     * Nb : This code is currently 'like' a rename to a specialy set apart
+     * name table. Changes here and in TclRenameCommand must
+     * be kept in synch untill the common parts are actually
+     * factorized out.
+     */
+
+    /*
+     * Remove the hash entry for the command from the interpreter command
+     * table. This is like deleting the command, so bump its command epoch;
+     * this invalidates any cached references that point to the command.
+     */
+
+    if (cmdPtr->hPtr != NULL) {
+        Tcl_DeleteHashEntry(cmdPtr->hPtr);
+        cmdPtr->hPtr = (Tcl_HashEntry *) NULL;
+	cmdPtr->cmdEpoch++;
+    }
+
+    /*
+     * Now link the hash table entry with the command structure.
+     * We ensured above that the nsPtr was right.
+     */
+    
+    cmdPtr->hPtr = hPtr;
+    Tcl_SetHashValue(hPtr, (ClientData) cmdPtr);
+
+    /*
+     * If the command being hidden has a compile procedure, increment the
+     * interpreter's compileEpoch to invalidate its compiled code. This
+     * makes sure that we don't later try to execute old code compiled with
+     * command-specific (i.e., inline) bytecodes for the now-hidden
+     * command. This field is checked in Tcl_EvalObj and ObjInterpProc,
+     * and code whose compilation epoch doesn't match is recompiled.
+     */
+
+    if (cmdPtr->compileProc != NULL) {
+	iPtr->compileEpoch++;
+    }
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ExposeCommand --
+ *
+ *	Makes a previously hidden command callable from inside the
+ *	interpreter instead of only by its ancestors.
+ *
+ * Results:
+ *	A standard Tcl result. If an error occurs, a message is left
+ *	in interp->result.
+ *
+ * Side effects:
+ *	Moves commands from one hash table to another.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ExposeCommand(interp, hiddenCmdToken, cmdName)
+    Tcl_Interp *interp;		/* Interpreter in which to make command
+                                 * callable. */
+    char *hiddenCmdToken;	/* Name of hidden command. */
+    char *cmdName;		/* Name of to-be-exposed command. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Command *cmdPtr;
+    Namespace *nsPtr;
+    Tcl_HashEntry *hPtr;
+    Tcl_HashTable *hTblPtr;
+    int new;
+
+    if (iPtr->flags & DELETED) {
+        /*
+         * The interpreter is being deleted. Do not create any new
+         * structures, because it is not safe to modify the interpreter.
+         */
+        
+        return TCL_ERROR;
+    }
+
+    /*
+     * Check that we have a regular name for the command
+     * (that the user is not trying to do an expose and a rename
+     *  (to another namespace) at the same time)
+     */
+
+    if (strstr(cmdName, "::") != NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "can not expose to a namespace ",
+		"(use expose to toplevel, then rename)",
+                 (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    /*
+     * Find the hash table for the hidden commands; error out if there
+     * is none.
+     */
+
+    hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclHiddenCmds",
+            NULL);
+    if (hTblPtr == NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "unknown hidden command \"", hiddenCmdToken,
+                "\"", (char *) NULL);
+        return TCL_ERROR;
+    }
+        
+    /*
+     * Get the command from the hidden command table:
+     */
+
+    hPtr = Tcl_FindHashEntry(hTblPtr, hiddenCmdToken);
+    if (hPtr == (Tcl_HashEntry *) NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "unknown hidden command \"", hiddenCmdToken,
+                "\"", (char *) NULL);
+        return TCL_ERROR;
+    }
+    cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+    
+
+    /*
+     * Check that we have a true global namespace
+     * command (enforced by Tcl_HideCommand() but let's double
+     * check. (If it was not, we would not really know how to
+     * handle it).
+     */
+    if ( cmdPtr->nsPtr != iPtr->globalNsPtr ) {
+	/* 
+	 * This case is theoritically impossible,
+	 * we might rather panic() than 'nicely' erroring out ?
+	 */
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "trying to expose a non global command name space command",
+		(char *) NULL);
+        return TCL_ERROR;
+    }
+    
+    /* This is the global table */
+    nsPtr = cmdPtr->nsPtr;
+
+    /*
+     * It is an error to overwrite an existing exposed command as a result
+     * of exposing a previously hidden command.
+     */
+
+    hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &new);
+    if (!new) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "exposed command \"", cmdName,
+                "\" already exists", (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    /*
+     * Remove the hash entry for the command from the interpreter hidden
+     * command table.
+     */
+
+    if (cmdPtr->hPtr != NULL) {
+        Tcl_DeleteHashEntry(cmdPtr->hPtr);
+        cmdPtr->hPtr = NULL;
+    }
+
+    /*
+     * Now link the hash table entry with the command structure.
+     * This is like creating a new command, so deal with any shadowing
+     * of commands in the global namespace.
+     */
+    
+    cmdPtr->hPtr = hPtr;
+
+    Tcl_SetHashValue(hPtr, (ClientData) cmdPtr);
+
+    /*
+     * Not needed as we are only in the global namespace
+     * (but would be needed again if we supported namespace command hiding)
+     *
+     * TclResetShadowedCmdRefs(interp, cmdPtr);
+     */
+
+
+    /*
+     * If the command being exposed has a compile procedure, increment
+     * interpreter's compileEpoch to invalidate its compiled code. This
+     * makes sure that we don't later try to execute old code compiled
+     * assuming the command is hidden. This field is checked in Tcl_EvalObj
+     * and ObjInterpProc, and code whose compilation epoch doesn't match is
+     * recompiled.
+     */
+
+    if (cmdPtr->compileProc != NULL) {
+	iPtr->compileEpoch++;
+    }
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateCommand --
+ *
+ *	Define a new command in a command table.
+ *
+ * Results:
+ *	The return value is a token for the command, which can
+ *	be used in future calls to Tcl_GetCommandName.
+ *
+ * Side effects:
+ *	If a command named cmdName already exists for interp, it is deleted.
+ *	In the future, when cmdName is seen as the name of a command by
+ *	Tcl_Eval, proc will be called. To support the bytecode interpreter,
+ *	the command is created with a wrapper Tcl_ObjCmdProc
+ *	(TclInvokeStringCommand) that eventially calls proc. When the
+ *	command is deleted from the table, deleteProc will be called.
+ *	See the manual entry for details on the calling sequence.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Command
+Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
+    Tcl_Interp *interp;		/* Token for command interpreter returned by
+				 * a previous call to Tcl_CreateInterp. */
+    char *cmdName;		/* Name of command. If it contains namespace
+				 * qualifiers, the new command is put in the
+				 * specified namespace; otherwise it is put
+				 * in the global namespace. */
+    Tcl_CmdProc *proc;		/* Procedure to associate with cmdName. */
+    ClientData clientData;	/* Arbitrary value passed to string proc. */
+    Tcl_CmdDeleteProc *deleteProc;
+				/* If not NULL, gives a procedure to call
+				 * when this command is deleted. */
+{
+    Interp *iPtr = (Interp *) interp;
+    ImportRef *oldRefPtr = NULL;
+    Namespace *nsPtr, *dummy1, *dummy2;
+    Command *cmdPtr, *refCmdPtr;
+    Tcl_HashEntry *hPtr;
+    char *tail;
+    int new;
+    ImportedCmdData *dataPtr;
+
+    if (iPtr->flags & DELETED) {
+	/*
+	 * The interpreter is being deleted.  Don't create any new
+	 * commands; it's not safe to muck with the interpreter anymore.
+	 */
+
+	return (Tcl_Command) NULL;
+    }
+
+    /*
+     * Determine where the command should reside. If its name contains 
+     * namespace qualifiers, we put it in the specified namespace; 
+     * otherwise, we always put it in the global namespace.
+     */
+
+    if (strstr(cmdName, "::") != NULL) {
+       TclGetNamespaceForQualName(interp, cmdName, (Namespace *) NULL,
+           CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
+       if ((nsPtr == NULL) || (tail == NULL)) {
+	    return (Tcl_Command) NULL;
+	}
+    } else {
+	nsPtr = iPtr->globalNsPtr;
+	tail = cmdName;
+    }
+    
+    hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new);
+    if (!new) {
+	/*
+	 * Command already exists. Delete the old one.
+	 * Be careful to preserve any existing import links so we can
+	 * restore them down below.  That way, you can redefine a
+	 * command and its import status will remain intact.
+	 */
+
+	cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+	oldRefPtr = cmdPtr->importRefPtr;
+	cmdPtr->importRefPtr = NULL;
+
+	Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
+	hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new);
+	if (!new) {
+	    /*
+	     * If the deletion callback recreated the command, just throw
+             * away the new command (if we try to delete it again, we
+             * could get stuck in an infinite loop).
+	     */
+
+	     ckfree((char*) cmdPtr);
+	}
+    }
+    cmdPtr = (Command *) ckalloc(sizeof(Command));
+    Tcl_SetHashValue(hPtr, cmdPtr);
+    cmdPtr->hPtr = hPtr;
+    cmdPtr->nsPtr = nsPtr;
+    cmdPtr->refCount = 1;
+    cmdPtr->cmdEpoch = 0;
+    cmdPtr->compileProc = (CompileProc *) NULL;
+    cmdPtr->objProc = TclInvokeStringCommand;
+    cmdPtr->objClientData = (ClientData) cmdPtr;
+    cmdPtr->proc = proc;
+    cmdPtr->clientData = clientData;
+    cmdPtr->deleteProc = deleteProc;
+    cmdPtr->deleteData = clientData;
+    cmdPtr->deleted = 0;
+    cmdPtr->importRefPtr = NULL;
+
+    /*
+     * Plug in any existing import references found above.  Be sure
+     * to update all of these references to point to the new command.
+     */
+
+    if (oldRefPtr != NULL) {
+	cmdPtr->importRefPtr = oldRefPtr;
+	while (oldRefPtr != NULL) {
+	    refCmdPtr = oldRefPtr->importedCmdPtr;
+	    dataPtr = (ImportedCmdData*)refCmdPtr->objClientData;
+	    dataPtr->realCmdPtr = cmdPtr;
+	    oldRefPtr = oldRefPtr->nextPtr;
+	}
+    }
+
+    /*
+     * We just created a command, so in its namespace and all of its parent
+     * namespaces, it may shadow global commands with the same name. If any
+     * shadowed commands are found, invalidate all cached command references
+     * in the affected namespaces.
+     */
+    
+    TclResetShadowedCmdRefs(interp, cmdPtr);
+    return (Tcl_Command) cmdPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateObjCommand --
+ *
+ *	Define a new object-based command in a command table.
+ *
+ * Results:
+ *	The return value is a token for the command, which can
+ *	be used in future calls to Tcl_NameOfCommand.
+ *
+ * Side effects:
+ *	If no command named "cmdName" already exists for interp, one is
+ *	created. Otherwise, if a command does exist, then if the
+ *	object-based Tcl_ObjCmdProc is TclInvokeStringCommand, we assume
+ *	Tcl_CreateCommand was called previously for the same command and
+ *	just set its Tcl_ObjCmdProc to the argument "proc"; otherwise, we
+ *	delete the old command.
+ *
+ *	In the future, during bytecode evaluation when "cmdName" is seen as
+ *	the name of a command by Tcl_EvalObj or Tcl_Eval, the object-based
+ *	Tcl_ObjCmdProc proc will be called. When the command is deleted from
+ *	the table, deleteProc will be called. See the manual entry for
+ *	details on the calling sequence.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Command
+Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc)
+    Tcl_Interp *interp;		/* Token for command interpreter (returned
+				 * by previous call to Tcl_CreateInterp). */
+    char *cmdName;		/* Name of command. If it contains namespace
+				 * qualifiers, the new command is put in the
+				 * specified namespace; otherwise it is put
+				 * in the global namespace. */
+    Tcl_ObjCmdProc *proc;	/* Object-based procedure to associate with
+				 * name. */
+    ClientData clientData;	/* Arbitrary value to pass to object
+    				 * procedure. */
+    Tcl_CmdDeleteProc *deleteProc;
+				/* If not NULL, gives a procedure to call
+				 * when this command is deleted. */
+{
+    Interp *iPtr = (Interp *) interp;
+    ImportRef *oldRefPtr = NULL;
+    Namespace *nsPtr, *dummy1, *dummy2;
+    Command *cmdPtr, *refCmdPtr;
+    Tcl_HashEntry *hPtr;
+    char *tail;
+    int new;
+    ImportedCmdData *dataPtr;
+
+    if (iPtr->flags & DELETED) {
+	/*
+	 * The interpreter is being deleted.  Don't create any new
+	 * commands;  it's not safe to muck with the interpreter anymore.
+	 */
+
+	return (Tcl_Command) NULL;
+    }
+
+    /*
+     * Determine where the command should reside. If its name contains 
+     * namespace qualifiers, we put it in the specified namespace; 
+     * otherwise, we always put it in the global namespace.
+     */
+
+    if (strstr(cmdName, "::") != NULL) {
+       TclGetNamespaceForQualName(interp, cmdName, (Namespace *) NULL,
+           CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
+       if ((nsPtr == NULL) || (tail == NULL)) {
+	    return (Tcl_Command) NULL;
+	}
+    } else {
+	nsPtr = iPtr->globalNsPtr;
+	tail = cmdName;
+    }
+
+    hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new);
+    if (!new) {
+	cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+
+	/*
+	 * Command already exists. If its object-based Tcl_ObjCmdProc is
+	 * TclInvokeStringCommand, we just set its Tcl_ObjCmdProc to the
+	 * argument "proc". Otherwise, we delete the old command. 
+	 */
+
+	if (cmdPtr->objProc == TclInvokeStringCommand) {
+	    cmdPtr->objProc = proc;
+	    cmdPtr->objClientData = clientData;
+            cmdPtr->deleteProc = deleteProc;
+            cmdPtr->deleteData = clientData;
+	    return (Tcl_Command) cmdPtr;
+	}
+
+	/*
+	 * Otherwise, we delete the old command.  Be careful to preserve
+	 * any existing import links so we can restore them down below.
+	 * That way, you can redefine a command and its import status
+	 * will remain intact.
+	 */
+
+	oldRefPtr = cmdPtr->importRefPtr;
+	cmdPtr->importRefPtr = NULL;
+
+	Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
+	hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new);
+	if (!new) {
+	    /*
+	     * If the deletion callback recreated the command, just throw
+	     * away the new command (if we try to delete it again, we
+	     * could get stuck in an infinite loop).
+	     */
+
+	     ckfree((char *) Tcl_GetHashValue(hPtr));
+	}
+    }
+    cmdPtr = (Command *) ckalloc(sizeof(Command));
+    Tcl_SetHashValue(hPtr, cmdPtr);
+    cmdPtr->hPtr = hPtr;
+    cmdPtr->nsPtr = nsPtr;
+    cmdPtr->refCount = 1;
+    cmdPtr->cmdEpoch = 0;
+    cmdPtr->compileProc = (CompileProc *) NULL;
+    cmdPtr->objProc = proc;
+    cmdPtr->objClientData = clientData;
+    cmdPtr->proc = TclInvokeObjectCommand;
+    cmdPtr->clientData = (ClientData) cmdPtr;
+    cmdPtr->deleteProc = deleteProc;
+    cmdPtr->deleteData = clientData;
+    cmdPtr->deleted = 0;
+    cmdPtr->importRefPtr = NULL;
+
+    /*
+     * Plug in any existing import references found above.  Be sure
+     * to update all of these references to point to the new command.
+     */
+
+    if (oldRefPtr != NULL) {
+	cmdPtr->importRefPtr = oldRefPtr;
+	while (oldRefPtr != NULL) {
+	    refCmdPtr = oldRefPtr->importedCmdPtr;
+	    dataPtr = (ImportedCmdData*)refCmdPtr->objClientData;
+	    dataPtr->realCmdPtr = cmdPtr;
+	    oldRefPtr = oldRefPtr->nextPtr;
+	}
+    }
+    
+    /*
+     * We just created a command, so in its namespace and all of its parent
+     * namespaces, it may shadow global commands with the same name. If any
+     * shadowed commands are found, invalidate all cached command references
+     * in the affected namespaces.
+     */
+    
+    TclResetShadowedCmdRefs(interp, cmdPtr);
+    return (Tcl_Command) cmdPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInvokeStringCommand --
+ *
+ *	"Wrapper" Tcl_ObjCmdProc used to call an existing string-based
+ *	Tcl_CmdProc if no object-based procedure exists for a command. A
+ *	pointer to this procedure is stored as the Tcl_ObjCmdProc in a
+ *	Command structure. It simply turns around and calls the string
+ *	Tcl_CmdProc in the Command structure.
+ *
+ * Results:
+ *	A standard Tcl object result value.
+ *
+ * Side effects:
+ *	Besides those side effects of the called Tcl_CmdProc,
+ *	TclInvokeStringCommand allocates and frees storage.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclInvokeStringCommand(clientData, interp, objc, objv)
+    ClientData clientData;	/* Points to command's Command structure. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    register int objc;		/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    register Command *cmdPtr = (Command *) clientData;
+    register int i;
+    int result;
+
+    /*
+     * This procedure generates an argv array for the string arguments. It
+     * starts out with stack-allocated space but uses dynamically-allocated
+     * storage if needed.
+     */
+
+#define NUM_ARGS 20
+    char *(argStorage[NUM_ARGS]);
+    char **argv = argStorage;
+
+    /*
+     * Create the string argument array "argv". Make sure argv is large
+     * enough to hold the objc arguments plus 1 extra for the zero
+     * end-of-argv word.
+     * THIS FAILS IF ANY ARGUMENT OBJECT CONTAINS AN EMBEDDED NULL.
+     */
+
+    if ((objc + 1) > NUM_ARGS) {
+	argv = (char **) ckalloc((unsigned)(objc + 1) * sizeof(char *));
+    }
+
+    for (i = 0;  i < objc;  i++) {
+	argv[i] = Tcl_GetStringFromObj(objv[i], (int *) NULL);
+    }
+    argv[objc] = 0;
+
+    /*
+     * Invoke the command's string-based Tcl_CmdProc.
+     */
+
+    result = (*cmdPtr->proc)(cmdPtr->clientData, interp, objc, argv);
+
+    /*
+     * Free the argv array if malloc'ed storage was used.
+     */
+
+    if (argv != argStorage) {
+	ckfree((char *) argv);
+    }
+    return result;
+#undef NUM_ARGS
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInvokeObjectCommand --
+ *
+ *	"Wrapper" Tcl_CmdProc used to call an existing object-based
+ *	Tcl_ObjCmdProc if no string-based procedure exists for a command.
+ *	A pointer to this procedure is stored as the Tcl_CmdProc in a
+ *	Command structure. It simply turns around and calls the object
+ *	Tcl_ObjCmdProc in the Command structure.
+ *
+ * Results:
+ *	A standard Tcl string result value.
+ *
+ * Side effects:
+ *	Besides those side effects of the called Tcl_CmdProc,
+ *	TclInvokeStringCommand allocates and frees storage.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclInvokeObjectCommand(clientData, interp, argc, argv)
+    ClientData clientData;	/* Points to command's Command structure. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int argc;			/* Number of arguments. */
+    register char **argv;	/* Argument strings. */
+{
+    Command *cmdPtr = (Command *) clientData;
+    register Tcl_Obj *objPtr;
+    register int i;
+    int length, result;
+
+    /*
+     * This procedure generates an objv array for object arguments that hold
+     * the argv strings. It starts out with stack-allocated space but uses
+     * dynamically-allocated storage if needed.
+     */
+
+#define NUM_ARGS 20
+    Tcl_Obj *(argStorage[NUM_ARGS]);
+    register Tcl_Obj **objv = argStorage;
+
+    /*
+     * Create the object argument array "objv". Make sure objv is large
+     * enough to hold the objc arguments plus 1 extra for the zero
+     * end-of-objv word.
+     */
+
+    if ((argc + 1) > NUM_ARGS) {
+	objv = (Tcl_Obj **)
+	    ckalloc((unsigned)(argc + 1) * sizeof(Tcl_Obj *));
+    }
+
+    for (i = 0;  i < argc;  i++) {
+	length = strlen(argv[i]);
+	TclNewObj(objPtr);
+	TclInitStringRep(objPtr, argv[i], length);
+	Tcl_IncrRefCount(objPtr);
+	objv[i] = objPtr;
+    }
+    objv[argc] = 0;
+
+    /*
+     * Invoke the command's object-based Tcl_ObjCmdProc.
+     */
+
+    result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, argc, objv);
+
+    /*
+     * Move the interpreter's object result to the string result, 
+     * then reset the object result.
+     * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULL BYTES.
+     */
+
+    Tcl_SetResult(interp,
+	    TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
+	    TCL_VOLATILE);
+    
+    /*
+     * Decrement the ref counts for the argument objects created above,
+     * then free the objv array if malloc'ed storage was used.
+     */
+
+    for (i = 0;  i < argc;  i++) {
+	objPtr = objv[i];
+	Tcl_DecrRefCount(objPtr);
+    }
+    if (objv != argStorage) {
+	ckfree((char *) objv);
+    }
+    return result;
+#undef NUM_ARGS
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetCommandInfo --
+ *
+ *	Modifies various information about a Tcl command. Note that
+ *	this procedure will not change a command's namespace; use
+ *	Tcl_RenameCommand to do that. Also, the isNativeObjectProc
+ *	member of *infoPtr is ignored.
+ *
+ * Results:
+ *	If cmdName exists in interp, then the information at *infoPtr
+ *	is stored with the command in place of the current information
+ *	and 1 is returned. If the command doesn't exist then 0 is
+ *	returned. 
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_SetCommandInfo(interp, cmdName, infoPtr)
+    Tcl_Interp *interp;			/* Interpreter in which to look
+					 * for command. */
+    char *cmdName;			/* Name of desired command. */
+    Tcl_CmdInfo *infoPtr;		/* Where to store information about
+					 * command. */
+{
+    Tcl_Command cmd;
+    Command *cmdPtr;
+
+    cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
+            /*flags*/ 0);
+    if (cmd == (Tcl_Command) NULL) {
+	return 0;
+    }
+
+    /*
+     * The isNativeObjectProc and nsPtr members of *infoPtr are ignored.
+     */
+    
+    cmdPtr = (Command *) cmd;
+    cmdPtr->proc = infoPtr->proc;
+    cmdPtr->clientData = infoPtr->clientData;
+    if (infoPtr->objProc == (Tcl_ObjCmdProc *) NULL) {
+	cmdPtr->objProc = TclInvokeStringCommand;
+	cmdPtr->objClientData = (ClientData) cmdPtr;
+    } else {
+	cmdPtr->objProc = infoPtr->objProc;
+	cmdPtr->objClientData = infoPtr->objClientData;
+    }
+    cmdPtr->deleteProc = infoPtr->deleteProc;
+    cmdPtr->deleteData = infoPtr->deleteData;
+    return 1;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetCommandInfo --
+ *
+ *	Returns various information about a Tcl command.
+ *
+ * Results:
+ *	If cmdName exists in interp, then *infoPtr is modified to
+ *	hold information about cmdName and 1 is returned.  If the
+ *	command doesn't exist then 0 is returned and *infoPtr isn't
+ *	modified.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetCommandInfo(interp, cmdName, infoPtr)
+    Tcl_Interp *interp;			/* Interpreter in which to look
+					 * for command. */
+    char *cmdName;			/* Name of desired command. */
+    Tcl_CmdInfo *infoPtr;		/* Where to store information about
+					 * command. */
+{
+    Tcl_Command cmd;
+    Command *cmdPtr;
+
+    cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
+            /*flags*/ 0);
+    if (cmd == (Tcl_Command) NULL) {
+	return 0;
+    }
+
+    /*
+     * Set isNativeObjectProc 1 if objProc was registered by a call to
+     * Tcl_CreateObjCommand. Otherwise set it to 0.
+     */
+
+    cmdPtr = (Command *) cmd;
+    infoPtr->isNativeObjectProc =
+	    (cmdPtr->objProc != TclInvokeStringCommand);
+    infoPtr->objProc = cmdPtr->objProc;
+    infoPtr->objClientData = cmdPtr->objClientData;
+    infoPtr->proc = cmdPtr->proc;
+    infoPtr->clientData = cmdPtr->clientData;
+    infoPtr->deleteProc = cmdPtr->deleteProc;
+    infoPtr->deleteData = cmdPtr->deleteData;
+    infoPtr->namespacePtr = (Tcl_Namespace *) cmdPtr->nsPtr;
+    return 1;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetCommandName --
+ *
+ *	Given a token returned by Tcl_CreateCommand, this procedure
+ *	returns the current name of the command (which may have changed
+ *	due to renaming).
+ *
+ * Results:
+ *	The return value is the name of the given command.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_GetCommandName(interp, command)
+    Tcl_Interp *interp;		/* Interpreter containing the command. */
+    Tcl_Command command;	/* Token for command returned by a previous
+				 * call to Tcl_CreateCommand. The command
+				 * must not have been deleted. */
+{
+    Command *cmdPtr = (Command *) command;
+
+    if ((cmdPtr == NULL) || (cmdPtr->hPtr == NULL)) {
+
+	/*
+	 * This should only happen if command was "created" after the
+	 * interpreter began to be deleted, so there isn't really any
+	 * command. Just return an empty string.
+	 */
+
+	return "";
+    }
+    return Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetCommandFullName --
+ *
+ *	Given a token returned by, e.g., Tcl_CreateCommand or
+ *	Tcl_FindCommand, this procedure appends to an object the command's
+ *	full name, qualified by a sequence of parent namespace names. The
+ *	command's fully-qualified name may have changed due to renaming.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The command's fully-qualified name is appended to the string
+ *	representation of objPtr. 
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_GetCommandFullName(interp, command, objPtr)
+    Tcl_Interp *interp;		/* Interpreter containing the command. */
+    Tcl_Command command;	/* Token for command returned by a previous
+				 * call to Tcl_CreateCommand. The command
+				 * must not have been deleted. */
+    Tcl_Obj *objPtr;		/* Points to the object onto which the
+				 * command's full name is appended. */
+
+{
+    Interp *iPtr = (Interp *) interp;
+    register Command *cmdPtr = (Command *) command;
+    char *name;
+
+    /*
+     * Add the full name of the containing namespace, followed by the "::"
+     * separator, and the command name.
+     */
+
+    if (cmdPtr != NULL) {
+	if (cmdPtr->nsPtr != NULL) {
+	    Tcl_AppendToObj(objPtr, cmdPtr->nsPtr->fullName, -1);
+	    if (cmdPtr->nsPtr != iPtr->globalNsPtr) {
+		Tcl_AppendToObj(objPtr, "::", 2);
+	    }
+	}
+	if (cmdPtr->hPtr != NULL) {
+	    name = Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr);
+	    Tcl_AppendToObj(objPtr, name, -1);
+	}
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteCommand --
+ *
+ *	Remove the given command from the given interpreter.
+ *
+ * Results:
+ *	0 is returned if the command was deleted successfully.
+ *	-1 is returned if there didn't exist a command by that name.
+ *
+ * Side effects:
+ *	cmdName will no longer be recognized as a valid command for
+ *	interp.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_DeleteCommand(interp, cmdName)
+    Tcl_Interp *interp;		/* Token for command interpreter (returned
+				 * by a previous Tcl_CreateInterp call). */
+    char *cmdName;		/* Name of command to remove. */
+{
+    Tcl_Command cmd;
+
+    /*
+     *  Find the desired command and delete it.
+     */
+
+    cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
+            /*flags*/ 0);
+    if (cmd == (Tcl_Command) NULL) {
+	return -1;
+    }
+    return Tcl_DeleteCommandFromToken(interp, cmd);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteCommandFromToken --
+ *
+ *	Removes the given command from the given interpreter. This procedure
+ *	resembles Tcl_DeleteCommand, but takes a Tcl_Command token instead
+ *	of a command name for efficiency.
+ *
+ * Results:
+ *	0 is returned if the command was deleted successfully.
+ *	-1 is returned if there didn't exist a command by that name.
+ *
+ * Side effects:
+ *	The command specified by "cmd" will no longer be recognized as a
+ *	valid command for "interp".
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_DeleteCommandFromToken(interp, cmd)
+    Tcl_Interp *interp;		/* Token for command interpreter returned by
+				 * a previous call to Tcl_CreateInterp. */
+    Tcl_Command cmd;            /* Token for command to delete. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Command *cmdPtr = (Command *) cmd;
+    ImportRef *refPtr, *nextRefPtr;
+    Tcl_Command importCmd;
+
+    /*
+     * The code here is tricky.  We can't delete the hash table entry
+     * before invoking the deletion callback because there are cases
+     * where the deletion callback needs to invoke the command (e.g.
+     * object systems such as OTcl). However, this means that the
+     * callback could try to delete or rename the command. The deleted
+     * flag allows us to detect these cases and skip nested deletes.
+     */
+
+    if (cmdPtr->deleted) {
+	/*
+	 * Another deletion is already in progress.  Remove the hash
+	 * table entry now, but don't invoke a callback or free the
+	 * command structure.
+	 */
+
+        Tcl_DeleteHashEntry(cmdPtr->hPtr);
+	cmdPtr->hPtr = NULL;
+	return 0;
+    }
+
+    /*
+     * If the command being deleted has a compile procedure, increment the
+     * interpreter's compileEpoch to invalidate its compiled code. This
+     * makes sure that we don't later try to execute old code compiled with
+     * command-specific (i.e., inline) bytecodes for the now-deleted
+     * command. This field is checked in Tcl_EvalObj and ObjInterpProc, and
+     * code whose compilation epoch doesn't match is recompiled.
+     */
+
+    if (cmdPtr->compileProc != NULL) {
+        iPtr->compileEpoch++;
+    }
+
+    cmdPtr->deleted = 1;
+    if (cmdPtr->deleteProc != NULL) {
+	/*
+	 * Delete the command's client data. If this was an imported command
+	 * created when a command was imported into a namespace, this client
+	 * data will be a pointer to a ImportedCmdData structure describing
+	 * the "real" command that this imported command refers to.
+	 */
+	
+	(*cmdPtr->deleteProc)(cmdPtr->deleteData);
+    }
+
+    /*
+     * Bump the command epoch counter. This will invalidate all cached
+     * references that point to this command.
+     */
+    
+    cmdPtr->cmdEpoch++;
+
+    /*
+     * If this command was imported into other namespaces, then imported
+     * commands were created that refer back to this command. Delete these
+     * imported commands now.
+     */
+
+    for (refPtr = cmdPtr->importRefPtr;  refPtr != NULL;
+            refPtr = nextRefPtr) {
+	nextRefPtr = refPtr->nextPtr;
+	importCmd = (Tcl_Command) refPtr->importedCmdPtr;
+        Tcl_DeleteCommandFromToken(interp, importCmd);
+    }
+
+    /*
+     * Don't use hPtr to delete the hash entry here, because it's
+     * possible that the deletion callback renamed the command.
+     * Instead, use cmdPtr->hptr, and make sure that no-one else
+     * has already deleted the hash entry.
+     */
+
+    if (cmdPtr->hPtr != NULL) {
+	Tcl_DeleteHashEntry(cmdPtr->hPtr);
+    }
+
+    /*
+     * Mark the Command structure as no longer valid. This allows
+     * TclExecuteByteCode to recognize when a Command has logically been
+     * deleted and a pointer to this Command structure cached in a CmdName
+     * object is invalid. TclExecuteByteCode will look up the command again
+     * in the interpreter's command hashtable.
+     */
+
+    cmdPtr->objProc = NULL;
+
+    /*
+     * Now free the Command structure, unless there is another reference to
+     * it from a CmdName Tcl object in some ByteCode code sequence. In that
+     * case, delay the cleanup until all references are either discarded
+     * (when a ByteCode is freed) or replaced by a new reference (when a
+     * cached CmdName Command reference is found to be invalid and
+     * TclExecuteByteCode looks up the command in the command hashtable).
+     */
+    
+    TclCleanupCommand(cmdPtr);
+    return 0;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCleanupCommand --
+ *
+ *	This procedure frees up a Command structure unless it is still
+ *	referenced from an interpreter's command hashtable or from a CmdName
+ *	Tcl object representing the name of a command in a ByteCode
+ *	instruction sequence. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Memory gets freed unless a reference to the Command structure still
+ *	exists. In that case the cleanup is delayed until the command is
+ *	deleted or when the last ByteCode referring to it is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclCleanupCommand(cmdPtr)
+    register Command *cmdPtr;	/* Points to the Command structure to
+				 * be freed. */
+{
+    cmdPtr->refCount--;
+    if (cmdPtr->refCount <= 0) {
+	ckfree((char *) cmdPtr);
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Eval --
+ *
+ *	Execute a Tcl command in a string.
+ *
+ * Results:
+ *	The return value is one of the return codes defined in tcl.h
+ *	(such as TCL_OK), and interp->result contains a string value
+ *	to supplement the return code. The value of interp->result
+ *	will persist only until the next call to Tcl_Eval or Tcl_EvalObj:
+ *	you must copy it or lose it!
+ *
+ * Side effects:
+ *	The string is compiled to produce a ByteCode object that holds the
+ *	command's bytecode instructions. However, this ByteCode object is
+ *	lost after executing the command. The command's execution will
+ *	almost certainly have side effects. interp->termOffset is set to the
+ *	offset of the character in "string" just after the last one
+ *	successfully compiled or executed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_Eval(interp, string)
+    Tcl_Interp *interp;		/* Token for command interpreter (returned
+				 * by previous call to Tcl_CreateInterp). */
+    char *string;		/* Pointer to TCL command to execute. */
+{
+    register Tcl_Obj *cmdPtr;
+    int length = strlen(string);
+    int result;
+
+    if (length > 0) {
+	/*
+	 * Initialize a Tcl object from the command string.
+	 */
+
+	TclNewObj(cmdPtr);
+	TclInitStringRep(cmdPtr, string, length);
+	Tcl_IncrRefCount(cmdPtr);
+
+	/*
+	 * Compile and execute the bytecodes.
+	 */
+    
+	result = Tcl_EvalObj(interp, cmdPtr);
+
+	/*
+	 * Move the interpreter's object result to the string result, 
+	 * then reset the object result.
+	 * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
+	 */
+
+	Tcl_SetResult(interp,
+	        TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
+	        TCL_VOLATILE);
+
+	/*
+	 * Discard the Tcl object created to hold the command and its code.
+	 */
+	
+	Tcl_DecrRefCount(cmdPtr);	
+    } else {
+	/*
+	 * An empty string. Just reset the interpreter's result.
+	 */
+
+	Tcl_ResetResult(interp);
+	result = TCL_OK;
+    }
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_EvalObj --
+ *
+ *	Execute Tcl commands stored in a Tcl object. These commands are
+ *	compiled into bytecodes if necessary.
+ *
+ * Results:
+ *	The return value is one of the return codes defined in tcl.h
+ *	(such as TCL_OK), and the interpreter's result contains a value
+ *	to supplement the return code.
+ *
+ * Side effects:
+ *	The object is converted, if necessary, to a ByteCode object that
+ *	holds the bytecode instructions for the commands. Executing the
+ *	commands will almost certainly have side effects that depend
+ *	on those commands.
+ *
+ *	Just as in Tcl_Eval, interp->termOffset is set to the offset of the
+ *	last character executed in the objPtr's string.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#undef Tcl_EvalObj
+
+int
+Tcl_EvalObj(interp, objPtr)
+    Tcl_Interp *interp;			/* Token for command interpreter
+					 * (returned by a previous call to
+					 * Tcl_CreateInterp). */
+    Tcl_Obj *objPtr;			/* Pointer to object containing
+					 * commands to execute. */
+{
+    register Interp *iPtr = (Interp *) interp;
+    int flags;				/* Interp->evalFlags value when the
+					 * procedure was called. */
+    register ByteCode* codePtr;		/* Tcl Internal type of bytecode. */
+    int oldCount = iPtr->cmdCount;	/* Used to tell whether any commands
+					 * at all were executed. */
+    int numSrcChars;
+    register int result;
+    Namespace *namespacePtr;
+
+    /*
+     * Reset both the interpreter's string and object results and clear out
+     * any error information. This makes sure that we return an empty
+     * result if there are no commands in the command string.
+     */
+
+    Tcl_ResetResult(interp);
+
+    /*
+     * Check depth of nested calls to Tcl_Eval:  if this gets too large,
+     * it's probably because of an infinite loop somewhere.
+     */
+
+    iPtr->numLevels++;
+    if (iPtr->numLevels > iPtr->maxNestingDepth) {
+	iPtr->numLevels--;
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		"too many nested calls to Tcl_EvalObj (infinite loop?)", -1);
+	return TCL_ERROR;
+    }    
+
+    /*
+     * If the interpreter has been deleted, return an error.
+     */
+    
+    if (iPtr->flags & DELETED) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	        "attempt to call eval in deleted interpreter", -1);
+	Tcl_SetErrorCode(interp, "CORE", "IDELETE",
+	        "attempt to call eval in deleted interpreter", (char *) NULL);
+	iPtr->numLevels--;
+	return TCL_ERROR;
+    }
+
+    /*
+     * Get the ByteCode from the object. If it exists, make sure it hasn't
+     * been invalidated by, e.g., someone redefining a command with a
+     * compile procedure (this might make the compiled code wrong). If
+     * necessary, convert the object to be a ByteCode object and compile it.
+     * Also, if the code was compiled in/for a different interpreter,
+     * or for a different namespace, or for the same namespace but
+     * with different name resolution rules, we recompile it.
+     *
+     * Precompiled objects, however, are immutable and therefore
+     * they are not recompiled, even if the epoch has changed.
+     */
+
+    if (iPtr->varFramePtr != NULL) {
+        namespacePtr = iPtr->varFramePtr->nsPtr;
+    } else {
+        namespacePtr = iPtr->globalNsPtr;
+    }
+
+    if (objPtr->typePtr == &tclByteCodeType) {
+	codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+	
+	if ((codePtr->iPtr != iPtr)
+	        || (codePtr->compileEpoch != iPtr->compileEpoch)
+	        || (codePtr->nsPtr != namespacePtr)
+	        || (codePtr->nsEpoch != namespacePtr->resolverEpoch)) {
+            if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
+                if (codePtr->iPtr != iPtr) {
+                    panic("Tcl_EvalObj: compiled script jumped interps");
+                }
+	        codePtr->compileEpoch = iPtr->compileEpoch;
+            } else {
+                tclByteCodeType.freeIntRepProc(objPtr);
+            }
+	}
+    }
+    if (objPtr->typePtr != &tclByteCodeType) {
+	/*
+	 * First reset any error line number information.
+	 */
+	
+	iPtr->errorLine = 1;   /* no correct line # information yet */
+	result = tclByteCodeType.setFromAnyProc(interp, objPtr);
+	if (result != TCL_OK) {
+	    iPtr->numLevels--;
+	    return result;
+	}
+    }
+    codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+
+    /*
+     * Extract then reset the compilation flags in the interpreter.
+     * Resetting the flags must be done after any compilation.
+     */
+
+    flags = iPtr->evalFlags;
+    iPtr->evalFlags = 0;
+
+    /*
+     * Execute the commands. If the code was compiled from an empty string,
+     * don't bother executing the code.
+     */
+
+    numSrcChars = codePtr->numSrcChars;
+    if ((numSrcChars > 0) || (codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
+	/*
+	 * Increment the code's ref count while it is being executed. If
+	 * afterwards no references to it remain, free the code.
+	 */
+	
+	codePtr->refCount++;
+	result = TclExecuteByteCode(interp, codePtr);
+	codePtr->refCount--;
+	if (codePtr->refCount <= 0) {
+	    TclCleanupByteCode(codePtr);
+	}
+    } else {
+	Tcl_ResetResult(interp);
+	result = TCL_OK;
+    }
+
+    /*
+     * If no commands at all were executed, check for asynchronous
+     * handlers so that they at least get one change to execute.
+     * This is needed to handle event loops written in Tcl with
+     * empty bodies.
+     */
+
+    if ((oldCount == iPtr->cmdCount) && (Tcl_AsyncReady())) {
+	result = Tcl_AsyncInvoke(interp, result);
+    }
+
+    /*
+     * Free up any extra resources that were allocated.
+     */
+
+    iPtr->numLevels--;
+    if (iPtr->numLevels == 0) {
+	if (result == TCL_RETURN) {
+	    result = TclUpdateReturnInfo(iPtr);
+	}
+	if ((result != TCL_OK) && (result != TCL_ERROR)
+		&& !(flags & TCL_ALLOW_EXCEPTIONS)) {
+	    Tcl_ResetResult(interp);
+	    if (result == TCL_BREAK) {
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		        "invoked \"break\" outside of a loop", -1);
+	    } else if (result == TCL_CONTINUE) {
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		        "invoked \"continue\" outside of a loop", -1);
+	    } else {
+		char buf[50];
+		sprintf(buf, "command returned bad code: %d", result);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
+	    }
+	    result = TCL_ERROR;
+	}
+    }
+
+    /*
+     * If an error occurred, record information about what was being
+     * executed when the error occurred.
+     */
+
+    if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
+	char buf[200];
+	char *ellipsis = "";
+	char *bytes;
+	int length;
+
+	/*
+	 * Figure out how much of the command to print in the error
+	 * message (up to a certain number of characters, or up to
+	 * the first new-line).
+	 * THIS FAILS IF THE OBJECT'S STRING REP CONTAINS A NULL.
+	 */
+
+	bytes = Tcl_GetStringFromObj(objPtr, &length);
+	length = TclMin(numSrcChars, length);
+	if (length > 150) {
+	    length = 150;
+	    ellipsis = " ...";
+	}
+
+	if (!(iPtr->flags & ERR_IN_PROGRESS)) {
+	    sprintf(buf, "\n    while executing\n\"%.*s%s\"",
+		    length, bytes, ellipsis);
+	} else {
+	    sprintf(buf, "\n    invoked from within\n\"%.*s%s\"",
+		    length, bytes, ellipsis);
+	}
+	Tcl_AddObjErrorInfo(interp, buf, -1);
+    }
+
+    /*
+     * Set the interpreter's termOffset member to the offset of the
+     * character just after the last one executed. We approximate the offset
+     * of the last character executed by using the number of characters
+     * compiled.
+     */
+
+    iPtr->termOffset = numSrcChars;
+    iPtr->flags &= ~ERR_ALREADY_LOGGED;
+    return result;
+}
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean --
+ *
+ *	Procedures to evaluate an expression and return its value in a
+ *	particular form.
+ *
+ * Results:
+ *	Each of the procedures below returns a standard Tcl result. If an
+ *	error occurs then an error message is left in interp->result.
+ *	Otherwise the value of the expression, in the appropriate form, is
+ *	stored at *ptr. If the expression had a result that was
+ *	incompatible with the desired form then an error is returned.
+ *
+ * Side effects:
+ *	None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tcl_ExprLong(interp, string, ptr)
+    Tcl_Interp *interp;		/* Context in which to evaluate the
+				 * expression. */
+    char *string;		/* Expression to evaluate. */
+    long *ptr;			/* Where to store result. */
+{
+    register Tcl_Obj *exprPtr;
+    Tcl_Obj *resultPtr;
+    int length = strlen(string);
+    int result = TCL_OK;
+
+    if (length > 0) {
+	exprPtr = Tcl_NewStringObj(string, length);
+	Tcl_IncrRefCount(exprPtr);
+	result = Tcl_ExprObj(interp, exprPtr, &resultPtr);
+	if (result == TCL_OK) {
+	    /*
+	     * Store an integer based on the expression result.
+	     */
+	    
+	    if (resultPtr->typePtr == &tclIntType) {
+		*ptr = resultPtr->internalRep.longValue;
+	    } else if (resultPtr->typePtr == &tclDoubleType) {
+		*ptr = (long) resultPtr->internalRep.doubleValue;
+	    } else {
+		Tcl_SetResult(interp,
+		        "expression didn't have numeric value", TCL_STATIC);
+		result = TCL_ERROR;
+	    }
+	    Tcl_DecrRefCount(resultPtr);  /* discard the result object */
+	} else {
+	    /*
+	     * Move the interpreter's object result to the string result, 
+	     * then reset the object result.
+	     * FAILS IF OBJECT RESULT'S STRING REPRESENTATION HAS NULLS.
+	     */
+
+	    Tcl_SetResult(interp,
+	            TclGetStringFromObj(Tcl_GetObjResult(interp),
+		            (int *) NULL),
+	            TCL_VOLATILE);
+	}
+	Tcl_DecrRefCount(exprPtr);  /* discard the expression object */	
+    } else {
+	/*
+	 * An empty string. Just set the result integer to 0.
+	 */
+	
+	*ptr = 0;
+    }
+    return result;
+}
+
+int
+Tcl_ExprDouble(interp, string, ptr)
+    Tcl_Interp *interp;		/* Context in which to evaluate the
+				 * expression. */
+    char *string;		/* Expression to evaluate. */
+    double *ptr;		/* Where to store result. */
+{
+    register Tcl_Obj *exprPtr;
+    Tcl_Obj *resultPtr;
+    int length = strlen(string);
+    int result = TCL_OK;
+
+    if (length > 0) {
+	exprPtr = Tcl_NewStringObj(string, length);
+	Tcl_IncrRefCount(exprPtr);
+	result = Tcl_ExprObj(interp, exprPtr, &resultPtr);
+	if (result == TCL_OK) {
+	    /*
+	     * Store a double  based on the expression result.
+	     */
+	    
+	    if (resultPtr->typePtr == &tclIntType) {
+		*ptr = (double) resultPtr->internalRep.longValue;
+	    } else if (resultPtr->typePtr == &tclDoubleType) {
+		*ptr = resultPtr->internalRep.doubleValue;
+	    } else {
+		Tcl_SetResult(interp,
+		        "expression didn't have numeric value", TCL_STATIC);
+		result = TCL_ERROR;
+	    }
+	    Tcl_DecrRefCount(resultPtr);  /* discard the result object */
+	} else {
+	    /*
+	     * Move the interpreter's object result to the string result, 
+	     * then reset the object result.
+	     * FAILS IF OBJECT RESULT'S STRING REPRESENTATION HAS NULLS.
+	     */
+
+	    Tcl_SetResult(interp,
+	            TclGetStringFromObj(Tcl_GetObjResult(interp),
+		            (int *) NULL),
+	            TCL_VOLATILE);
+	}
+	Tcl_DecrRefCount(exprPtr);  /* discard the expression object */
+    } else {
+	/*
+	 * An empty string. Just set the result double to 0.0.
+	 */
+	
+	*ptr = 0.0;
+    }
+    return result;
+}
+
+int
+Tcl_ExprBoolean(interp, string, ptr)
+    Tcl_Interp *interp;		/* Context in which to evaluate the
+			         * expression. */
+    char *string;		/* Expression to evaluate. */
+    int *ptr;			/* Where to store 0/1 result. */
+{
+    register Tcl_Obj *exprPtr;
+    Tcl_Obj *resultPtr;
+    int length = strlen(string);
+    int result = TCL_OK;
+
+    if (length > 0) {
+	exprPtr = Tcl_NewStringObj(string, length);
+	Tcl_IncrRefCount(exprPtr);
+	result = Tcl_ExprObj(interp, exprPtr, &resultPtr);
+	if (result == TCL_OK) {
+	    /*
+	     * Store a boolean based on the expression result.
+	     */
+	    
+	    if (resultPtr->typePtr == &tclIntType) {
+		*ptr = (resultPtr->internalRep.longValue != 0);
+	    } else if (resultPtr->typePtr == &tclDoubleType) {
+		*ptr = (resultPtr->internalRep.doubleValue != 0.0);
+	    } else {
+		result = Tcl_GetBooleanFromObj(interp, resultPtr, ptr);
+	    }
+	    Tcl_DecrRefCount(resultPtr);  /* discard the result object */
+	}
+	if (result != TCL_OK) {
+	    /*
+	     * Move the interpreter's object result to the string result, 
+	     * then reset the object result.
+	     * FAILS IF OBJECT RESULT'S STRING REPRESENTATION HAS NULLS.
+	     */
+
+	    Tcl_SetResult(interp,
+	            TclGetStringFromObj(Tcl_GetObjResult(interp),
+		            (int *) NULL),
+	            TCL_VOLATILE);
+	}
+	Tcl_DecrRefCount(exprPtr); /* discard the expression object */
+    } else {
+	/*
+	 * An empty string. Just set the result boolean to 0 (false).
+	 */
+	
+	*ptr = 0;
+    }
+    return result;
+}
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tcl_ExprLongObj, Tcl_ExprDoubleObj, Tcl_ExprBooleanObj --
+ *
+ *	Procedures to evaluate an expression in an object and return its
+ *	value in a particular form.
+ *
+ * Results:
+ *	Each of the procedures below returns a standard Tcl result
+ *	object. If an error occurs then an error message is left in the
+ *	interpreter's result. Otherwise the value of the expression, in the
+ *	appropriate form, is stored at *ptr. If the expression had a result
+ *	that was incompatible with the desired form then an error is
+ *	returned.
+ *
+ * Side effects:
+ *	None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tcl_ExprLongObj(interp, objPtr, ptr)
+    Tcl_Interp *interp;			/* Context in which to evaluate the
+					 * expression. */
+    register Tcl_Obj *objPtr;		/* Expression to evaluate. */
+    long *ptr;				/* Where to store long result. */
+{
+    Tcl_Obj *resultPtr;
+    int result;
+
+    result = Tcl_ExprObj(interp, objPtr, &resultPtr);
+    if (result == TCL_OK) {
+	if (resultPtr->typePtr == &tclIntType) {
+	    *ptr = resultPtr->internalRep.longValue;
+	} else if (resultPtr->typePtr == &tclDoubleType) {
+	    *ptr = (long) resultPtr->internalRep.doubleValue;
+	} else {
+	    result = Tcl_GetLongFromObj(interp, resultPtr, ptr);
+	    if (result != TCL_OK) {
+		return result;
+	    }
+	}
+	Tcl_DecrRefCount(resultPtr);  /* discard the result object */
+    }
+    return result;
+}
+
+int
+Tcl_ExprDoubleObj(interp, objPtr, ptr)
+    Tcl_Interp *interp;			/* Context in which to evaluate the
+					 * expression. */
+    register Tcl_Obj *objPtr;		/* Expression to evaluate. */
+    double *ptr;			/* Where to store double result. */
+{
+    Tcl_Obj *resultPtr;
+    int result;
+
+    result = Tcl_ExprObj(interp, objPtr, &resultPtr);
+    if (result == TCL_OK) {
+	if (resultPtr->typePtr == &tclIntType) {
+	    *ptr = (double) resultPtr->internalRep.longValue;
+	} else if (resultPtr->typePtr == &tclDoubleType) {
+	    *ptr = resultPtr->internalRep.doubleValue;
+	} else {
+	    result = Tcl_GetDoubleFromObj(interp, resultPtr, ptr);
+	    if (result != TCL_OK) {
+		return result;
+	    }
+	}
+	Tcl_DecrRefCount(resultPtr);  /* discard the result object */
+    }
+    return result;
+}
+
+int
+Tcl_ExprBooleanObj(interp, objPtr, ptr)
+    Tcl_Interp *interp;			/* Context in which to evaluate the
+					 * expression. */
+    register Tcl_Obj *objPtr;		/* Expression to evaluate. */
+    int *ptr;				/* Where to store 0/1 result. */
+{
+    Tcl_Obj *resultPtr;
+    int result;
+
+    result = Tcl_ExprObj(interp, objPtr, &resultPtr);
+    if (result == TCL_OK) {
+	if (resultPtr->typePtr == &tclIntType) {
+	    *ptr = (resultPtr->internalRep.longValue != 0);
+	} else if (resultPtr->typePtr == &tclDoubleType) {
+	    *ptr = (resultPtr->internalRep.doubleValue != 0.0);
+	} else {
+	    result = Tcl_GetBooleanFromObj(interp, resultPtr, ptr);
+	    if (result != TCL_OK) {
+		return result;
+	    }
+	}
+	Tcl_DecrRefCount(resultPtr);  /* discard the result object */
+    }
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInvoke --
+ *
+ *	Invokes a Tcl command, given an argv/argc, from either the
+ *	exposed or the hidden sets of commands in the given interpreter.
+ *	NOTE: The command is invoked in the current stack frame of
+ *	the interpreter, thus it can modify local variables.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Whatever the command does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclInvoke(interp, argc, argv, flags)
+    Tcl_Interp *interp;		/* Where to invoke the command. */
+    int argc;			/* Count of args. */
+    register char **argv;	/* The arg strings; argv[0] is the name of
+                                 * the command to invoke. */
+    int flags;			/* Combination of flags controlling the
+				 * call: TCL_INVOKE_HIDDEN and
+				 * TCL_INVOKE_NO_UNKNOWN. */
+{
+    register Tcl_Obj *objPtr;
+    register int i;
+    int length, result;
+
+    /*
+     * This procedure generates an objv array for object arguments that hold
+     * the argv strings. It starts out with stack-allocated space but uses
+     * dynamically-allocated storage if needed.
+     */
+
+#define NUM_ARGS 20
+    Tcl_Obj *(objStorage[NUM_ARGS]);
+    register Tcl_Obj **objv = objStorage;
+
+    /*
+     * Create the object argument array "objv". Make sure objv is large
+     * enough to hold the objc arguments plus 1 extra for the zero
+     * end-of-objv word.
+     */
+
+    if ((argc + 1) > NUM_ARGS) {
+	objv = (Tcl_Obj **)
+	    ckalloc((unsigned)(argc + 1) * sizeof(Tcl_Obj *));
+    }
+
+    for (i = 0;  i < argc;  i++) {
+	length = strlen(argv[i]);
+	objv[i] = Tcl_NewStringObj(argv[i], length);
+	Tcl_IncrRefCount(objv[i]);
+    }
+    objv[argc] = 0;
+
+    /*
+     * Use TclObjInterpProc to actually invoke the command.
+     */
+
+    result = TclObjInvoke(interp, argc, objv, flags);
+
+    /*
+     * Move the interpreter's object result to the string result, 
+     * then reset the object result.
+     * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
+     */
+    
+    Tcl_SetResult(interp,
+	    TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
+	    TCL_VOLATILE);
+
+    /*
+     * Decrement the ref counts on the objv elements since we are done
+     * with them.
+     */
+
+    for (i = 0;  i < argc;  i++) {
+	objPtr = objv[i];
+	Tcl_DecrRefCount(objPtr);
+    }
+    
+    /*
+     * Free the objv array if malloc'ed storage was used.
+     */
+
+    if (objv != objStorage) {
+	ckfree((char *) objv);
+    }
+    return result;
+#undef NUM_ARGS
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGlobalInvoke --
+ *
+ *	Invokes a Tcl command, given an argv/argc, from either the
+ *	exposed or hidden sets of commands in the given interpreter.
+ *	NOTE: The command is invoked in the global stack frame of
+ *	the interpreter, thus it cannot see any current state on
+ *	the stack for that interpreter.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Whatever the command does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclGlobalInvoke(interp, argc, argv, flags)
+    Tcl_Interp *interp;		/* Where to invoke the command. */
+    int argc;			/* Count of args. */
+    register char **argv;	/* The arg strings; argv[0] is the name of
+                                 * the command to invoke. */
+    int flags;			/* Combination of flags controlling the
+				 * call: TCL_INVOKE_HIDDEN and
+				 * TCL_INVOKE_NO_UNKNOWN. */
+{
+    register Interp *iPtr = (Interp *) interp;
+    int result;
+    CallFrame *savedVarFramePtr;
+
+    savedVarFramePtr = iPtr->varFramePtr;
+    iPtr->varFramePtr = NULL;
+    result = TclInvoke(interp, argc, argv, flags);
+    iPtr->varFramePtr = savedVarFramePtr;
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclObjInvokeGlobal --
+ *
+ *	Object version: Invokes a Tcl command, given an objv/objc, from
+ *	either the exposed or hidden set of commands in the given
+ *	interpreter.
+ *	NOTE: The command is invoked in the global stack frame of the
+ *	interpreter, thus it cannot see any current state on the
+ *	stack of that interpreter.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Whatever the command does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclObjInvokeGlobal(interp, objc, objv, flags)
+    Tcl_Interp *interp;		/* Interpreter in which command is
+				 * to be invoked. */
+    int objc;			/* Count of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument value objects; objv[0]
+				 * points to the name of the
+				 * command to invoke. */
+    int flags;			/* Combination of flags controlling
+                                 * the call: TCL_INVOKE_HIDDEN and
+                                 * TCL_INVOKE_NO_UNKNOWN. */
+{
+    register Interp *iPtr = (Interp *) interp;
+    int result;
+    CallFrame *savedVarFramePtr;
+
+    savedVarFramePtr = iPtr->varFramePtr;
+    iPtr->varFramePtr = NULL;
+    result = TclObjInvoke(interp, objc, objv, flags);
+    iPtr->varFramePtr = savedVarFramePtr;
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclObjInvoke --
+ *
+ *	Invokes a Tcl command, given an objv/objc, from either the
+ *	exposed or the hidden sets of commands in the given interpreter.
+ *
+ * Results:
+ *	A standard Tcl object result.
+ *
+ * Side effects:
+ *	Whatever the command does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclObjInvoke(interp, objc, objv, flags)
+    Tcl_Interp *interp;		/* Interpreter in which command is
+				 * to be invoked. */
+    int objc;			/* Count of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument value objects; objv[0]
+				 * points to the name of the
+				 * command to invoke. */
+    int flags;			/* Combination of flags controlling
+                                 * the call: TCL_INVOKE_HIDDEN and
+                                 * TCL_INVOKE_NO_UNKNOWN. */
+{
+    register Interp *iPtr = (Interp *) interp;
+    Tcl_HashTable *hTblPtr;	/* Table of hidden commands. */
+    char *cmdName;		/* Name of the command from objv[0]. */
+    register Tcl_HashEntry *hPtr;
+    Tcl_Command cmd;
+    Command *cmdPtr;
+    int localObjc;		/* Used to invoke "unknown" if the */
+    Tcl_Obj **localObjv = NULL;	/* command is not found. */
+    register int i;
+    int length, result;
+    char *bytes;
+
+    if (interp == (Tcl_Interp *) NULL) {
+        return TCL_ERROR;
+    }
+
+    if ((objc < 1) || (objv == (Tcl_Obj **) NULL)) {
+        Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	        "illegal argument vector", -1);
+        return TCL_ERROR;
+    }
+
+    /*
+     * THE FOLLOWING CODE FAILS IF THE STRING REP CONTAINS NULLS.
+     */
+    
+    cmdName = Tcl_GetStringFromObj(objv[0], (int *) NULL);
+    if (flags & TCL_INVOKE_HIDDEN) {
+        /*
+         * Find the table of hidden commands; error out if none.
+         */
+
+        hTblPtr = (Tcl_HashTable *)
+	        Tcl_GetAssocData(interp, "tclHiddenCmds", NULL);
+        if (hTblPtr == (Tcl_HashTable *) NULL) {
+            badhiddenCmdToken:
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		     "invalid hidden command name \"", cmdName, "\"",
+		     (char *) NULL);
+            return TCL_ERROR;
+        }
+        hPtr = Tcl_FindHashEntry(hTblPtr, cmdName);
+
+        /*
+         * We never invoke "unknown" for hidden commands.
+         */
+        
+        if (hPtr == NULL) {
+            goto badhiddenCmdToken;
+        }
+	cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+    } else {
+	cmdPtr = NULL;
+	cmd = Tcl_FindCommand(interp, cmdName,
+	        (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY);
+        if (cmd != (Tcl_Command) NULL) {
+	    cmdPtr = (Command *) cmd;
+        }
+	if (cmdPtr == NULL) {
+            if (!(flags & TCL_INVOKE_NO_UNKNOWN)) {
+		cmd = Tcl_FindCommand(interp, "unknown",
+                        (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY);
+		if (cmd != (Tcl_Command) NULL) {
+	            cmdPtr = (Command *) cmd;
+                }
+                if (cmdPtr != NULL) {
+                    localObjc = (objc + 1);
+                    localObjv = (Tcl_Obj **)
+			ckalloc((unsigned) (sizeof(Tcl_Obj *) * localObjc));
+		    localObjv[0] = Tcl_NewStringObj("unknown", -1);
+		    Tcl_IncrRefCount(localObjv[0]);
+                    for (i = 0;  i < objc;  i++) {
+                        localObjv[i+1] = objv[i];
+                    }
+                    objc = localObjc;
+                    objv = localObjv;
+                }
+            }
+
+            /*
+             * Check again if we found the command. If not, "unknown" is
+             * not present and we cannot help, or the caller said not to
+             * call "unknown" (they specified TCL_INVOKE_NO_UNKNOWN).
+             */
+
+            if (cmdPtr == NULL) {
+		Tcl_ResetResult(interp);
+		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+			"invalid command name \"",  cmdName, "\"", 
+			 (char *) NULL);
+                return TCL_ERROR;
+            }
+        }
+    }
+
+    /*
+     * Invoke the command procedure. First reset the interpreter's string
+     * and object results to their default empty values since they could
+     * have gotten changed by earlier invocations.
+     */
+
+    Tcl_ResetResult(interp);
+    iPtr->cmdCount++;
+    result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
+
+    /*
+     * If an error occurred, record information about what was being
+     * executed when the error occurred.
+     */
+
+    if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
+        Tcl_DString ds;
+        
+        Tcl_DStringInit(&ds);
+        if (!(iPtr->flags & ERR_IN_PROGRESS)) {
+            Tcl_DStringAppend(&ds, "\n    while invoking\n\"", -1);
+        } else {
+            Tcl_DStringAppend(&ds, "\n    invoked from within\n\"", -1);
+        }
+        for (i = 0;  i < objc;  i++) {
+	    bytes = Tcl_GetStringFromObj(objv[i], &length);
+            Tcl_DStringAppend(&ds, bytes, length);
+            if (i < (objc - 1)) {
+                Tcl_DStringAppend(&ds, " ", -1);
+            } else if (Tcl_DStringLength(&ds) > 100) {
+                Tcl_DStringSetLength(&ds, 100);
+                Tcl_DStringAppend(&ds, "...", -1);
+                break;
+            }
+        }
+        
+        Tcl_DStringAppend(&ds, "\"", -1);
+        Tcl_AddObjErrorInfo(interp, Tcl_DStringValue(&ds), -1);
+        Tcl_DStringFree(&ds);
+	iPtr->flags &= ~ERR_ALREADY_LOGGED;
+    }
+
+    /*
+     * Free any locally allocated storage used to call "unknown".
+     */
+
+    if (localObjv != (Tcl_Obj **) NULL) {
+        ckfree((char *) localObjv);
+    }
+    return result;
+}
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tcl_ExprString --
+ *
+ *	Evaluate an expression in a string and return its value in string
+ *	form.
+ *
+ * Results:
+ *	A standard Tcl result. If the result is TCL_OK, then the
+ *	interpreter's result is set to the string value of the
+ *	expression. If the result is TCL_OK, then interp->result
+ *	contains an error message.
+ *
+ * Side effects:
+ *	A Tcl object is allocated to hold a copy of the expression string.
+ *	This expression object is passed to Tcl_ExprObj and then
+ *	deallocated.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tcl_ExprString(interp, string)
+    Tcl_Interp *interp;		/* Context in which to evaluate the
+				 * expression. */
+    char *string;		/* Expression to evaluate. */
+{
+    register Tcl_Obj *exprPtr;
+    Tcl_Obj *resultPtr;
+    int length = strlen(string);
+    char buf[100];
+    int result = TCL_OK;
+
+    if (length > 0) {
+	TclNewObj(exprPtr);
+	TclInitStringRep(exprPtr, string, length);
+	Tcl_IncrRefCount(exprPtr);
+
+	result = Tcl_ExprObj(interp, exprPtr, &resultPtr);
+	if (result == TCL_OK) {
+	    /*
+	     * Set the interpreter's string result from the result object.
+	     */
+	    
+	    if (resultPtr->typePtr == &tclIntType) {
+		sprintf(buf, "%ld", resultPtr->internalRep.longValue);
+		Tcl_SetResult(interp, buf, TCL_VOLATILE);
+	    } else if (resultPtr->typePtr == &tclDoubleType) {
+		Tcl_PrintDouble((Tcl_Interp *) NULL,
+		        resultPtr->internalRep.doubleValue, buf);
+		Tcl_SetResult(interp, buf, TCL_VOLATILE);
+	    } else {
+		/*
+		 * Set interpreter's string result from the result object.
+		 * FAILS IF OBJECT RESULT'S STRING REPRESENTATION HAS NULLS.
+		 */
+	    
+		Tcl_SetResult(interp,
+	                TclGetStringFromObj(resultPtr, (int *) NULL),
+	                TCL_VOLATILE);
+	    }
+	    Tcl_DecrRefCount(resultPtr);  /* discard the result object */
+	} else {
+	    /*
+	     * Move the interpreter's object result to the string result, 
+	     * then reset the object result.
+	     * FAILS IF OBJECT RESULT'S STRING REPRESENTATION HAS NULLS.
+	     */
+	    
+	    Tcl_SetResult(interp,
+	            TclGetStringFromObj(Tcl_GetObjResult(interp),
+			    (int *) NULL),
+	            TCL_VOLATILE);
+	}
+	Tcl_DecrRefCount(exprPtr); /* discard the expression object */
+    } else {
+	/*
+	 * An empty string. Just set the interpreter's result to 0.
+	 */
+	
+	Tcl_SetResult(interp, "0", TCL_VOLATILE);
+    }
+    return result;
+}
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tcl_ExprObj --
+ *
+ *	Evaluate an expression in a Tcl_Obj.
+ *
+ * Results:
+ *	A standard Tcl object result. If the result is other than TCL_OK,
+ *	then the interpreter's result contains an error message. If the
+ *	result is TCL_OK, then a pointer to the expression's result value
+ *	object is stored in resultPtrPtr. In that case, the object's ref
+ *	count is incremented to reflect the reference returned to the
+ *	caller; the caller is then responsible for the resulting object
+ *	and must, for example, decrement the ref count when it is finished
+ *	with the object.
+ *
+ * Side effects:
+ *	Any side effects caused by subcommands in the expression, if any.
+ *	The interpreter result is not modified unless there is an error.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tcl_ExprObj(interp, objPtr, resultPtrPtr)
+    Tcl_Interp *interp;		/* Context in which to evaluate the
+				 * expression. */
+    register Tcl_Obj *objPtr;	/* Points to Tcl object containing
+				 * expression to evaluate. */
+    Tcl_Obj **resultPtrPtr;	/* Where the Tcl_Obj* that is the expression
+				 * result is stored if no errors occur. */
+{
+    Interp *iPtr = (Interp *) interp;
+    CompileEnv compEnv;		/* Compilation environment structure
+				 * allocated in frame. */
+    register ByteCode *codePtr = NULL;
+    				/* Tcl Internal type of bytecode.
+				 * Initialized to avoid compiler warning. */
+    AuxData *auxDataPtr;
+    Interp dummy;
+    Tcl_Obj *saveObjPtr;
+    char *string;
+    int result;
+    int i;
+
+    /*
+     * Get the ByteCode from the object. If it exists, make sure it hasn't
+     * been invalidated by, e.g., someone redefining a command with a
+     * compile procedure (this might make the compiled code wrong). If
+     * necessary, convert the object to be a ByteCode object and compile it.
+     * Also, if the code was compiled in/for a different interpreter, we
+     * recompile it.
+     *
+     * Precompiled expressions, however, are immutable and therefore
+     * they are not recompiled, even if the epoch has changed.
+     *
+     * THIS FAILS IF THE OBJECT'S STRING REP HAS A NULL BYTE.
+     */
+
+    if (objPtr->typePtr == &tclByteCodeType) {
+	codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+	if ((codePtr->iPtr != iPtr)
+	        || (codePtr->compileEpoch != iPtr->compileEpoch)) {
+            if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
+                if (codePtr->iPtr != iPtr) {
+                    panic("Tcl_ExprObj: compiled expression jumped interps");
+                }
+	        codePtr->compileEpoch = iPtr->compileEpoch;
+            } else {
+                tclByteCodeType.freeIntRepProc(objPtr);
+                objPtr->typePtr = (Tcl_ObjType *) NULL;
+            }
+	}
+    }
+    if (objPtr->typePtr != &tclByteCodeType) {
+	int length;
+	string = Tcl_GetStringFromObj(objPtr, &length);
+	TclInitCompileEnv(interp, &compEnv, string);
+	result = TclCompileExpr(interp, string, string + length,
+		/*flags*/ 0, &compEnv);
+	if (result == TCL_OK) {
+	    /*
+	     * If the expression yielded no instructions (e.g., was empty),
+	     * push an integer zero object as the expressions's result.
+	     */
+	    
+	    if (compEnv.codeNext == NULL) {
+		int objIndex = TclObjIndexForString("0", 0,
+			/*allocStrRep*/ 0, /*inHeap*/ 0, &compEnv);
+		Tcl_Obj *objPtr = compEnv.objArrayPtr[objIndex];
+
+		Tcl_InvalidateStringRep(objPtr);
+		objPtr->internalRep.longValue = 0;
+		objPtr->typePtr = &tclIntType;
+		
+		TclEmitPush(objIndex, &compEnv);
+	    }
+	    
+	    /*
+	     * Add done instruction at the end of the instruction sequence.
+	     */
+	    
+	    TclEmitOpcode(INST_DONE, &compEnv);
+	    
+	    TclInitByteCodeObj(objPtr, &compEnv);
+	    codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+	    if (tclTraceCompile == 2) {
+		TclPrintByteCodeObj(interp, objPtr);
+	    }
+	    TclFreeCompileEnv(&compEnv);
+	} else {
+	    /*
+	     * Compilation errors. Decrement the ref counts on any objects
+	     * in the object array before freeing the compilation
+	     * environment.
+	     */
+	    
+	    for (i = 0;  i < compEnv.objArrayNext;  i++) {
+		Tcl_Obj *elemPtr = compEnv.objArrayPtr[i];
+		Tcl_DecrRefCount(elemPtr);
+	    }
+
+	    auxDataPtr = compEnv.auxDataArrayPtr;
+	    for (i = 0;  i < compEnv.auxDataArrayNext;  i++) {
+		if (auxDataPtr->type->freeProc != NULL) {
+		    auxDataPtr->type->freeProc(auxDataPtr->clientData);
+		}
+		auxDataPtr++;
+	    }
+	    TclFreeCompileEnv(&compEnv);
+	    return result;
+	}
+    }
+
+    /*
+     * Execute the expression after first saving the interpreter's result.
+     */
+    
+    dummy.objResultPtr = Tcl_NewObj();
+    Tcl_IncrRefCount(dummy.objResultPtr);
+    if (interp->freeProc == 0) {
+	dummy.freeProc = (Tcl_FreeProc *) 0;
+	dummy.result = "";
+	Tcl_SetResult((Tcl_Interp *) &dummy, interp->result,
+	        TCL_VOLATILE);
+    } else {
+	dummy.freeProc = interp->freeProc;
+	dummy.result = interp->result;
+	interp->freeProc = (Tcl_FreeProc *) 0;
+    }
+    
+    saveObjPtr = Tcl_GetObjResult(interp);
+    Tcl_IncrRefCount(saveObjPtr);
+    
+    /*
+     * Increment the code's ref count while it is being executed. If
+     * afterwards no references to it remain, free the code.
+     */
+    
+    codePtr->refCount++;
+    result = TclExecuteByteCode(interp, codePtr);
+    codePtr->refCount--;
+    if (codePtr->refCount <= 0) {
+	TclCleanupByteCode(codePtr);
+    }
+    
+    /*
+     * If the expression evaluated successfully, store a pointer to its
+     * value object in resultPtrPtr then restore the old interpreter result.
+     * We increment the object's ref count to reflect the reference that we
+     * are returning to the caller. We also decrement the ref count of the
+     * interpreter's result object after calling Tcl_SetResult since we
+     * next store into that field directly.
+     */
+    
+    if (result == TCL_OK) {
+	*resultPtrPtr = iPtr->objResultPtr;
+	Tcl_IncrRefCount(iPtr->objResultPtr);
+	
+	Tcl_SetResult(interp, dummy.result,
+	        ((dummy.freeProc == 0) ? TCL_VOLATILE : dummy.freeProc));
+	Tcl_DecrRefCount(iPtr->objResultPtr);
+	iPtr->objResultPtr = saveObjPtr;
+    } else {
+	Tcl_DecrRefCount(saveObjPtr);
+	Tcl_FreeResult((Tcl_Interp *) &dummy);
+    }
+
+    Tcl_DecrRefCount(dummy.objResultPtr);
+    dummy.objResultPtr = NULL;
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateTrace --
+ *
+ *	Arrange for a procedure to be called to trace command execution.
+ *
+ * Results:
+ *	The return value is a token for the trace, which may be passed
+ *	to Tcl_DeleteTrace to eliminate the trace.
+ *
+ * Side effects:
+ *	From now on, proc will be called just before a command procedure
+ *	is called to execute a Tcl command.  Calls to proc will have the
+ *	following form:
+ *
+ *	void
+ *	proc(clientData, interp, level, command, cmdProc, cmdClientData,
+ *		argc, argv)
+ *	    ClientData clientData;
+ *	    Tcl_Interp *interp;
+ *	    int level;
+ *	    char *command;
+ *	    int (*cmdProc)();
+ *	    ClientData cmdClientData;
+ *	    int argc;
+ *	    char **argv;
+ *	{
+ *	}
+ *
+ *	The clientData and interp arguments to proc will be the same
+ *	as the corresponding arguments to this procedure.  Level gives
+ *	the nesting level of command interpretation for this interpreter
+ *	(0 corresponds to top level).  Command gives the ASCII text of
+ *	the raw command, cmdProc and cmdClientData give the procedure that
+ *	will be called to process the command and the ClientData value it
+ *	will receive, and argc and argv give the arguments to the
+ *	command, after any argument parsing and substitution.  Proc
+ *	does not return a value.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Trace
+Tcl_CreateTrace(interp, level, proc, clientData)
+    Tcl_Interp *interp;		/* Interpreter in which to create trace. */
+    int level;			/* Only call proc for commands at nesting
+				 * level<=argument level (1=>top level). */
+    Tcl_CmdTraceProc *proc;	/* Procedure to call before executing each
+				 * command. */
+    ClientData clientData;	/* Arbitrary value word to pass to proc. */
+{
+    register Trace *tracePtr;
+    register Interp *iPtr = (Interp *) interp;
+
+    /*
+     * Invalidate existing compiled code for this interpreter and arrange
+     * (by setting the DONT_COMPILE_CMDS_INLINE flag) that when compiling
+     * new code, no commands will be compiled inline (i.e., into an inline
+     * sequence of instructions). We do this because commands that were
+     * compiled inline will never result in a command trace being called.
+     */
+
+    iPtr->compileEpoch++;
+    iPtr->flags |= DONT_COMPILE_CMDS_INLINE;
+
+    tracePtr = (Trace *) ckalloc(sizeof(Trace));
+    tracePtr->level = level;
+    tracePtr->proc = proc;
+    tracePtr->clientData = clientData;
+    tracePtr->nextPtr = iPtr->tracePtr;
+    iPtr->tracePtr = tracePtr;
+
+    return (Tcl_Trace) tracePtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteTrace --
+ *
+ *	Remove a trace.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	From now on there will be no more calls to the procedure given
+ *	in trace.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DeleteTrace(interp, trace)
+    Tcl_Interp *interp;		/* Interpreter that contains trace. */
+    Tcl_Trace trace;		/* Token for trace (returned previously by
+				 * Tcl_CreateTrace). */
+{
+    register Interp *iPtr = (Interp *) interp;
+    register Trace *tracePtr = (Trace *) trace;
+    register Trace *tracePtr2;
+
+    if (iPtr->tracePtr == tracePtr) {
+	iPtr->tracePtr = tracePtr->nextPtr;
+	ckfree((char *) tracePtr);
+    } else {
+	for (tracePtr2 = iPtr->tracePtr; tracePtr2 != NULL;
+		tracePtr2 = tracePtr2->nextPtr) {
+	    if (tracePtr2->nextPtr == tracePtr) {
+		tracePtr2->nextPtr = tracePtr->nextPtr;
+		ckfree((char *) tracePtr);
+		break;
+	    }
+	}
+    }
+
+    if (iPtr->tracePtr == NULL) {
+	/*
+	 * When compiling new code, allow commands to be compiled inline.
+	 */
+
+	iPtr->flags &= ~DONT_COMPILE_CMDS_INLINE;
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AddErrorInfo --
+ *
+ *	Add information to the "errorInfo" variable that describes the
+ *	current error.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The contents of message are added to the "errorInfo" variable.
+ *	If Tcl_Eval has been called since the current value of errorInfo
+ *	was set, errorInfo is cleared before adding the new message.
+ *	If we are just starting to log an error, errorInfo is initialized
+ *	from the error message in the interpreter's result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AddErrorInfo(interp, message)
+    Tcl_Interp *interp;		/* Interpreter to which error information
+				 * pertains. */
+    char *message;		/* Message to record. */
+{
+    Tcl_AddObjErrorInfo(interp, message, -1);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AddObjErrorInfo --
+ *
+ *	Add information to the "errorInfo" variable that describes the
+ *	current error. This routine differs from Tcl_AddErrorInfo by
+ *	taking a byte pointer and length.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	"length" bytes from "message" are added to the "errorInfo" variable.
+ *	If "length" is negative, use bytes up to the first NULL byte.
+ *	If Tcl_EvalObj has been called since the current value of errorInfo
+ *	was set, errorInfo is cleared before adding the new message.
+ *	If we are just starting to log an error, errorInfo is initialized
+ *	from the error message in the interpreter's result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AddObjErrorInfo(interp, message, length)
+    Tcl_Interp *interp;		/* Interpreter to which error information
+				 * pertains. */
+    char *message;		/* Points to the first byte of an array of
+				 * bytes of the message. */
+    register int length;	/* The number of bytes in the message.
+				 * If < 0, then append all bytes up to a
+				 * NULL byte. */
+{
+    register Interp *iPtr = (Interp *) interp;
+    Tcl_Obj *namePtr, *messagePtr;
+    
+    /*
+     * If we are just starting to log an error, errorInfo is initialized
+     * from the error message in the interpreter's result.
+     */
+
+    namePtr = Tcl_NewStringObj("errorInfo", -1);
+    Tcl_IncrRefCount(namePtr);
+    
+    if (!(iPtr->flags & ERR_IN_PROGRESS)) { /* just starting to log error */
+	iPtr->flags |= ERR_IN_PROGRESS;
+
+	if (iPtr->result[0] == 0) {
+	    (void) Tcl_ObjSetVar2(interp, namePtr, (Tcl_Obj *) NULL,
+	            iPtr->objResultPtr, TCL_GLOBAL_ONLY);
+	} else {		/* use the string result */
+	    Tcl_SetVar2(interp, "errorInfo", (char *) NULL, interp->result,
+		    TCL_GLOBAL_ONLY);
+	}
+
+	/*
+	 * If the errorCode variable wasn't set by the code that generated
+	 * the error, set it to "NONE".
+	 */
+
+	if (!(iPtr->flags & ERROR_CODE_SET)) {
+	    (void) Tcl_SetVar2(interp, "errorCode", (char *) NULL, "NONE",
+		    TCL_GLOBAL_ONLY);
+	}
+    }
+
+    /*
+     * Now append "message" to the end of errorInfo.
+     */
+
+    if (length != 0) {
+	messagePtr = Tcl_NewStringObj(message, length);
+	Tcl_IncrRefCount(messagePtr);
+	Tcl_ObjSetVar2(interp, namePtr, (Tcl_Obj *) NULL, messagePtr,
+		(TCL_GLOBAL_ONLY | TCL_APPEND_VALUE));
+	Tcl_DecrRefCount(messagePtr); /* free msg object appended above */
+    }
+
+    Tcl_DecrRefCount(namePtr);    /* free the name object */
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_VarEval --
+ *
+ *	Given a variable number of string arguments, concatenate them
+ *	all together and execute the result as a Tcl command.
+ *
+ * Results:
+ *	A standard Tcl return result.  An error message or other
+ *	result may be left in interp->result.
+ *
+ * Side effects:
+ *	Depends on what was done by the command.
+ *
+ *----------------------------------------------------------------------
+ */
+	/* VARARGS2 */ /* ARGSUSED */
+int
+Tcl_VarEval TCL_VARARGS_DEF(Tcl_Interp *,arg1)
+{
+    va_list argList;
+    Tcl_DString buf;
+    char *string;
+    Tcl_Interp *interp;
+    int result;
+
+    /*
+     * Copy the strings one after the other into a single larger
+     * string.  Use stack-allocated space for small commands, but if
+     * the command gets too large than call ckalloc to create the
+     * space.
+     */
+
+    interp = TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
+    Tcl_DStringInit(&buf);
+    while (1) {
+	string = va_arg(argList, char *);
+	if (string == NULL) {
+	    break;
+	}
+	Tcl_DStringAppend(&buf, string, -1);
+    }
+    va_end(argList);
+
+    result = Tcl_Eval(interp, Tcl_DStringValue(&buf));
+    Tcl_DStringFree(&buf);
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GlobalEval --
+ *
+ *	Evaluate a command at global level in an interpreter.
+ *
+ * Results:
+ *	A standard Tcl result is returned, and interp->result is
+ *	modified accordingly.
+ *
+ * Side effects:
+ *	The command string is executed in interp, and the execution
+ *	is carried out in the variable context of global level (no
+ *	procedures active), just as if an "uplevel #0" command were
+ *	being executed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GlobalEval(interp, command)
+    Tcl_Interp *interp;		/* Interpreter in which to evaluate command. */
+    char *command;		/* Command to evaluate. */
+{
+    register Interp *iPtr = (Interp *) interp;
+    int result;
+    CallFrame *savedVarFramePtr;
+
+    savedVarFramePtr = iPtr->varFramePtr;
+    iPtr->varFramePtr = NULL;
+    result = Tcl_Eval(interp, command);
+    iPtr->varFramePtr = savedVarFramePtr;
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GlobalEvalObj --
+ *
+ *	Execute Tcl commands stored in a Tcl object at global level in
+ *	an interpreter. These commands are compiled into bytecodes if
+ *	necessary.
+ *
+ * Results:
+ *	A standard Tcl result is returned, and the interpreter's result
+ *	contains a Tcl object value to supplement the return code.
+ *
+ * Side effects:
+ *	The object is converted, if necessary, to a ByteCode object that
+ *	holds the bytecode instructions for the commands. Executing the
+ *	commands will almost certainly have side effects that depend on
+ *	those commands.
+ *
+ *	The commands are executed in interp, and the execution
+ *	is carried out in the variable context of global level (no
+ *	procedures active), just as if an "uplevel #0" command were
+ *	being executed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GlobalEvalObj(interp, objPtr)
+    Tcl_Interp *interp;		/* Interpreter in which to evaluate
+				 * commands. */
+    Tcl_Obj *objPtr;		/* Pointer to object containing commands
+				 * to execute. */
+{
+    register Interp *iPtr = (Interp *) interp;
+    int result;
+    CallFrame *savedVarFramePtr;
+
+    savedVarFramePtr = iPtr->varFramePtr;
+    iPtr->varFramePtr = NULL;
+    result = Tcl_EvalObj(interp, objPtr);
+    iPtr->varFramePtr = savedVarFramePtr;
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetRecursionLimit --
+ *
+ *	Set the maximum number of recursive calls that may be active
+ *	for an interpreter at once.
+ *
+ * Results:
+ *	The return value is the old limit on nesting for interp.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_SetRecursionLimit(interp, depth)
+    Tcl_Interp *interp;			/* Interpreter whose nesting limit
+					 * is to be set. */
+    int depth;				/* New value for maximimum depth. */
+{
+    Interp *iPtr = (Interp *) interp;
+    int old;
+
+    old = iPtr->maxNestingDepth;
+    if (depth > 0) {
+	iPtr->maxNestingDepth = depth;
+    }
+    return old;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AllowExceptions --
+ *
+ *	Sets a flag in an interpreter so that exceptions can occur
+ *	in the next call to Tcl_Eval without them being turned into
+ *	errors.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The TCL_ALLOW_EXCEPTIONS flag gets set in the interpreter's
+ *	evalFlags structure.  See the reference documentation for
+ *	more details.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AllowExceptions(interp)
+    Tcl_Interp *interp;		/* Interpreter in which to set flag. */
+{
+    Interp *iPtr = (Interp *) interp;
+
+    iPtr->evalFlags |= TCL_ALLOW_EXCEPTIONS;
+}
+
Index: /trunk/tcl/tclCkalloc.c
===================================================================
--- /trunk/tcl/tclCkalloc.c	(revision 2)
+++ /trunk/tcl/tclCkalloc.c	(revision 2)
@@ -0,0 +1,829 @@
+/* 
+ * tclCkalloc.c --
+ *
+ *    Interface to malloc and free that provides support for debugging problems
+ *    involving overwritten, double freeing memory and loss of memory.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * This code contributed by Karl Lehenbauer and Mark Diekhans
+ *
+ * RCS: @(#) $Id: tclCkalloc.c,v 1.1 2008-06-04 13:58:04 demin Exp $
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+#define FALSE	0
+#define TRUE	1
+
+#ifdef TCL_MEM_DEBUG
+
+/*
+ * One of the following structures is allocated each time the
+ * "memory tag" command is invoked, to hold the current tag.
+ */
+
+typedef struct MemTag {
+    int refCount;		/* Number of mem_headers referencing
+				 * this tag. */
+    char string[4];		/* Actual size of string will be as
+				 * large as needed for actual tag.  This
+				 * must be the last field in the structure. */
+} MemTag;
+
+#define TAG_SIZE(bytesInString) ((unsigned) sizeof(MemTag) + bytesInString - 3)
+
+static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers
+				 * (set by "memory tag" command). */
+
+/*
+ * One of the following structures is allocated just before each
+ * dynamically allocated chunk of memory, both to record information
+ * about the chunk and to help detect chunk under-runs.
+ */
+
+#define LOW_GUARD_SIZE (8 + (32 - (sizeof(long) + sizeof(int)))%8)
+struct mem_header {
+    struct mem_header *flink;
+    struct mem_header *blink;
+    MemTag *tagPtr;		/* Tag from "memory tag" command;  may be
+				 * NULL. */
+    char *file;
+    long length;
+    int line;
+    unsigned char low_guard[LOW_GUARD_SIZE];
+				/* Aligns body on 8-byte boundary, plus
+				 * provides at least 8 additional guard bytes
+				 * to detect underruns. */
+    char body[1];		/* First byte of client's space.  Actual
+				 * size of this field will be larger than
+				 * one. */
+};
+
+static struct mem_header *allocHead = NULL;  /* List of allocated structures */
+
+#define GUARD_VALUE  0141
+
+/*
+ * The following macro determines the amount of guard space *above* each
+ * chunk of memory.
+ */
+
+#define HIGH_GUARD_SIZE 8
+
+/*
+ * The following macro computes the offset of the "body" field within
+ * mem_header.  It is used to get back to the header pointer from the
+ * body pointer that's used by clients.
+ */
+
+#define BODY_OFFSET \
+	((unsigned long) (&((struct mem_header *) 0)->body))
+
+static int total_mallocs = 0;
+static int total_frees = 0;
+static int current_bytes_malloced = 0;
+static int maximum_bytes_malloced = 0;
+static int current_malloc_packets = 0;
+static int maximum_malloc_packets = 0;
+static int break_on_malloc = 0;
+static int trace_on_at_malloc = 0;
+static int  alloc_tracing = FALSE;
+static int  init_malloced_bodies = TRUE;
+#ifdef MEM_VALIDATE
+    static int  validate_memory = TRUE;
+#else
+    static int  validate_memory = FALSE;
+#endif
+
+/*
+ * Prototypes for procedures defined in this file:
+ */
+
+static int		MemoryCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv));
+static void		ValidateMemory _ANSI_ARGS_((
+			    struct mem_header *memHeaderP, char *file,
+			    int line, int nukeGuards));
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDumpMemoryInfo --
+ *     Display the global memory management statistics.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TclDumpMemoryInfo(outFile) 
+    FILE *outFile;
+{
+        fprintf(outFile,"total mallocs             %10d\n", 
+                total_mallocs);
+        fprintf(outFile,"total frees               %10d\n", 
+                total_frees);
+        fprintf(outFile,"current packets allocated %10d\n", 
+                current_malloc_packets);
+        fprintf(outFile,"current bytes allocated   %10d\n", 
+                current_bytes_malloced);
+        fprintf(outFile,"maximum packets allocated %10d\n", 
+                maximum_malloc_packets);
+        fprintf(outFile,"maximum bytes allocated   %10d\n", 
+                maximum_bytes_malloced);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ValidateMemory --
+ *     Procedure to validate allocted memory guard zones.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+ValidateMemory(memHeaderP, file, line, nukeGuards)
+    struct mem_header *memHeaderP;
+    char              *file;
+    int                line;
+    int                nukeGuards;
+{
+    unsigned char *hiPtr;
+    int   idx;
+    int   guard_failed = FALSE;
+    int byte;
+    
+    for (idx = 0; idx < LOW_GUARD_SIZE; idx++) {
+        byte = *(memHeaderP->low_guard + idx);
+        if (byte != GUARD_VALUE) {
+            guard_failed = TRUE;
+            fflush(stdout);
+	    byte &= 0xff;
+            fprintf(stderr, "low guard byte %d is 0x%x  \t%c\n", idx, byte,
+		    (isprint(UCHAR(byte)) ? byte : ' '));
+        }
+    }
+    if (guard_failed) {
+        TclDumpMemoryInfo (stderr);
+        fprintf(stderr, "low guard failed at %lx, %s %d\n",
+                 (long unsigned int) memHeaderP->body, file, line);
+        fflush(stderr);  /* In case name pointer is bad. */
+        fprintf(stderr, "%ld bytes allocated at (%s %d)\n", memHeaderP->length,
+		memHeaderP->file, memHeaderP->line);
+        panic ("Memory validation failure");
+    }
+
+    hiPtr = (unsigned char *)memHeaderP->body + memHeaderP->length;
+    for (idx = 0; idx < HIGH_GUARD_SIZE; idx++) {
+        byte = *(hiPtr + idx);
+        if (byte != GUARD_VALUE) {
+            guard_failed = TRUE;
+            fflush (stdout);
+	    byte &= 0xff;
+            fprintf(stderr, "hi guard byte %d is 0x%x  \t%c\n", idx, byte,
+		    (isprint(UCHAR(byte)) ? byte : ' '));
+        }
+    }
+
+    if (guard_failed) {
+        TclDumpMemoryInfo (stderr);
+        fprintf(stderr, "high guard failed at %lx, %s %d\n",
+                 (long unsigned int) memHeaderP->body, file, line);
+        fflush(stderr);  /* In case name pointer is bad. */
+        fprintf(stderr, "%ld bytes allocated at (%s %d)\n",
+		memHeaderP->length, memHeaderP->file,
+		memHeaderP->line);
+        panic("Memory validation failure");
+    }
+
+    if (nukeGuards) {
+        memset ((char *) memHeaderP->low_guard, 0, LOW_GUARD_SIZE); 
+        memset ((char *) hiPtr, 0, HIGH_GUARD_SIZE); 
+    }
+
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ValidateAllMemory --
+ *     Validates guard regions for all allocated memory.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+Tcl_ValidateAllMemory (file, line)
+    char  *file;
+    int    line;
+{
+    struct mem_header *memScanP;
+
+    for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink)
+        ValidateMemory(memScanP, file, line, FALSE);
+
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DumpActiveMemory --
+ *     Displays all allocated memory to stderr.
+ *
+ * Results:
+ *     Return TCL_ERROR if an error accessing the file occures, `errno' 
+ *     will have the file error number left in it.
+ *----------------------------------------------------------------------
+ */
+int
+Tcl_DumpActiveMemory (fileName)
+    char *fileName;
+{
+    FILE              *fileP;
+    struct mem_header *memScanP;
+    char              *address;
+
+    fileP = fopen(fileName, "w");
+    if (fileP == NULL)
+        return TCL_ERROR;
+
+    for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
+        address = &memScanP->body [0];
+        fprintf(fileP, "%8lx - %8lx  %7ld @ %s %d %s",
+		(long unsigned int) address,
+                 (long unsigned int) address + memScanP->length - 1,
+		 memScanP->length, memScanP->file, memScanP->line,
+		 (memScanP->tagPtr == NULL) ? "" : memScanP->tagPtr->string);
+	(void) fputc('\n', fileP);
+    }
+    fclose (fileP);
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DbCkalloc - debugging ckalloc
+ *
+ *        Allocate the requested amount of space plus some extra for
+ *        guard bands at both ends of the request, plus a size, panicing 
+ *        if there isn't enough space, then write in the guard bands
+ *        and return the address of the space in the middle that the
+ *        user asked for.
+ *
+ *        The second and third arguments are file and line, these contain
+ *        the filename and line number corresponding to the caller.
+ *        These are sent by the ckalloc macro; it uses the preprocessor
+ *        autodefines __FILE__ and __LINE__.
+ *
+ *----------------------------------------------------------------------
+ */
+char *
+Tcl_DbCkalloc(size, file, line)
+    unsigned int size;
+    char        *file;
+    int          line;
+{
+    struct mem_header *result;
+
+    if (validate_memory)
+        Tcl_ValidateAllMemory (file, line);
+
+    result = (struct mem_header *) TclpAlloc((unsigned)size + 
+                              sizeof(struct mem_header) + HIGH_GUARD_SIZE);
+    if (result == NULL) {
+        fflush(stdout);
+        TclDumpMemoryInfo(stderr);
+        panic("unable to alloc %d bytes, %s line %d", size, file, 
+              line);
+    }
+
+    /*
+     * Fill in guard zones and size.  Also initialize the contents of
+     * the block with bogus bytes to detect uses of initialized data.
+     * Link into allocated list.
+     */
+    if (init_malloced_bodies) {
+        memset ((VOID *) result, GUARD_VALUE,
+		size + sizeof(struct mem_header) + HIGH_GUARD_SIZE);
+    } else {
+	memset ((char *) result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE);
+	memset (result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE);
+    }
+    result->length = size;
+    result->tagPtr = curTagPtr;
+    if (curTagPtr != NULL) {
+	curTagPtr->refCount++;
+    }
+    result->file = file;
+    result->line = line;
+    result->flink = allocHead;
+    result->blink = NULL;
+    if (allocHead != NULL)
+        allocHead->blink = result;
+    allocHead = result;
+
+    total_mallocs++;
+    if (trace_on_at_malloc && (total_mallocs >= trace_on_at_malloc)) {
+        (void) fflush(stdout);
+        fprintf(stderr, "reached malloc trace enable point (%d)\n",
+                total_mallocs);
+        fflush(stderr);
+        alloc_tracing = TRUE;
+        trace_on_at_malloc = 0;
+    }
+
+    if (alloc_tracing)
+        fprintf(stderr,"ckalloc %lx %d %s %d\n",
+		(long unsigned int) result->body, size, file, line);
+
+    if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
+        break_on_malloc = 0;
+        (void) fflush(stdout);
+        fprintf(stderr,"reached malloc break limit (%d)\n", 
+                total_mallocs);
+        fprintf(stderr, "program will now enter C debugger\n");
+        (void) fflush(stderr);
+	abort();
+    }
+
+    current_malloc_packets++;
+    if (current_malloc_packets > maximum_malloc_packets)
+        maximum_malloc_packets = current_malloc_packets;
+    current_bytes_malloced += size;
+    if (current_bytes_malloced > maximum_bytes_malloced)
+        maximum_bytes_malloced = current_bytes_malloced;
+
+    return result->body;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DbCkfree - debugging ckfree
+ *
+ *        Verify that the low and high guards are intact, and if so
+ *        then free the buffer else panic.
+ *
+ *        The guards are erased after being checked to catch duplicate
+ *        frees.
+ *
+ *        The second and third arguments are file and line, these contain
+ *        the filename and line number corresponding to the caller.
+ *        These are sent by the ckfree macro; it uses the preprocessor
+ *        autodefines __FILE__ and __LINE__.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_DbCkfree(ptr, file, line)
+    char *  ptr;
+    char     *file;
+    int       line;
+{
+    /*
+     * The following cast is *very* tricky.  Must convert the pointer
+     * to an integer before doing arithmetic on it, because otherwise
+     * the arithmetic will be done differently (and incorrectly) on
+     * word-addressed machines such as Crays (will subtract only bytes,
+     * even though BODY_OFFSET is in words on these machines).
+     */
+
+    struct mem_header *memp = (struct mem_header *)
+	    (((unsigned long) ptr) - BODY_OFFSET);
+
+    if (alloc_tracing)
+        fprintf(stderr, "ckfree %lx %ld %s %d\n",
+		(long unsigned int) memp->body, memp->length, file, line);
+
+    if (validate_memory)
+        Tcl_ValidateAllMemory(file, line);
+
+    ValidateMemory(memp, file, line, TRUE);
+    if (init_malloced_bodies) {
+	memset((VOID *) ptr, GUARD_VALUE, (size_t) memp->length);
+    }
+
+    total_frees++;
+    current_malloc_packets--;
+    current_bytes_malloced -= memp->length;
+
+    if (memp->tagPtr != NULL) {
+	memp->tagPtr->refCount--;
+	if ((memp->tagPtr->refCount == 0) && (curTagPtr != memp->tagPtr)) {
+	    TclpFree((char *) memp->tagPtr);
+	}
+    }
+
+    /*
+     * Delink from allocated list
+     */
+    if (memp->flink != NULL)
+        memp->flink->blink = memp->blink;
+    if (memp->blink != NULL)
+        memp->blink->flink = memp->flink;
+    if (allocHead == memp)
+        allocHead = memp->flink;
+    TclpFree((char *) memp);
+    return 0;
+}
+
+
+/*
+ *--------------------------------------------------------------------
+ *
+ * Tcl_DbCkrealloc - debugging ckrealloc
+ *
+ *	Reallocate a chunk of memory by allocating a new one of the
+ *	right size, copying the old data to the new location, and then
+ *	freeing the old memory space, using all the memory checking
+ *	features of this package.
+ *
+ *--------------------------------------------------------------------
+ */
+char *
+Tcl_DbCkrealloc(ptr, size, file, line)
+    char *ptr;
+    unsigned int size;
+    char *file;
+    int line;
+{
+    char *new;
+    unsigned int copySize;
+
+    /*
+     * See comment from Tcl_DbCkfree before you change the following
+     * line.
+     */
+
+    struct mem_header *memp = (struct mem_header *)
+	    (((unsigned long) ptr) - BODY_OFFSET);
+
+    copySize = size;
+    if (copySize > (unsigned int) memp->length) {
+	copySize = memp->length;
+    }
+    new = Tcl_DbCkalloc(size, file, line);
+    memcpy((VOID *) new, (VOID *) ptr, (size_t) copySize);
+    Tcl_DbCkfree(ptr, file, line);
+    return(new);
+}
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Alloc, et al. --
+ *
+ *	These functions are defined in terms of the debugging versions
+ *	when TCL_MEM_DEBUG is set.
+ *
+ * Results:
+ *	Same as the debug versions.
+ *
+ * Side effects:
+ *	Same as the debug versions.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#undef Tcl_Alloc
+#undef Tcl_Free
+#undef Tcl_Realloc
+
+char *
+Tcl_Alloc(size)
+    unsigned int size;
+{
+    return Tcl_DbCkalloc(size, "unknown", 0);
+}
+
+void
+Tcl_Free(ptr)
+    char *ptr;
+{
+    Tcl_DbCkfree(ptr, "unknown", 0);
+}
+
+char *
+Tcl_Realloc(ptr, size)
+    char *ptr;
+    unsigned int size;
+{
+    return Tcl_DbCkrealloc(ptr, size, "unknown", 0);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MemoryCmd --
+ *     Implements the TCL memory command:
+ *       memory info
+ *       memory display
+ *       break_on_malloc count
+ *       trace_on_at_malloc count
+ *       trace on|off
+ *       validate on|off
+ *
+ * Results:
+ *     Standard TCL results.
+ *
+ *----------------------------------------------------------------------
+ */
+	/* ARGSUSED */
+static int
+MemoryCmd (clientData, interp, argc, argv)
+    ClientData  clientData;
+    Tcl_Interp *interp;
+    int         argc;
+    char      **argv;
+{
+    char *fileName;
+    Tcl_DString buffer;
+    int result;
+
+    if (argc < 2) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"",
+		argv[0], " option [args..]\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    if (strcmp(argv[1],"active") == 0) {
+        if (argc != 3) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"",
+		    argv[0], " active file\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
+	if (fileName == NULL) {
+	    return TCL_ERROR;
+	}
+	result = Tcl_DumpActiveMemory (fileName);
+	Tcl_DStringFree(&buffer);
+	if (result != TCL_OK) {
+	    Tcl_AppendResult(interp, "error accessing ", argv[2], 
+		    (char *) NULL);
+	    return TCL_ERROR;
+	}
+	return TCL_OK;
+    }
+    if (strcmp(argv[1],"break_on_malloc") == 0) {
+        if (argc != 3) {
+            goto argError;
+	}
+        if (Tcl_GetInt(interp, argv[2], &break_on_malloc) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+        return TCL_OK;
+    }
+    if (strcmp(argv[1],"info") == 0) {
+        TclDumpMemoryInfo(stdout);
+        return TCL_OK;
+    }
+    if (strcmp(argv[1],"init") == 0) {
+        if (argc != 3) {
+            goto bad_suboption;
+	}
+        init_malloced_bodies = (strcmp(argv[2],"on") == 0);
+        return TCL_OK;
+    }
+    if (strcmp(argv[1],"tag") == 0) {
+	if (argc != 3) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		    " tag string\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	if ((curTagPtr != NULL) && (curTagPtr->refCount == 0)) {
+	    TclpFree((char *) curTagPtr);
+	}
+	curTagPtr = (MemTag *) TclpAlloc(TAG_SIZE(strlen(argv[2])));
+	curTagPtr->refCount = 0;
+	strcpy(curTagPtr->string, argv[2]);
+	return TCL_OK;
+    }
+    if (strcmp(argv[1],"trace") == 0) {
+        if (argc != 3) {
+            goto bad_suboption;
+	}
+        alloc_tracing = (strcmp(argv[2],"on") == 0);
+        return TCL_OK;
+    }
+
+    if (strcmp(argv[1],"trace_on_at_malloc") == 0) {
+        if (argc != 3) {
+            goto argError;
+	}
+        if (Tcl_GetInt(interp, argv[2], &trace_on_at_malloc) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	return TCL_OK;
+    }
+    if (strcmp(argv[1],"validate") == 0) {
+        if (argc != 3) {
+	    goto bad_suboption;
+	}
+        validate_memory = (strcmp(argv[2],"on") == 0);
+        return TCL_OK;
+    }
+
+    Tcl_AppendResult(interp, "bad option \"", argv[1],
+	    "\": should be active, break_on_malloc, info, init, ",
+	    "tag, trace, trace_on_at_malloc, or validate", (char *) NULL);
+    return TCL_ERROR;
+
+argError:
+    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+	    " ", argv[1], " count\"", (char *) NULL);
+    return TCL_ERROR;
+
+bad_suboption:
+    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+	    " ", argv[1], " on|off\"", (char *) NULL);
+    return TCL_ERROR;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_InitMemory --
+ *     Initialize the memory command.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+Tcl_InitMemory(interp)
+    Tcl_Interp *interp;
+{
+    Tcl_CreateCommand (interp, "memory", MemoryCmd, (ClientData) NULL, 
+	    (Tcl_CmdDeleteProc *) NULL);
+}
+
+#else
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Alloc --
+ *     Interface to TclpAlloc when TCL_MEM_DEBUG is disabled.  It does check
+ *     that memory was actually allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_Alloc (size)
+    unsigned int size;
+{
+        char *result;
+
+        result = TclpAlloc(size);
+        if (result == NULL) 
+                panic("unable to alloc %d bytes", size);
+        return result;
+}
+
+char *
+Tcl_DbCkalloc(size, file, line)
+    unsigned int size;
+    char        *file;
+    int          line;
+{
+    char *result;
+
+    result = (char *) TclpAlloc(size);
+
+    if (result == NULL) {
+        fflush(stdout);
+        panic("unable to alloc %d bytes, %s line %d", size, file, 
+              line);
+    }
+    return result;
+}
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Realloc --
+ *     Interface to TclpRealloc when TCL_MEM_DEBUG is disabled.  It does 
+ *     check that memory was actually allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_Realloc(ptr, size)
+    char *ptr;
+    unsigned int size;
+{
+    char *result;
+
+    result = TclpRealloc(ptr, size);
+    if (result == NULL) 
+	panic("unable to realloc %d bytes", size);
+    return result;
+}
+
+char *
+Tcl_DbCkrealloc(ptr, size, file, line)
+    char *ptr;
+    unsigned int size;
+    char *file;
+    int line;
+{
+    char *result;
+
+    result = (char *) TclpRealloc(ptr, size);
+
+    if (result == NULL) {
+        fflush(stdout);
+        panic("unable to realloc %d bytes, %s line %d", size, file, 
+              line);
+    }
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Free --
+ *     Interface to TclpFree when TCL_MEM_DEBUG is disabled.  Done here
+ *     rather in the macro to keep some modules from being compiled with 
+ *     TCL_MEM_DEBUG enabled and some with it disabled.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_Free (ptr)
+    char *ptr;
+{
+        TclpFree(ptr);
+}
+
+int
+Tcl_DbCkfree(ptr, file, line)
+    char *  ptr;
+    char     *file;
+    int       line;
+{
+    TclpFree(ptr);
+    return 0;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_InitMemory --
+ *     Dummy initialization for memory command, which is only available 
+ *     if TCL_MEM_DEBUG is on.
+ *
+ *----------------------------------------------------------------------
+ */
+	/* ARGSUSED */
+void
+Tcl_InitMemory(interp)
+    Tcl_Interp *interp;
+{
+}
+
+#undef Tcl_DumpActiveMemory
+#undef Tcl_ValidateAllMemory
+
+extern int		Tcl_DumpActiveMemory _ANSI_ARGS_((char *fileName));
+extern void		Tcl_ValidateAllMemory _ANSI_ARGS_((char *file,
+			    int line));
+
+int
+Tcl_DumpActiveMemory(fileName)
+    char *fileName;
+{
+    return TCL_OK;
+}
+
+void
+Tcl_ValidateAllMemory(file, line)
+    char  *file;
+    int    line;
+{
+}
+
+#endif
Index: /trunk/tcl/tclCmdAH.c
===================================================================
--- /trunk/tcl/tclCmdAH.c	(revision 2)
+++ /trunk/tcl/tclCmdAH.c	(revision 2)
@@ -0,0 +1,1202 @@
+/* 
+ * tclCmdAH.c --
+ *
+ *	This file contains the top-level command routines for most of
+ *	the Tcl built-in commands whose names begin with the letters
+ *	A to H.
+ *
+ * Copyright (c) 1987-1993 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.1 2008-06-04 13:58:04 demin Exp $
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_BreakCmd --
+ *
+ *	This procedure is invoked to process the "break" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ *	With the bytecode compiler, this procedure is only called when
+ *	a command name is computed at runtime, and is "break" or the name
+ *	to which "break" was renamed: e.g., "set z break; $z"
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_BreakCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    if (argc != 1) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"",
+		argv[0], "\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+    return TCL_BREAK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CaseObjCmd --
+ *
+ *	This procedure is invoked to process the "case" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_CaseObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    register int i;
+    int body, result;
+    char *string, *arg;
+    int argLen, caseObjc;
+    Tcl_Obj *CONST *caseObjv;
+    Tcl_Obj *armPtr;
+
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"string ?in? patList body ... ?default body?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * THIS FAILS IF AN OBJECT'S STRING REP HAS A NULL BYTE.
+     */
+    
+    string = Tcl_GetStringFromObj(objv[1], &argLen);
+    body = -1;
+
+    arg = Tcl_GetStringFromObj(objv[2], &argLen);
+    if (strcmp(arg, "in") == 0) {
+	i = 3;
+    } else {
+	i = 2;
+    }
+    caseObjc = objc - i;
+    caseObjv = objv + i;
+
+    /*
+     * If all of the pattern/command pairs are lumped into a single
+     * argument, split them out again.
+     * THIS FAILS IF THE ARG'S STRING REP CONTAINS A NULL
+     */
+
+    if (caseObjc == 1) {
+	Tcl_Obj **newObjv;
+	
+	Tcl_ListObjGetElements(interp, caseObjv[0], &caseObjc, &newObjv);
+	caseObjv = newObjv;
+    }
+
+    for (i = 0;  i < caseObjc;  i += 2) {
+	int patObjc, j;
+	char **patObjv;
+	char *pat;
+	register char *p;
+
+	if (i == (caseObjc-1)) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	            "extra case pattern with no body", -1);
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Check for special case of single pattern (no list) with
+	 * no backslash sequences.
+	 */
+
+	pat = Tcl_GetStringFromObj(caseObjv[i], &argLen);
+	for (p = pat;  *p != 0;  p++) {	/* FAILS IF NULL BYTE */
+	    if (isspace(UCHAR(*p)) || (*p == '\\')) {
+		break;
+	    }
+	}
+	if (*p == 0) {
+	    if ((*pat == 'd') && (strcmp(pat, "default") == 0)) {
+		body = i+1;
+	    }
+	    if (Tcl_StringMatch(string, pat)) {
+		body = i+1;
+		goto match;
+	    }
+	    continue;
+	}
+
+
+	/*
+	 * Break up pattern lists, then check each of the patterns
+	 * in the list.
+	 */
+
+	result = Tcl_SplitList(interp, pat, &patObjc, &patObjv);
+	if (result != TCL_OK) {
+	    return result;
+	}
+	for (j = 0; j < patObjc; j++) {
+	    if (Tcl_StringMatch(string, patObjv[j])) {
+		body = i+1;
+		break;
+	    }
+	}
+	ckfree((char *) patObjv);
+	if (j < patObjc) {
+	    break;
+	}
+    }
+
+    match:
+    if (body != -1) {
+	armPtr = caseObjv[body-1];
+	result = Tcl_EvalObj(interp, caseObjv[body]);
+	if (result == TCL_ERROR) {
+	    char msg[100];
+	    
+	    arg = Tcl_GetStringFromObj(armPtr, &argLen);
+	    sprintf(msg, "\n    (\"%.*s\" arm line %d)", argLen, arg,
+	            interp->errorLine);
+	    Tcl_AddObjErrorInfo(interp, msg, -1);
+	}
+	return result;
+    }
+
+    /*
+     * Nothing matched: return nothing.
+     */
+
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CatchObjCmd --
+ *
+ *	This object-based procedure is invoked to process the "catch" Tcl 
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_CatchObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Tcl_Obj *varNamePtr = NULL;
+    int result;
+
+    if ((objc != 2) && (objc != 3)) {
+	Tcl_WrongNumArgs(interp, 1, objv, "command ?varName?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Save a pointer to the variable name object, if any, in case the
+     * Tcl_EvalObj reallocates the bytecode interpreter's evaluation
+     * stack rendering objv invalid.
+     */
+    
+    if (objc == 3) {
+	varNamePtr = objv[2];
+    }
+    
+    result = Tcl_EvalObj(interp, objv[1]);
+    
+    if (objc == 3) {
+	if (Tcl_ObjSetVar2(interp, varNamePtr, NULL,
+		    Tcl_GetObjResult(interp), TCL_PARSE_PART1) == NULL) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),  
+	            "couldn't save command result in variable", -1);
+	    return TCL_ERROR;
+	}
+    }
+
+    /*
+     * Set the interpreter's object result to an integer object holding the
+     * integer Tcl_EvalObj result. Note that we don't bother generating a
+     * string representation. We reset the interpreter's object result
+     * to an unshared empty object and then set it to be an integer object.
+     */
+
+    Tcl_ResetResult(interp);
+    Tcl_SetIntObj(Tcl_GetObjResult(interp), result);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ConcatObjCmd --
+ *
+ *	This object-based procedure is invoked to process the "concat" Tcl
+ *	command. See the user documentation for details on what it does/
+ *
+ * Results:
+ *	A standard Tcl object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_ConcatObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    if (objc >= 2) {
+	Tcl_SetObjResult(interp, Tcl_ConcatObj(objc-1, objv+1));
+    }
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ContinueCmd -
+ *
+ *	This procedure is invoked to process the "continue" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ *	With the bytecode compiler, this procedure is only called when
+ *	a command name is computed at runtime, and is "continue" or the name
+ *	to which "continue" was renamed: e.g., "set z continue; $z"
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_ContinueCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    if (argc != 1) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		"\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+    return TCL_CONTINUE;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ErrorObjCmd --
+ *
+ *	This procedure is invoked to process the "error" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_ErrorObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Interp *iPtr = (Interp *) interp;
+    register Tcl_Obj *namePtr;
+    char *info;
+    int infoLen;
+
+    if ((objc < 2) || (objc > 4)) {
+	Tcl_WrongNumArgs(interp, 1, objv, "message ?errorInfo? ?errorCode?");
+	return TCL_ERROR;
+    }
+    
+    if (objc >= 3) {		/* process the optional info argument */
+	info = Tcl_GetStringFromObj(objv[2], &infoLen);
+	if (*info != 0) {
+	    Tcl_AddObjErrorInfo(interp, info, infoLen);
+	    iPtr->flags |= ERR_ALREADY_LOGGED;
+	}
+    }
+    
+    if (objc == 4) {
+	namePtr = Tcl_NewStringObj("errorCode", -1);
+	Tcl_ObjSetVar2(interp, namePtr, (Tcl_Obj *) NULL, objv[3],
+		TCL_GLOBAL_ONLY);
+	iPtr->flags |= ERROR_CODE_SET;
+	Tcl_DecrRefCount(namePtr); /* we're done with name object */
+    }
+    
+    Tcl_SetObjResult(interp, objv[1]);
+    return TCL_ERROR;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_EvalObjCmd --
+ *
+ *	This object-based procedure is invoked to process the "eval" Tcl 
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_EvalObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    int result;
+    register Tcl_Obj *objPtr;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
+	return TCL_ERROR;
+    }
+    
+    if (objc == 2) {
+	result = Tcl_EvalObj(interp, objv[1]);
+    } else {
+	/*
+	 * More than one argument: concatenate them together with spaces
+	 * between, then evaluate the result.
+	 */
+    
+	objPtr = Tcl_ConcatObj(objc-1, objv+1);
+	result = Tcl_EvalObj(interp, objPtr);
+	Tcl_DecrRefCount(objPtr);  /* we're done with the object */
+    }
+    if (result == TCL_ERROR) {
+	char msg[60];
+	sprintf(msg, "\n    (\"eval\" body line %d)", interp->errorLine);
+	Tcl_AddObjErrorInfo(interp, msg, -1);
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ExprObjCmd --
+ *
+ *	This object-based procedure is invoked to process the "expr" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ *	With the bytecode compiler, this procedure is called in two
+ *	circumstances: 1) to execute expr commands that are too complicated
+ *	or too unsafe to try compiling directly into an inline sequence of
+ *	instructions, and 2) to execute commands where the command name is
+ *	computed at runtime and is "expr" or the name to which "expr" was
+ *	renamed (e.g., "set z expr; $z 2+3")
+ *
+ * Results:
+ *	A standard Tcl object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_ExprObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    register Tcl_Obj *objPtr;
+    Tcl_Obj *resultPtr;
+    register char *bytes;
+    int length, i, result;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
+	return TCL_ERROR;
+    }
+
+    if (objc == 2) {
+	result = Tcl_ExprObj(interp, objv[1], &resultPtr);
+	if (result == TCL_OK) {
+	    Tcl_SetObjResult(interp, resultPtr);
+	    Tcl_DecrRefCount(resultPtr);  /* done with the result object */
+	}
+	return result;
+    }
+
+    /*
+     * Create a new object holding the concatenated argument strings.
+     * THIS FAILS IF AN OBJECT'S STRING REP HAS A NULL BYTE.
+     */
+
+    bytes = Tcl_GetStringFromObj(objv[1], &length);
+    objPtr = Tcl_NewStringObj(bytes, length);
+    Tcl_IncrRefCount(objPtr);
+    for (i = 2;  i < objc;  i++) {
+	Tcl_AppendToObj(objPtr, " ", 1);
+	bytes = Tcl_GetStringFromObj(objv[i], &length);
+	Tcl_AppendToObj(objPtr, bytes, length);
+    }
+
+    /*
+     * Evaluate the concatenated string object.
+     */
+
+    result = Tcl_ExprObj(interp, objPtr, &resultPtr);
+    if (result == TCL_OK) {
+	Tcl_SetObjResult(interp, resultPtr);
+	Tcl_DecrRefCount(resultPtr);  /* done with the result object */
+    }
+
+    /*
+     * Free allocated resources.
+     */
+    
+    Tcl_DecrRefCount(objPtr);
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ForCmd --
+ *
+ *      This procedure is invoked to process the "for" Tcl command.
+ *      See the user documentation for details on what it does.
+ *
+ *	With the bytecode compiler, this procedure is only called when
+ *	a command name is computed at runtime, and is "for" or the name
+ *	to which "for" was renamed: e.g.,
+ *	"set z for; $z {set i 0} {$i<100} {incr i} {puts $i}"
+ *
+ * Results:
+ *      A standard Tcl result.
+ *
+ * Side effects:
+ *      See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+        /* ARGSUSED */
+int
+Tcl_ForCmd(dummy, interp, argc, argv)
+    ClientData dummy;                   /* Not used. */
+    Tcl_Interp *interp;                 /* Current interpreter. */
+    int argc;                           /* Number of arguments. */
+    char **argv;                        /* Argument strings. */
+{
+    int result, value;
+
+    if (argc != 5) {
+        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+                " start test next command\"", (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    result = Tcl_Eval(interp, argv[1]);
+    if (result != TCL_OK) {
+        if (result == TCL_ERROR) {
+            Tcl_AddErrorInfo(interp, "\n    (\"for\" initial command)");
+        }
+        return result;
+    }
+    while (1) {
+        result = Tcl_ExprBoolean(interp, argv[2], &value);
+        if (result != TCL_OK) {
+            return result;
+        }
+        if (!value) {
+            break;
+        }
+        result = Tcl_Eval(interp, argv[4]);
+        if ((result != TCL_OK) && (result != TCL_CONTINUE)) {
+            if (result == TCL_ERROR) {
+                char msg[60];
+                sprintf(msg, "\n    (\"for\" body line %d)",interp->errorLine);
+                Tcl_AddErrorInfo(interp, msg);
+            }
+            break;
+        }
+        result = Tcl_Eval(interp, argv[3]);
+	if (result == TCL_BREAK) {
+            break;
+        } else if (result != TCL_OK) {
+            if (result == TCL_ERROR) {
+                Tcl_AddErrorInfo(interp, "\n    (\"for\" loop-end command)");
+            }
+            return result;
+        }
+    }
+    if (result == TCL_BREAK) {
+        result = TCL_OK;
+    }
+    if (result == TCL_OK) {
+        Tcl_ResetResult(interp);
+    }
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ForeachObjCmd --
+ *
+ *	This object-based procedure is invoked to process the "foreach" Tcl
+ *	command.  See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_ForeachObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    int result = TCL_OK;
+    int i;			/* i selects a value list */
+    int j, maxj;		/* Number of loop iterations */
+    int v;			/* v selects a loop variable */
+    int numLists;		/* Count of value lists */
+    Tcl_Obj *bodyPtr;
+
+    /*
+     * We copy the argument object pointers into a local array to avoid
+     * the problem that "objv" might become invalid. It is a pointer into
+     * the evaluation stack and that stack might be grown and reallocated
+     * if the loop body requires a large amount of stack space.
+     */
+    
+#define NUM_ARGS 9
+    Tcl_Obj *(argObjStorage[NUM_ARGS]);
+    Tcl_Obj **argObjv = argObjStorage;
+    
+#define STATIC_LIST_SIZE 4
+    int indexArray[STATIC_LIST_SIZE];	  /* Array of value list indices */
+    int varcListArray[STATIC_LIST_SIZE];  /* # loop variables per list */
+    Tcl_Obj **varvListArray[STATIC_LIST_SIZE]; /* Array of var name lists */
+    int argcListArray[STATIC_LIST_SIZE];  /* Array of value list sizes */
+    Tcl_Obj **argvListArray[STATIC_LIST_SIZE]; /* Array of value lists */
+
+    int *index = indexArray;
+    int *varcList = varcListArray;
+    Tcl_Obj ***varvList = varvListArray;
+    int *argcList = argcListArray;
+    Tcl_Obj ***argvList = argvListArray;
+
+    if (objc < 4 || (objc%2 != 0)) {
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"varList list ?varList list ...? command");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Create the object argument array "argObjv". Make sure argObjv is
+     * large enough to hold the objc arguments.
+     */
+
+    if (objc > NUM_ARGS) {
+	argObjv = (Tcl_Obj **) ckalloc(objc * sizeof(Tcl_Obj *));
+    }
+    for (i = 0;  i < objc;  i++) {
+	argObjv[i] = objv[i];
+    }
+
+    /*
+     * Manage numList parallel value lists.
+     * argvList[i] is a value list counted by argcList[i]
+     * varvList[i] is the list of variables associated with the value list
+     * varcList[i] is the number of variables associated with the value list
+     * index[i] is the current pointer into the value list argvList[i]
+     */
+
+    numLists = (objc-2)/2;
+    if (numLists > STATIC_LIST_SIZE) {
+	index = (int *) ckalloc(numLists * sizeof(int));
+	varcList = (int *) ckalloc(numLists * sizeof(int));
+	varvList = (Tcl_Obj ***) ckalloc(numLists * sizeof(Tcl_Obj **));
+	argcList = (int *) ckalloc(numLists * sizeof(int));
+	argvList = (Tcl_Obj ***) ckalloc(numLists * sizeof(Tcl_Obj **));
+    }
+    for (i = 0;  i < numLists;  i++) {
+	index[i] = 0;
+	varcList[i] = 0;
+	varvList[i] = (Tcl_Obj **) NULL;
+	argcList[i] = 0;
+	argvList[i] = (Tcl_Obj **) NULL;
+    }
+
+    /*
+     * Break up the value lists and variable lists into elements
+     * THIS FAILS IF THE OBJECT'S STRING REP HAS A NULL BYTE.
+     */
+
+    maxj = 0;
+    for (i = 0;  i < numLists;  i++) {
+	result = Tcl_ListObjGetElements(interp, argObjv[1+i*2],
+	        &varcList[i], &varvList[i]);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	if (varcList[i] < 1) {
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	            "foreach varlist is empty", -1);
+	    result = TCL_ERROR;
+	    goto done;
+	}
+	
+	result = Tcl_ListObjGetElements(interp, argObjv[2+i*2],
+	        &argcList[i], &argvList[i]);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	
+	j = argcList[i] / varcList[i];
+	if ((argcList[i] % varcList[i]) != 0) {
+	    j++;
+	}
+	if (j > maxj) {
+	    maxj = j;
+	}
+    }
+
+    /*
+     * Iterate maxj times through the lists in parallel
+     * If some value lists run out of values, set loop vars to ""
+     */
+    
+    bodyPtr = argObjv[objc-1];
+    for (j = 0;  j < maxj;  j++) {
+	for (i = 0;  i < numLists;  i++) {
+	    /*
+	     * If a variable or value list object has been converted to
+	     * another kind of Tcl object, convert it back to a list object
+	     * and refetch the pointer to its element array.
+	     */
+
+	    if (argObjv[1+i*2]->typePtr != &tclListType) {
+		result = Tcl_ListObjGetElements(interp, argObjv[1+i*2],
+		        &varcList[i], &varvList[i]);
+		if (result != TCL_OK) {
+		    panic("Tcl_ForeachObjCmd: could not reconvert variable list %d to a list object\n", i);
+		}
+	    }
+	    if (argObjv[2+i*2]->typePtr != &tclListType) {
+		result = Tcl_ListObjGetElements(interp, argObjv[2+i*2],
+	                &argcList[i], &argvList[i]);
+		if (result != TCL_OK) {
+		    panic("Tcl_ForeachObjCmd: could not reconvert value list %d to a list object\n", i);
+		}
+	    }
+	    
+	    for (v = 0;  v < varcList[i];  v++) {
+		int k = index[i]++;
+		Tcl_Obj *valuePtr, *varValuePtr;
+		int isEmptyObj = 0;
+		
+		if (k < argcList[i]) {
+		    valuePtr = argvList[i][k];
+		} else {
+		    valuePtr = Tcl_NewObj(); /* empty string */
+		    isEmptyObj = 1;
+		}
+		varValuePtr = Tcl_ObjSetVar2(interp, varvList[i][v], NULL,
+			valuePtr, TCL_PARSE_PART1);
+		if (varValuePtr == NULL) {
+		    if (isEmptyObj) {
+			Tcl_DecrRefCount(valuePtr);
+		    }
+		    Tcl_ResetResult(interp);
+		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+			"couldn't set loop variable: \"",
+			Tcl_GetStringFromObj(varvList[i][v], (int *) NULL),
+			"\"", (char *) NULL);
+		    result = TCL_ERROR;
+		    goto done;
+		}
+
+	    }
+	}
+
+	result = Tcl_EvalObj(interp, bodyPtr);
+	if (result != TCL_OK) {
+	    if (result == TCL_CONTINUE) {
+		result = TCL_OK;
+	    } else if (result == TCL_BREAK) {
+		result = TCL_OK;
+		break;
+	    } else if (result == TCL_ERROR) {
+		char msg[100];
+		sprintf(msg, "\n    (\"foreach\" body line %d)",
+			interp->errorLine);
+		Tcl_AddObjErrorInfo(interp, msg, -1);
+		break;
+	    } else {
+		break;
+	    }
+	}
+    }
+    if (result == TCL_OK) {
+	Tcl_ResetResult(interp);
+    }
+
+    done:
+    if (numLists > STATIC_LIST_SIZE) {
+	ckfree((char *) index);
+	ckfree((char *) varcList);
+	ckfree((char *) argcList);
+	ckfree((char *) varvList);
+	ckfree((char *) argvList);
+    }
+    if (argObjv != argObjStorage) {
+	ckfree((char *) argObjv);
+    }
+    return result;
+#undef STATIC_LIST_SIZE
+#undef NUM_ARGS
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FormatObjCmd --
+ *
+ *	This procedure is invoked to process the "format" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_FormatObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;    	/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    register char *format;	/* Used to read characters from the format
+				 * string. */
+    int formatLen;              /* The length of the format string */
+    char *endPtr;               /* Points to the last char in format array */
+    char newFormat[40];		/* A new format specifier is generated here. */
+    int width;			/* Field width from field specifier, or 0 if
+				 * no width given. */
+    int precision;		/* Field precision from field specifier, or 0
+				 * if no precision given. */
+    int size;			/* Number of bytes needed for result of
+				 * conversion, based on type of conversion
+				 * ("e", "s", etc.), width, and precision. */
+    int intValue;		/* Used to hold value to pass to sprintf, if
+				 * it's a one-word integer or char value */
+    char *ptrValue = NULL;	/* Used to hold value to pass to sprintf, if
+				 * it's a one-word value. */
+    double doubleValue;		/* Used to hold value to pass to sprintf if
+				 * it's a double value. */
+    int whichValue;		/* Indicates which of intValue, ptrValue,
+				 * or doubleValue has the value to pass to
+				 * sprintf, according to the following
+				 * definitions: */
+#   define INT_VALUE 0
+#   define PTR_VALUE 1
+#   define DOUBLE_VALUE 2
+#   define MAX_FLOAT_SIZE 320
+    
+    Tcl_Obj *resultPtr;  	/* Where result is stored finally. */
+    char staticBuf[MAX_FLOAT_SIZE + 1];
+                                /* A static buffer to copy the format results 
+				 * into */
+    char *dst = staticBuf;      /* The buffer that sprintf writes into each
+				 * time the format processes a specifier */
+    int dstSize = MAX_FLOAT_SIZE;
+                                /* The size of the dst buffer */
+    int noPercent;		/* Special case for speed:  indicates there's
+				 * no field specifier, just a string to copy.*/
+    int objIndex;		/* Index of argument to substitute next. */
+    int gotXpg = 0;		/* Non-zero means that an XPG3 %n$-style
+				 * specifier has been seen. */
+    int gotSequential = 0;	/* Non-zero means that a regular sequential
+				 * (non-XPG3) conversion specifier has been
+				 * seen. */
+    int useShort;		/* Value to be printed is short (half word). */
+    char *end;			/* Used to locate end of numerical fields. */
+
+    /*
+     * This procedure is a bit nasty.  The goal is to use sprintf to
+     * do most of the dirty work.  There are several problems:
+     * 1. this procedure can't trust its arguments.
+     * 2. we must be able to provide a large enough result area to hold
+     *    whatever's generated.  This is hard to estimate.
+     * 2. there's no way to move the arguments from objv to the call
+     *    to sprintf in a reasonable way.  This is particularly nasty
+     *    because some of the arguments may be two-word values (doubles).
+     * So, what happens here is to scan the format string one % group
+     * at a time, making many individual calls to sprintf.
+     */
+
+    if (objc < 2) {
+        Tcl_WrongNumArgs(interp, 1, objv,
+		"formatString ?arg arg ...?");
+	return TCL_ERROR;
+    }
+
+    format = Tcl_GetStringFromObj(objv[1], &formatLen);
+    endPtr = format + formatLen;
+    resultPtr = Tcl_NewObj();
+    objIndex = 2;
+
+    while (format < endPtr) {
+	register char *newPtr = newFormat;
+
+	width = precision = noPercent = useShort = 0;
+	whichValue = PTR_VALUE;
+
+	/*
+	 * Get rid of any characters before the next field specifier.
+	 */
+	if (*format != '%') {
+	    ptrValue = format;
+	    while ((*format != '%') && (format < endPtr)) {
+		format++;
+	    }
+	    size = format - ptrValue;
+	    noPercent = 1;
+	    goto doField;
+	}
+
+	if (format[1] == '%') {
+	    ptrValue = format;
+	    size = 1;
+	    noPercent = 1;
+	    format += 2;
+	    goto doField;
+	}
+
+	/*
+	 * Parse off a field specifier, compute how many characters
+	 * will be needed to store the result, and substitute for
+	 * "*" size specifiers.
+	 */
+	*newPtr = '%';
+	newPtr++;
+	format++;
+	if (isdigit(UCHAR(*format))) {
+	    int tmp;
+
+	    /*
+	     * Check for an XPG3-style %n$ specification.  Note: there
+	     * must not be a mixture of XPG3 specs and non-XPG3 specs
+	     * in the same format string.
+	     */
+
+	    tmp = strtoul(format, &end, 10);
+	    if (*end != '$') {
+		goto notXpg;
+	    }
+	    format = end+1;
+	    gotXpg = 1;
+	    if (gotSequential) {
+		goto mixedXPG;
+	    }
+	    objIndex = tmp+1;
+	    if ((objIndex < 2) || (objIndex >= objc)) {
+		goto badIndex;
+	    }
+	    goto xpgCheckDone;
+	}
+
+	notXpg:
+	gotSequential = 1;
+	if (gotXpg) {
+	    goto mixedXPG;
+	}
+
+	xpgCheckDone:
+	while ((*format == '-') || (*format == '#') || (*format == '0')
+		|| (*format == ' ') || (*format == '+')) {
+	    *newPtr = *format;
+	    newPtr++;
+	    format++;
+	}
+	if (isdigit(UCHAR(*format))) {
+	    width = strtoul(format, &end, 10);
+	    format = end;
+	} else if (*format == '*') {
+	    if (objIndex >= objc) {
+		goto badIndex;
+	    }
+	    if (Tcl_GetIntFromObj(interp, objv[objIndex], 
+                    &width) != TCL_OK) {
+		goto fmtError;
+	    }
+	    objIndex++;
+	    format++;
+	}
+	if (width > 100000) {
+	    /*
+	     * Don't allow arbitrarily large widths:  could cause core
+	     * dump when we try to allocate a zillion bytes of memory
+	     * below.
+	     */
+
+	    width = 100000;
+	} else if (width < 0) {
+	    width = 0;
+	}
+	if (width != 0) {
+	    TclFormatInt(newPtr, width);
+	    while (*newPtr != 0) {
+		newPtr++;
+	    }
+	}
+	if (*format == '.') {
+	    *newPtr = '.';
+	    newPtr++;
+	    format++;
+	}
+	if (isdigit(UCHAR(*format))) {
+	    precision = strtoul(format, &end, 10);
+	    format = end;
+	} else if (*format == '*') {
+	    if (objIndex >= objc) {
+		goto badIndex;
+	    }
+	    if (Tcl_GetIntFromObj(interp, objv[objIndex], 
+                    &precision) != TCL_OK) {
+		goto fmtError;
+	    }
+	    objIndex++;
+	    format++;
+	}
+	if (precision != 0) {
+	    TclFormatInt(newPtr, precision);
+	    while (*newPtr != 0) {
+		newPtr++;
+	    }
+	}
+	if (*format == 'l') {
+	    format++;
+	} else if (*format == 'h') {
+	    useShort = 1;
+	    *newPtr = 'h';
+	    newPtr++;
+	    format++;
+	}
+	*newPtr = *format;
+	newPtr++;
+	*newPtr = 0;
+	if (objIndex >= objc) {
+	    goto badIndex;
+	}
+	switch (*format) {
+	    case 'i':
+		newPtr[-1] = 'd';
+	    case 'd':
+	    case 'o':
+	    case 'u':
+	    case 'x':
+	    case 'X':
+		if (Tcl_GetIntFromObj(interp, objv[objIndex], 
+		        (int *) &intValue) != TCL_OK) {
+		    goto fmtError;
+		}
+		whichValue = INT_VALUE;
+		size = 40 + precision;
+		break;
+	    case 's':
+		ptrValue = Tcl_GetStringFromObj(objv[objIndex], &size);
+		break;
+	    case 'c':
+		if (Tcl_GetIntFromObj(interp, objv[objIndex], 
+                        (int *) &intValue) != TCL_OK) {
+		    goto fmtError;
+		}
+		whichValue = INT_VALUE;
+		size = 1;
+		break;
+	    case 'e':
+	    case 'E':
+	    case 'f':
+	    case 'g':
+	    case 'G':
+		if (Tcl_GetDoubleFromObj(interp, objv[objIndex], 
+			&doubleValue) != TCL_OK) {
+		    goto fmtError;
+		}
+		whichValue = DOUBLE_VALUE;
+		size = MAX_FLOAT_SIZE;
+		if (precision > 10) {
+		    size += precision;
+		}
+		break;
+	    case 0:
+		Tcl_SetResult(interp,
+		        "format string ended in middle of field specifier",
+			TCL_STATIC);
+		goto fmtError;
+	    default:
+		{
+		    char buf[40];
+		    sprintf(buf, "bad field specifier \"%c\"", *format);
+		    Tcl_SetResult(interp, buf, TCL_VOLATILE);
+		    goto fmtError;
+		}
+	}
+	objIndex++;
+	format++;
+
+	/*
+	 * Make sure that there's enough space to hold the formatted
+	 * result, then format it.
+	 */
+
+	doField:
+	if (width > size) {
+	    size = width;
+	}
+	if (noPercent) {
+	    Tcl_AppendToObj(resultPtr, ptrValue, size);
+	} else {
+	    if (size > dstSize) {
+	        if (dst != staticBuf) {
+		    ckfree(dst);
+		}
+		dst = (char *) ckalloc((unsigned) (size + 1));
+		dstSize = size;
+	    }
+
+	    if (whichValue == DOUBLE_VALUE) {
+	        sprintf(dst, newFormat, doubleValue);
+	    } else if (whichValue == INT_VALUE) {
+		if (useShort) {
+		    sprintf(dst, newFormat, (short) intValue);
+		} else {
+		    sprintf(dst, newFormat, intValue);
+		}
+	    } else {
+	        sprintf(dst, newFormat, ptrValue);
+	    }
+	    Tcl_AppendToObj(resultPtr, dst, -1);
+	}
+    }
+
+    Tcl_SetObjResult(interp, resultPtr);
+    if(dst != staticBuf) {
+        ckfree(dst);
+    }
+    return TCL_OK;
+
+    mixedXPG:
+    Tcl_SetResult(interp, 
+            "cannot mix \"%\" and \"%n$\" conversion specifiers", TCL_STATIC);
+    goto fmtError;
+
+    badIndex:
+    if (gotXpg) {
+        Tcl_SetResult(interp, 
+                "\"%n$\" argument index out of range", TCL_STATIC);
+    } else {
+        Tcl_SetResult(interp, 
+                "not enough arguments for all format specifiers", TCL_STATIC);
+    }
+
+    fmtError:
+    if(dst != staticBuf) {
+        ckfree(dst);
+    }
+    Tcl_DecrRefCount(resultPtr);
+    return TCL_ERROR;
+}
Index: /trunk/tcl/tclCmdIL.c
===================================================================
--- /trunk/tcl/tclCmdIL.c	(revision 2)
+++ /trunk/tcl/tclCmdIL.c	(revision 2)
@@ -0,0 +1,2771 @@
+/* 
+ * tclCmdIL.c --
+ *
+ *	This file contains the top-level command routines for most of
+ *	the Tcl built-in commands whose names begin with the letters
+ *	I through L.  It contains only commands in the generic core
+ *	(i.e. those that don't depend much upon UNIX facilities).
+ *
+ * Copyright (c) 1987-1993 The Regents of the University of California.
+ * Copyright (c) 1993-1997 Lucent Technologies.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.1 2008-06-04 13:58:04 demin Exp $
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+#include "tclCompile.h"
+
+/*
+ * During execution of the "lsort" command, structures of the following
+ * type are used to arrange the objects being sorted into a collection
+ * of linked lists.
+ */
+
+typedef struct SortElement {
+    Tcl_Obj *objPtr;			/* Object being sorted. */
+    struct SortElement *nextPtr;        /* Next element in the list, or
+					 * NULL for end of list. */
+} SortElement;
+
+/*
+ * The "lsort" command needs to pass certain information down to the
+ * function that compares two list elements, and the comparison function
+ * needs to pass success or failure information back up to the top-level
+ * "lsort" command.  The following structure is used to pass this
+ * information.
+ */
+
+typedef struct SortInfo {
+    int isIncreasing;		/* Nonzero means sort in increasing order. */
+    int sortMode;		/* The sort mode.  One of SORTMODE_*
+				 * values defined below */
+    Tcl_DString compareCmd;	/* The Tcl comparison command when sortMode
+				 * is SORTMODE_COMMAND.  Pre-initialized to
+				 * hold base of command.*/
+    int index;			/* If the -index option was specified, this
+				 * holds the index of the list element
+				 * to extract for comparison.  If -index
+				 * wasn't specified, this is -1. */
+    Tcl_Interp *interp;		/* The interpreter in which the sortis
+				 * being done. */
+    int resultCode;		/* Completion code for the lsort command.
+				 * If an error occurs during the sort this
+				 * is changed from TCL_OK to  TCL_ERROR. */
+} SortInfo;
+
+/*
+ * The "sortMode" field of the SortInfo structure can take on any of the
+ * following values.
+ */
+
+#define SORTMODE_ASCII      0
+#define SORTMODE_INTEGER    1
+#define SORTMODE_REAL       2
+#define SORTMODE_COMMAND    3
+#define SORTMODE_DICTIONARY 4
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static void		AppendLocals _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *listPtr, char *pattern,
+			    int includeLinks));
+static int		DictionaryCompare _ANSI_ARGS_((char *left,
+			    char *right));
+static int		InfoArgsCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoBodyCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoCmdCountCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoCommandsCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoCompleteCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoDefaultCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoExistsCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoGlobalsCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoLevelCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoLibraryCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoLocalsCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoNameOfExecutableCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoPatchLevelCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoProcsCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoScriptCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoSharedlibCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoTclVersionCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoVarsCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static SortElement *    MergeSort _ANSI_ARGS_((SortElement *headPt,
+			    SortInfo *infoPtr));
+static SortElement *    MergeLists _ANSI_ARGS_((SortElement *leftPtr,
+			    SortElement *rightPtr, SortInfo *infoPtr));
+static int		SortCompare _ANSI_ARGS_((Tcl_Obj *firstPtr,
+			    Tcl_Obj *second, SortInfo *infoPtr));
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_IfCmd --
+ *
+ *	This procedure is invoked to process the "if" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ *	With the bytecode compiler, this procedure is only called when
+ *	a command name is computed at runtime, and is "if" or the name
+ *	to which "if" was renamed: e.g., "set z if; $z 1 {puts foo}"
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_IfCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    int i, result, value;
+
+    i = 1;
+    while (1) {
+	/*
+	 * At this point in the loop, argv and argc refer to an expression
+	 * to test, either for the main expression or an expression
+	 * following an "elseif".  The arguments after the expression must
+	 * be "then" (optional) and a script to execute if the expression is
+	 * true.
+	 */
+
+	if (i >= argc) {
+	    Tcl_AppendResult(interp, "wrong # args: no expression after \"",
+		    argv[i-1], "\" argument", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	result = Tcl_ExprBoolean(interp, argv[i], &value);
+	if (result != TCL_OK) {
+	    return result;
+	}
+	i++;
+	if ((i < argc) && (strcmp(argv[i], "then") == 0)) {
+	    i++;
+	}
+	if (i >= argc) {
+	    Tcl_AppendResult(interp, "wrong # args: no script following \"",
+		    argv[i-1], "\" argument", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	if (value) {
+	    return Tcl_Eval(interp, argv[i]);
+	}
+	
+	/*
+	 * The expression evaluated to false.  Skip the command, then
+	 * see if there is an "else" or "elseif" clause.
+	 */
+
+	i++;
+	if (i >= argc) {
+	    return TCL_OK;
+	}
+	if ((argv[i][0] == 'e') && (strcmp(argv[i], "elseif") == 0)) {
+	    i++;
+	    continue;
+	}
+	break;
+    }
+
+    /*
+     * Couldn't find a "then" or "elseif" clause to execute.  Check now
+     * for an "else" clause.  We know that there's at least one more
+     * argument when we get here.
+     */
+
+    if (strcmp(argv[i], "else") == 0) {
+	i++;
+	if (i >= argc) {
+	    Tcl_AppendResult(interp,
+		    "wrong # args: no script following \"else\" argument",
+		    (char *) NULL);
+	    return TCL_ERROR;
+	}
+    }
+    return Tcl_Eval(interp, argv[i]);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_IncrCmd --
+ *
+ *	This procedure is invoked to process the "incr" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ *	With the bytecode compiler, this procedure is only called when
+ *	a command name is computed at runtime, and is "incr" or the name
+ *	to which "incr" was renamed: e.g., "set z incr; $z i -1"
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+    /* ARGSUSED */
+int
+Tcl_IncrCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    int value;
+    char *oldString, *result;
+    char newString[30];
+
+    if ((argc != 2) && (argc != 3)) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" varName ?increment?\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    oldString = Tcl_GetVar(interp, argv[1], TCL_LEAVE_ERR_MSG);
+    if (oldString == NULL) {
+	return TCL_ERROR;
+    }
+    if (Tcl_GetInt(interp, oldString, &value) != TCL_OK) {
+	Tcl_AddErrorInfo(interp,
+		"\n    (reading value of variable to increment)");
+	return TCL_ERROR;
+    }
+    if (argc == 2) {
+	value += 1;
+    } else {
+	int increment;
+
+	if (Tcl_GetInt(interp, argv[2], &increment) != TCL_OK) {
+	    Tcl_AddErrorInfo(interp,
+		    "\n    (reading increment)");
+	    return TCL_ERROR;
+	}
+	value += increment;
+    }
+    TclFormatInt(newString, value);
+    result = Tcl_SetVar(interp, argv[1], newString, TCL_LEAVE_ERR_MSG);
+    if (result == NULL) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Copy the result since the variable's value might change.
+     */
+    
+    Tcl_SetResult(interp, result, TCL_VOLATILE);
+    return TCL_OK; 
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_InfoObjCmd --
+ *
+ *	This procedure is invoked to process the "info" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_InfoObjCmd(clientData, interp, objc, objv)
+    ClientData clientData;	/* Arbitrary value passed to the command. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    static char *subCmds[] = {
+       "args", "body", "cmdcount", "commands",
+	     "complete", "default", "exists", "globals",
+	     "level", "library",
+	     "locals", "nameofexecutable", "patchlevel", "procs",
+	     "script", "sharedlibextension", "tclversion", "vars",
+	     (char *) NULL};
+    enum ISubCmdIdx {
+	    IArgsIdx, IBodyIdx, ICmdCountIdx, ICommandsIdx,
+	    ICompleteIdx, IDefaultIdx, IExistsIdx, IGlobalsIdx,
+      ILevelIdx, ILibraryIdx,
+	    ILocalsIdx, INameOfExecutableIdx, IPatchLevelIdx, IProcsIdx,
+	    IScriptIdx, ISharedLibExtensionIdx, ITclVersionIdx, IVarsIdx
+    } index;
+    int result;
+
+    if (objc < 2) {
+        Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+        return TCL_ERROR;
+    }
+    
+    result = Tcl_GetIndexFromObj(interp, objv[1], subCmds, "option", 0,
+	    (int *) &index);
+    if (result != TCL_OK) {
+	return result;
+    }
+
+    switch (index) {
+        case IArgsIdx:
+	    result = InfoArgsCmd(clientData, interp, objc, objv);
+            break;
+	case IBodyIdx:
+	    result = InfoBodyCmd(clientData, interp, objc, objv);
+	    break;
+	case ICmdCountIdx:
+	    result = InfoCmdCountCmd(clientData, interp, objc, objv);
+	    break;
+        case ICommandsIdx:
+	    result = InfoCommandsCmd(clientData, interp, objc, objv);
+	    break;
+        case ICompleteIdx:
+	    result = InfoCompleteCmd(clientData, interp, objc, objv);
+	    break;
+	case IDefaultIdx:
+	    result = InfoDefaultCmd(clientData, interp, objc, objv);
+	    break;
+	case IExistsIdx:
+	    result = InfoExistsCmd(clientData, interp, objc, objv);
+	    break;
+	case IGlobalsIdx:
+	    result = InfoGlobalsCmd(clientData, interp, objc, objv);
+	    break;
+	case ILevelIdx:
+	    result = InfoLevelCmd(clientData, interp, objc, objv);
+	    break;
+	case ILibraryIdx:
+	    result = InfoLibraryCmd(clientData, interp, objc, objv);
+	    break;
+	case ILocalsIdx:
+	    result = InfoLocalsCmd(clientData, interp, objc, objv);
+	    break;
+	case INameOfExecutableIdx:
+	    result = InfoNameOfExecutableCmd(clientData, interp, objc, objv);
+	    break;
+	case IPatchLevelIdx:
+	    result = InfoPatchLevelCmd(clientData, interp, objc, objv);
+	    break;
+        case IProcsIdx:
+	    result = InfoProcsCmd(clientData, interp, objc, objv);
+	    break;
+        case IScriptIdx:
+	    result = InfoScriptCmd(clientData, interp, objc, objv);
+	    break;
+	case ISharedLibExtensionIdx:
+	    result = InfoSharedlibCmd(clientData, interp, objc, objv);
+	    break;
+	case ITclVersionIdx:
+	    result = InfoTclVersionCmd(clientData, interp, objc, objv);
+	    break;
+	case IVarsIdx:
+	    result = InfoVarsCmd(clientData, interp, objc, objv);
+	    break;
+    }
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoArgsCmd --
+ *
+ *      Called to implement the "info args" command that returns the
+ *      argument list for a procedure. Handles the following syntax:
+ *
+ *          info args procName
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoArgsCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    register Interp *iPtr = (Interp *) interp;
+    char *name;
+    Proc *procPtr;
+    CompiledLocal *localPtr;
+    Tcl_Obj *listObjPtr;
+
+    if (objc != 3) {
+        Tcl_WrongNumArgs(interp, 2, objv, "procname");
+        return TCL_ERROR;
+    }
+
+    name = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+    procPtr = TclFindProc(iPtr, name);
+    if (procPtr == NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "\"", name, "\" isn't a procedure", (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    /*
+     * Build a return list containing the arguments.
+     */
+    
+    listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+    for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;
+            localPtr = localPtr->nextPtr) {
+        if (TclIsVarArgument(localPtr)) {
+            Tcl_ListObjAppendElement(interp, listObjPtr,
+		    Tcl_NewStringObj(localPtr->name, -1));
+        }
+    }
+    Tcl_SetObjResult(interp, listObjPtr);
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoBodyCmd --
+ *
+ *      Called to implement the "info body" command that returns the body
+ *      for a procedure. Handles the following syntax:
+ *
+ *          info body procName
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoBodyCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    register Interp *iPtr = (Interp *) interp;
+    char *name;
+    Proc *procPtr;
+    Tcl_Obj *bodyPtr, *resultPtr;
+    
+    if (objc != 3) {
+        Tcl_WrongNumArgs(interp, 2, objv, "procname");
+        return TCL_ERROR;
+    }
+
+    name = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+    procPtr = TclFindProc(iPtr, name);
+    if (procPtr == NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"\"", name, "\" isn't a procedure", (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    /*
+     * we need to check if the body from this procedure had been generated
+     * from a precompiled body. If that is the case, then the bodyPtr's
+     * string representation is bogus, since sources are not available.
+     * In order to make sure that later manipulations of the object do not
+     * invalidate the internal representation, we make a copy of the string
+     * representation and return that one, instead.
+     */
+
+    bodyPtr = procPtr->bodyPtr;
+    resultPtr = bodyPtr;
+    if (bodyPtr->typePtr == &tclByteCodeType) {
+        ByteCode *codePtr = (ByteCode *) bodyPtr->internalRep.otherValuePtr;
+
+        if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
+            resultPtr = Tcl_NewStringObj(bodyPtr->bytes, bodyPtr->length);
+        }
+    }
+    
+    Tcl_SetObjResult(interp, resultPtr);
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoCmdCountCmd --
+ *
+ *      Called to implement the "info cmdcount" command that returns the
+ *      number of commands that have been executed. Handles the following
+ *      syntax:
+ *
+ *          info cmdcount
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoCmdCountCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Interp *iPtr = (Interp *) interp;
+    
+    if (objc != 2) {
+        Tcl_WrongNumArgs(interp, 2, objv, NULL);
+        return TCL_ERROR;
+    }
+
+    Tcl_SetIntObj(Tcl_GetObjResult(interp), iPtr->cmdCount);
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoCommandsCmd --
+ *
+ *	Called to implement the "info commands" command that returns the
+ *	list of commands in the interpreter that match an optional pattern.
+ *	The pattern, if any, consists of an optional sequence of namespace
+ *	names separated by "::" qualifiers, which is followed by a
+ *	glob-style pattern that restricts which commands are returned.
+ *	Handles the following syntax:
+ *
+ *          info commands ?pattern?
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoCommandsCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    char *cmdName, *pattern, *simplePattern;
+    register Tcl_HashEntry *entryPtr;
+    Tcl_HashSearch search;
+    Namespace *nsPtr;
+    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
+    Namespace *currNsPtr   = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    Tcl_Obj *listPtr, *elemObjPtr;
+    int specificNsInPattern = 0;  /* Init. to avoid compiler warning. */
+    Tcl_Command cmd;
+
+    /*
+     * Get the pattern and find the "effective namespace" in which to
+     * list commands.
+     */
+
+    if (objc == 2) {
+        simplePattern = NULL;
+	nsPtr = currNsPtr;
+	specificNsInPattern = 0;
+    } else if (objc == 3) {
+	/*
+	 * From the pattern, get the effective namespace and the simple
+	 * pattern (no namespace qualifiers or ::'s) at the end. If an
+	 * error was found while parsing the pattern, return it. Otherwise,
+	 * if the namespace wasn't found, just leave nsPtr NULL: we will
+	 * return an empty list since no commands there can be found.
+	 */
+
+	Namespace *dummy1NsPtr, *dummy2NsPtr;
+	
+        pattern = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+       TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,
+           /*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern);
+
+	if (nsPtr != NULL) {	/* we successfully found the pattern's ns */
+	    specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
+	}
+    } else {
+        Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
+        return TCL_ERROR;
+    }
+
+    /*
+     * Scan through the effective namespace's command table and create a
+     * list with all commands that match the pattern. If a specific
+     * namespace was requested in the pattern, qualify the command names
+     * with the namespace name.
+     */
+
+    listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+
+    if (nsPtr != NULL) {
+	entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
+	while (entryPtr != NULL) {
+	    cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
+	    if ((simplePattern == NULL)
+	            || Tcl_StringMatch(cmdName, simplePattern)) {
+		if (specificNsInPattern) {
+		    cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr);
+		    elemObjPtr = Tcl_NewObj();
+		    Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
+		} else {
+		    elemObjPtr = Tcl_NewStringObj(cmdName, -1);
+		}
+		Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
+	    }
+	    entryPtr = Tcl_NextHashEntry(&search);
+	}
+
+	/*
+	 * If the effective namespace isn't the global :: namespace, and a
+	 * specific namespace wasn't requested in the pattern, then add in
+	 * all global :: commands that match the simple pattern. Of course,
+	 * we add in only those commands that aren't hidden by a command in
+	 * the effective namespace.
+	 */
+	
+	if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
+	    entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search);
+	    while (entryPtr != NULL) {
+		cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
+		if ((simplePattern == NULL)
+	                || Tcl_StringMatch(cmdName, simplePattern)) {
+		    if (Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName) == NULL) {
+			Tcl_ListObjAppendElement(interp, listPtr,
+				Tcl_NewStringObj(cmdName, -1));
+		    }
+		}
+		entryPtr = Tcl_NextHashEntry(&search);
+	    }
+	}
+    }
+    
+    Tcl_SetObjResult(interp, listPtr);
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoCompleteCmd --
+ *
+ *      Called to implement the "info complete" command that determines
+ *      whether a string is a complete Tcl command. Handles the following
+ *      syntax:
+ *
+ *          info complete command
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoCompleteCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    if (objc != 3) {
+        Tcl_WrongNumArgs(interp, 2, objv, "command");
+        return TCL_ERROR;
+    }
+
+    if (TclObjCommandComplete(objv[2])) {
+	Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
+    } else {
+	Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
+    }
+
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoDefaultCmd --
+ *
+ *      Called to implement the "info default" command that returns the
+ *      default value for a procedure argument. Handles the following
+ *      syntax:
+ *
+ *          info default procName arg varName
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoDefaultCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Interp *iPtr = (Interp *) interp;
+    char *procName, *argName, *varName;
+    Proc *procPtr;
+    CompiledLocal *localPtr;
+    Tcl_Obj *valueObjPtr;
+
+    if (objc != 5) {
+        Tcl_WrongNumArgs(interp, 2, objv, "procname arg varname");
+        return TCL_ERROR;
+    }
+
+    procName = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+    argName = Tcl_GetStringFromObj(objv[3], (int *) NULL);
+
+    procPtr = TclFindProc(iPtr, procName);
+    if (procPtr == NULL) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"\"", procName, "\" isn't a procedure", (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;
+            localPtr = localPtr->nextPtr) {
+        if (TclIsVarArgument(localPtr)
+		&& (strcmp(argName, localPtr->name) == 0)) {
+            if (localPtr->defValuePtr != NULL) {
+		valueObjPtr = Tcl_ObjSetVar2(interp, objv[4], NULL,
+                        localPtr->defValuePtr, 0);
+                if (valueObjPtr == NULL) {
+                    defStoreError:
+		    varName = Tcl_GetStringFromObj(objv[4], (int *) NULL);
+		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+	                    "couldn't store default value in variable \"",
+			    varName, "\"", (char *) NULL);
+                    return TCL_ERROR;
+                }
+		Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
+            } else {
+                Tcl_Obj *nullObjPtr = Tcl_NewObj();
+                valueObjPtr = Tcl_ObjSetVar2(interp, objv[4], NULL,
+                    nullObjPtr, 0);
+                if (valueObjPtr == NULL) {
+                    Tcl_DecrRefCount(nullObjPtr); /* free unneeded obj */
+                    goto defStoreError;
+                }
+		Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
+            }
+            return TCL_OK;
+        }
+    }
+
+    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+	    "procedure \"", procName, "\" doesn't have an argument \"",
+	    argName, "\"", (char *) NULL);
+    return TCL_ERROR;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoExistsCmd --
+ *
+ *      Called to implement the "info exists" command that determines
+ *      whether a variable exists. Handles the following syntax:
+ *
+ *          info exists varName
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoExistsCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    char *varName;
+    Var *varPtr, *arrayPtr;
+
+    if (objc != 3) {
+        Tcl_WrongNumArgs(interp, 2, objv, "varName");
+        return TCL_ERROR;
+    }
+
+    varName = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+    varPtr = TclLookupVar(interp, varName, (char *) NULL,
+            TCL_PARSE_PART1, "access",
+            /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+    if ((varPtr != NULL) && !TclIsVarUndefined(varPtr)) {
+        Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
+    } else {
+        Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
+    }
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoGlobalsCmd --
+ *
+ *      Called to implement the "info globals" command that returns the list
+ *      of global variables matching an optional pattern. Handles the
+ *      following syntax:
+ *
+ *          info globals ?pattern?
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoGlobalsCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    char *varName, *pattern;
+    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
+    register Tcl_HashEntry *entryPtr;
+    Tcl_HashSearch search;
+    Var *varPtr;
+    Tcl_Obj *listPtr;
+
+    if (objc == 2) {
+        pattern = NULL;
+    } else if (objc == 3) {
+        pattern = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+    } else {
+        Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
+        return TCL_ERROR;
+    }
+
+    /*
+     * Scan through the global :: namespace's variable table and create a
+     * list of all global variables that match the pattern.
+     */
+    
+    listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+    for (entryPtr = Tcl_FirstHashEntry(&globalNsPtr->varTable, &search);
+            entryPtr != NULL;
+            entryPtr = Tcl_NextHashEntry(&search)) {
+        varPtr = (Var *) Tcl_GetHashValue(entryPtr);
+        if (TclIsVarUndefined(varPtr)) {
+            continue;
+        }
+        varName = Tcl_GetHashKey(&globalNsPtr->varTable, entryPtr);
+        if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
+            Tcl_ListObjAppendElement(interp, listPtr,
+		    Tcl_NewStringObj(varName, -1));
+        }
+    }
+    Tcl_SetObjResult(interp, listPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoLevelCmd --
+ *
+ *      Called to implement the "info level" command that returns
+ *      information about the call stack. Handles the following syntax:
+ *
+ *          info level ?number?
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoLevelCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Interp *iPtr = (Interp *) interp;
+    int level;
+    CallFrame *framePtr;
+    Tcl_Obj *listPtr;
+
+    if (objc == 2) {		/* just "info level" */
+        if (iPtr->varFramePtr == NULL) {
+            Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
+        } else {
+            Tcl_SetIntObj(Tcl_GetObjResult(interp), iPtr->varFramePtr->level);
+        }
+        return TCL_OK;
+    } else if (objc == 3) {
+        if (Tcl_GetIntFromObj(interp, objv[2], &level) != TCL_OK) {
+            return TCL_ERROR;
+        }
+        if (level <= 0) {
+            if (iPtr->varFramePtr == NULL) {
+                levelError:
+		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+			"bad level \"",
+			Tcl_GetStringFromObj(objv[2], (int *) NULL),
+			"\"", (char *) NULL);
+                return TCL_ERROR;
+            }
+            level += iPtr->varFramePtr->level;
+        }
+        for (framePtr = iPtr->varFramePtr;  framePtr != NULL;
+                framePtr = framePtr->callerVarPtr) {
+            if (framePtr->level == level) {
+                break;
+            }
+        }
+        if (framePtr == NULL) {
+            goto levelError;
+        }
+
+        listPtr = Tcl_NewListObj(framePtr->objc, framePtr->objv);
+        Tcl_SetObjResult(interp, listPtr);
+        return TCL_OK;
+    }
+
+    Tcl_WrongNumArgs(interp, 2, objv, "?number?");
+    return TCL_ERROR;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoLibraryCmd --
+ *
+ *      Called to implement the "info library" command that returns the
+ *      library directory for the Tcl installation. Handles the following
+ *      syntax:
+ *
+ *          info library
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoLibraryCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    char *libDirName;
+
+    if (objc != 2) {
+        Tcl_WrongNumArgs(interp, 2, objv, NULL);
+        return TCL_ERROR;
+    }
+
+    libDirName = Tcl_GetVar(interp, "tcl_library", TCL_GLOBAL_ONLY);
+    if (libDirName != NULL) {
+        Tcl_SetStringObj(Tcl_GetObjResult(interp), libDirName, -1);
+        return TCL_OK;
+    }
+    Tcl_SetStringObj(Tcl_GetObjResult(interp), 
+            "no library has been specified for Tcl", -1);
+    return TCL_ERROR;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoLocalsCmd --
+ *
+ *      Called to implement the "info locals" command to return a list of
+ *      local variables that match an optional pattern. Handles the
+ *      following syntax:
+ *
+ *          info locals ?pattern?
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoLocalsCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Interp *iPtr = (Interp *) interp;
+    char *pattern;
+    Tcl_Obj *listPtr;
+
+    if (objc == 2) {
+        pattern = NULL;
+    } else if (objc == 3) {
+        pattern = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+    } else {
+        Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
+        return TCL_ERROR;
+    }
+    
+    if (iPtr->varFramePtr == NULL || !iPtr->varFramePtr->isProcCallFrame) {
+        return TCL_OK;
+    }
+
+    /*
+     * Return a list containing names of first the compiled locals (i.e. the
+     * ones stored in the call frame), then the variables in the local hash
+     * table (if one exists).
+     */
+    
+    listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+    AppendLocals(interp, listPtr, pattern, 0);
+    Tcl_SetObjResult(interp, listPtr);
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AppendLocals --
+ *
+ *	Append the local variables for the current frame to the
+ *	specified list object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AppendLocals(interp, listPtr, pattern, includeLinks)
+    Tcl_Interp *interp;		/* Current interpreter. */
+    Tcl_Obj *listPtr;		/* List object to append names to. */
+    char *pattern;		/* Pattern to match against. */
+    int includeLinks;		/* 1 if upvars should be included, else 0. */
+{
+    Interp *iPtr = (Interp *) interp;
+    CompiledLocal *localPtr;
+    Var *varPtr;
+    int i, localVarCt;
+    char *varName;
+    Tcl_HashTable *localVarTablePtr;
+    register Tcl_HashEntry *entryPtr;
+    Tcl_HashSearch search;
+
+    localPtr = iPtr->varFramePtr->procPtr->firstLocalPtr;
+    localVarCt = iPtr->varFramePtr->numCompiledLocals;
+    varPtr = iPtr->varFramePtr->compiledLocals;
+    localVarTablePtr = iPtr->varFramePtr->varTablePtr;
+
+    for (i = 0; i < localVarCt; i++) {
+	/*
+	 * Skip nameless (temporary) variables and undefined variables
+	 */
+
+	if (!TclIsVarTemporary(localPtr) && !TclIsVarUndefined(varPtr)) {
+	    varName = varPtr->name;
+	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
+		Tcl_ListObjAppendElement(interp, listPtr,
+		        Tcl_NewStringObj(varName, -1));
+	    }
+        }
+	varPtr++;
+	localPtr = localPtr->nextPtr;
+    }
+    
+    if (localVarTablePtr != NULL) {
+	for (entryPtr = Tcl_FirstHashEntry(localVarTablePtr, &search);
+	        entryPtr != NULL;
+                entryPtr = Tcl_NextHashEntry(&search)) {
+	    varPtr = (Var *) Tcl_GetHashValue(entryPtr);
+	    if (!TclIsVarUndefined(varPtr)
+		    && (includeLinks || !TclIsVarLink(varPtr))) {
+		varName = Tcl_GetHashKey(localVarTablePtr, entryPtr);
+		if ((pattern == NULL)
+		        || Tcl_StringMatch(varName, pattern)) {
+		    Tcl_ListObjAppendElement(interp, listPtr,
+			    Tcl_NewStringObj(varName, -1));
+		}
+	    }
+	}
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoNameOfExecutableCmd --
+ *
+ *      Called to implement the "info nameofexecutable" command that returns
+ *      the name of the binary file running this application. Handles the
+ *      following syntax:
+ *
+ *          info nameofexecutable
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoNameOfExecutableCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    CONST char *nameOfExecutable;
+
+    if (objc != 2) {
+        Tcl_WrongNumArgs(interp, 2, objv, NULL);
+        return TCL_ERROR;
+    }
+
+    nameOfExecutable = Tcl_GetNameOfExecutable();
+    
+    if (nameOfExecutable != NULL) {
+	Tcl_SetStringObj(Tcl_GetObjResult(interp), (char *)nameOfExecutable, -1);
+    }
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoPatchLevelCmd --
+ *
+ *      Called to implement the "info patchlevel" command that returns the
+ *      default value for an argument to a procedure. Handles the following
+ *      syntax:
+ *
+ *          info patchlevel
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoPatchLevelCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    char *patchlevel;
+
+    if (objc != 2) {
+        Tcl_WrongNumArgs(interp, 2, objv, NULL);
+        return TCL_ERROR;
+    }
+
+    patchlevel = Tcl_GetVar(interp, "tcl_patchLevel",
+            (TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
+    if (patchlevel != NULL) {
+        Tcl_SetStringObj(Tcl_GetObjResult(interp), patchlevel, -1);
+        return TCL_OK;
+    }
+    return TCL_ERROR;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoProcsCmd --
+ *
+ *      Called to implement the "info procs" command that returns the
+ *      procedures in the current namespace that match an optional pattern.
+ *      Handles the following syntax:
+ *
+ *          info procs ?pattern?
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoProcsCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    char *cmdName, *pattern;
+    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    register Tcl_HashEntry *entryPtr;
+    Tcl_HashSearch search;
+    Command *cmdPtr;
+    Tcl_Obj *listPtr;
+
+    if (objc == 2) {
+        pattern = NULL;
+    } else if (objc == 3) {
+        pattern = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+    } else {
+        Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
+        return TCL_ERROR;
+    }
+
+    /*
+     * Scan through the current namespace's command table and return a list
+     * of all procs that match the pattern.
+     */
+    
+    listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+    for (entryPtr = Tcl_FirstHashEntry(&currNsPtr->cmdTable, &search);
+            entryPtr != NULL;
+            entryPtr = Tcl_NextHashEntry(&search)) {
+        cmdName = Tcl_GetHashKey(&currNsPtr->cmdTable, entryPtr);
+        cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
+        if (TclIsProc(cmdPtr)) {
+            if ((pattern == NULL) || Tcl_StringMatch(cmdName, pattern)) {
+                Tcl_ListObjAppendElement(interp, listPtr,
+		        Tcl_NewStringObj(cmdName, -1));
+            }
+        }
+    }
+    Tcl_SetObjResult(interp, listPtr);
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoScriptCmd --
+ *
+ *      Called to implement the "info script" command that returns the
+ *      script file that is currently being evaluated. Handles the
+ *      following syntax:
+ *
+ *          info script
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoScriptCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Interp *iPtr = (Interp *) interp;
+    if (objc != 2) {
+        Tcl_WrongNumArgs(interp, 2, objv, NULL);
+        return TCL_ERROR;
+    }
+
+    if (iPtr->scriptFile != NULL) {
+        Tcl_SetStringObj(Tcl_GetObjResult(interp), iPtr->scriptFile, -1);
+    }
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoSharedlibCmd --
+ *
+ *      Called to implement the "info sharedlibextension" command that
+ *      returns the file extension used for shared libraries. Handles the
+ *      following syntax:
+ *
+ *          info sharedlibextension
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoSharedlibCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    if (objc != 2) {
+        Tcl_WrongNumArgs(interp, 2, objv, NULL);
+        return TCL_ERROR;
+    }
+    
+#ifdef TCL_SHLIB_EXT
+    Tcl_SetStringObj(Tcl_GetObjResult(interp), TCL_SHLIB_EXT, -1);
+#endif
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoTclVersionCmd --
+ *
+ *      Called to implement the "info tclversion" command that returns the
+ *      version number for this Tcl library. Handles the following syntax:
+ *
+ *          info tclversion
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoTclVersionCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    char *version;
+
+    if (objc != 2) {
+        Tcl_WrongNumArgs(interp, 2, objv, NULL);
+        return TCL_ERROR;
+    }
+
+    version = Tcl_GetVar(interp, "tcl_version",
+        (TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
+    if (version != NULL) {
+        Tcl_SetStringObj(Tcl_GetObjResult(interp), version, -1);
+        return TCL_OK;
+    }
+    return TCL_ERROR;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoVarsCmd --
+ *
+ *	Called to implement the "info vars" command that returns the
+ *	list of variables in the interpreter that match an optional pattern.
+ *	The pattern, if any, consists of an optional sequence of namespace
+ *	names separated by "::" qualifiers, which is followed by a
+ *	glob-style pattern that restricts which variables are returned.
+ *	Handles the following syntax:
+ *
+ *          info vars ?pattern?
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoVarsCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Interp *iPtr = (Interp *) interp;
+    char *varName, *pattern, *simplePattern;
+    register Tcl_HashEntry *entryPtr;
+    Tcl_HashSearch search;
+    Var *varPtr;
+    Namespace *nsPtr;
+    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
+    Namespace *currNsPtr   = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    Tcl_Obj *listPtr, *elemObjPtr;
+    int specificNsInPattern = 0;  /* Init. to avoid compiler warning. */
+
+    /*
+     * Get the pattern and find the "effective namespace" in which to
+     * list variables. We only use this effective namespace if there's
+     * no active Tcl procedure frame.
+     */
+
+    if (objc == 2) {
+        simplePattern = NULL;
+	nsPtr = currNsPtr;
+	specificNsInPattern = 0;
+    } else if (objc == 3) {
+	/*
+	 * From the pattern, get the effective namespace and the simple
+	 * pattern (no namespace qualifiers or ::'s) at the end. If an
+	 * error was found while parsing the pattern, return it. Otherwise,
+	 * if the namespace wasn't found, just leave nsPtr NULL: we will
+	 * return an empty list since no variables there can be found.
+	 */
+
+	Namespace *dummy1NsPtr, *dummy2NsPtr;
+
+        pattern = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+       TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,
+           /*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern);
+
+	if (nsPtr != NULL) {	/* we successfully found the pattern's ns */
+	    specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
+	}
+    } else {
+        Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
+        return TCL_ERROR;
+    }
+
+    /*
+     * If the namespace specified in the pattern wasn't found, just return.
+     */
+
+    if (nsPtr == NULL) {
+	return TCL_OK;
+    }
+    
+    listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+    
+    if ((iPtr->varFramePtr == NULL)
+	    || !iPtr->varFramePtr->isProcCallFrame
+	    || specificNsInPattern) {
+	/*
+	 * There is no frame pointer, the frame pointer was pushed only
+	 * to activate a namespace, or we are in a procedure call frame
+	 * but a specific namespace was specified. Create a list containing
+	 * only the variables in the effective namespace's variable table.
+	 */
+	
+	entryPtr = Tcl_FirstHashEntry(&nsPtr->varTable, &search);
+	while (entryPtr != NULL) {
+	    varPtr = (Var *) Tcl_GetHashValue(entryPtr);
+	    if (!TclIsVarUndefined(varPtr)
+		    || (varPtr->flags & VAR_NAMESPACE_VAR)) {
+		varName = Tcl_GetHashKey(&nsPtr->varTable, entryPtr);
+		if ((simplePattern == NULL)
+	                || Tcl_StringMatch(varName, simplePattern)) {
+		    if (specificNsInPattern) {
+			elemObjPtr = Tcl_NewObj();
+			Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,
+			        elemObjPtr);
+		    } else {
+			elemObjPtr = Tcl_NewStringObj(varName, -1);
+		    }
+		    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
+		}
+	    }
+	    entryPtr = Tcl_NextHashEntry(&search);
+	}
+
+	/*
+	 * If the effective namespace isn't the global :: namespace, and a
+	 * specific namespace wasn't requested in the pattern (i.e., the
+	 * pattern only specifies variable names), then add in all global ::
+	 * variables that match the simple pattern. Of course, add in only
+	 * those variables that aren't hidden by a variable in the effective
+	 * namespace.
+	 */
+
+	if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
+	    entryPtr = Tcl_FirstHashEntry(&globalNsPtr->varTable, &search);
+	    while (entryPtr != NULL) {
+		varPtr = (Var *) Tcl_GetHashValue(entryPtr);
+		if (!TclIsVarUndefined(varPtr)
+		        || (varPtr->flags & VAR_NAMESPACE_VAR)) {
+		    varName = Tcl_GetHashKey(&globalNsPtr->varTable,
+			    entryPtr);
+		    if ((simplePattern == NULL)
+	                    || Tcl_StringMatch(varName, simplePattern)) {
+			if (Tcl_FindHashEntry(&nsPtr->varTable, varName) == NULL) {
+			    Tcl_ListObjAppendElement(interp, listPtr,
+			            Tcl_NewStringObj(varName, -1));
+			}
+		    }
+		}
+		entryPtr = Tcl_NextHashEntry(&search);
+	    }
+	}
+    } else {
+	AppendLocals(interp, listPtr, simplePattern, 1);
+    }
+    
+    Tcl_SetObjResult(interp, listPtr);
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_JoinObjCmd --
+ *
+ *	This procedure is invoked to process the "join" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_JoinObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* The argument objects. */
+{
+    char *joinString, *bytes;
+    int joinLength, listLen, length, i, result;
+    Tcl_Obj **elemPtrs;
+    Tcl_Obj *resObjPtr;
+
+    if (objc == 2) {
+	joinString = " ";
+	joinLength = 1;
+    } else if (objc == 3) {
+	joinString = Tcl_GetStringFromObj(objv[2], &joinLength);
+    } else {
+	Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Make sure the list argument is a list object and get its length and
+     * a pointer to its array of element pointers.
+     */
+
+    result = Tcl_ListObjGetElements(interp, objv[1], &listLen, &elemPtrs);
+    if (result != TCL_OK) {
+	return result;
+    }
+
+    /*
+     * Now concatenate strings to form the "joined" result. We append
+     * directly into the interpreter's result object.
+     */
+
+    resObjPtr = Tcl_GetObjResult(interp);
+
+    for (i = 0;  i < listLen;  i++) {
+	bytes = Tcl_GetStringFromObj(elemPtrs[i], &length);
+	if (i > 0) {
+	    Tcl_AppendToObj(resObjPtr, joinString, joinLength);
+	}
+	Tcl_AppendToObj(resObjPtr, bytes, length);
+    }
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LindexObjCmd --
+ *
+ *	This object-based procedure is invoked to process the "lindex" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+    /* ARGSUSED */
+int
+Tcl_LindexObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Tcl_Obj *listPtr;
+    Tcl_Obj **elemPtrs;
+    int listLen, index, result;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "list index");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Convert the first argument to a list if necessary.
+     */
+
+    listPtr = objv[1];
+    result = Tcl_ListObjGetElements(interp, listPtr, &listLen, &elemPtrs);
+    if (result != TCL_OK) {
+	return result;
+    }
+
+    /*
+     * Get the index from objv[2].
+     */
+
+    result = TclGetIntForIndex(interp, objv[2], /*endValue*/ (listLen - 1),
+	    &index);
+    if (result != TCL_OK) {
+	return result;
+    }
+    if ((index < 0) || (index >= listLen)) {
+	/*
+	 * The index is out of range: the result is an empty string object.
+	 */
+	
+	return TCL_OK;
+    }
+
+    /*
+     * Make sure listPtr still refers to a list object. It might have been
+     * converted to an int above if the argument objects were shared.
+     */
+
+    if (listPtr->typePtr != &tclListType) {
+	result = Tcl_ListObjGetElements(interp, listPtr, &listLen,
+	        &elemPtrs);
+	if (result != TCL_OK) {
+	    return result;
+	}
+    }
+
+    /*
+     * Set the interpreter's object result to the index-th list element.
+     */
+
+    Tcl_SetObjResult(interp, elemPtrs[index]);
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LinsertObjCmd --
+ *
+ *	This object-based procedure is invoked to process the "linsert" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A new Tcl list object formed by inserting zero or more elements 
+ *	into a list.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_LinsertObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    register int objc;		/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Tcl_Obj *listPtr, *resultPtr;
+    Tcl_ObjType *typePtr;
+    int index, isDuplicate, len, result;
+
+    if (objc < 4) {
+	Tcl_WrongNumArgs(interp, 1, objv, "list index element ?element ...?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Get the index first since, if a conversion to int is needed, it
+     * will invalidate the list's internal representation.
+     */
+
+    result = TclGetIntForIndex(interp, objv[2], /*endValue*/ INT_MAX,
+	    &index);
+    if (result != TCL_OK) {
+	return result;
+    }
+
+    /*
+     * If the list object is unshared we can modify it directly. Otherwise
+     * we create a copy to modify: this is "copy on write". We create the
+     * duplicate directly in the interpreter's object result.
+     */
+    
+    listPtr = objv[1];
+    isDuplicate = 0;
+    if (Tcl_IsShared(listPtr)) {
+	/*
+	 * The following code must reflect the logic in Tcl_DuplicateObj()
+	 * except that it must duplicate the list object directly into the
+	 * interpreter's result.
+	 */
+	
+	Tcl_ResetResult(interp);
+	resultPtr = Tcl_GetObjResult(interp);
+	typePtr = listPtr->typePtr;
+	if (listPtr->bytes == NULL) {
+	    resultPtr->bytes = NULL;
+	} else if (listPtr->bytes != tclEmptyStringRep) {
+	    len = listPtr->length;
+	    TclInitStringRep(resultPtr, listPtr->bytes, len);
+	}
+	if (typePtr != NULL) {
+	    if (typePtr->dupIntRepProc == NULL) {
+		resultPtr->internalRep = listPtr->internalRep;
+		resultPtr->typePtr = typePtr;
+	    } else {
+		(*typePtr->dupIntRepProc)(listPtr, resultPtr);
+	    }
+	}
+	listPtr = resultPtr;
+	isDuplicate = 1;
+    }
+    
+    if ((objc == 4) && (index == INT_MAX)) {
+	/*
+	 * Special case: insert one element at the end of the list.
+	 */
+
+	result = Tcl_ListObjAppendElement(interp, listPtr, objv[3]);
+    } else if (objc > 3) {
+	result = Tcl_ListObjReplace(interp, listPtr, index, 0,
+				    (objc-3), &(objv[3]));
+    }
+    if (result != TCL_OK) {
+	return result;
+    }
+    
+    /*
+     * Set the interpreter's object result.
+     */
+
+    if (!isDuplicate) {
+	Tcl_SetObjResult(interp, listPtr);
+    }
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ListObjCmd --
+ *
+ *	This procedure is invoked to process the "list" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_ListObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    register int objc;			/* Number of arguments. */
+    register Tcl_Obj *CONST objv[];	/* The argument objects. */
+{
+    /*
+     * If there are no list elements, the result is an empty object.
+     * Otherwise modify the interpreter's result object to be a list object.
+     */
+    
+    if (objc > 1) {
+	Tcl_SetListObj(Tcl_GetObjResult(interp), (objc-1), &(objv[1]));
+    }
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LlengthObjCmd --
+ *
+ *	This object-based procedure is invoked to process the "llength" Tcl
+ *	command.  See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_LlengthObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int objc;				/* Number of arguments. */
+    register Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    int listLen, result;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "list");
+	return TCL_ERROR;
+    }
+
+    result = Tcl_ListObjLength(interp, objv[1], &listLen);
+    if (result != TCL_OK) {
+	return result;
+    }
+
+    /*
+     * Set the interpreter's object result to an integer object holding the
+     * length. 
+     */
+
+    Tcl_SetIntObj(Tcl_GetObjResult(interp), listLen);
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LrangeObjCmd --
+ *
+ *	This procedure is invoked to process the "lrange" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_LrangeObjCmd(notUsed, interp, objc, objv)
+    ClientData notUsed;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int objc;				/* Number of arguments. */
+    register Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Tcl_Obj *listPtr;
+    Tcl_Obj **elemPtrs;
+    int listLen, first, last, numElems, result;
+
+    if (objc != 4) {
+	Tcl_WrongNumArgs(interp, 1, objv, "list first last");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Make sure the list argument is a list object and get its length and
+     * a pointer to its array of element pointers.
+     */
+
+    listPtr = objv[1];
+    result = Tcl_ListObjGetElements(interp, listPtr, &listLen, &elemPtrs);
+    if (result != TCL_OK) {
+	return result;
+    }
+
+    /*
+     * Get the first and last indexes.
+     */
+
+    result = TclGetIntForIndex(interp, objv[2], /*endValue*/ (listLen - 1),
+	    &first);
+    if (result != TCL_OK) {
+	return result;
+    }
+    if (first < 0) {
+	first = 0;
+    }
+
+    result = TclGetIntForIndex(interp, objv[3], /*endValue*/ (listLen - 1),
+	    &last);
+    if (result != TCL_OK) {
+	return result;
+    }
+    if (last >= listLen) {
+	last = (listLen - 1);
+    }
+    
+    if (first > last) {
+	return TCL_OK;		/* the result is an empty object */
+    }
+
+    /*
+     * Make sure listPtr still refers to a list object. It might have been
+     * converted to an int above if the argument objects were shared.
+     */  
+
+    if (listPtr->typePtr != &tclListType) {
+        result = Tcl_ListObjGetElements(interp, listPtr, &listLen,
+                &elemPtrs);
+        if (result != TCL_OK) {
+            return result;
+        }
+    }
+
+    /*
+     * Extract a range of fields. We modify the interpreter's result object
+     * to be a list object containing the specified elements.
+     */
+
+    numElems = (last - first + 1);
+    Tcl_SetListObj(Tcl_GetObjResult(interp), numElems, &(elemPtrs[first]));
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LreplaceObjCmd --
+ *
+ *	This object-based procedure is invoked to process the "lreplace" 
+ *	Tcl command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A new Tcl list object formed by replacing zero or more elements of
+ *	a list.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_LreplaceObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    register Tcl_Obj *listPtr;
+    int createdNewObj, first, last, listLen, numToDelete;
+    int firstArgLen, result;
+    char *firstArg;
+
+    if (objc < 4) {
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"list first last ?element element ...?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * If the list object is unshared we can modify it directly, otherwise
+     * we create a copy to modify: this is "copy on write".
+     */
+    
+    listPtr = objv[1];
+    createdNewObj = 0;
+    if (Tcl_IsShared(listPtr)) {
+	listPtr = Tcl_DuplicateObj(listPtr);
+	createdNewObj = 1;
+    }
+    result = Tcl_ListObjLength(interp, listPtr, &listLen);
+    if (result != TCL_OK) {
+        errorReturn:
+	if (createdNewObj) {
+	    Tcl_DecrRefCount(listPtr); /* free unneeded obj */
+	}
+	return result;
+    }
+
+    /*
+     * Get the first and last indexes.
+     */
+
+    result = TclGetIntForIndex(interp, objv[2], /*endValue*/ (listLen - 1),
+	    &first);
+    if (result != TCL_OK) {
+	goto errorReturn;
+    }
+    firstArg = Tcl_GetStringFromObj(objv[2], &firstArgLen);
+
+    result = TclGetIntForIndex(interp, objv[3], /*endValue*/ (listLen - 1),
+	    &last);
+    if (result != TCL_OK) {
+	goto errorReturn;
+    }
+
+    if (first < 0)  {
+    	first = 0;
+    }
+    if ((first >= listLen) && (listLen > 0)
+	    && (strncmp(firstArg, "end", (unsigned) firstArgLen) != 0)) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"list doesn't contain element ",
+		Tcl_GetStringFromObj(objv[2], (int *) NULL), (int *) NULL);
+	result = TCL_ERROR;
+	goto errorReturn;
+    }
+    if (last >= listLen) {
+    	last = (listLen - 1);
+    }
+    if (first <= last) {
+	numToDelete = (last - first + 1);
+    } else {
+	numToDelete = 0;
+    }
+
+    if (objc > 4) {
+	result = Tcl_ListObjReplace(interp, listPtr, first, numToDelete,
+	        (objc-4), &(objv[4]));
+    } else {
+	result = Tcl_ListObjReplace(interp, listPtr, first, numToDelete,
+		0, NULL);
+    }
+    if (result != TCL_OK) {
+	goto errorReturn;
+    }
+
+    /*
+     * Set the interpreter's object result. 
+     */
+
+    Tcl_SetObjResult(interp, listPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LsortObjCmd --
+ *
+ *	This procedure is invoked to process the "lsort" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_LsortObjCmd(clientData, interp, objc, objv)
+    ClientData clientData;	/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument values. */
+{
+    int i, index, dummy;
+    Tcl_Obj *resultPtr;
+    int length;
+    Tcl_Obj *cmdPtr, **listObjPtrs;
+    SortElement *elementArray;
+    SortElement *elementPtr;        
+    SortInfo sortInfo;                  /* Information about this sort that
+                                         * needs to be passed to the 
+                                         * comparison function */
+    static char *switches[] =
+	    {"-ascii", "-command", "-decreasing", "-dictionary",
+	    "-increasing", "-index", "-integer", "-real", (char *) NULL};
+
+    resultPtr = Tcl_GetObjResult(interp);
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?options? list");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Parse arguments to set up the mode for the sort.
+     */
+
+    sortInfo.isIncreasing = 1;
+    sortInfo.sortMode = SORTMODE_ASCII;
+    sortInfo.index = -1;
+    sortInfo.interp = interp;
+    sortInfo.resultCode = TCL_OK;
+    cmdPtr = NULL;
+    for (i = 1; i < objc-1; i++) {
+	if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0, &index)
+		!= TCL_OK) {
+	    return TCL_ERROR;
+	}
+	switch (index) {
+	    case 0:			/* -ascii */
+		sortInfo.sortMode = SORTMODE_ASCII;
+		break;
+	    case 1:			/* -command */
+		if (i == (objc-2)) {
+		    Tcl_AppendToObj(resultPtr,
+			    "\"-command\" option must be followed by comparison command",
+			    -1);
+		    return TCL_ERROR;
+		}
+		sortInfo.sortMode = SORTMODE_COMMAND;
+		cmdPtr = objv[i+1];
+		i++;
+		break;
+	    case 2:			/* -decreasing */
+		sortInfo.isIncreasing = 0;
+		break;
+	    case 3:			/* -dictionary */
+		sortInfo.sortMode = SORTMODE_DICTIONARY;
+		break;
+	    case 4:			/* -increasing */
+		sortInfo.isIncreasing = 1;
+		break;
+	    case 5:			/* -index */
+		if (i == (objc-2)) {
+		    Tcl_AppendToObj(resultPtr,
+			    "\"-index\" option must be followed by list index",
+			    -1);
+		    return TCL_ERROR;
+		}
+		if (TclGetIntForIndex(interp, objv[i+1], -2, &sortInfo.index)
+			!= TCL_OK) {
+		    return TCL_ERROR;
+		}
+		cmdPtr = objv[i+1];
+		i++;
+		break;
+	    case 6:			/* -integer */
+		sortInfo.sortMode = SORTMODE_INTEGER;
+		break;
+	    case 7:			/* -real */
+		sortInfo.sortMode = SORTMODE_REAL;
+		break;
+	}
+    }
+    if (sortInfo.sortMode == SORTMODE_COMMAND) {
+	Tcl_DStringInit(&sortInfo.compareCmd);
+	Tcl_DStringAppend(&sortInfo.compareCmd,
+		Tcl_GetStringFromObj(cmdPtr, &dummy), -1);
+    }
+
+    sortInfo.resultCode = Tcl_ListObjGetElements(interp, objv[objc-1],
+	    &length, &listObjPtrs);
+    if (sortInfo.resultCode != TCL_OK) {
+	goto done;
+    }
+    if (length <= 0) {
+        return TCL_OK;
+    }
+    elementArray = (SortElement *) ckalloc(length * sizeof(SortElement));
+    for (i=0; i < length; i++){
+	elementArray[i].objPtr = listObjPtrs[i];
+	elementArray[i].nextPtr = &elementArray[i+1];
+    }
+    elementArray[length-1].nextPtr = NULL;
+    elementPtr = MergeSort(elementArray, &sortInfo);
+    if (sortInfo.resultCode == TCL_OK) {
+	/*
+	 * Note: must clear the interpreter's result object: it could
+	 * have been set by the -command script.
+	 */
+
+	Tcl_ResetResult(interp);
+	resultPtr = Tcl_GetObjResult(interp);
+	for (; elementPtr != NULL; elementPtr = elementPtr->nextPtr){
+	    Tcl_ListObjAppendElement(interp, resultPtr, elementPtr->objPtr);
+	}
+    }
+    ckfree((char*) elementArray);
+
+    done:
+    if (sortInfo.sortMode == SORTMODE_COMMAND) {
+	Tcl_DStringFree(&sortInfo.compareCmd);
+    }
+    return sortInfo.resultCode;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MergeSort -
+ *
+ *	This procedure sorts a linked list of SortElement structures
+ *	use the merge-sort algorithm.
+ *
+ * Results:
+ *      A pointer to the head of the list after sorting is returned.
+ *
+ * Side effects:
+ *	None, unless a user-defined comparison command does something
+ *	weird.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static SortElement *
+MergeSort(headPtr, infoPtr)
+    SortElement *headPtr;               /* First element on the list */
+    SortInfo *infoPtr;                  /* Information needed by the
+                                         * comparison operator */
+{
+    /*
+     * The subList array below holds pointers to temporary lists built
+     * during the merge sort.  Element i of the array holds a list of
+     * length 2**i.
+     */
+
+#   define NUM_LISTS 30
+    SortElement *subList[NUM_LISTS];
+    SortElement *elementPtr;
+    int i;
+
+    for(i = 0; i < NUM_LISTS; i++){
+        subList[i] = NULL;
+    }
+    while (headPtr != NULL) {
+	elementPtr = headPtr;
+	headPtr = headPtr->nextPtr;
+	elementPtr->nextPtr = 0;
+	for (i = 0; (i < NUM_LISTS) && (subList[i] != NULL); i++){
+	    elementPtr = MergeLists(subList[i], elementPtr, infoPtr);
+	    subList[i] = NULL;
+	}
+	if (i >= NUM_LISTS) {
+	    i = NUM_LISTS-1;
+	}
+	subList[i] = elementPtr;
+    }
+    elementPtr = NULL;
+    for (i = 0; i < NUM_LISTS; i++){
+        elementPtr = MergeLists(subList[i], elementPtr, infoPtr);
+    }
+    return elementPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MergeLists -
+ *
+ *	This procedure combines two sorted lists of SortElement structures
+ *	into a single sorted list.
+ *
+ * Results:
+ *      The unified list of SortElement structures.
+ *
+ * Side effects:
+ *	None, unless a user-defined comparison command does something
+ *	weird.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static SortElement *
+MergeLists(leftPtr, rightPtr, infoPtr)
+    SortElement *leftPtr;               /* First list to be merged; may be
+					 * NULL. */
+    SortElement *rightPtr;              /* Second list to be merged; may be
+					 * NULL. */
+    SortInfo *infoPtr;                  /* Information needed by the
+                                         * comparison operator. */
+{
+    SortElement *headPtr;
+    SortElement *tailPtr;
+
+    if (leftPtr == NULL) {
+        return rightPtr;
+    }
+    if (rightPtr == NULL) {
+        return leftPtr;
+    }
+    if (SortCompare(leftPtr->objPtr, rightPtr->objPtr, infoPtr) > 0) {
+	tailPtr = rightPtr;
+	rightPtr = rightPtr->nextPtr;
+    } else {
+	tailPtr = leftPtr;
+	leftPtr = leftPtr->nextPtr;
+    }
+    headPtr = tailPtr;
+    while ((leftPtr != NULL) && (rightPtr != NULL)) {
+	if (SortCompare(leftPtr->objPtr, rightPtr->objPtr, infoPtr) > 0) {
+	    tailPtr->nextPtr = rightPtr;
+	    tailPtr = rightPtr;
+	    rightPtr = rightPtr->nextPtr;
+	} else {
+	    tailPtr->nextPtr = leftPtr;
+	    tailPtr = leftPtr;
+	    leftPtr = leftPtr->nextPtr;
+	}
+    }
+    if (leftPtr != NULL) {
+       tailPtr->nextPtr = leftPtr;
+    } else {
+       tailPtr->nextPtr = rightPtr;
+    }
+    return headPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SortCompare --
+ *
+ *	This procedure is invoked by MergeLists to determine the proper
+ *	ordering between two elements.
+ *
+ * Results:
+ *      A negative results means the the first element comes before the
+ *      second, and a positive results means that the second element
+ *      should come first.  A result of zero means the two elements
+ *      are equal and it doesn't matter which comes first.
+ *
+ * Side effects:
+ *	None, unless a user-defined comparison command does something
+ *	weird.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SortCompare(objPtr1, objPtr2, infoPtr)
+    Tcl_Obj *objPtr1, *objPtr2;		/* Values to be compared. */
+    SortInfo *infoPtr;                  /* Information passed from the
+                                         * top-level "lsort" command */
+{
+    int order, dummy, listLen, index;
+    Tcl_Obj *objPtr;
+    char buffer[30];
+
+    order = 0;
+    if (infoPtr->resultCode != TCL_OK) {
+	/*
+	 * Once an error has occurred, skip any future comparisons
+	 * so as to preserve the error message in sortInterp->result.
+	 */
+
+	return order;
+    }
+    if (infoPtr->index != -1) {
+	/*
+	 * The "-index" option was specified.  Treat each object as a
+	 * list, extract the requested element from each list, and
+	 * compare the elements, not the lists.  The special index "end"
+	 * is signaled here with a large negative index.
+	 */
+
+	if (Tcl_ListObjLength(infoPtr->interp, objPtr1, &listLen) != TCL_OK) {
+	    infoPtr->resultCode = TCL_ERROR;
+	    return order;
+	}
+	if (infoPtr->index < -1) {
+	    index = listLen - 1;
+	} else {
+	    index = infoPtr->index;
+	}
+
+	if (Tcl_ListObjIndex(infoPtr->interp, objPtr1, index, &objPtr)
+		!= TCL_OK) {
+	    infoPtr->resultCode = TCL_ERROR;
+	    return order;
+	}
+	if (objPtr == NULL) {
+	    objPtr = objPtr1;
+	    missingElement:
+	    sprintf(buffer, "%d", infoPtr->index);
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->interp),
+			"element ", buffer, " missing from sublist \"",
+			Tcl_GetStringFromObj(objPtr, (int *) NULL),
+			"\"", (char *) NULL);
+	    infoPtr->resultCode = TCL_ERROR;
+	    return order;
+	}
+	objPtr1 = objPtr;
+
+	if (Tcl_ListObjLength(infoPtr->interp, objPtr2, &listLen) != TCL_OK) {
+	    infoPtr->resultCode = TCL_ERROR;
+	    return order;
+	}
+	if (infoPtr->index < -1) {
+	    index = listLen - 1;
+	} else {
+	    index = infoPtr->index;
+	}
+
+	if (Tcl_ListObjIndex(infoPtr->interp, objPtr2, index, &objPtr)
+		!= TCL_OK) {
+	    infoPtr->resultCode = TCL_ERROR;
+	    return order;
+	}
+	if (objPtr == NULL) {
+	    objPtr = objPtr2;
+	    goto missingElement;
+	}
+	objPtr2 = objPtr;
+    }
+    if (infoPtr->sortMode == SORTMODE_ASCII) {
+	order = strcmp(Tcl_GetStringFromObj(objPtr1, &dummy),
+		Tcl_GetStringFromObj(objPtr2, &dummy));
+    } else if (infoPtr->sortMode == SORTMODE_DICTIONARY) {
+	order = DictionaryCompare(
+		Tcl_GetStringFromObj(objPtr1, &dummy),
+		Tcl_GetStringFromObj(objPtr2, &dummy));
+    } else if (infoPtr->sortMode == SORTMODE_INTEGER) {
+	int a, b;
+
+	if ((Tcl_GetIntFromObj(infoPtr->interp, objPtr1, &a) != TCL_OK)
+		|| (Tcl_GetIntFromObj(infoPtr->interp, objPtr2, &b)
+		!= TCL_OK)) {
+	    infoPtr->resultCode = TCL_ERROR;
+	    return order;
+	}
+	if (a > b) {
+	    order = 1;
+	} else if (b > a) {
+	    order = -1;
+	}
+    } else if (infoPtr->sortMode == SORTMODE_REAL) {
+	double a, b;
+
+	if ((Tcl_GetDoubleFromObj(infoPtr->interp, objPtr1, &a) != TCL_OK)
+	      || (Tcl_GetDoubleFromObj(infoPtr->interp, objPtr2, &b)
+		      != TCL_OK)) {
+	    infoPtr->resultCode = TCL_ERROR;
+	    return order;
+	}
+	if (a > b) {
+	    order = 1;
+	} else if (b > a) {
+	    order = -1;
+	}
+    } else {
+	int oldLength;
+
+	/*
+	 * Generate and evaluate a command to determine which string comes
+	 * first.
+	 */
+
+	oldLength = Tcl_DStringLength(&infoPtr->compareCmd);
+	Tcl_DStringAppendElement(&infoPtr->compareCmd,
+		Tcl_GetStringFromObj(objPtr1, &dummy));
+	Tcl_DStringAppendElement(&infoPtr->compareCmd,
+		Tcl_GetStringFromObj(objPtr2, &dummy));
+	infoPtr->resultCode = Tcl_Eval(infoPtr->interp, 
+		Tcl_DStringValue(&infoPtr->compareCmd));
+	Tcl_DStringTrunc(&infoPtr->compareCmd, oldLength);
+	if (infoPtr->resultCode != TCL_OK) {
+	    Tcl_AddErrorInfo(infoPtr->interp,
+		    "\n    (-compare command)");
+	    return order;
+	}
+
+	/*
+	 * Parse the result of the command.
+	 */
+
+	if (Tcl_GetIntFromObj(infoPtr->interp,
+		Tcl_GetObjResult(infoPtr->interp), &order) != TCL_OK) {
+	    Tcl_ResetResult(infoPtr->interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(infoPtr->interp),
+		    "-compare command returned non-numeric result", -1);
+	    infoPtr->resultCode = TCL_ERROR;
+	    return order;
+	}
+    }
+    if (!infoPtr->isIncreasing) {
+	order = -order;
+    }
+    return order;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DictionaryCompare
+ *
+ *	This function compares two strings as if they were being used in
+ *	an index or card catalog.  The case of alphabetic characters is
+ *	ignored, except to break ties.  Thus "B" comes before "b" but
+ *	after "a".  Also, integers embedded in the strings compare in
+ *	numerical order.  In other words, "x10y" comes after "x9y", not
+ *      before it as it would when using strcmp().
+ *
+ * Results:
+ *      A negative result means that the first element comes before the
+ *      second, and a positive result means that the second element
+ *      should come first.  A result of zero means the two elements
+ *      are equal and it doesn't matter which comes first.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DictionaryCompare(left, right)
+    char *left, *right;          /* The strings to compare */
+{
+    int diff, zeros;
+    int secondaryDiff = 0;
+
+    while (1) {
+	if (isdigit(UCHAR(*right)) && isdigit(UCHAR(*left))) {
+	    /*
+	     * There are decimal numbers embedded in the two
+	     * strings.  Compare them as numbers, rather than
+	     * strings.  If one number has more leading zeros than
+	     * the other, the number with more leading zeros sorts
+	     * later, but only as a secondary choice.
+	     */
+
+	    zeros = 0;
+	    while ((*right == '0') && (isdigit(UCHAR(right[1])))) {
+		right++;
+		zeros--;
+	    }
+	    while ((*left == '0') && (isdigit(UCHAR(left[1])))) {
+		left++;
+		zeros++;
+	    }
+	    if (secondaryDiff == 0) {
+		secondaryDiff = zeros;
+	    }
+
+	    /*
+	     * The code below compares the numbers in the two
+	     * strings without ever converting them to integers.  It
+	     * does this by first comparing the lengths of the
+	     * numbers and then comparing the digit values.
+	     */
+
+	    diff = 0;
+	    while (1) {
+		if (diff == 0) {
+		    diff = UCHAR(*left) - UCHAR(*right);
+		}
+		right++;
+		left++;
+		if (!isdigit(UCHAR(*right))) {
+		    if (isdigit(UCHAR(*left))) {
+			return 1;
+		    } else {
+			/*
+			 * The two numbers have the same length. See
+			 * if their values are different.
+			 */
+
+			if (diff != 0) {
+			    return diff;
+			}
+			break;
+		    }
+		} else if (!isdigit(UCHAR(*left))) {
+		    return -1;
+		}
+	    }
+	    continue;
+	}
+        diff = UCHAR(*left) - UCHAR(*right);
+        if (diff) {
+            if (isupper(UCHAR(*left)) && islower(UCHAR(*right))) {
+                diff = UCHAR(tolower(*left)) - UCHAR(*right);
+                if (diff) {
+		    return diff;
+                } else if (secondaryDiff == 0) {
+		    secondaryDiff = -1;
+                }
+            } else if (isupper(UCHAR(*right)) && islower(UCHAR(*left))) {
+                diff = UCHAR(*left) - UCHAR(tolower(UCHAR(*right)));
+                if (diff) {
+		    return diff;
+                } else if (secondaryDiff == 0) {
+		    secondaryDiff = 1;
+                }
+            } else {
+                return diff;
+            }
+        }
+        if (*left == 0) {
+	    break;
+	}
+        left++;
+        right++;
+    }
+    if (diff == 0) {
+	diff = secondaryDiff;
+    }
+    return diff;
+}
Index: /trunk/tcl/tclCmdMZ.c
===================================================================
--- /trunk/tcl/tclCmdMZ.c	(revision 2)
+++ /trunk/tcl/tclCmdMZ.c	(revision 2)
@@ -0,0 +1,1428 @@
+/* 
+ * tclCmdMZ.c --
+ *
+ *	This file contains the top-level command routines for most of
+ *	the Tcl built-in commands whose names begin with the letters
+ *	M to Z.  It contains only commands in the generic core (i.e.
+ *	those that don't depend much upon UNIX facilities).
+ *
+ * Copyright (c) 1987-1993 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.1 2008-06-04 13:58:04 demin Exp $
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+#include "tclCompile.h"
+
+/*
+ * Structure used to hold information about variable traces:
+ */
+
+typedef struct {
+    int flags;			/* Operations for which Tcl command is
+				 * to be invoked. */
+    char *errMsg;		/* Error message returned from Tcl command,
+				 * or NULL.  Malloc'ed. */
+    int length;			/* Number of non-NULL chars. in command. */
+    char command[4];		/* Space for Tcl command to invoke.  Actual
+				 * size will be as large as necessary to
+				 * hold command.  This field must be the
+				 * last in the structure, so that it can
+				 * be larger than 4 bytes. */
+} TraceVarInfo;
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static char *		TraceVarProc _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, char *name1, char *name2,
+			    int flags));
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ReturnObjCmd --
+ *
+ *	This object-based procedure is invoked to process the "return" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_ReturnObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Interp *iPtr = (Interp *) interp;
+    int optionLen, argLen, code, result;
+
+    if (iPtr->errorInfo != NULL) {
+	ckfree(iPtr->errorInfo);
+	iPtr->errorInfo = NULL;
+    }
+    if (iPtr->errorCode != NULL) {
+	ckfree(iPtr->errorCode);
+	iPtr->errorCode = NULL;
+    }
+    code = TCL_OK;
+
+   /*
+    * THIS FAILS IF AN OBJECT CONTAINS AN EMBEDDED NULL.
+    */
+    
+    for (objv++, objc--;  objc > 1;  objv += 2, objc -= 2) {
+	char *option = Tcl_GetStringFromObj(objv[0], &optionLen);
+	char *arg = Tcl_GetStringFromObj(objv[1], &argLen);
+    	
+	if (strcmp(option, "-code") == 0) {
+	    register int c = arg[0];
+	    if ((c == 'o') && (strcmp(arg, "ok") == 0)) {
+		code = TCL_OK;
+	    } else if ((c == 'e') && (strcmp(arg, "error") == 0)) {
+		code = TCL_ERROR;
+	    } else if ((c == 'r') && (strcmp(arg, "return") == 0)) {
+		code = TCL_RETURN;
+	    } else if ((c == 'b') && (strcmp(arg, "break") == 0)) {
+		code = TCL_BREAK;
+	    } else if ((c == 'c') && (strcmp(arg, "continue") == 0)) {
+		code = TCL_CONTINUE;
+	    } else {
+		result = Tcl_GetIntFromObj((Tcl_Interp *) NULL, objv[1],
+		        &code);
+		if (result != TCL_OK) {
+		    Tcl_ResetResult(interp);
+		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+			    "bad completion code \"",
+			    Tcl_GetStringFromObj(objv[1], (int *) NULL),
+			    "\": must be ok, error, return, break, ",
+			    "continue, or an integer", (char *) NULL);
+		    return result;
+		}
+	    }
+	} else if (strcmp(option, "-errorinfo") == 0) {
+	    iPtr->errorInfo =
+		(char *) ckalloc((unsigned) (strlen(arg) + 1));
+	    strcpy(iPtr->errorInfo, arg);
+	} else if (strcmp(option, "-errorcode") == 0) {
+	    iPtr->errorCode =
+		(char *) ckalloc((unsigned) (strlen(arg) + 1));
+	    strcpy(iPtr->errorCode, arg);
+	} else {
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		    "bad option \"", option,
+		    "\": must be -code, -errorcode, or -errorinfo",
+		    (char *) NULL);
+	    return TCL_ERROR;
+	}
+    }
+    
+    if (objc == 1) {
+	/*
+	 * Set the interpreter's object result. An inline version of
+	 * Tcl_SetObjResult.
+	 */
+
+	Tcl_SetObjResult(interp, objv[0]);
+    }
+    iPtr->returnCode = code;
+    return TCL_RETURN;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ScanCmd --
+ *
+ *	This procedure is invoked to process the "scan" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_ScanCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+#   define MAX_FIELDS 20
+    typedef struct {
+	char fmt;			/* Format for field. */
+	int size;			/* How many bytes to allow for
+					 * field. */
+	char *location;			/* Where field will be stored. */
+    } Field;
+    Field fields[MAX_FIELDS];		/* Info about all the fields in the
+					 * format string. */
+    register Field *curField;
+    int numFields = 0;			/* Number of fields actually
+					 * specified. */
+    int suppress;			/* Current field is assignment-
+					 * suppressed. */
+    int totalSize = 0;			/* Number of bytes needed to store
+					 * all results combined. */
+    char *results;			/* Where scanned output goes.
+					 * Malloced; NULL means not allocated
+					 * yet. */
+    int numScanned;			/* sscanf's result. */
+    register char *fmt;
+    int i, widthSpecified, length, code;
+    char buf[40];
+
+    /*
+     * The variables below are used to hold a copy of the format
+     * string, so that we can replace format specifiers like "%f"
+     * and "%F" with specifiers like "%lf"
+     */
+
+#   define STATIC_SIZE 5
+    char copyBuf[STATIC_SIZE], *fmtCopy;
+    register char *dst;
+
+    if (argc < 3) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" string format ?varName varName ...?\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * This procedure operates in four stages:
+     * 1. Scan the format string, collecting information about each field.
+     * 2. Allocate an array to hold all of the scanned fields.
+     * 3. Call sscanf to do all the dirty work, and have it store the
+     *    parsed fields in the array.
+     * 4. Pick off the fields from the array and assign them to variables.
+     */
+
+    code = TCL_OK;
+    results = NULL;
+    length = strlen(argv[2]) * 2 + 1;
+    if (length < STATIC_SIZE) {
+	fmtCopy = copyBuf;
+    } else {
+	fmtCopy = (char *) ckalloc((unsigned) length);
+    }
+    dst = fmtCopy;
+    for (fmt = argv[2]; *fmt != 0; fmt++) {
+	*dst = *fmt;
+	dst++;
+	if (*fmt != '%') {
+	    continue;
+	}
+	fmt++;
+	if (*fmt == '%') {
+	    *dst = *fmt;
+	    dst++;
+	    continue;
+	}
+	if (*fmt == '*') {
+	    suppress = 1;
+	    *dst = *fmt;
+	    dst++;
+	    fmt++;
+	} else {
+	    suppress = 0;
+	}
+	widthSpecified = 0;
+	while (isdigit(UCHAR(*fmt))) {
+	    widthSpecified = 1;
+	    *dst = *fmt;
+	    dst++;
+	    fmt++;
+	}
+	if ((*fmt == 'l') || (*fmt == 'h') || (*fmt == 'L')) {
+	    fmt++;
+	}
+	*dst = *fmt;
+	dst++;
+	if (suppress) {
+	    continue;
+	}
+	if (numFields == MAX_FIELDS) {
+	    Tcl_SetResult(interp, "too many fields to scan", TCL_STATIC);
+	    code = TCL_ERROR;
+	    goto done;
+	}
+	curField = &fields[numFields];
+	numFields++;
+	switch (*fmt) {
+	    case 'd':
+	    case 'i':
+	    case 'o':
+	    case 'x':
+		curField->fmt = 'd';
+		curField->size = sizeof(int);
+		break;
+
+	    case 'u':
+		curField->fmt = 'u';
+		curField->size = sizeof(int);
+		break;
+
+	    case 's':
+		curField->fmt = 's';
+		curField->size = strlen(argv[1]) + 1;
+		break;
+
+	    case 'c':
+                if (widthSpecified) {
+		    Tcl_SetResult(interp,
+		            "field width may not be specified in %c conversion",
+			    TCL_STATIC);
+		    code = TCL_ERROR;
+		    goto done;
+                }
+		curField->fmt = 'c';
+		curField->size = sizeof(int);
+		break;
+
+	    case 'e':
+	    case 'f':
+	    case 'g':
+		dst[-1] = 'l';
+		dst[0] = 'f';
+		dst++;
+		curField->fmt = 'f';
+		curField->size = sizeof(double);
+		break;
+
+	    case '[':
+		curField->fmt = 's';
+		curField->size = strlen(argv[1]) + 1;
+		do {
+		    fmt++;
+		    if (*fmt == 0) {
+			Tcl_SetResult(interp,
+			        "unmatched [ in format string", TCL_STATIC);
+			code = TCL_ERROR;
+			goto done;
+		    }
+		    *dst = *fmt;
+		    dst++;
+		} while (*fmt != ']');
+		break;
+
+	    default:
+		{
+		    char buf[50];
+
+		    sprintf(buf, "bad scan conversion character \"%c\"", *fmt);
+		    Tcl_SetResult(interp, buf, TCL_VOLATILE);
+		    code = TCL_ERROR;
+		    goto done;
+		}
+	}
+	curField->size = TCL_ALIGN(curField->size);
+	totalSize += curField->size;
+    }
+    *dst = 0;
+
+    if (numFields != (argc-3)) {
+	Tcl_SetResult(interp,
+		"different numbers of variable names and field specifiers",
+		TCL_STATIC);
+	code = TCL_ERROR;
+	goto done;
+    }
+
+    /*
+     * Step 2:
+     */
+
+    results = (char *) ckalloc((unsigned) totalSize);
+    for (i = 0, totalSize = 0, curField = fields;
+	    i < numFields; i++, curField++) {
+	curField->location = results + totalSize;
+	totalSize += curField->size;
+    }
+
+    /*
+     * Fill in the remaining fields with NULL;  the only purpose of
+     * this is to keep some memory analyzers, like Purify, from
+     * complaining.
+     */
+
+    for ( ; i < MAX_FIELDS; i++, curField++) {
+	curField->location = NULL;
+    }
+
+    /*
+     * Step 3:
+     */
+
+    numScanned = sscanf(argv[1], fmtCopy,
+	    fields[0].location, fields[1].location, fields[2].location,
+	    fields[3].location, fields[4].location, fields[5].location,
+	    fields[6].location, fields[7].location, fields[8].location,
+	    fields[9].location, fields[10].location, fields[11].location,
+	    fields[12].location, fields[13].location, fields[14].location,
+	    fields[15].location, fields[16].location, fields[17].location,
+	    fields[18].location, fields[19].location);
+
+    /*
+     * Step 4:
+     */
+
+    if (numScanned < numFields) {
+	numFields = numScanned;
+    }
+    for (i = 0, curField = fields; i < numFields; i++, curField++) {
+	switch (curField->fmt) {
+	    char string[TCL_DOUBLE_SPACE];
+
+	    case 'd':
+		TclFormatInt(string, *((int *) curField->location));
+		if (Tcl_SetVar(interp, argv[i+3], string, 0) == NULL) {
+		    storeError:
+		    Tcl_AppendResult(interp,
+			    "couldn't set variable \"", argv[i+3], "\"",
+			    (char *) NULL);
+		    code = TCL_ERROR;
+		    goto done;
+		}
+		break;
+
+	    case 'u':
+		sprintf(string, "%u", *((int *) curField->location));
+		if (Tcl_SetVar(interp, argv[i+3], string, 0) == NULL) {
+		    goto storeError;
+		}
+		break;
+
+	    case 'c':
+		TclFormatInt(string, *((char *) curField->location) & 0xff);
+		if (Tcl_SetVar(interp, argv[i+3], string, 0) == NULL) {
+		    goto storeError;
+		}
+		break;
+
+	    case 's':
+		if (Tcl_SetVar(interp, argv[i+3], curField->location, 0)
+			== NULL) {
+		    goto storeError;
+		}
+		break;
+
+	    case 'f':
+		Tcl_PrintDouble((Tcl_Interp *) NULL,
+			*((double *) curField->location), string);
+		if (Tcl_SetVar(interp, argv[i+3], string, 0) == NULL) {
+		    goto storeError;
+		}
+		break;
+	}
+    }
+    TclFormatInt(buf, numScanned);
+    Tcl_SetResult(interp, buf, TCL_VOLATILE);
+    done:
+    if (results != NULL) {
+	ckfree(results);
+    }
+    if (fmtCopy != copyBuf) {
+	ckfree(fmtCopy);
+    }
+    return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SplitObjCmd --
+ *
+ *	This procedure is invoked to process the "split" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_SplitObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    register char *p, *p2;
+    char *splitChars, *string, *elementStart;
+    int splitCharLen, stringLen, i, j;
+    Tcl_Obj *listPtr;
+
+    if (objc == 2) {
+	splitChars = " \n\t\r";
+	splitCharLen = 4;
+    } else if (objc == 3) {
+	splitChars = Tcl_GetStringFromObj(objv[2], &splitCharLen);
+    } else {
+	Tcl_WrongNumArgs(interp, 1, objv, "string ?splitChars?");
+	return TCL_ERROR;
+    }
+
+    string = Tcl_GetStringFromObj(objv[1], &stringLen);
+    listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+    
+    /*
+     * Handle the special case of splitting on every character.
+     */
+
+    if (splitCharLen == 0) {
+	for (i = 0, p = string;  i < stringLen;  i++, p++) {
+	    Tcl_ListObjAppendElement(interp, listPtr,
+                    Tcl_NewStringObj(p, 1));
+	}
+    } else {
+	/*
+	 * Normal case: split on any of a given set of characters.
+	 * Discard instances of the split characters.
+	 */
+
+	for (i = 0, p = elementStart = string;  i < stringLen;  i++, p++) {
+	    for (j = 0, p2 = splitChars;  j < splitCharLen;  j++, p2++) {
+		if (*p2 == *p) {
+		    Tcl_ListObjAppendElement(interp, listPtr,
+                            Tcl_NewStringObj(elementStart, (p-elementStart)));
+		    elementStart = p+1;
+		    break;
+		}
+	    }
+	}
+	if (p != string) {
+	    int remainingChars = stringLen - (elementStart-string);
+	    Tcl_ListObjAppendElement(interp, listPtr,
+                    Tcl_NewStringObj(elementStart, remainingChars));
+	}
+    }
+
+    Tcl_SetObjResult(interp, listPtr);
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_StringObjCmd --
+ *
+ *	This procedure is invoked to process the "string" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_StringObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    int index, left, right;
+    Tcl_Obj *resultPtr;
+    char *string1, *string2;
+    int length1, length2;
+    static char *options[] = {
+	"compare",	"first",	"index",	"last",
+	"length",	"match",	"range",	"tolower",
+	"toupper",	"trim",		"trimleft",	"trimright",
+	"wordend",	"wordstart",	NULL
+    };
+    enum options {
+	STR_COMPARE,	STR_FIRST,	STR_INDEX,	STR_LAST,
+	STR_LENGTH,	STR_MATCH,	STR_RANGE,	STR_TOLOWER,
+	STR_TOUPPER,	STR_TRIM,	STR_TRIMLEFT,	STR_TRIMRIGHT,
+	STR_WORDEND,	STR_WORDSTART
+    };	  
+	    
+    if (objc < 2) {
+        Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
+	return TCL_ERROR;
+    }
+    
+    if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
+	    &index) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    resultPtr = Tcl_GetObjResult(interp);
+    switch ((enum options) index) {
+	case STR_COMPARE: {
+	    int match, length;
+
+	    if (objc != 4) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "string1 string2");
+		return TCL_ERROR;
+	    }
+
+	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
+	    string2 = Tcl_GetStringFromObj(objv[3], &length2);
+
+	    length = (length1 < length2) ? length1 : length2;
+	    match = memcmp(string1, string2, (unsigned) length);
+	    if (match == 0) {
+	        match = length1 - length2;
+	    }
+	    Tcl_SetIntObj(resultPtr, (match > 0) ? 1 : (match < 0) ? -1 : 0);
+	    break;
+	}
+	case STR_FIRST: {
+	    register char *p, *end;
+	    int match;
+
+	    if (objc != 4) {
+	        badFirstLastArgs:
+	        Tcl_WrongNumArgs(interp, 2, objv, "string1 string2");
+		return TCL_ERROR;
+	    }
+
+	    match = -1;
+	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
+	    string2 = Tcl_GetStringFromObj(objv[3], &length2);
+	    if (length1 > 0) {
+		end = string2 + length2 - length1 + 1;
+		for (p = string2;  p < end;  p++) {
+		  /*
+		   * Scan forward to find the first character.
+		   */
+		    
+		  p = memchr(p, *string1, (unsigned) (end - p));
+		  if (p == NULL) {
+		      break;
+		  }
+		  if (memcmp(string1, p, (unsigned) length1) == 0) {
+		      match = p - string2;
+		      break;
+		  }
+		}
+	    }
+	    Tcl_SetIntObj(resultPtr, match);
+	    break;
+	}
+	case STR_INDEX: {
+	    int index;
+
+	    if (objc != 4) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "string charIndex");
+		return TCL_ERROR;
+	    }
+
+	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
+	    if (Tcl_GetIntFromObj(interp, objv[3], &index) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if ((index >= 0) && (index < length1)) {
+	        Tcl_SetStringObj(resultPtr, string1 + index, 1);
+	    }
+	    break;
+	}
+	case STR_LAST: {
+	    register char *p;
+	    int match;
+
+	    if (objc != 4) {
+	        goto badFirstLastArgs;
+	    }
+
+	    match = -1;
+	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
+	    string2 = Tcl_GetStringFromObj(objv[3], &length2);
+	    if (length1 > 0) {
+		for (p = string2 + length2 - length1;  p >= string2;  p--) {
+		    /*
+		     * Scan backwards to find the first character.
+		     */
+		    
+		    while ((p != string2) && (*p != *string1)) {
+			p--;
+		    }
+		    if (memcmp(string1, p, (unsigned) length1) == 0) {
+			match = p - string2;
+			break;
+		    }
+		}
+	    }
+	    Tcl_SetIntObj(resultPtr, match);
+	    break;
+	}
+	case STR_LENGTH: {
+	    if (objc != 3) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "string");
+		return TCL_ERROR;
+	    }
+
+	    (void) Tcl_GetStringFromObj(objv[2], &length1);
+	    Tcl_SetIntObj(resultPtr, length1);
+	    break;
+	}
+	case STR_MATCH: {
+	    if (objc != 4) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "pattern string");
+		return TCL_ERROR;
+	    }
+
+	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
+	    string2 = Tcl_GetStringFromObj(objv[3], &length2);
+	    Tcl_SetBooleanObj(resultPtr, Tcl_StringMatch(string2, string1));
+	    break;
+	}
+	case STR_RANGE: {
+	    int first, last;
+
+	    if (objc != 5) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "string first last");
+		return TCL_ERROR;
+	    }
+
+	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
+	    if (TclGetIntForIndex(interp, objv[3], length1 - 1,
+		    &first) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (TclGetIntForIndex(interp, objv[4], length1 - 1,
+		    &last) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (first < 0) {
+		first = 0;
+	    }
+	    if (last >= length1 - 1) {
+		last = length1 - 1;
+	    }
+	    if (last >= first) {
+	        Tcl_SetStringObj(resultPtr, string1 + first, last - first + 1);
+	    }
+	    break;
+	}
+	case STR_TOLOWER: {
+	    register char *p, *end;
+
+	    if (objc != 3) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "string");
+		return TCL_ERROR;
+	    }
+
+	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
+
+	    /*
+	     * Since I know resultPtr is not a shared object, I can reach
+	     * in and diddle the bytes in its string rep to convert them in
+	     * place to lower case.
+	     */
+
+	    Tcl_SetStringObj(resultPtr, string1, length1);
+	    string1 = Tcl_GetStringFromObj(resultPtr, &length1);
+	    end = string1 + length1;
+	    for (p = string1; p < end; p++) {
+		if (isupper(UCHAR(*p))) {
+		    *p = (char) tolower(UCHAR(*p));
+		}
+	    }
+	    break;
+	}
+	case STR_TOUPPER: {
+	    register char *p, *end;
+
+	    if (objc != 3) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "string");
+		return TCL_ERROR;
+	    }
+
+	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
+
+	    /*
+	     * Since I know resultPtr is not a shared object, I can reach
+	     * in and diddle the bytes in its string rep to convert them in
+	     * place to upper case.
+	     */
+
+	    Tcl_SetStringObj(resultPtr, string1, length1);
+	    string1 = Tcl_GetStringFromObj(resultPtr, &length1);
+	    end = string1 + length1;
+	    for (p = string1; p < end; p++) {
+		if (islower(UCHAR(*p))) {
+		    *p = (char) toupper(UCHAR(*p));
+		}
+	    }
+	    break;
+	}
+	case STR_TRIM: {
+	    char ch;
+	    register char *p, *end;
+	    char *check, *checkEnd;
+
+	    left = 1;
+	    right = 1;
+
+	    trim:
+	    if (objc == 4) {
+		string2 = Tcl_GetStringFromObj(objv[3], &length2);
+	    } else if (objc == 3) {
+		string2 = " \t\n\r";
+		length2 = strlen(string2);
+	    } else {
+	        Tcl_WrongNumArgs(interp, 2, objv, "string ?chars?");
+		return TCL_ERROR;
+	    }
+	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
+	    checkEnd = string2 + length2;
+
+	    if (left) {
+		end = string1 + length1;
+		for (p = string1; p < end; p++) {
+		    ch = *p;
+		    for (check = string2; ; check++) {
+			if (check >= checkEnd) {
+			    p = end;
+			    break;
+			}
+			if (ch == *check) {
+			    length1--;
+			    string1++;
+			    break;
+			}
+		    }
+		}
+	    }
+	    if (right) {
+	        end = string1;
+		for (p = string1 + length1; p > end; ) {
+		    p--;
+		    ch = *p;
+		    for (check = string2; ; check++) {
+		        if (check >= checkEnd) {
+			    p = end;
+			    break;
+			}
+			if (ch == *check) {
+			    length1--;
+			    break;
+			}
+		    }
+		}
+	    }
+	    Tcl_SetStringObj(resultPtr, string1, length1);
+	    break;
+	}
+	case STR_TRIMLEFT: {
+	    left = 1;
+	    right = 0;
+	    goto trim;
+	}
+	case STR_TRIMRIGHT: {
+	    left = 0;
+	    right = 1;
+	    goto trim;
+	}
+	case STR_WORDEND: {
+	    int cur, c;
+	    
+	    if (objc != 4) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "string index");
+		return TCL_ERROR;
+	    }
+
+	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
+	    if (Tcl_GetIntFromObj(interp, objv[3], &index) != TCL_OK) {
+	        return TCL_ERROR;
+	    }
+	    if (index < 0) {
+		index = 0;
+	    }
+	    cur = length1;
+	    if (index < length1) {
+		for (cur = index; cur < length1; cur++) {
+		    c = UCHAR(string1[cur]);
+		    if (!isalnum(c) && (c != '_')) {
+			break;
+		    }
+		}
+		if (cur == index) {
+		    cur = index + 1;
+		}
+	    }
+	    Tcl_SetIntObj(resultPtr, cur);
+	    break;
+	}
+	case STR_WORDSTART: {
+	    int cur, c;
+	    
+	    if (objc != 4) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "string index");
+		return TCL_ERROR;
+	    }
+
+	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
+	    if (Tcl_GetIntFromObj(interp, objv[3], &index) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (index >= length1) {
+		index = length1 - 1;
+	    }
+	    cur = 0;
+	    if (index > 0) {
+	        for (cur = index; cur >= 0; cur--) {
+		    c = UCHAR(string1[cur]);
+		    if (!isalnum(c) && (c != '_')) {
+			break;
+		    }
+		}
+		if (cur != index) {
+		    cur += 1;
+		}
+	    }
+	    Tcl_SetIntObj(resultPtr, cur);
+	    break;
+	}
+    }
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SubstCmd --
+ *
+ *	This procedure is invoked to process the "subst" Tcl command.
+ *	See the user documentation for details on what it does.  This
+ *	command is an almost direct copy of an implementation by
+ *	Andrew Payne.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_SubstCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_DString result;
+    char *p, *old, *value;
+    int code, count, doVars, doCmds, doBackslashes, i;
+    size_t length;
+    char c;
+
+    /*
+     * Parse command-line options.
+     */
+
+    doVars = doCmds = doBackslashes = 1;
+    for (i = 1; i < (argc-1); i++) {
+	p = argv[i];
+	if (*p != '-') {
+	    break;
+	}
+	length = strlen(p);
+	if (length < 4) {
+	    badSwitch:
+	    Tcl_AppendResult(interp, "bad switch \"", p,
+		    "\": must be -nobackslashes, -nocommands, ",
+		    "or -novariables", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	if ((p[3] == 'b') && (strncmp(p, "-nobackslashes", length) == 0)) {
+	    doBackslashes = 0;
+	} else if ((p[3] == 'c') && (strncmp(p, "-nocommands", length) == 0)) {
+	    doCmds = 0;
+	} else if ((p[3] == 'v') && (strncmp(p, "-novariables", length) == 0)) {
+	    doVars = 0;
+	} else {
+	    goto badSwitch;
+	}
+    }
+    if (i != (argc-1)) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" ?-nobackslashes? ?-nocommands? ?-novariables? string\"",
+		(char *) NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Scan through the string one character at a time, performing
+     * command, variable, and backslash substitutions.
+     */
+
+    Tcl_DStringInit(&result);
+    old = p = argv[i];
+    while (*p != 0) {
+	switch (*p) {
+	    case '\\':
+		if (doBackslashes) {
+		    if (p != old) {
+			Tcl_DStringAppend(&result, old, p-old);
+		    }
+		    c = Tcl_Backslash(p, &count);
+		    Tcl_DStringAppend(&result, &c, 1);
+		    p += count;
+		    old = p;
+		} else {
+		    p++;
+		}
+		break;
+
+	    case '$':
+		if (doVars) {
+		    if (p != old) {
+			Tcl_DStringAppend(&result, old, p-old);
+		    }
+		    value = Tcl_ParseVar(interp, p, &p);
+		    if (value == NULL) {
+			Tcl_DStringFree(&result);
+			return TCL_ERROR;
+		    }
+		    Tcl_DStringAppend(&result, value, -1);
+		    old = p;
+		} else {
+		    p++;
+		}
+		break;
+
+	    case '[':
+		if (doCmds) {
+		    if (p != old) {
+			Tcl_DStringAppend(&result, old, p-old);
+		    }
+		    iPtr->evalFlags = TCL_BRACKET_TERM;
+		    code = Tcl_Eval(interp, p+1);
+		    if (code == TCL_ERROR) {
+			Tcl_DStringFree(&result);
+			return code;
+		    }
+		    old = p = (p+1 + iPtr->termOffset+1);
+		    Tcl_DStringAppend(&result, iPtr->result, -1);
+		    Tcl_ResetResult(interp);
+		} else {
+		    p++;
+		}
+		break;
+
+	    default:
+		p++;
+		break;
+	}
+    }
+    if (p != old) {
+	Tcl_DStringAppend(&result, old, p-old);
+    }
+    Tcl_DStringResult(interp, &result);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_TraceCmd --
+ *
+ *	This procedure is invoked to process the "trace" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_TraceCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    int c;
+    size_t length;
+
+    if (argc < 2) {
+	Tcl_AppendResult(interp, "too few args: should be \"",
+		argv[0], " option [arg arg ...]\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+    c = argv[1][1];
+    length = strlen(argv[1]);
+    if ((c == 'a') && (strncmp(argv[1], "variable", length) == 0)
+	    && (length >= 2)) {
+	char *p;
+	int flags, length;
+	TraceVarInfo *tvarPtr;
+
+	if (argc != 5) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"",
+		    argv[0], " variable name ops command\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+
+	flags = 0;
+	for (p = argv[3] ; *p != 0; p++) {
+	    if (*p == 'r') {
+		flags |= TCL_TRACE_READS;
+	    } else if (*p == 'w') {
+		flags |= TCL_TRACE_WRITES;
+	    } else if (*p == 'u') {
+		flags |= TCL_TRACE_UNSETS;
+	    } else {
+		goto badOps;
+	    }
+	}
+	if (flags == 0) {
+	    goto badOps;
+	}
+
+	length = strlen(argv[4]);
+	tvarPtr = (TraceVarInfo *) ckalloc((unsigned)
+		(sizeof(TraceVarInfo) - sizeof(tvarPtr->command) + length + 1));
+	tvarPtr->flags = flags;
+	tvarPtr->errMsg = NULL;
+	tvarPtr->length = length;
+	flags |= TCL_TRACE_UNSETS;
+	strcpy(tvarPtr->command, argv[4]);
+	if (Tcl_TraceVar(interp, argv[2], flags, TraceVarProc,
+		(ClientData) tvarPtr) != TCL_OK) {
+	    ckfree((char *) tvarPtr);
+	    return TCL_ERROR;
+	}
+    } else if ((c == 'd') && (strncmp(argv[1], "vdelete", length)
+	    && (length >= 2)) == 0) {
+	char *p;
+	int flags, length;
+	TraceVarInfo *tvarPtr;
+	ClientData clientData;
+
+	if (argc != 5) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"",
+		    argv[0], " vdelete name ops command\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+
+	flags = 0;
+	for (p = argv[3] ; *p != 0; p++) {
+	    if (*p == 'r') {
+		flags |= TCL_TRACE_READS;
+	    } else if (*p == 'w') {
+		flags |= TCL_TRACE_WRITES;
+	    } else if (*p == 'u') {
+		flags |= TCL_TRACE_UNSETS;
+	    } else {
+		goto badOps;
+	    }
+	}
+	if (flags == 0) {
+	    goto badOps;
+	}
+
+	/*
+	 * Search through all of our traces on this variable to
+	 * see if there's one with the given command.  If so, then
+	 * delete the first one that matches.
+	 */
+
+	length = strlen(argv[4]);
+	clientData = 0;
+	while ((clientData = Tcl_VarTraceInfo(interp, argv[2], 0,
+		TraceVarProc, clientData)) != 0) {
+	    tvarPtr = (TraceVarInfo *) clientData;
+	    if ((tvarPtr->length == length) && (tvarPtr->flags == flags)
+		    && (strncmp(argv[4], tvarPtr->command,
+		    (size_t) length) == 0)) {
+		Tcl_UntraceVar(interp, argv[2], flags | TCL_TRACE_UNSETS,
+			TraceVarProc, clientData);
+		if (tvarPtr->errMsg != NULL) {
+		    ckfree(tvarPtr->errMsg);
+		}
+		ckfree((char *) tvarPtr);
+		break;
+	    }
+	}
+    } else if ((c == 'i') && (strncmp(argv[1], "vinfo", length) == 0)
+	    && (length >= 2)) {
+	ClientData clientData;
+	char ops[4], *p;
+	char *prefix = "{";
+
+	if (argc != 3) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"",
+		    argv[0], " vinfo name\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	clientData = 0;
+	while ((clientData = Tcl_VarTraceInfo(interp, argv[2], 0,
+		TraceVarProc, clientData)) != 0) {
+	    TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
+	    p = ops;
+	    if (tvarPtr->flags & TCL_TRACE_READS) {
+		*p = 'r';
+		p++;
+	    }
+	    if (tvarPtr->flags & TCL_TRACE_WRITES) {
+		*p = 'w';
+		p++;
+	    }
+	    if (tvarPtr->flags & TCL_TRACE_UNSETS) {
+		*p = 'u';
+		p++;
+	    }
+	    *p = '\0';
+	    Tcl_AppendResult(interp, prefix, (char *) NULL);
+	    Tcl_AppendElement(interp, ops);
+	    Tcl_AppendElement(interp, tvarPtr->command);
+	    Tcl_AppendResult(interp, "}", (char *) NULL);
+	    prefix = " {";
+	}
+    } else {
+	Tcl_AppendResult(interp, "bad option \"", argv[1],
+		"\": should be variable, vdelete, or vinfo",
+		(char *) NULL);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+
+    badOps:
+    Tcl_AppendResult(interp, "bad operations \"", argv[3],
+	    "\": should be one or more of rwu", (char *) NULL);
+    return TCL_ERROR;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TraceVarProc --
+ *
+ *	This procedure is called to handle variable accesses that have
+ *	been traced using the "trace" command.
+ *
+ * Results:
+ *	Normally returns NULL.  If the trace command returns an error,
+ *	then this procedure returns an error string.
+ *
+ * Side effects:
+ *	Depends on the command associated with the trace.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static char *
+TraceVarProc(clientData, interp, name1, name2, flags)
+    ClientData clientData;	/* Information about the variable trace. */
+    Tcl_Interp *interp;		/* Interpreter containing variable. */
+    char *name1;		/* Name of variable or array. */
+    char *name2;		/* Name of element within array;  NULL means
+				 * scalar variable is being referenced. */
+    int flags;			/* OR-ed bits giving operation and other
+				 * information. */
+{
+    Interp *iPtr = (Interp *) interp;
+    TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
+    char *result;
+    int code;
+    Interp dummy;
+    Tcl_DString cmd;
+    Tcl_Obj *saveObjPtr, *oldObjResultPtr;
+
+    result = NULL;
+    if (tvarPtr->errMsg != NULL) {
+	ckfree(tvarPtr->errMsg);
+	tvarPtr->errMsg = NULL;
+    }
+    if ((tvarPtr->flags & flags) && !(flags & TCL_INTERP_DESTROYED)) {
+
+	/*
+	 * Generate a command to execute by appending list elements
+	 * for the two variable names and the operation.  The five
+	 * extra characters are for three space, the opcode character,
+	 * and the terminating null.
+	 */
+
+	if (name2 == NULL) {
+	    name2 = "";
+	}
+	Tcl_DStringInit(&cmd);
+	Tcl_DStringAppend(&cmd, tvarPtr->command, tvarPtr->length);
+	Tcl_DStringAppendElement(&cmd, name1);
+	Tcl_DStringAppendElement(&cmd, name2);
+	if (flags & TCL_TRACE_READS) {
+	    Tcl_DStringAppend(&cmd, " r", 2);
+	} else if (flags & TCL_TRACE_WRITES) {
+	    Tcl_DStringAppend(&cmd, " w", 2);
+	} else if (flags & TCL_TRACE_UNSETS) {
+	    Tcl_DStringAppend(&cmd, " u", 2);
+	}
+
+	/*
+	 * Execute the command.  Be careful to save and restore both the
+	 * string and object results from the interpreter used for
+	 * the command. We discard any object result the command returns.
+	 */
+
+	dummy.objResultPtr = Tcl_NewObj();
+	Tcl_IncrRefCount(dummy.objResultPtr);
+	if (interp->freeProc == 0) {
+	    dummy.freeProc = (Tcl_FreeProc *) 0;
+	    dummy.result = "";
+	    Tcl_SetResult((Tcl_Interp *) &dummy, interp->result,
+		    TCL_VOLATILE);
+	} else {
+	    dummy.freeProc = interp->freeProc;
+	    dummy.result = interp->result;
+	    interp->freeProc = (Tcl_FreeProc *) 0;
+	}
+	
+	saveObjPtr = Tcl_GetObjResult(interp);
+	Tcl_IncrRefCount(saveObjPtr);
+	
+	code = Tcl_Eval(interp, Tcl_DStringValue(&cmd));
+	if (code != TCL_OK) {	     /* copy error msg to result */
+	    tvarPtr->errMsg = (char *)
+		    ckalloc((unsigned) (strlen(interp->result) + 1));
+	    strcpy(tvarPtr->errMsg, interp->result);
+	    result = tvarPtr->errMsg;
+	    Tcl_ResetResult(interp); /* must clear error state. */
+	}
+
+	/*
+	 * Restore the interpreter's string result.
+	 */
+	
+	Tcl_SetResult(interp, dummy.result,
+		(dummy.freeProc == 0) ? TCL_VOLATILE : dummy.freeProc);
+
+	/*
+	 * Restore the interpreter's object result from saveObjPtr.
+	 */
+
+	oldObjResultPtr = iPtr->objResultPtr;
+	iPtr->objResultPtr = saveObjPtr;  /* was incremented above */
+	Tcl_DecrRefCount(oldObjResultPtr);
+
+	Tcl_DecrRefCount(dummy.objResultPtr);
+	dummy.objResultPtr = NULL;
+	Tcl_DStringFree(&cmd);
+    }
+    if (flags & TCL_TRACE_DESTROYED) {
+	result = NULL;
+	if (tvarPtr->errMsg != NULL) {
+	    ckfree(tvarPtr->errMsg);
+	}
+	ckfree((char *) tvarPtr);
+    }
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_WhileCmd --
+ *
+ *      This procedure is invoked to process the "while" Tcl command.
+ *      See the user documentation for details on what it does.
+ *
+ *	With the bytecode compiler, this procedure is only called when
+ *	a command name is computed at runtime, and is "while" or the name
+ *	to which "while" was renamed: e.g., "set z while; $z {$i<100} {}"
+ *
+ * Results:
+ *      A standard Tcl result.
+ *
+ * Side effects:
+ *      See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+        /* ARGSUSED */
+int
+Tcl_WhileCmd(dummy, interp, argc, argv)
+    ClientData dummy;                   /* Not used. */
+    Tcl_Interp *interp;                 /* Current interpreter. */
+    int argc;                           /* Number of arguments. */
+    char **argv;                        /* Argument strings. */
+{
+    int result, value;
+
+    if (argc != 3) {
+        Tcl_AppendResult(interp, "wrong # args: should be \"",
+                argv[0], " test command\"", (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    while (1) {
+        result = Tcl_ExprBoolean(interp, argv[1], &value);
+        if (result != TCL_OK) {
+            return result;
+        }
+        if (!value) {
+            break;
+        }
+        result = Tcl_Eval(interp, argv[2]);
+        if ((result != TCL_OK) && (result != TCL_CONTINUE)) {
+            if (result == TCL_ERROR) {
+                char msg[60];
+                sprintf(msg, "\n    (\"while\" body line %d)",
+                        interp->errorLine);
+                Tcl_AddErrorInfo(interp, msg);
+            }
+            break;
+        }
+    }
+    if (result == TCL_BREAK) {
+        result = TCL_OK;
+    }
+    if (result == TCL_OK) {
+        Tcl_ResetResult(interp);
+    }
+    return result;
+}
+
Index: /trunk/tcl/tclCompExpr.c
===================================================================
--- /trunk/tcl/tclCompExpr.c	(revision 2)
+++ /trunk/tcl/tclCompExpr.c	(revision 2)
@@ -0,0 +1,2403 @@
+/* 
+ * tclCompExpr.c --
+ *
+ *	This file contains the code to compile Tcl expressions.
+ *
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclCompExpr.c,v 1.1 2008-06-04 13:58:05 demin Exp $
+ */
+
+#include "tclInt.h"
+#include "tclCompile.h"
+
+/*
+ * The stuff below is a bit of a hack so that this file can be used in
+ * environments that include no UNIX, i.e. no errno: just arrange to use
+ * the errno from tclExecute.c here.
+ */
+
+#ifndef TCL_GENERIC_ONLY
+#include "tclPort.h"
+#else
+#define NO_ERRNO_H
+#endif
+
+#ifdef NO_ERRNO_H
+extern int errno;			/* Use errno from tclExecute.c. */
+#define ERANGE 34
+#endif
+
+/*
+ * Boolean variable that controls whether expression compilation tracing
+ * is enabled.
+ */
+
+#ifdef TCL_COMPILE_DEBUG
+static int traceCompileExpr = 0;
+#endif /* TCL_COMPILE_DEBUG */
+
+/*
+ * The ExprInfo structure describes the state of compiling an expression.
+ * A pointer to an ExprInfo record is passed among the routines in
+ * this module.
+ */
+
+typedef struct ExprInfo {
+    int token;			/* Type of the last token parsed in expr.
+				 * See below for definitions. Corresponds
+				 * to the characters just before next. */
+    int objIndex;		/* If token is a literal value, the index of
+				 * an object holding the value in the code's
+				 * object table; otherwise is NULL. */
+    char *funcName;		/* If the token is FUNC_NAME, points to the
+				 * first character of the math function's
+				 * name; otherwise is NULL. */
+    char *next;			/* Position of the next character to be
+				 * scanned in the expression string. */
+    char *originalExpr;		/* The entire expression that was originally
+				 * passed to Tcl_ExprString et al. */
+    char *lastChar;		/* Pointer to terminating null in
+				 * originalExpr. */
+    int hasOperators;		/* Set 1 if the expr has operators; 0 if
+				 * expr is only a primary. If 1 after
+				 * compiling an expr, a tryCvtToNumeric
+				 * instruction is emitted to convert the
+				 * primary to a number if possible. */
+    int exprIsJustVarRef;	/* Set 1 if the expr consists of just a
+				 * variable reference as in the expression
+				 * of "if $b then...". Otherwise 0. If 1 the
+				 * expr is compiled out-of-line in order to
+				 * implement expr's 2 level substitution
+				 * semantics properly. */
+    int exprIsComparison;	/* Set 1 if the top-level operator in the
+				 * expr is a comparison. Otherwise 0. If 1,
+				 * because the operands might be strings,
+				 * the expr is compiled out-of-line in order
+				 * to implement expr's 2 level substitution
+				 * semantics properly. */
+} ExprInfo;
+
+/*
+ * Definitions of the different tokens that appear in expressions. The order
+ * of these must match the corresponding entries in the operatorStrings
+ * array below.
+ */
+
+#define LITERAL		0
+#define FUNC_NAME	(LITERAL + 1)
+#define OPEN_BRACKET	(LITERAL + 2)
+#define CLOSE_BRACKET	(LITERAL + 3)
+#define OPEN_PAREN	(LITERAL + 4)
+#define CLOSE_PAREN	(LITERAL + 5)
+#define DOLLAR		(LITERAL + 6)
+#define QUOTE		(LITERAL + 7)
+#define COMMA		(LITERAL + 8)
+#define END		(LITERAL + 9)
+#define UNKNOWN		(LITERAL + 10)
+
+/*
+ * Binary operators:
+ */
+
+#define MULT		(UNKNOWN + 1)
+#define DIVIDE		(MULT + 1)
+#define MOD		(MULT + 2)
+#define PLUS		(MULT + 3)
+#define MINUS		(MULT + 4)
+#define LEFT_SHIFT	(MULT + 5)
+#define RIGHT_SHIFT	(MULT + 6)
+#define LESS		(MULT + 7)
+#define GREATER		(MULT + 8)
+#define LEQ		(MULT + 9)
+#define GEQ		(MULT + 10)
+#define EQUAL		(MULT + 11)
+#define NEQ		(MULT + 12)
+#define BIT_AND		(MULT + 13)
+#define BIT_XOR		(MULT + 14)
+#define BIT_OR		(MULT + 15)
+#define AND		(MULT + 16)
+#define OR		(MULT + 17)
+#define QUESTY		(MULT + 18)
+#define COLON		(MULT + 19)
+
+/*
+ * Unary operators. Unary minus and plus are represented by the (binary)
+ * tokens MINUS and PLUS.
+ */
+
+#define NOT		(COLON + 1)
+#define BIT_NOT		(NOT + 1)
+
+/*
+ * Mapping from tokens to strings; used for debugging messages. These
+ * entries must match the order and number of the token definitions above.
+ */
+
+#ifdef TCL_COMPILE_DEBUG
+static char *tokenStrings[] = {
+    "LITERAL", "FUNCNAME",
+    "[", "]", "(", ")", "$", "\"", ",", "END", "UNKNOWN",
+    "*", "/", "%", "+", "-",
+    "<<", ">>", "<", ">", "<=", ">=", "==", "!=",
+    "&", "^", "|", "&&", "||", "?", ":",
+    "!", "~"
+};
+#endif /* TCL_COMPILE_DEBUG */
+
+/*
+ * Declarations for local procedures to this file:
+ */
+
+static int		CompileAddExpr _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExprInfo *infoPtr, int flags,
+			    CompileEnv *envPtr));
+static int		CompileBitAndExpr _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExprInfo *infoPtr, int flags,
+			    CompileEnv *envPtr));
+static int		CompileBitOrExpr _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExprInfo *infoPtr, int flags,
+			    CompileEnv *envPtr));
+static int		CompileBitXorExpr _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExprInfo *infoPtr, int flags,
+			    CompileEnv *envPtr));
+static int		CompileCondExpr _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExprInfo *infoPtr, int flags,
+			    CompileEnv *envPtr));
+static int		CompileEqualityExpr _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExprInfo *infoPtr, int flags,
+			    CompileEnv *envPtr));
+static int		CompileLandExpr _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExprInfo *infoPtr, int flags,
+			    CompileEnv *envPtr));
+static int		CompileLorExpr _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExprInfo *infoPtr, int flags,
+			    CompileEnv *envPtr));
+static int		CompileMathFuncCall _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExprInfo *infoPtr, int flags,
+			    CompileEnv *envPtr));
+static int		CompileMultiplyExpr _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExprInfo *infoPtr, int flags,
+			    CompileEnv *envPtr));
+static int		CompilePrimaryExpr _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExprInfo *infoPtr, int flags,
+			    CompileEnv *envPtr));
+static int		CompileRelationalExpr _ANSI_ARGS_((
+    			    Tcl_Interp *interp, ExprInfo *infoPtr,
+			    int flags, CompileEnv *envPtr));
+static int		CompileShiftExpr _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExprInfo *infoPtr, int flags,
+			    CompileEnv *envPtr));
+static int		CompileUnaryExpr _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExprInfo *infoPtr, int flags,
+			    CompileEnv *envPtr));
+static int		GetToken _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExprInfo *infoPtr, CompileEnv *envPtr));
+
+/*
+ * Macro used to debug the execution of the recursive descent parser used
+ * to compile expressions.
+ */
+
+#ifdef TCL_COMPILE_DEBUG
+#define HERE(production, level) \
+    if (traceCompileExpr) { \
+	fprintf(stderr, "%*s%s: token=%s, next=\"%.20s\"\n", \
+		(level), " ", (production), tokenStrings[infoPtr->token], \
+		infoPtr->next); \
+    }
+#else
+#define HERE(production, level)
+#endif /* TCL_COMPILE_DEBUG */
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileExpr --
+ *
+ *	This procedure compiles a string containing a Tcl expression into
+ *	Tcl bytecodes. This procedure is the top-level interface to the
+ *	the expression compilation module, and is used by such public
+ *	procedures as Tcl_ExprString, Tcl_ExprStringObj, Tcl_ExprLong,
+ *	Tcl_ExprDouble, Tcl_ExprBoolean, and Tcl_ExprBooleanObj.
+ *
+ *	Note that the topmost recursive-descent parsing routine used by
+ *	TclCompileExpr to compile expressions is called "CompileCondExpr"
+ *	and not, e.g., "CompileExpr". This is done to avoid an extra
+ *	procedure call since such a procedure would only return the result
+ *	of calling CompileCondExpr. Other recursive-descent procedures
+ *	that need to parse expressions also call CompileCondExpr.
+ *
+ * Results:
+ *	The return value is TCL_OK on a successful compilation and TCL_ERROR
+ *	on failure. If TCL_ERROR is returned, then the interpreter's result
+ *	contains an error message.
+ *
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed; this might
+ *	be the offset of the ']' (if flags & TCL_BRACKET_TERM), or the
+ *	offset of the '\0' at the end of the string.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the expression.
+ *
+ *	envPtr->exprIsJustVarRef is set 1 if the expression consisted of
+ *	a single variable reference as in the expression of "if $b then...".
+ *	Otherwise it is set 0. This is used to implement Tcl's two level
+ *	expression substitution semantics properly.
+ *
+ *	envPtr->exprIsComparison is set 1 if the top-level operator in the
+ *	expr is a comparison. Otherwise it is set 0. If 1, because the
+ *	operands might be strings, the expr is compiled out-of-line in order
+ *	to implement expr's 2 level substitution semantics properly.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the expression at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileExpr(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *string;		/* The source string to compile. */
+    char *lastChar;		/* Pointer to terminating character of
+				 * string. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    Interp *iPtr = (Interp *) interp;
+    ExprInfo info;
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute the expression. */
+    int result;
+
+#ifdef TCL_COMPILE_DEBUG
+    if (traceCompileExpr) {
+	fprintf(stderr, "expr: string=\"%.30s\"\n", string);
+    }
+#endif /* TCL_COMPILE_DEBUG */
+
+    /*
+     * Register the builtin math functions the first time an expression is
+     * compiled.
+     */
+
+    if (!(iPtr->flags & EXPR_INITIALIZED)) {
+	BuiltinFunc *funcPtr;
+	Tcl_HashEntry *hPtr;
+	MathFunc *mathFuncPtr;
+	int i;
+
+	iPtr->flags |= EXPR_INITIALIZED;
+	i = 0;
+	for (funcPtr = builtinFuncTable; funcPtr->name != NULL; funcPtr++) {
+	    Tcl_CreateMathFunc(interp, funcPtr->name,
+		    funcPtr->numArgs, funcPtr->argTypes,
+		    (Tcl_MathProc *) NULL, (ClientData) 0);
+	    
+	    hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcPtr->name);
+	    if (hPtr == NULL) {
+		panic("TclCompileExpr: Tcl_CreateMathFunc incorrectly registered '%s'", funcPtr->name);
+		return TCL_ERROR;
+	    }
+	    mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
+	    mathFuncPtr->builtinFuncIndex = i;
+	    i++;
+	}
+    }
+
+    info.token = UNKNOWN;
+    info.objIndex = -1;
+    info.funcName = NULL;
+    info.next = string;
+    info.originalExpr = string;
+    info.lastChar = lastChar;
+    info.hasOperators = 0;
+    info.exprIsJustVarRef = 1;	/* will be set 0 if anything else is seen */
+    info.exprIsComparison = 0;	/* set 1 if topmost operator is <,==,etc. */
+
+    /*
+     * Get the first token then compile an expression.
+     */
+
+    result = GetToken(interp, &info, envPtr);
+    if (result != TCL_OK) {
+	goto done;
+    }
+    
+    result = CompileCondExpr(interp, &info, flags, envPtr);
+    if (result != TCL_OK) {
+	goto done;
+    }
+    if (info.token != END) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"syntax error in expression \"", string, "\"", (char *) NULL);
+	result = TCL_ERROR;
+	goto done;
+    }
+    if (!info.hasOperators) {
+	/*
+	 * Attempt to convert the primary's object to an int or double.
+	 * This is done in order to support Tcl's policy of interpreting
+	 * operands if at all possible as first integers, else
+	 * floating-point numbers.
+	 */
+	
+	TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
+    }
+    maxDepth = envPtr->maxStackDepth;
+
+    done:
+    envPtr->termOffset = (info.next - string);
+    envPtr->maxStackDepth = maxDepth;
+    envPtr->exprIsJustVarRef = info.exprIsJustVarRef;
+    envPtr->exprIsComparison = info.exprIsComparison;
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileCondExpr --
+ *
+ *	This procedure compiles a Tcl conditional expression:
+ *	condExpr ::= lorExpr ['?' condExpr ':' condExpr]
+ *
+ *	Note that this is the topmost recursive-descent parsing routine used
+ *	by TclCompileExpr to compile expressions. It does not call an
+ *	separate, higher-level "CompileExpr" procedure. This avoids an extra
+ *	procedure call since such a procedure would only return the result
+ *	of calling CompileCondExpr. Other recursive-descent procedures that
+ *	need to parse expressions also call CompileCondExpr.
+ *
+ * Results:
+ *	The return value is TCL_OK on a successful compilation and TCL_ERROR
+ *	on failure. If TCL_ERROR is returned, then the interpreter's result
+ *	contains an error message.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the expression.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the expression at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileCondExpr(interp, infoPtr, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    ExprInfo *infoPtr;		/* Describes the compilation state for the
+				 * expression being compiled. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute the expression. */
+    JumpFixup jumpAroundThenFixup, jumpAroundElseFixup;
+				/* Used to update or replace one-byte jumps
+				 * around the then and else expressions when
+				 * their target PCs are determined. */
+    int elseCodeOffset, currCodeOffset, jumpDist, result;
+    
+    HERE("condExpr", 1);
+    result = CompileLorExpr(interp, infoPtr, flags, envPtr);
+    if (result != TCL_OK) {
+	goto done;
+    }
+    maxDepth = envPtr->maxStackDepth;
+    
+    if (infoPtr->token == QUESTY) {
+	result = GetToken(interp, infoPtr, envPtr); /* skip over the '?' */
+	if (result != TCL_OK) {
+	    goto done;
+	}
+
+	/*
+	 * Emit the jump around the "then" clause to the "else" condExpr if
+	 * the test was false. We emit a one byte (relative) jump here, and
+	 * replace it later with a four byte jump if the jump target is more
+	 * than 127 bytes away.
+	 */
+
+	TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpAroundThenFixup);
+
+	/*
+	 * Compile the "then" expression. Note that if a subexpression
+	 * is only a primary, we need to try to convert it to numeric.
+	 * This is done in order to support Tcl's policy of interpreting
+	 * operands if at all possible as first integers, else
+	 * floating-point numbers.
+	 */
+
+	infoPtr->hasOperators = 0;
+	infoPtr->exprIsJustVarRef = 0;
+	infoPtr->exprIsComparison = 0;
+	result = CompileCondExpr(interp, infoPtr, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+	if (infoPtr->token != COLON) {
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		    "syntax error in expression \"", infoPtr->originalExpr,
+		    "\"", (char *) NULL);
+	    result = TCL_ERROR;
+	    goto done;
+	}
+	if (!infoPtr->hasOperators) {
+	    TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
+	}
+	result = GetToken(interp, infoPtr, envPtr); /* skip over the ':' */
+	if (result != TCL_OK) {
+	    goto done;
+	}
+
+	/*
+	 * Emit an unconditional jump around the "else" condExpr.
+	 */
+
+	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
+	        &jumpAroundElseFixup);
+
+	/*
+	 * Compile the "else" expression.
+	 */
+
+	infoPtr->hasOperators = 0;
+	elseCodeOffset = TclCurrCodeOffset();
+	result = CompileCondExpr(interp, infoPtr, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+	if (!infoPtr->hasOperators) {
+	    TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
+	}
+
+	/*
+	 * Fix up the second jump: the unconditional jump around the "else"
+	 * expression. If the distance is too great (> 127 bytes), replace
+	 * it with a four byte instruction and move the instructions after
+	 * the jump down.
+	 */
+
+	currCodeOffset = TclCurrCodeOffset();
+	jumpDist = (currCodeOffset - jumpAroundElseFixup.codeOffset);
+	if (TclFixupForwardJump(envPtr, &jumpAroundElseFixup, jumpDist, 127)) {
+	    /*
+	     * Update the else expression's starting code offset since it
+	     * moved down 3 bytes too.
+	     */
+	    
+	    elseCodeOffset += 3;
+	}
+	
+	/*
+	 * Now fix up the first branch: the jumpFalse after the test. If the
+	 * distance is too great, replace it with a four byte instruction
+	 * and update the code offsets for the commands in both the "then"
+	 * and "else" expressions.
+	 */
+
+	jumpDist = (elseCodeOffset - jumpAroundThenFixup.codeOffset);
+	TclFixupForwardJump(envPtr, &jumpAroundThenFixup, jumpDist, 127);
+
+	infoPtr->hasOperators = 1;
+
+	/*
+	 * A comparison is not the top-level operator in this expression.
+	 */
+
+	infoPtr->exprIsComparison = 0;
+    }
+
+    done:
+    envPtr->maxStackDepth = maxDepth;
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileLorExpr --
+ *
+ *	This procedure compiles a Tcl logical or expression:
+ *	lorExpr ::= landExpr {'||' landExpr}
+ *
+ * Results:
+ *	The return value is TCL_OK on a successful compilation and TCL_ERROR
+ *	on failure. If TCL_ERROR is returned, then the interpreter's result
+ *	contains an error message.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the expression.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the expression at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileLorExpr(interp, infoPtr, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    ExprInfo *infoPtr;		/* Describes the compilation state for the
+				 * expression being compiled. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    int maxDepth;		/* Maximum number of stack elements needed
+				 * to execute the expression. */
+    JumpFixupArray jumpFixupArray;
+				/* Used to fix up the forward "short
+				 * circuit" jump after each or-ed
+				 * subexpression to just after the last
+				 * subexpression. */
+    JumpFixup jumpTrueFixup, jumpFixup;
+    				/* Used to emit the jumps in the code to
+				 * convert the first operand to a 0 or 1. */
+    int fixupIndex, jumpDist, currCodeOffset, objIndex, j, result;
+    Tcl_Obj *objPtr;
+    
+    HERE("lorExpr", 2);
+    result = CompileLandExpr(interp, infoPtr, flags, envPtr);
+    if ((result != TCL_OK) || (infoPtr->token != OR)) {
+	return result;		/* envPtr->maxStackDepth is already set */
+    }
+
+    infoPtr->hasOperators = 1;
+    infoPtr->exprIsJustVarRef = 0;
+    maxDepth = envPtr->maxStackDepth;
+    TclInitJumpFixupArray(&jumpFixupArray);
+    while (infoPtr->token == OR) {
+	result = GetToken(interp, infoPtr, envPtr); /* skip over the '||' */
+	if (result != TCL_OK) {
+	    goto done;
+	}
+
+	if (jumpFixupArray.next == 0) {
+	    /*
+	     * Just the first "lor" operand is on the stack. The following
+	     * is slightly ugly: we need to convert that first "lor" operand
+	     * to a "0" or "1" to get the correct result if it is nonzero.
+	     * Eventually we'll use a new instruction for this.
+	     */
+
+	    TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &jumpTrueFixup);
+	    
+	    objIndex = TclObjIndexForString("0", 1, /*allocStrRep*/ 0,
+					    /*inHeap*/ 0, envPtr);
+	    objPtr = envPtr->objArrayPtr[objIndex];
+
+	    Tcl_InvalidateStringRep(objPtr);
+	    objPtr->internalRep.longValue = 0;
+	    objPtr->typePtr = &tclIntType;
+	    
+	    TclEmitPush(objIndex, envPtr);
+	    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
+
+	    jumpDist = (TclCurrCodeOffset() - jumpTrueFixup.codeOffset);
+	    if (TclFixupForwardJump(envPtr, &jumpTrueFixup, jumpDist, 127)) {
+		panic("CompileLorExpr: bad jump distance %d\n", jumpDist);
+	    }
+	    objIndex = TclObjIndexForString("1", 1, /*allocStrRep*/ 0,
+				            /*inHeap*/ 0, envPtr);
+	    objPtr = envPtr->objArrayPtr[objIndex];
+
+	    Tcl_InvalidateStringRep(objPtr);
+	    objPtr->internalRep.longValue = 1;
+	    objPtr->typePtr = &tclIntType;
+	    
+	    TclEmitPush(objIndex, envPtr);
+
+	    jumpDist = (TclCurrCodeOffset() - jumpFixup.codeOffset);
+	    if (TclFixupForwardJump(envPtr, &jumpFixup, jumpDist, 127)) {
+		panic("CompileLorExpr: bad jump distance %d\n", jumpDist);
+	    }
+	}
+
+	/*
+	 * Duplicate the value on top of the stack to prevent the jump from
+	 * consuming it.
+	 */
+
+	TclEmitOpcode(INST_DUP, envPtr);
+
+	/*
+	 * Emit the "short circuit" jump around the rest of the lorExp if
+	 * the previous expression was true. We emit a one byte (relative)
+	 * jump here, and replace it later with a four byte jump if the jump
+	 * target is more than 127 bytes away.
+	 */
+
+	if (jumpFixupArray.next == jumpFixupArray.end) {
+	    TclExpandJumpFixupArray(&jumpFixupArray);
+	}
+	fixupIndex = jumpFixupArray.next;
+	jumpFixupArray.next++;
+	TclEmitForwardJump(envPtr, TCL_TRUE_JUMP,
+	        &(jumpFixupArray.fixup[fixupIndex]));
+	
+	/*
+	 * Compile the subexpression.
+	 */
+
+	result = CompileLandExpr(interp, infoPtr, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
+
+	/*
+	 * Emit a "logical or" instruction. This does not try to "short-
+	 * circuit" the evaluation of both operands of a Tcl "||" operator,
+	 * but instead ensures that we either have a "1" or a "0" result.
+	 */
+
+	TclEmitOpcode(INST_LOR, envPtr);
+    }
+
+    /*
+     * Now that we know the target of the forward jumps, update the jumps
+     * with the correct distance. Also, if the distance is too great (> 127
+     * bytes), replace the jump with a four byte instruction and move the
+     * instructions after the jump down.
+     */
+    
+    for (j = jumpFixupArray.next;  j > 0;  j--) {
+	fixupIndex = (j - 1);	/* process closest jump first */
+	currCodeOffset = TclCurrCodeOffset();
+	jumpDist = (currCodeOffset - jumpFixupArray.fixup[fixupIndex].codeOffset);
+	TclFixupForwardJump(envPtr, &(jumpFixupArray.fixup[fixupIndex]), jumpDist, 127);
+    }
+
+    /*
+     * We get here only if one or more ||'s appear as top-level operators.
+     */
+
+    done:
+    infoPtr->exprIsComparison = 0;
+    TclFreeJumpFixupArray(&jumpFixupArray);
+    envPtr->maxStackDepth = maxDepth;
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileLandExpr --
+ *
+ *	This procedure compiles a Tcl logical and expression:
+ *	landExpr ::= bitOrExpr {'&&' bitOrExpr}
+ *
+ * Results:
+ *	The return value is TCL_OK on a successful compilation and TCL_ERROR
+ *	on failure. If TCL_ERROR is returned, then the interpreter's result
+ *	contains an error message.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the expression.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the expression at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileLandExpr(interp, infoPtr, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    ExprInfo *infoPtr;		/* Describes the compilation state for the
+				 * expression being compiled. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    int maxDepth;		/* Maximum number of stack elements needed
+				 * to execute the expression. */
+    JumpFixupArray jumpFixupArray;
+				/* Used to fix up the forward "short
+				 * circuit" jump after each and-ed
+				 * subexpression to just after the last
+				 * subexpression. */
+    JumpFixup jumpTrueFixup, jumpFixup;
+    				/* Used to emit the jumps in the code to
+				 * convert the first operand to a 0 or 1. */
+    int fixupIndex, jumpDist, currCodeOffset, objIndex, j, result;
+    Tcl_Obj *objPtr;
+
+    HERE("landExpr", 3);
+    result = CompileBitOrExpr(interp, infoPtr, flags, envPtr);
+    if ((result != TCL_OK) || (infoPtr->token != AND)) {
+	return result;		/* envPtr->maxStackDepth is already set */
+    }
+
+    infoPtr->hasOperators = 1;
+    infoPtr->exprIsJustVarRef = 0;
+    maxDepth = envPtr->maxStackDepth;
+    TclInitJumpFixupArray(&jumpFixupArray);
+    while (infoPtr->token == AND) {
+	result = GetToken(interp, infoPtr, envPtr); /* skip over the '&&' */
+	if (result != TCL_OK) {
+	    goto done;
+	}
+
+	if (jumpFixupArray.next == 0) {
+	    /*
+	     * Just the first "land" operand is on the stack. The following
+	     * is slightly ugly: we need to convert the first "land" operand
+	     * to a "0" or "1" to get the correct result if it is
+	     * nonzero. Eventually we'll use a new instruction.
+	     */
+
+	    TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &jumpTrueFixup);
+	     
+	    objIndex = TclObjIndexForString("0", 1, /*allocStrRep*/ 0,
+				            /*inHeap*/ 0, envPtr);
+	    objPtr = envPtr->objArrayPtr[objIndex];
+
+	    Tcl_InvalidateStringRep(objPtr);
+	    objPtr->internalRep.longValue = 0;
+	    objPtr->typePtr = &tclIntType;
+	    
+	    TclEmitPush(objIndex, envPtr);
+	    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
+
+	    jumpDist = (TclCurrCodeOffset() - jumpTrueFixup.codeOffset);
+	    if (TclFixupForwardJump(envPtr, &jumpTrueFixup, jumpDist, 127)) {
+		panic("CompileLandExpr: bad jump distance %d\n", jumpDist);
+	    }
+	    objIndex = TclObjIndexForString("1", 1, /*allocStrRep*/ 0,
+				            /*inHeap*/ 0, envPtr);
+	    objPtr = envPtr->objArrayPtr[objIndex];
+
+	    Tcl_InvalidateStringRep(objPtr);
+	    objPtr->internalRep.longValue = 1;
+	    objPtr->typePtr = &tclIntType;
+	    
+	    TclEmitPush(objIndex, envPtr);
+
+	    jumpDist = (TclCurrCodeOffset() - jumpFixup.codeOffset);
+	    if (TclFixupForwardJump(envPtr, &jumpFixup, jumpDist, 127)) {
+		panic("CompileLandExpr: bad jump distance %d\n", jumpDist);
+	    }
+	}
+
+	/*
+	 * Duplicate the value on top of the stack to prevent the jump from
+	 * consuming it.
+	 */
+
+	TclEmitOpcode(INST_DUP, envPtr);
+
+	/*
+	 * Emit the "short circuit" jump around the rest of the landExp if
+	 * the previous expression was false. We emit a one byte (relative)
+	 * jump here, and replace it later with a four byte jump if the jump
+	 * target is more than 127 bytes away.
+	 */
+
+	if (jumpFixupArray.next == jumpFixupArray.end) {
+	    TclExpandJumpFixupArray(&jumpFixupArray);
+	}
+	fixupIndex = jumpFixupArray.next;
+	jumpFixupArray.next++;
+	TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
+		&(jumpFixupArray.fixup[fixupIndex]));
+	
+	/*
+	 * Compile the subexpression.
+	 */
+
+	result = CompileBitOrExpr(interp, infoPtr, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
+
+	/*
+	 * Emit a "logical and" instruction. This does not try to "short-
+	 * circuit" the evaluation of both operands of a Tcl "&&" operator,
+	 * but instead ensures that we either have a "1" or a "0" result.
+	 */
+
+	TclEmitOpcode(INST_LAND, envPtr);
+    }
+
+    /*
+     * Now that we know the target of the forward jumps, update the jumps
+     * with the correct distance. Also, if the distance is too great (> 127
+     * bytes), replace the jump with a four byte instruction and move the
+     * instructions after the jump down.
+     */
+    
+    for (j = jumpFixupArray.next;  j > 0;  j--) {
+	fixupIndex = (j - 1);	/* process closest jump first */
+	currCodeOffset = TclCurrCodeOffset();
+	jumpDist = (currCodeOffset - jumpFixupArray.fixup[fixupIndex].codeOffset);
+	TclFixupForwardJump(envPtr, &(jumpFixupArray.fixup[fixupIndex]),
+	        jumpDist, 127);
+    }
+
+    /*
+     * We get here only if one or more &&'s appear as top-level operators.
+     */
+
+    done:
+    infoPtr->exprIsComparison = 0;
+    TclFreeJumpFixupArray(&jumpFixupArray);
+    envPtr->maxStackDepth = maxDepth;
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileBitOrExpr --
+ *
+ *	This procedure compiles a Tcl bitwise or expression:
+ *	bitOrExpr ::= bitXorExpr {'|' bitXorExpr}
+ *
+ * Results:
+ *	The return value is TCL_OK on a successful compilation and TCL_ERROR
+ *	on failure. If TCL_ERROR is returned, then the interpreter's result
+ *	contains an error message.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the expression.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the expression at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileBitOrExpr(interp, infoPtr, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    ExprInfo *infoPtr;		/* Describes the compilation state for the
+				 * expression being compiled. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute the expression. */
+    int result;
+
+    HERE("bitOrExpr", 4);
+    result = CompileBitXorExpr(interp, infoPtr, flags, envPtr);
+    if (result != TCL_OK) {
+	goto done;
+    }
+    maxDepth = envPtr->maxStackDepth;
+    
+    while (infoPtr->token == BIT_OR) {
+	infoPtr->hasOperators = 1;
+	infoPtr->exprIsJustVarRef = 0;
+	result = GetToken(interp, infoPtr, envPtr); /* skip over the '|' */
+	if (result != TCL_OK) {
+	    goto done;
+	}
+
+	result = CompileBitXorExpr(interp, infoPtr, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
+	
+	TclEmitOpcode(INST_BITOR, envPtr);
+
+	/*
+	 * A comparison is not the top-level operator in this expression.
+	 */
+
+	infoPtr->exprIsComparison = 0;
+    }
+
+    done:
+    envPtr->maxStackDepth = maxDepth;
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileBitXorExpr --
+ *
+ *	This procedure compiles a Tcl bitwise exclusive or expression:
+ *	bitXorExpr ::= bitAndExpr {'^' bitAndExpr}
+ *
+ * Results:
+ *	The return value is TCL_OK on a successful compilation and TCL_ERROR
+ *	on failure. If TCL_ERROR is returned, then the interpreter's result
+ *	contains an error message.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the expression.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the expression at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileBitXorExpr(interp, infoPtr, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    ExprInfo *infoPtr;		/* Describes the compilation state for the
+				 * expression being compiled. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute the expression. */
+    int result;
+
+    HERE("bitXorExpr", 5);
+    result = CompileBitAndExpr(interp, infoPtr, flags, envPtr);
+    if (result != TCL_OK) {
+	goto done;
+    }
+    maxDepth = envPtr->maxStackDepth;
+    
+    while (infoPtr->token == BIT_XOR) {
+	infoPtr->hasOperators = 1;
+	infoPtr->exprIsJustVarRef = 0;
+	result = GetToken(interp, infoPtr, envPtr); /* skip over the '^' */
+	if (result != TCL_OK) {
+	    goto done;
+	}
+
+	result = CompileBitAndExpr(interp, infoPtr, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
+	
+	TclEmitOpcode(INST_BITXOR, envPtr);
+
+	/*
+	 * A comparison is not the top-level operator in this expression.
+	 */
+
+	infoPtr->exprIsComparison = 0;
+    }
+
+    done:
+    envPtr->maxStackDepth = maxDepth;
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileBitAndExpr --
+ *
+ *	This procedure compiles a Tcl bitwise and expression:
+ *	bitAndExpr ::= equalityExpr {'&' equalityExpr}
+ *
+ * Results:
+ *	The return value is TCL_OK on a successful compilation and TCL_ERROR
+ *	on failure. If TCL_ERROR is returned, then the interpreter's result
+ *	contains an error message.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the expression.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the expression at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileBitAndExpr(interp, infoPtr, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    ExprInfo *infoPtr;		/* Describes the compilation state for the
+				 * expression being compiled. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute the expression. */
+    int result;
+
+    HERE("bitAndExpr", 6);
+    result = CompileEqualityExpr(interp, infoPtr, flags, envPtr);
+    if (result != TCL_OK) {
+	goto done;
+    }
+    maxDepth = envPtr->maxStackDepth;
+    
+    while (infoPtr->token == BIT_AND) {
+	infoPtr->hasOperators = 1;
+	infoPtr->exprIsJustVarRef = 0;
+	result = GetToken(interp, infoPtr, envPtr); /* skip over the '&' */
+	if (result != TCL_OK) {
+	    goto done;
+	}
+
+	result = CompileEqualityExpr(interp, infoPtr, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
+	
+	TclEmitOpcode(INST_BITAND, envPtr);
+
+	/*
+	 * A comparison is not the top-level operator in this expression.
+	 */
+
+	infoPtr->exprIsComparison = 0;
+    }
+
+    done:
+    envPtr->maxStackDepth = maxDepth;
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileEqualityExpr --
+ *
+ *	This procedure compiles a Tcl equality (inequality) expression:
+ *	equalityExpr ::= relationalExpr {('==' | '!=') relationalExpr}
+ *
+ * Results:
+ *	The return value is TCL_OK on a successful compilation and TCL_ERROR
+ *	on failure. If TCL_ERROR is returned, then the interpreter's result
+ *	contains an error message.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the expression.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the expression at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileEqualityExpr(interp, infoPtr, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    ExprInfo *infoPtr;		/* Describes the compilation state for the
+				 * expression being compiled. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute the expression. */
+    int op, result;
+
+    HERE("equalityExpr", 7);
+    result = CompileRelationalExpr(interp, infoPtr, flags, envPtr);
+    if (result != TCL_OK) {
+	goto done;
+    }
+    maxDepth = envPtr->maxStackDepth;
+
+    op = infoPtr->token;
+    while ((op == EQUAL) || (op == NEQ)) {
+	infoPtr->hasOperators = 1;
+	infoPtr->exprIsJustVarRef = 0;
+	result = GetToken(interp, infoPtr, envPtr); /* skip over == or != */
+	if (result != TCL_OK) {
+	    goto done;
+	}
+
+	result = CompileRelationalExpr(interp, infoPtr, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
+
+	if (op == EQUAL) {
+	    TclEmitOpcode(INST_EQ, envPtr);
+	} else {
+	    TclEmitOpcode(INST_NEQ, envPtr);
+	}
+	
+	op = infoPtr->token;
+
+	/*
+	 * A comparison _is_ the top-level operator in this expression.
+	 */
+	
+	infoPtr->exprIsComparison = 1;
+    }
+
+    done:
+    envPtr->maxStackDepth = maxDepth;
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileRelationalExpr --
+ *
+ *	This procedure compiles a Tcl relational expression:
+ *	relationalExpr ::= shiftExpr {('<' | '>' | '<=' | '>=') shiftExpr}
+ *
+ * Results:
+ *	The return value is TCL_OK on a successful compilation and TCL_ERROR
+ *	on failure. If TCL_ERROR is returned, then the interpreter's result
+ *	contains an error message.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the expression.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the expression at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileRelationalExpr(interp, infoPtr, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    ExprInfo *infoPtr;		/* Describes the compilation state for the
+				 * expression being compiled. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute the expression. */
+    int op, result;
+
+    HERE("relationalExpr", 8);
+    result = CompileShiftExpr(interp, infoPtr, flags, envPtr);
+    if (result != TCL_OK) {
+	goto done;
+    }
+    maxDepth = envPtr->maxStackDepth;
+
+    op = infoPtr->token;
+    while ((op == LESS) || (op == GREATER) || (op == LEQ) || (op == GEQ)) {
+	infoPtr->hasOperators = 1;
+	infoPtr->exprIsJustVarRef = 0;
+	result = GetToken(interp, infoPtr, envPtr); /* skip over the op */
+	if (result != TCL_OK) {
+	    goto done;
+	}
+
+	result = CompileShiftExpr(interp, infoPtr, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
+
+	switch (op) {
+	case LESS:
+	    TclEmitOpcode(INST_LT, envPtr);
+	    break;
+	case GREATER:
+	    TclEmitOpcode(INST_GT, envPtr);
+	    break;
+	case LEQ:
+	    TclEmitOpcode(INST_LE, envPtr);
+	    break;
+	case GEQ:
+	    TclEmitOpcode(INST_GE, envPtr);
+	    break;
+	}
+
+	op = infoPtr->token;
+
+	/*
+	 * A comparison _is_ the top-level operator in this expression.
+	 */
+	
+	infoPtr->exprIsComparison = 1;
+    }
+
+    done:
+    envPtr->maxStackDepth = maxDepth;
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileShiftExpr --
+ *
+ *	This procedure compiles a Tcl shift expression:
+ *	shiftExpr ::= addExpr {('<<' | '>>') addExpr}
+ *
+ * Results:
+ *	The return value is TCL_OK on a successful compilation and TCL_ERROR
+ *	on failure. If TCL_ERROR is returned, then the interpreter's result
+ *	contains an error message.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the expression.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the expression at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileShiftExpr(interp, infoPtr, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    ExprInfo *infoPtr;		/* Describes the compilation state for the
+				 * expression being compiled. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute the expression. */
+    int op, result;
+
+    HERE("shiftExpr", 9);
+    result = CompileAddExpr(interp, infoPtr, flags, envPtr);
+    if (result != TCL_OK) {
+	goto done;
+    }
+    maxDepth = envPtr->maxStackDepth;
+
+    op = infoPtr->token;
+    while ((op == LEFT_SHIFT) || (op == RIGHT_SHIFT)) {
+	infoPtr->hasOperators = 1;
+	infoPtr->exprIsJustVarRef = 0;
+	result = GetToken(interp, infoPtr, envPtr); /* skip over << or >> */
+	if (result != TCL_OK) {
+	    goto done;
+	}
+
+	result = CompileAddExpr(interp, infoPtr, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
+
+	if (op == LEFT_SHIFT) {
+	    TclEmitOpcode(INST_LSHIFT, envPtr);
+	} else {
+	    TclEmitOpcode(INST_RSHIFT, envPtr);
+	}
+
+	op = infoPtr->token;
+
+	/*
+	 * A comparison is not the top-level operator in this expression.
+	 */
+
+	infoPtr->exprIsComparison = 0;
+    }
+
+    done:
+    envPtr->maxStackDepth = maxDepth;
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileAddExpr --
+ *
+ *	This procedure compiles a Tcl addition expression:
+ *	addExpr ::= multiplyExpr {('+' | '-') multiplyExpr}
+ *
+ * Results:
+ *	The return value is TCL_OK on a successful compilation and TCL_ERROR
+ *	on failure. If TCL_ERROR is returned, then the interpreter's result
+ *	contains an error message.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the expression.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the expression at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileAddExpr(interp, infoPtr, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    ExprInfo *infoPtr;		/* Describes the compilation state for the
+				 * expression being compiled. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute the expression. */
+    int op, result;
+
+    HERE("addExpr", 10);
+    result = CompileMultiplyExpr(interp, infoPtr, flags, envPtr);
+    if (result != TCL_OK) {
+	goto done;
+    }
+    maxDepth = envPtr->maxStackDepth;
+
+    op = infoPtr->token;
+    while ((op == PLUS) || (op == MINUS)) {
+	infoPtr->hasOperators = 1;
+	infoPtr->exprIsJustVarRef = 0;
+	result = GetToken(interp, infoPtr, envPtr); /* skip over + or - */
+	if (result != TCL_OK) {
+	    goto done;
+	}
+
+	result = CompileMultiplyExpr(interp, infoPtr, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
+
+	if (op == PLUS) {
+	    TclEmitOpcode(INST_ADD, envPtr);
+	} else {
+	    TclEmitOpcode(INST_SUB, envPtr);
+	}
+
+	op = infoPtr->token;
+
+	/*
+	 * A comparison is not the top-level operator in this expression.
+	 */
+
+	infoPtr->exprIsComparison = 0;
+    }
+
+    done:
+    envPtr->maxStackDepth = maxDepth;
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileMultiplyExpr --
+ *
+ *	This procedure compiles a Tcl multiply expression:
+ *	multiplyExpr ::= unaryExpr {('*' | '/' | '%') unaryExpr}
+ *
+ * Results:
+ *	The return value is TCL_OK on a successful compilation and TCL_ERROR
+ *	on failure. If TCL_ERROR is returned, then the interpreter's result
+ *	contains an error message.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the expression.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the expression at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileMultiplyExpr(interp, infoPtr, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    ExprInfo *infoPtr;		/* Describes the compilation state for the
+				 * expression being compiled. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute the expression. */
+    int op, result;
+
+    HERE("multiplyExpr", 11);
+    result = CompileUnaryExpr(interp, infoPtr, flags, envPtr);
+    if (result != TCL_OK) {
+	goto done;
+    }
+    maxDepth = envPtr->maxStackDepth;
+
+    op = infoPtr->token;
+    while ((op == MULT) || (op == DIVIDE) || (op == MOD)) {
+	infoPtr->hasOperators = 1;
+	infoPtr->exprIsJustVarRef = 0;
+	result = GetToken(interp, infoPtr, envPtr); /* skip over * or / */
+	if (result != TCL_OK) {
+	    goto done;
+	}
+
+	result = CompileUnaryExpr(interp, infoPtr, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
+
+	if (op == MULT) {
+	    TclEmitOpcode(INST_MULT, envPtr);
+	} else if (op == DIVIDE) {
+	    TclEmitOpcode(INST_DIV, envPtr);
+	} else {
+	    TclEmitOpcode(INST_MOD, envPtr);
+	}
+
+	op = infoPtr->token;
+
+	/*
+	 * A comparison is not the top-level operator in this expression.
+	 */
+
+	infoPtr->exprIsComparison = 0;
+    }
+
+    done:
+    envPtr->maxStackDepth = maxDepth;
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileUnaryExpr --
+ *
+ *	This procedure compiles a Tcl unary expression:
+ *	unaryExpr ::= ('+' | '-' | '~' | '!') unaryExpr | primaryExpr
+ *
+ * Results:
+ *	The return value is TCL_OK on a successful compilation and TCL_ERROR
+ *	on failure. If TCL_ERROR is returned, then the interpreter's result
+ *	contains an error message.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the expression.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the expression at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileUnaryExpr(interp, infoPtr, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    ExprInfo *infoPtr;		/* Describes the compilation state for the
+				 * expression being compiled. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute the expression. */
+    int op, result;
+
+    HERE("unaryExpr", 12);
+    op = infoPtr->token;
+    if ((op == PLUS) || (op == MINUS) || (op == BIT_NOT) || (op == NOT)) {
+	infoPtr->hasOperators = 1;
+	infoPtr->exprIsJustVarRef = 0;
+	result = GetToken(interp, infoPtr, envPtr); /* skip over the op */
+	if (result != TCL_OK) {
+	    goto done;
+	}
+
+	result = CompileUnaryExpr(interp, infoPtr, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = envPtr->maxStackDepth;
+
+	switch (op) {
+	case PLUS:
+	    TclEmitOpcode(INST_UPLUS, envPtr);
+	    break;
+	case MINUS:
+	    TclEmitOpcode(INST_UMINUS, envPtr);
+	    break;
+	case BIT_NOT:
+	    TclEmitOpcode(INST_BITNOT, envPtr);
+	    break;
+	case NOT:
+	    TclEmitOpcode(INST_LNOT, envPtr);
+	    break;
+	}
+
+	/*
+	 * A comparison is not the top-level operator in this expression.
+	 */
+
+	infoPtr->exprIsComparison = 0;
+    } else {			/* must be a primaryExpr */
+	result = CompilePrimaryExpr(interp, infoPtr, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = envPtr->maxStackDepth;
+    }
+
+    done:
+    envPtr->maxStackDepth = maxDepth;
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompilePrimaryExpr --
+ *
+ *	This procedure compiles a Tcl primary expression:
+ *	primaryExpr ::= literal | varReference | quotedString |
+ *			'[' command ']' | mathFuncCall | '(' condExpr ')'
+ *
+ * Results:
+ *	The return value is TCL_OK on a successful compilation and TCL_ERROR
+ *	on failure. If TCL_ERROR is returned, then the interpreter's result
+ *	contains an error message.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the expression.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the expression at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompilePrimaryExpr(interp, infoPtr, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    ExprInfo *infoPtr;		/* Describes the compilation state for the
+				 * expression being compiled. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute the expression. */
+    int theToken;
+    char *dollarPtr, *quotePtr, *cmdPtr, *termPtr;
+    int result = TCL_OK;
+
+    /*
+     * We emit tryCvtToNumeric instructions after most of these primary
+     * expressions in order to support Tcl's policy of interpreting operands
+     * as first integers if possible, otherwise floating-point numbers if
+     * possible.
+     */
+
+    HERE("primaryExpr", 13);
+    theToken = infoPtr->token;
+
+    if ((theToken != DOLLAR) && (theToken != OPEN_PAREN)) {
+	infoPtr->exprIsJustVarRef = 0;
+    }
+    switch (theToken) {
+    case LITERAL:		/* int, double, or string in braces */
+	TclEmitPush(infoPtr->objIndex, envPtr);
+	maxDepth = 1;
+	break;
+	
+    case DOLLAR:		/* $var variable reference */
+	dollarPtr = (infoPtr->next - 1);
+	envPtr->pushSimpleWords = 1;
+	result = TclCompileDollarVar(interp, dollarPtr,
+		infoPtr->lastChar, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = envPtr->maxStackDepth;
+	infoPtr->next = (dollarPtr + envPtr->termOffset);
+	break;
+	
+    case QUOTE:			/* quotedString */
+	quotePtr = infoPtr->next;
+	envPtr->pushSimpleWords = 1;
+	result = TclCompileQuotes(interp, quotePtr,
+		infoPtr->lastChar, '"', flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = envPtr->maxStackDepth;
+	infoPtr->next = (quotePtr + envPtr->termOffset);
+	break;
+	
+    case OPEN_BRACKET:		/* '[' command ']' */
+	cmdPtr = infoPtr->next;
+	envPtr->pushSimpleWords = 1;
+	result = TclCompileString(interp, cmdPtr,
+		infoPtr->lastChar, (flags | TCL_BRACKET_TERM), envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	termPtr = (cmdPtr + envPtr->termOffset);
+	if (*termPtr == ']') {
+	    infoPtr->next = (termPtr + 1); /* advance over the ']'. */
+	} else if (termPtr == infoPtr->lastChar) {
+	    /*
+	     * Missing ] at end of nested command.
+	     */
+	    
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	            "missing close-bracket", -1);
+	    result = TCL_ERROR;
+	    goto done;
+	} else {
+	    panic("CompilePrimaryExpr: unexpected termination char '%c' for nested command\n", *termPtr);
+	}
+	maxDepth = envPtr->maxStackDepth;
+	break;
+	
+    case FUNC_NAME:
+	result = CompileMathFuncCall(interp, infoPtr, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = envPtr->maxStackDepth;
+	break;
+	
+    case OPEN_PAREN:
+	result = GetToken(interp, infoPtr, envPtr); /* skip over the '(' */
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	infoPtr->exprIsComparison = 0;
+	result = CompileCondExpr(interp, infoPtr, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = envPtr->maxStackDepth;
+	if (infoPtr->token != CLOSE_PAREN) {
+	    goto syntaxError;
+	}
+	break;
+	
+    default:
+	goto syntaxError;
+    }
+
+    if (theToken != FUNC_NAME) {
+	/*
+	 * Advance to the next token before returning.
+	 */
+	
+	result = GetToken(interp, infoPtr, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+    }
+
+    done:
+    envPtr->maxStackDepth = maxDepth;
+    return result;
+
+    syntaxError:
+    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+	    "syntax error in expression \"", infoPtr->originalExpr,
+	    "\"", (char *) NULL);
+    return TCL_ERROR;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileMathFuncCall --
+ *
+ *	This procedure compiles a call on a math function in an expression:
+ *	mathFuncCall ::= funcName '(' [condExpr {',' condExpr}] ')'
+ *
+ * Results:
+ *	The return value is TCL_OK on a successful compilation and TCL_ERROR
+ *	on failure. If TCL_ERROR is returned, then the interpreter's result
+ *	contains an error message.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the function.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the math function at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileMathFuncCall(interp, infoPtr, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    ExprInfo *infoPtr;		/* Describes the compilation state for the
+				 * expression being compiled. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    Interp *iPtr = (Interp *) interp;
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute the expression. */
+    MathFunc *mathFuncPtr;	/* Info about math function. */
+    int objIndex;		/* The object array index for an object
+				 * holding the function name if it is not
+				 * builtin. */
+    Tcl_HashEntry *hPtr;
+    char *p, *funcName;
+    char savedChar;
+    int result, i;
+
+    /*
+     * infoPtr->funcName points to the first character of the math
+     * function's name. Look for the end of its name and look up the
+     * MathFunc record for the function.
+     */
+
+    funcName = p = infoPtr->funcName;
+    while (isalnum(UCHAR(*p)) || (*p == '_')) {
+	p++;
+    }
+    infoPtr->next = p;
+    
+    result = GetToken(interp, infoPtr, envPtr); /* skip over func name */
+    if (result != TCL_OK) {
+	goto done;
+    }
+    if (infoPtr->token != OPEN_PAREN) {
+	goto syntaxError;
+    }
+    result = GetToken(interp, infoPtr, envPtr); /* skip over '(' */
+    if (result != TCL_OK) {
+	goto done;
+    }
+    
+    savedChar = *p;
+    *p = 0;
+    hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcName);
+    if (hPtr == NULL) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"unknown math function \"", funcName, "\"", (char *) NULL);
+	result = TCL_ERROR;
+	*p = savedChar;
+	goto done;
+    }
+    mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
+
+    /*
+     * If not a builtin function, push an object with the function's name.
+     */
+
+    if (mathFuncPtr->builtinFuncIndex < 0) {   /* not builtin */
+	objIndex = TclObjIndexForString(funcName, -1, /*allocStrRep*/ 1,
+				        /*inHeap*/ 0, envPtr);
+	TclEmitPush(objIndex, envPtr);
+	maxDepth = 1;
+    }
+
+    /*
+     * Restore the saved character after the function name.
+     */
+
+    *p = savedChar;
+
+    /*
+     * Compile the arguments for the function, if there are any.
+     */
+
+    if (mathFuncPtr->numArgs > 0) {
+	for (i = 0;  ;  i++) {
+	    infoPtr->exprIsComparison = 0;
+	    result = CompileCondExpr(interp, infoPtr, flags, envPtr);
+	    if (result != TCL_OK) {
+		goto done;
+	    }
+    
+	    /*
+	     * Check for a ',' between arguments or a ')' ending the
+	     * argument list.
+	     */
+    
+	    if (i == (mathFuncPtr->numArgs-1)) {
+		if (infoPtr->token == CLOSE_PAREN) {
+		    break;	/* exit the argument parsing loop */
+		} else if (infoPtr->token == COMMA) {
+		    Tcl_ResetResult(interp);
+		    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		            "too many arguments for math function", -1);
+		    result = TCL_ERROR;
+		    goto done;
+		} else {
+		    goto syntaxError;
+		}
+	    }
+	    if (infoPtr->token != COMMA) {
+		if (infoPtr->token == CLOSE_PAREN) {
+		    Tcl_ResetResult(interp);
+		    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		            "too few arguments for math function", -1);
+		    result = TCL_ERROR;
+		    goto done;
+		} else {
+		    goto syntaxError;
+		}
+	    }
+	    result = GetToken(interp, infoPtr, envPtr); /* skip over , */
+	    if (result != TCL_OK) {
+		goto done;
+	    }
+	    maxDepth++;
+	}
+    }
+
+    if (infoPtr->token != CLOSE_PAREN) {
+	goto syntaxError;
+    }
+    result = GetToken(interp, infoPtr, envPtr); /* skip over ')' */
+    if (result != TCL_OK) {
+	goto done;
+    }
+    
+    /*
+     * Compile the call on the math function. Note that the "objc" argument
+     * count for non-builtin functions is incremented by 1 to include the
+     * the function name itself.
+     */
+
+    if (mathFuncPtr->builtinFuncIndex >= 0) { /* a builtin function */
+	TclEmitInstUInt1(INST_CALL_BUILTIN_FUNC1,
+			mathFuncPtr->builtinFuncIndex, envPtr);
+    } else {
+	TclEmitInstUInt1(INST_CALL_FUNC1, (mathFuncPtr->numArgs+1), envPtr);
+    }
+
+    /*
+     * A comparison is not the top-level operator in this expression.
+     */
+
+    done:
+    infoPtr->exprIsComparison = 0;
+    envPtr->maxStackDepth = maxDepth;
+    return result;
+
+    syntaxError:
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"syntax error in expression \"", infoPtr->originalExpr,
+		"\"", (char *) NULL);
+    return TCL_ERROR;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetToken --
+ *
+ *	Lexical scanner used to compile expressions: parses a single 
+ *	operator or other syntactic element from an expression string.
+ *
+ * Results:
+ *	TCL_OK is returned unless an error occurred. In that case a standard
+ *	Tcl error is returned, using the interpreter's result to hold an
+ *	error message. TCL_ERROR is returned if an integer overflow, or a
+ *	floating-point overflow or underflow occurred while reading in a
+ *	number. If the lexical analysis is successful, infoPtr->token refers
+ *	to the next symbol in the expression string, and infoPtr->next is
+ *	advanced past the token. Also, if the token is a integer, double, or
+ *	string literal, then infoPtr->objIndex the index of an object
+ *	holding the value in the code's object table; otherwise is NULL.
+ *
+ * Side effects:
+ *	Object are added to envPtr to hold the values of scanned literal
+ *	integers, doubles, or strings.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetToken(interp, infoPtr, envPtr)
+    Tcl_Interp *interp;			/* Interpreter to use for error
+					 * reporting. */
+    register ExprInfo *infoPtr;         /* Describes the state of the
+					 * compiling the expression,
+					 * including the resulting token. */
+    CompileEnv *envPtr;			/* Holds objects that store literal
+					 * values that are scanned. */
+{
+    register char *src;		/* Points to current source char. */
+    register char c;		/* The current char. */
+    register int type;		/* Current char's CHAR_TYPE type. */
+    char *termPtr;		/* Points to char terminating a literal. */
+    char savedChar;		/* Holds the character termporarily replaced
+				 * by a null character during processing of
+				 * literal tokens. */
+    int objIndex;		/* The object array index for an object
+				 * holding a scanned literal. */
+    long longValue;		/* Value of a scanned integer literal. */
+    double doubleValue;		/* Value of a scanned double literal. */
+    Tcl_Obj *objPtr;
+
+    /*
+     * First initialize the scanner's "result" fields to default values.
+     */
+    
+    infoPtr->token = UNKNOWN;
+    infoPtr->objIndex = -1;
+    infoPtr->funcName = NULL;
+
+    /*
+     * Scan over leading white space at the start of a token. Note that a
+     * backslash-newline is treated as a space.
+     */
+
+    src = infoPtr->next;
+    c = *src;
+    type = CHAR_TYPE(src, infoPtr->lastChar);
+    while ((type & (TCL_SPACE | TCL_BACKSLASH)) || (c == '\n')) {
+	if (type == TCL_BACKSLASH) {
+	    if (src[1] == '\n') {
+		src += 2;
+	    } else {
+		break;	/* no longer white space */
+	    }
+	} else {
+	    src++;
+	}
+	c = *src;
+	type = CHAR_TYPE(src, infoPtr->lastChar);
+    }
+    if (src == infoPtr->lastChar) {
+	infoPtr->token = END;
+	infoPtr->next = src;
+	return TCL_OK;
+    }
+
+    /*
+     * Try to parse the token first as an integer or floating-point
+     * number. Don't check for a number if the first character is "+" or
+     * "-". If we did, we might treat a binary operator as unary by mistake,
+     * which would eventually cause a syntax error.
+     */
+
+    if ((*src != '+') && (*src != '-')) {
+	int startsWithDigit = isdigit(UCHAR(*src));
+	
+	if (startsWithDigit && TclLooksLikeInt(src)) {
+	    errno = 0;
+	    longValue = strtoul(src, &termPtr, 0);
+	    if (errno == ERANGE) {
+		char *s = "integer value too large to represent";
+		
+		Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
+		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s,
+			(char *) NULL);
+		return TCL_ERROR;
+	    }
+	    if (termPtr != src) {
+		/*
+		 * src was the start of a valid integer. Find/create an
+		 * object in envPtr's object array to contain the integer.
+		 */
+	    
+		savedChar = *termPtr;
+		*termPtr = '\0';
+		objIndex = TclObjIndexForString(src, termPtr - src,
+		        /*allocStrRep*/ 0, /*inHeap*/ 0, envPtr);
+		*termPtr = savedChar;  /* restore the saved char */
+		
+		objPtr = envPtr->objArrayPtr[objIndex];
+		Tcl_InvalidateStringRep(objPtr);
+		objPtr->internalRep.longValue = longValue;
+		objPtr->typePtr = &tclIntType;
+		
+		infoPtr->token = LITERAL;
+		infoPtr->objIndex = objIndex;
+		infoPtr->next = termPtr;
+		return TCL_OK;
+	    }
+	} else if (startsWithDigit || (*src == '.')
+	        || (*src == 'n') || (*src == 'N')) {
+	    errno = 0;
+	    doubleValue = strtod(src, &termPtr);
+	    if (termPtr != src) {
+		if (errno != 0) {
+		    TclExprFloatError(interp, doubleValue);
+		    return TCL_ERROR;
+		}
+
+		/*
+		 * Find/create an object in the object array containing the
+		 * double.
+		 */
+		
+		savedChar = *termPtr;
+		*termPtr = '\0';
+		objIndex = TclObjIndexForString(src, termPtr - src,
+			/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+		*termPtr = savedChar;  /* restore the saved char */
+		
+		objPtr = envPtr->objArrayPtr[objIndex];
+		objPtr->internalRep.doubleValue = doubleValue;
+		objPtr->typePtr = &tclDoubleType;
+		
+		infoPtr->token = LITERAL;
+		infoPtr->objIndex = objIndex;
+		infoPtr->next = termPtr;
+		return TCL_OK;
+	    }
+	}
+    }
+
+    /*
+     * Not an integer or double literal. Check next for a string literal
+     * in braces.
+     */
+
+    if (*src == '{') {
+	int level = 0;		 /* The {} nesting level. */
+	int hasBackslashNL = 0;  /* Nonzero if '\newline' was found. */
+	char *string = src;	 /* Set below to point just after the
+				  * starting '{'. */
+	char *last;		 /* Points just before terminating '}'. */
+	int numChars;		 /* Number of chars in braced string. */
+	char savedChar;		 /* Holds the character from string
+				  * termporarily replaced by a null char
+				  * during braced string processing. */
+	int numRead;
+
+	/*
+	 * Check first for any backslash-newlines, since we must treat
+	 * backslash-newlines specially (they must be replaced by spaces).
+	 */
+
+	while (1) {
+	    if (src == infoPtr->lastChar) {
+		Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		        "missing close-brace", -1);
+		return TCL_ERROR;
+	    } else if (CHAR_TYPE(src, infoPtr->lastChar) == TCL_NORMAL) {
+		src++;
+		continue;
+	    }
+	    c = *src++;
+	    if (c == '{') {
+		level++;
+	    } else if (c == '}') {
+		--level;
+		if (level == 0) {
+		    last = (src - 2); /* i.e. just before terminating } */
+		    break;
+		}
+	    } else if (c == '\\') {
+		if (*src == '\n') {
+		    hasBackslashNL = 1;
+		}
+		(void) Tcl_Backslash(src-1, &numRead);
+		src += numRead - 1;
+	    }
+	}
+
+	/*
+	 * Create a string object for the braced string. This will start at
+	 * "string" and ends just after "last" (which points to the final
+	 * character before the terminating '}'). If backslash-newlines were
+	 * found, we copy characters one at a time into a heap-allocated
+	 * buffer and do backslash-newline substitutions.
+	 */
+
+	string++;
+	numChars = (last - string + 1);
+	savedChar = string[numChars];
+	string[numChars] = '\0';
+	if (hasBackslashNL && (numChars > 0)) {
+	    char *buffer = ckalloc((unsigned) numChars + 1);
+	    register char *dst = buffer;
+	    register char *p = string;
+	    while (p <= last) {
+		c = *dst++ = *p++;
+		if (c == '\\') {
+		    if (*p == '\n') {
+			dst[-1] = Tcl_Backslash(p-1, &numRead);
+			p += numRead - 1;
+		    } else {
+			(void) Tcl_Backslash(p-1, &numRead);
+			while (numRead > 1) {
+			    *dst++ = *p++;
+			    numRead--;
+			}
+		    }
+		}
+	    }
+	    *dst = '\0';
+	    objIndex = TclObjIndexForString(buffer, dst - buffer,
+		    /*allocStrRep*/ 1, /*inHeap*/ 1, envPtr);
+	} else {
+	    objIndex = TclObjIndexForString(string, numChars,
+		    /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+	}
+	string[numChars] = savedChar;   /* restore the saved char */
+
+	infoPtr->token = LITERAL;
+	infoPtr->objIndex = objIndex;
+	infoPtr->next = src;
+	return TCL_OK;
+    }
+
+    /*
+     * Not an literal value.
+     */
+
+    infoPtr->next = src+1;   /* assume a 1 char token and advance over it */
+    switch (*src) {
+	case '[':
+	    infoPtr->token = OPEN_BRACKET;
+	    return TCL_OK;
+
+	case ']':
+	    infoPtr->token = CLOSE_BRACKET;
+	    return TCL_OK;
+
+	case '(':
+	    infoPtr->token = OPEN_PAREN;
+	    return TCL_OK;
+
+	case ')':
+	    infoPtr->token = CLOSE_PAREN;
+	    return TCL_OK;
+
+	case '$':
+	    infoPtr->token = DOLLAR;
+	    return TCL_OK;
+
+	case '"':
+	    infoPtr->token = QUOTE;
+	    return TCL_OK;
+
+	case ',':
+	    infoPtr->token = COMMA;
+	    return TCL_OK;
+
+	case '*':
+	    infoPtr->token = MULT;
+	    return TCL_OK;
+
+	case '/':
+	    infoPtr->token = DIVIDE;
+	    return TCL_OK;
+
+	case '%':
+	    infoPtr->token = MOD;
+	    return TCL_OK;
+
+	case '+':
+	    infoPtr->token = PLUS;
+	    return TCL_OK;
+
+	case '-':
+	    infoPtr->token = MINUS;
+	    return TCL_OK;
+
+	case '?':
+	    infoPtr->token = QUESTY;
+	    return TCL_OK;
+
+	case ':':
+	    infoPtr->token = COLON;
+	    return TCL_OK;
+
+	case '<':
+	    switch (src[1]) {
+		case '<':
+		    infoPtr->next = src+2;
+		    infoPtr->token = LEFT_SHIFT;
+		    break;
+		case '=':
+		    infoPtr->next = src+2;
+		    infoPtr->token = LEQ;
+		    break;
+		default:
+		    infoPtr->token = LESS;
+		    break;
+	    }
+	    return TCL_OK;
+
+	case '>':
+	    switch (src[1]) {
+		case '>':
+		    infoPtr->next = src+2;
+		    infoPtr->token = RIGHT_SHIFT;
+		    break;
+		case '=':
+		    infoPtr->next = src+2;
+		    infoPtr->token = GEQ;
+		    break;
+		default:
+		    infoPtr->token = GREATER;
+		    break;
+	    }
+	    return TCL_OK;
+
+	case '=':
+	    if (src[1] == '=') {
+		infoPtr->next = src+2;
+		infoPtr->token = EQUAL;
+	    } else {
+		infoPtr->token = UNKNOWN;
+	    }
+	    return TCL_OK;
+
+	case '!':
+	    if (src[1] == '=') {
+		infoPtr->next = src+2;
+		infoPtr->token = NEQ;
+	    } else {
+		infoPtr->token = NOT;
+	    }
+	    return TCL_OK;
+
+	case '&':
+	    if (src[1] == '&') {
+		infoPtr->next = src+2;
+		infoPtr->token = AND;
+	    } else {
+		infoPtr->token = BIT_AND;
+	    }
+	    return TCL_OK;
+
+	case '^':
+	    infoPtr->token = BIT_XOR;
+	    return TCL_OK;
+
+	case '|':
+	    if (src[1] == '|') {
+		infoPtr->next = src+2;
+		infoPtr->token = OR;
+	    } else {
+		infoPtr->token = BIT_OR;
+	    }
+	    return TCL_OK;
+
+	case '~':
+	    infoPtr->token = BIT_NOT;
+	    return TCL_OK;
+
+	default:
+	    if (isalpha(UCHAR(*src))) {
+		infoPtr->token = FUNC_NAME;
+		infoPtr->funcName = src;
+		while (isalnum(UCHAR(*src)) || (*src == '_')) {
+		    src++;
+		}
+		infoPtr->next = src;
+		return TCL_OK;
+	    }
+	    infoPtr->next = src+1;
+	    infoPtr->token = UNKNOWN;
+	    return TCL_OK;
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateMathFunc --
+ *
+ *	Creates a new math function for expressions in a given
+ *	interpreter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The function defined by "name" is created or redefined. If the
+ *	function already exists then its definition is replaced; this
+ *	includes the builtin functions. Redefining a builtin function forces
+ *	all existing code to be invalidated since that code may be compiled
+ *	using an instruction specific to the replaced function. In addition,
+ *	redefioning a non-builtin function will force existing code to be
+ *	invalidated if the number of arguments has changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_CreateMathFunc(interp, name, numArgs, argTypes, proc, clientData)
+    Tcl_Interp *interp;			/* Interpreter in which function is
+					 * to be available. */
+    char *name;				/* Name of function (e.g. "sin"). */
+    int numArgs;			/* Nnumber of arguments required by
+					 * function. */
+    Tcl_ValueType *argTypes;		/* Array of types acceptable for
+					 * each argument. */
+    Tcl_MathProc *proc;			/* Procedure that implements the
+					 * math function. */
+    ClientData clientData;		/* Additional value to pass to the
+					 * function. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_HashEntry *hPtr;
+    MathFunc *mathFuncPtr;
+    int new, i;
+
+    hPtr = Tcl_CreateHashEntry(&iPtr->mathFuncTable, name, &new);
+    if (new) {
+	Tcl_SetHashValue(hPtr, ckalloc(sizeof(MathFunc)));
+    }
+    mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
+
+    if (!new) {	
+	if (mathFuncPtr->builtinFuncIndex >= 0) {
+	    /*
+	     * We are redefining a builtin math function. Invalidate the
+             * interpreter's existing code by incrementing its
+             * compileEpoch member. This field is checked in Tcl_EvalObj
+             * and ObjInterpProc, and code whose compilation epoch doesn't
+             * match is recompiled. Newly compiled code will no longer
+             * treat the function as builtin.
+	     */
+
+	    iPtr->compileEpoch++;
+	} else {
+	    /*
+	     * A non-builtin function is being redefined. We must invalidate
+             * existing code if the number of arguments has changed. This
+	     * is because existing code was compiled assuming that number.
+	     */
+
+	    if (numArgs != mathFuncPtr->numArgs) {
+		iPtr->compileEpoch++;
+	    }
+	}
+    }
+    
+    mathFuncPtr->builtinFuncIndex = -1;	/* can't be a builtin function */
+    if (numArgs > MAX_MATH_ARGS) {
+	numArgs = MAX_MATH_ARGS;
+    }
+    mathFuncPtr->numArgs = numArgs;
+    for (i = 0;  i < numArgs;  i++) {
+	mathFuncPtr->argTypes[i] = argTypes[i];
+    }
+    mathFuncPtr->proc = proc;
+    mathFuncPtr->clientData = clientData;
+}
Index: /trunk/tcl/tclCompile.c
===================================================================
--- /trunk/tcl/tclCompile.c	(revision 2)
+++ /trunk/tcl/tclCompile.c	(revision 2)
@@ -0,0 +1,8149 @@
+/* 
+ * tclCompile.c --
+ *
+ *	This file contains procedures that compile Tcl commands or parts
+ *	of commands (like quoted strings or nested sub-commands) into a
+ *	sequence of instructions ("bytecodes"). 
+ *
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclCompile.c,v 1.1 2008-06-04 13:58:05 demin Exp $
+ */
+
+#include "tclInt.h"
+#include "tclCompile.h"
+
+/*
+ * Variable that controls whether compilation tracing is enabled and, if so,
+ * what level of tracing is desired:
+ *    0: no compilation tracing
+ *    1: summarize compilation of top level cmds and proc bodies
+ *    2: display all instructions of each ByteCode compiled
+ * This variable is linked to the Tcl variable "tcl_traceCompile".
+ */
+
+int tclTraceCompile = 0;
+static int traceInitialized = 0;
+
+/*
+ * Count of the number of compilations and various other compilation-
+ * related statistics.
+ */
+
+#ifdef TCL_COMPILE_STATS
+long tclNumCompilations = 0;
+double tclTotalSourceBytes = 0.0;
+double tclTotalCodeBytes = 0.0;
+
+double tclTotalInstBytes = 0.0;
+double tclTotalObjBytes = 0.0;
+double tclTotalExceptBytes = 0.0;
+double tclTotalAuxBytes = 0.0;
+double tclTotalCmdMapBytes = 0.0;
+
+double tclCurrentSourceBytes = 0.0;
+double tclCurrentCodeBytes = 0.0;
+
+int tclSourceCount[32];
+int tclByteCodeCount[32];
+#endif /* TCL_COMPILE_STATS */
+
+/*
+ * A table describing the Tcl bytecode instructions. The entries in this
+ * table must correspond to the list of instructions in tclInt.h. The names
+ * "op1" and "op4" refer to an instruction's one or four byte first operand.
+ * Similarly, "stktop" and "stknext" refer to the topmost and next to
+ * topmost stack elements.
+ *
+ * Note that the load, store, and incr instructions do not distinguish local
+ * from global variables; the bytecode interpreter at runtime uses the
+ * existence of a procedure call frame to distinguish these.
+ */
+
+InstructionDesc instructionTable[] = {
+   /* Name	      Bytes #Opnds Operand types        Stack top, next   */
+    {"done",	          1,   0,   {OPERAND_NONE}},
+        /* Finish ByteCode execution and return stktop (top stack item) */
+    {"push1",	          2,   1,   {OPERAND_UINT1}},
+        /* Push object at ByteCode objArray[op1] */
+    {"push4",	          5,   1,   {OPERAND_UINT4}},
+        /* Push object at ByteCode objArray[op4] */
+    {"pop",	          1,   0,   {OPERAND_NONE}},
+        /* Pop the topmost stack object */
+    {"dup",	          1,   0,   {OPERAND_NONE}},
+        /* Duplicate the topmost stack object and push the result */
+    {"concat1",	          2,   1,   {OPERAND_UINT1}},
+        /* Concatenate the top op1 items and push result */
+    {"invokeStk1",        2,   1,   {OPERAND_UINT1}},
+        /* Invoke command named objv[0]; <objc,objv> = <op1,top op1> */
+    {"invokeStk4",        5,   1,   {OPERAND_UINT4}},
+        /* Invoke command named objv[0]; <objc,objv> = <op4,top op4> */
+    {"evalStk",           1,   0,   {OPERAND_NONE}},
+        /* Evaluate command in stktop using Tcl_EvalObj. */
+    {"exprStk",           1,   0,   {OPERAND_NONE}},
+        /* Execute expression in stktop using Tcl_ExprStringObj. */
+    
+    {"loadScalar1",       2,   1,   {OPERAND_UINT1}},
+        /* Load scalar variable at index op1 <= 255 in call frame */
+    {"loadScalar4",       5,   1,   {OPERAND_UINT4}},
+        /* Load scalar variable at index op1 >= 256 in call frame */
+    {"loadScalarStk",     1,   0,   {OPERAND_NONE}},
+        /* Load scalar variable; scalar's name is stktop */
+    {"loadArray1",        2,   1,   {OPERAND_UINT1}},
+        /* Load array element; array at slot op1<=255, element is stktop */
+    {"loadArray4",        5,   1,   {OPERAND_UINT4}},
+        /* Load array element; array at slot op1 > 255, element is stktop */
+    {"loadArrayStk",      1,   0,   {OPERAND_NONE}},
+        /* Load array element; element is stktop, array name is stknext */
+    {"loadStk",           1,   0,   {OPERAND_NONE}},
+        /* Load general variable; unparsed variable name is stktop */
+    {"storeScalar1",      2,   1,   {OPERAND_UINT1}},
+        /* Store scalar variable at op1<=255 in frame; value is stktop */
+    {"storeScalar4",      5,   1,   {OPERAND_UINT4}},
+        /* Store scalar variable at op1 > 255 in frame; value is stktop */
+    {"storeScalarStk",    1,   0,   {OPERAND_NONE}},
+        /* Store scalar; value is stktop, scalar name is stknext */
+    {"storeArray1",       2,   1,   {OPERAND_UINT1}},
+        /* Store array element; array at op1<=255, value is top then elem */
+    {"storeArray4",       5,   1,   {OPERAND_UINT4}},
+        /* Store array element; array at op1>=256, value is top then elem */
+    {"storeArrayStk",     1,   0,   {OPERAND_NONE}},
+        /* Store array element; value is stktop, then elem, array names */
+    {"storeStk",          1,   0,   {OPERAND_NONE}},
+        /* Store general variable; value is stktop, then unparsed name */
+    
+    {"incrScalar1",       2,   1,   {OPERAND_UINT1}},
+        /* Incr scalar at index op1<=255 in frame; incr amount is stktop */
+    {"incrScalarStk",     1,   0,   {OPERAND_NONE}},
+        /* Incr scalar; incr amount is stktop, scalar's name is stknext */
+    {"incrArray1",        2,   1,   {OPERAND_UINT1}},
+        /* Incr array elem; arr at slot op1<=255, amount is top then elem */
+    {"incrArrayStk",      1,   0,   {OPERAND_NONE}},
+        /* Incr array element; amount is top then elem then array names */
+    {"incrStk",           1,   0,   {OPERAND_NONE}},
+        /* Incr general variable; amount is stktop then unparsed var name */
+    {"incrScalar1Imm",    3,   2,   {OPERAND_UINT1, OPERAND_INT1}},
+        /* Incr scalar at slot op1 <= 255; amount is 2nd operand byte */
+    {"incrScalarStkImm",  2,   1,   {OPERAND_INT1}},
+        /* Incr scalar; scalar name is stktop; incr amount is op1 */
+    {"incrArray1Imm",     3,   2,   {OPERAND_UINT1, OPERAND_INT1}},
+        /* Incr array elem; array at slot op1 <= 255, elem is stktop,
+	 * amount is 2nd operand byte */
+    {"incrArrayStkImm",   2,   1,   {OPERAND_INT1}},
+        /* Incr array element; elem is top then array name, amount is op1 */
+    {"incrStkImm",        2,   1,   {OPERAND_INT1}},
+        /* Incr general variable; unparsed name is top, amount is op1 */
+    
+    {"jump1",             2,   1,   {OPERAND_INT1}},
+        /* Jump relative to (pc + op1) */
+    {"jump4",             5,   1,   {OPERAND_INT4}},
+        /* Jump relative to (pc + op4) */
+    {"jumpTrue1",         2,   1,   {OPERAND_INT1}},
+        /* Jump relative to (pc + op1) if stktop expr object is true */
+    {"jumpTrue4",         5,   1,   {OPERAND_INT4}},
+        /* Jump relative to (pc + op4) if stktop expr object is true */
+    {"jumpFalse1",        2,   1,   {OPERAND_INT1}},
+        /* Jump relative to (pc + op1) if stktop expr object is false */
+    {"jumpFalse4",        5,   1,   {OPERAND_INT4}},
+        /* Jump relative to (pc + op4) if stktop expr object is false */
+
+    {"lor",               1,   0,   {OPERAND_NONE}},
+        /* Logical or:	push (stknext || stktop) */
+    {"land",              1,   0,   {OPERAND_NONE}},
+        /* Logical and:	push (stknext && stktop) */
+    {"bitor",             1,   0,   {OPERAND_NONE}},
+        /* Bitwise or:	push (stknext | stktop) */
+    {"bitxor",            1,   0,   {OPERAND_NONE}},
+        /* Bitwise xor	push (stknext ^ stktop) */
+    {"bitand",            1,   0,   {OPERAND_NONE}},
+        /* Bitwise and:	push (stknext & stktop) */
+    {"eq",                1,   0,   {OPERAND_NONE}},
+        /* Equal:	push (stknext == stktop) */
+    {"neq",               1,   0,   {OPERAND_NONE}},
+        /* Not equal:	push (stknext != stktop) */
+    {"lt",                1,   0,   {OPERAND_NONE}},
+        /* Less:	push (stknext < stktop) */
+    {"gt",                1,   0,   {OPERAND_NONE}},
+        /* Greater:	push (stknext || stktop) */
+    {"le",                1,   0,   {OPERAND_NONE}},
+        /* Logical or:	push (stknext || stktop) */
+    {"ge",                1,   0,   {OPERAND_NONE}},
+        /* Logical or:	push (stknext || stktop) */
+    {"lshift",            1,   0,   {OPERAND_NONE}},
+        /* Left shift:	push (stknext << stktop) */
+    {"rshift",            1,   0,   {OPERAND_NONE}},
+        /* Right shift:	push (stknext >> stktop) */
+    {"add",               1,   0,   {OPERAND_NONE}},
+        /* Add:		push (stknext + stktop) */
+    {"sub",               1,   0,   {OPERAND_NONE}},
+        /* Sub:		push (stkext - stktop) */
+    {"mult",              1,   0,   {OPERAND_NONE}},
+        /* Multiply:	push (stknext * stktop) */
+    {"div",               1,   0,   {OPERAND_NONE}},
+        /* Divide:	push (stknext / stktop) */
+    {"mod",               1,   0,   {OPERAND_NONE}},
+        /* Mod:		push (stknext % stktop) */
+    {"uplus",             1,   0,   {OPERAND_NONE}},
+        /* Unary plus:	push +stktop */
+    {"uminus",            1,   0,   {OPERAND_NONE}},
+        /* Unary minus:	push -stktop */
+    {"bitnot",            1,   0,   {OPERAND_NONE}},
+        /* Bitwise not:	push ~stktop */
+    {"not",               1,   0,   {OPERAND_NONE}},
+        /* Logical not:	push !stktop */
+    {"callBuiltinFunc1",  2,   1,   {OPERAND_UINT1}},
+        /* Call builtin math function with index op1; any args are on stk */
+    {"callFunc1",         2,   1,   {OPERAND_UINT1}},
+        /* Call non-builtin func objv[0]; <objc,objv>=<op1,top op1>  */
+    {"tryCvtToNumeric",   1,   0,   {OPERAND_NONE}},
+        /* Try converting stktop to first int then double if possible. */
+
+    {"break",             1,   0,   {OPERAND_NONE}},
+        /* Abort closest enclosing loop; if none, return TCL_BREAK code. */
+    {"continue",          1,   0,   {OPERAND_NONE}},
+        /* Skip to next iteration of closest enclosing loop; if none,
+	 * return TCL_CONTINUE code. */
+
+    {"foreach_start4",    5,   1,   {OPERAND_UINT4}},
+        /* Initialize execution of a foreach loop. Operand is aux data index
+	 * of the ForeachInfo structure for the foreach command. */
+    {"foreach_step4",     5,   1,   {OPERAND_UINT4}},
+        /* "Step" or begin next iteration of foreach loop. Push 0 if to
+	 *  terminate loop, else push 1. */
+
+    {"beginCatch4",	  5,   1,   {OPERAND_UINT4}},
+        /* Record start of catch with the operand's exception range index.
+	 * Push the current stack depth onto a special catch stack. */
+    {"endCatch",	  1,   0,   {OPERAND_NONE}},
+        /* End of last catch. Pop the bytecode interpreter's catch stack. */
+    {"pushResult",	  1,   0,   {OPERAND_NONE}},
+        /* Push the interpreter's object result onto the stack. */
+    {"pushReturnCode",	  1,   0,   {OPERAND_NONE}},
+        /* Push interpreter's return code (e.g. TCL_OK or TCL_ERROR) as
+	 * a new object onto the stack. */
+    {0}
+};
+
+/*
+ * The following table assigns a type to each character. Only types
+ * meaningful to Tcl parsing are represented here. The table is
+ * designed to be referenced with either signed or unsigned characters,
+ * so it has 384 entries. The first 128 entries correspond to negative
+ * character values, the next 256 correspond to positive character
+ * values. The last 128 entries are identical to the first 128. The
+ * table is always indexed with a 128-byte offset (the 128th entry
+ * corresponds to a 0 character value).
+ */
+
+unsigned char tclTypeTable[] = {
+    /*
+     * Negative character values, from -128 to -1:
+     */
+
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+
+    /*
+     * Positive character values, from 0-127:
+     */
+
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_SPACE,         TCL_COMMAND_END,   TCL_SPACE,
+    TCL_SPACE,         TCL_SPACE,         TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_SPACE,         TCL_NORMAL,        TCL_QUOTE,         TCL_NORMAL,
+    TCL_DOLLAR,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_COMMAND_END,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_OPEN_BRACKET,
+    TCL_BACKSLASH,     TCL_COMMAND_END,   TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_OPEN_BRACE,
+    TCL_NORMAL,        TCL_CLOSE_BRACE,   TCL_NORMAL,        TCL_NORMAL,
+
+    /*
+     * Large unsigned character values, from 128-255:
+     */
+
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+};
+
+/*
+ * Table of all AuxData types.
+ */
+
+static Tcl_HashTable auxDataTypeTable;
+static int auxDataTypeTableInitialized = 0;    /* 0 means not yet
+                                                * initialized. */
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static void		AdvanceToNextWord _ANSI_ARGS_((char *string,
+			    CompileEnv *envPtr));
+static int		CollectArgInfo _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, char *lastChar, int flags,
+			    ArgInfo *argInfoPtr));
+static int		CompileBraces _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, char *lastChar, int flags,
+			    CompileEnv *envPtr));
+static int		CompileCmdWordInline _ANSI_ARGS_((
+    			    Tcl_Interp *interp, char *string,
+			    char *lastChar, int flags, CompileEnv *envPtr));
+static int		CompileExprWord _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, char *lastChar, int flags, 
+			    CompileEnv *envPtr));
+static int		CompileMultipartWord _ANSI_ARGS_((
+    			    Tcl_Interp *interp, char *string,
+			    char *lastChar, int flags, CompileEnv *envPtr));
+static int		CompileWord _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, char *lastChar, int flags, 
+			    CompileEnv *envPtr));
+static int		CreateExceptionRange _ANSI_ARGS_((
+			    ExceptionRangeType type, CompileEnv *envPtr));
+static void		DupByteCodeInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
+			    Tcl_Obj *copyPtr));
+static ClientData	DupForeachInfo _ANSI_ARGS_((ClientData clientData));
+static unsigned char *	EncodeCmdLocMap _ANSI_ARGS_((
+			    CompileEnv *envPtr, ByteCode *codePtr,
+			    unsigned char *startPtr));
+static void		EnterCmdExtentData _ANSI_ARGS_((
+    			    CompileEnv *envPtr, int cmdNumber,
+			    int numSrcChars, int numCodeBytes));
+static void		EnterCmdStartData _ANSI_ARGS_((
+    			    CompileEnv *envPtr, int cmdNumber,
+			    int srcOffset, int codeOffset));
+static void		ExpandObjectArray _ANSI_ARGS_((CompileEnv *envPtr));
+static void		FreeForeachInfo _ANSI_ARGS_((
+			    ClientData clientData));
+static void		FreeByteCodeInternalRep _ANSI_ARGS_((
+    			    Tcl_Obj *objPtr));
+static void		FreeArgInfo _ANSI_ARGS_((ArgInfo *argInfoPtr));
+static int		GetCmdLocEncodingSize _ANSI_ARGS_((
+			    CompileEnv *envPtr));
+static void		InitArgInfo _ANSI_ARGS_((ArgInfo *argInfoPtr));
+static int		IsLocalScalar  _ANSI_ARGS_((char *name, int len));
+static int		LookupCompiledLocal _ANSI_ARGS_((
+        		    char *name, int nameChars, int createIfNew,
+			    int flagsIfCreated, Proc *procPtr));
+static int		SetByteCodeFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr));
+static void		UpdateStringOfByteCode _ANSI_ARGS_((Tcl_Obj *objPtr));
+
+/*
+ * The structure below defines the bytecode Tcl object type by
+ * means of procedures that can be invoked by generic object code.
+ */
+
+Tcl_ObjType tclByteCodeType = {
+    "bytecode",			/* name */
+    FreeByteCodeInternalRep,	/* freeIntRepProc */
+    DupByteCodeInternalRep,	/* dupIntRepProc */
+    UpdateStringOfByteCode,	/* updateStringProc */
+    SetByteCodeFromAny		/* setFromAnyProc */
+};
+
+/*
+ * The structures below define the AuxData types defined in this file.
+ */
+
+AuxDataType tclForeachInfoType = {
+    "ForeachInfo",				/* name */
+    DupForeachInfo,				/* dupProc */
+    FreeForeachInfo				/* freeProc */
+};
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPrintByteCodeObj --
+ *
+ *	This procedure prints ("disassembles") the instructions of a
+ *	bytecode object to stdout.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclPrintByteCodeObj(interp, objPtr)
+    Tcl_Interp *interp;		/* Used only for Tcl_GetStringFromObj. */
+    Tcl_Obj *objPtr;		/* The bytecode object to disassemble. */
+{
+    ByteCode* codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+    unsigned char *codeStart, *codeLimit, *pc;
+    unsigned char *codeDeltaNext, *codeLengthNext;
+    unsigned char *srcDeltaNext, *srcLengthNext;
+    int codeOffset, codeLen, srcOffset, srcLen;
+    int numCmds, numObjs, delta, objBytes, i;
+
+    if (codePtr->refCount <= 0) {
+	return;			/* already freed */
+    }
+
+    codeStart = codePtr->codeStart;
+    codeLimit = (codeStart + codePtr->numCodeBytes);
+    numCmds = codePtr->numCommands;
+    numObjs = codePtr->numObjects;
+
+    objBytes = (numObjs * sizeof(Tcl_Obj));
+    for (i = 0;  i < numObjs;  i++) {
+	Tcl_Obj *litObjPtr = codePtr->objArrayPtr[i];
+	if (litObjPtr->bytes != NULL) {
+	    objBytes += litObjPtr->length;
+	}
+    }
+
+    /*
+     * Print header lines describing the ByteCode.
+     */
+
+    fprintf(stdout, "\nByteCode 0x%x, ref ct %u, epoch %u, interp 0x%x(epoch %u)\n",
+	    (unsigned int) codePtr, codePtr->refCount,
+	    codePtr->compileEpoch, (unsigned int) codePtr->iPtr,
+	    codePtr->iPtr->compileEpoch);
+    fprintf(stdout, "  Source ");
+    TclPrintSource(stdout, codePtr->source,
+	    TclMin(codePtr->numSrcChars, 70));
+    fprintf(stdout, "\n  Cmds %d, chars %d, inst %d, objs %u, aux %d, stk depth %u, code/src %.2f\n",
+	    numCmds, codePtr->numSrcChars, codePtr->numCodeBytes, numObjs,
+	    codePtr->numAuxDataItems, codePtr->maxStackDepth,
+	    (codePtr->numSrcChars?
+	            ((float)codePtr->totalSize)/((float)codePtr->numSrcChars) : 0.0));
+    fprintf(stdout, "  Code %zu = %u(header)+%d(inst)+%d(objs)+%u(exc)+%u(aux)+%d(cmd map)\n",
+	    codePtr->totalSize, sizeof(ByteCode), codePtr->numCodeBytes,
+	    objBytes, (codePtr->numExcRanges * sizeof(ExceptionRange)),
+	    (codePtr->numAuxDataItems * sizeof(AuxData)),
+	    codePtr->numCmdLocBytes);
+
+    /*
+     * If the ByteCode is the compiled body of a Tcl procedure, print
+     * information about that procedure. Note that we don't know the
+     * procedure's name since ByteCode's can be shared among procedures.
+     */
+    
+    if (codePtr->procPtr != NULL) {
+	Proc *procPtr = codePtr->procPtr;
+	int numCompiledLocals = procPtr->numCompiledLocals;
+	fprintf(stdout,
+	        "  Proc 0x%x, ref ct %d, args %d, compiled locals %d\n",
+		(unsigned int) procPtr, procPtr->refCount, procPtr->numArgs,
+		numCompiledLocals);
+	if (numCompiledLocals > 0) {
+	    CompiledLocal *localPtr = procPtr->firstLocalPtr;
+	    for (i = 0;  i < numCompiledLocals;  i++) {
+		fprintf(stdout, "      %d: slot %d%s%s%s%s%s%s",
+			i, localPtr->frameIndex,
+			((localPtr->flags & VAR_SCALAR)?  ", scalar"  : ""),
+			((localPtr->flags & VAR_ARRAY)?  ", array"  : ""),
+			((localPtr->flags & VAR_LINK)?  ", link"  : ""),
+			((localPtr->flags & VAR_ARGUMENT)?  ", arg"  : ""),
+			((localPtr->flags & VAR_TEMPORARY)? ", temp" : ""),
+			((localPtr->flags & VAR_RESOLVED)? ", resolved" : ""));
+		if (TclIsVarTemporary(localPtr)) {
+		    fprintf(stdout,	"\n");
+		} else {
+		    fprintf(stdout,	", name=\"%s\"\n", localPtr->name);
+		}
+		localPtr = localPtr->nextPtr;
+	    }
+	}
+    }
+
+    /*
+     * Print the ExceptionRange array.
+     */
+
+    if (codePtr->numExcRanges > 0) {
+	fprintf(stdout, "  Exception ranges %d, depth %d:\n",
+	        codePtr->numExcRanges, codePtr->maxExcRangeDepth);
+	for (i = 0;  i < codePtr->numExcRanges;  i++) {
+	    ExceptionRange *rangePtr = &(codePtr->excRangeArrayPtr[i]);
+	    fprintf(stdout, "      %d: level %d, %s, pc %d-%d, ",
+		    i, rangePtr->nestingLevel,
+		    ((rangePtr->type == LOOP_EXCEPTION_RANGE)? "loop":"catch"),
+		    rangePtr->codeOffset,
+		    (rangePtr->codeOffset + rangePtr->numCodeBytes - 1));
+	    switch (rangePtr->type) {
+	    case LOOP_EXCEPTION_RANGE:
+		fprintf(stdout,	"continue %d, break %d\n",
+		        rangePtr->continueOffset, rangePtr->breakOffset);
+		break;
+	    case CATCH_EXCEPTION_RANGE:
+		fprintf(stdout,	"catch %d\n", rangePtr->catchOffset);
+		break;
+	    default:
+		panic("TclPrintSource: unrecognized ExceptionRange type %d\n",
+		        rangePtr->type);
+	    }
+	}
+    }
+    
+    /*
+     * If there were no commands (e.g., an expression or an empty string
+     * was compiled), just print all instructions and return.
+     */
+
+    if (numCmds == 0) {
+	pc = codeStart;
+	while (pc < codeLimit) {
+	    fprintf(stdout, "    ");
+	    pc += TclPrintInstruction(codePtr, pc);
+	}
+	return;
+    }
+    
+    /*
+     * Print table showing the code offset, source offset, and source
+     * length for each command. These are encoded as a sequence of bytes.
+     */
+
+    fprintf(stdout, "  Commands %d:", numCmds);
+    codeDeltaNext = codePtr->codeDeltaStart;
+    codeLengthNext = codePtr->codeLengthStart;
+    srcDeltaNext  = codePtr->srcDeltaStart;
+    srcLengthNext = codePtr->srcLengthStart;
+    codeOffset = srcOffset = 0;
+    for (i = 0;  i < numCmds;  i++) {
+	if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) {
+	    codeDeltaNext++;
+	    delta = TclGetInt4AtPtr(codeDeltaNext);
+	    codeDeltaNext += 4;
+	} else {
+	    delta = TclGetInt1AtPtr(codeDeltaNext);
+	    codeDeltaNext++;
+	}
+	codeOffset += delta;
+
+	if ((unsigned int) (*codeLengthNext) == (unsigned int) 0xFF) {
+	    codeLengthNext++;
+	    codeLen = TclGetInt4AtPtr(codeLengthNext);
+	    codeLengthNext += 4;
+	} else {
+	    codeLen = TclGetInt1AtPtr(codeLengthNext);
+	    codeLengthNext++;
+	}
+	
+	if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) {
+	    srcDeltaNext++;
+	    delta = TclGetInt4AtPtr(srcDeltaNext);
+	    srcDeltaNext += 4;
+	} else {
+	    delta = TclGetInt1AtPtr(srcDeltaNext);
+	    srcDeltaNext++;
+	}
+	srcOffset += delta;
+
+	if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) {
+	    srcLengthNext++;
+	    srcLen = TclGetInt4AtPtr(srcLengthNext);
+	    srcLengthNext += 4;
+	} else {
+	    srcLen = TclGetInt1AtPtr(srcLengthNext);
+	    srcLengthNext++;
+	}
+	
+	fprintf(stdout,	"%s%4d: pc %d-%d, source %d-%d",
+		((i % 2)? "	" : "\n   "),
+		(i+1), codeOffset, (codeOffset + codeLen - 1),
+		srcOffset, (srcOffset + srcLen - 1));
+    }
+    if ((numCmds > 0) && ((numCmds % 2) != 0)) {
+	fprintf(stdout,	"\n");
+    }
+    
+    /*
+     * Print each instruction. If the instruction corresponds to the start
+     * of a command, print the command's source. Note that we don't need
+     * the code length here.
+     */
+
+    codeDeltaNext = codePtr->codeDeltaStart;
+    srcDeltaNext  = codePtr->srcDeltaStart;
+    srcLengthNext = codePtr->srcLengthStart;
+    codeOffset = srcOffset = 0;
+    pc = codeStart;
+    for (i = 0;  i < numCmds;  i++) {
+	if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) {
+	    codeDeltaNext++;
+	    delta = TclGetInt4AtPtr(codeDeltaNext);
+	    codeDeltaNext += 4;
+	} else {
+	    delta = TclGetInt1AtPtr(codeDeltaNext);
+	    codeDeltaNext++;
+	}
+	codeOffset += delta;
+
+	if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) {
+	    srcDeltaNext++;
+	    delta = TclGetInt4AtPtr(srcDeltaNext);
+	    srcDeltaNext += 4;
+	} else {
+	    delta = TclGetInt1AtPtr(srcDeltaNext);
+	    srcDeltaNext++;
+	}
+	srcOffset += delta;
+
+	if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) {
+	    srcLengthNext++;
+	    srcLen = TclGetInt4AtPtr(srcLengthNext);
+	    srcLengthNext += 4;
+	} else {
+	    srcLen = TclGetInt1AtPtr(srcLengthNext);
+	    srcLengthNext++;
+	}
+
+	/*
+	 * Print instructions before command i.
+	 */
+	
+	while ((pc-codeStart) < codeOffset) {
+	    fprintf(stdout, "    ");
+	    pc += TclPrintInstruction(codePtr, pc);
+	}
+
+	fprintf(stdout, "  Command %d: ", (i+1));
+	TclPrintSource(stdout, (codePtr->source + srcOffset),
+	        TclMin(srcLen, 70));
+	fprintf(stdout, "\n");
+    }
+    if (pc < codeLimit) {
+	/*
+	 * Print instructions after the last command.
+	 */
+
+	while (pc < codeLimit) {
+	    fprintf(stdout, "    ");
+	    pc += TclPrintInstruction(codePtr, pc);
+	}
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPrintInstruction --
+ *
+ *	This procedure prints ("disassembles") one instruction from a
+ *	bytecode object to stdout.
+ *
+ * Results:
+ *	Returns the length in bytes of the current instruiction.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclPrintInstruction(codePtr, pc)
+    ByteCode* codePtr;		/* Bytecode containing the instruction. */
+    unsigned char *pc;		/* Points to first byte of instruction. */
+{
+    Proc *procPtr = codePtr->procPtr;
+    unsigned char opCode = *pc;
+    register InstructionDesc *instDesc = &instructionTable[opCode];
+    unsigned char *codeStart = codePtr->codeStart;
+    unsigned int pcOffset = (pc - codeStart);
+    int opnd, elemLen, i, j;
+    Tcl_Obj *elemPtr;
+    char *string;
+    
+    fprintf(stdout, "(%u) %s ", pcOffset, instDesc->name);
+    for (i = 0;  i < instDesc->numOperands;  i++) {
+	switch (instDesc->opTypes[i]) {
+	case OPERAND_INT1:
+	    opnd = TclGetInt1AtPtr(pc+1+i);
+	    if ((i == 0) && ((opCode == INST_JUMP1)
+			     || (opCode == INST_JUMP_TRUE1)
+		             || (opCode == INST_JUMP_FALSE1))) {
+		fprintf(stdout, "%d  	# pc %u", opnd, (pcOffset + opnd));
+	    } else {
+		fprintf(stdout, "%d", opnd);
+	    }
+	    break;
+	case OPERAND_INT4:
+	    opnd = TclGetInt4AtPtr(pc+1+i);
+	    if ((i == 0) && ((opCode == INST_JUMP4)
+			     || (opCode == INST_JUMP_TRUE4)
+		             || (opCode == INST_JUMP_FALSE4))) {
+		fprintf(stdout, "%d  	# pc %u", opnd, (pcOffset + opnd));
+	    } else {
+		fprintf(stdout, "%d", opnd);
+	    }
+	    break;
+	case OPERAND_UINT1:
+	    opnd = TclGetUInt1AtPtr(pc+1+i);
+	    if ((i == 0) && (opCode == INST_PUSH1)) {
+		elemPtr = codePtr->objArrayPtr[opnd];
+		string = Tcl_GetStringFromObj(elemPtr, &elemLen);
+		fprintf(stdout, "%u  	# ", (unsigned int) opnd);
+		TclPrintSource(stdout, string, TclMin(elemLen, 40));
+	    } else if ((i == 0) && ((opCode == INST_LOAD_SCALAR1)
+				    || (opCode == INST_LOAD_ARRAY1)
+				    || (opCode == INST_STORE_SCALAR1)
+				    || (opCode == INST_STORE_ARRAY1))) {
+		int localCt = procPtr->numCompiledLocals;
+		CompiledLocal *localPtr = procPtr->firstLocalPtr;
+		if (opnd >= localCt) {
+		    panic("TclPrintInstruction: bad local var index %u (%u locals)\n",
+			     (unsigned int) opnd, localCt);
+		    return instDesc->numBytes;
+		}
+		for (j = 0;  j < opnd;  j++) {
+		    localPtr = localPtr->nextPtr;
+		}
+		if (TclIsVarTemporary(localPtr)) {
+		    fprintf(stdout, "%u	# temp var %u",
+			    (unsigned int) opnd, (unsigned int) opnd);
+		} else {
+		    fprintf(stdout, "%u	# var ", (unsigned int) opnd);
+		    TclPrintSource(stdout, localPtr->name, 40);
+		}
+	    } else {
+		fprintf(stdout, "%u ", (unsigned int) opnd);
+	    }
+	    break;
+	case OPERAND_UINT4:
+	    opnd = TclGetUInt4AtPtr(pc+1+i);
+	    if (opCode == INST_PUSH4) {
+		elemPtr = codePtr->objArrayPtr[opnd];
+		string = Tcl_GetStringFromObj(elemPtr, &elemLen);
+		fprintf(stdout, "%u  	# ", opnd);
+		TclPrintSource(stdout, string, TclMin(elemLen, 40));
+	    } else if ((i == 0) && ((opCode == INST_LOAD_SCALAR4)
+				    || (opCode == INST_LOAD_ARRAY4)
+				    || (opCode == INST_STORE_SCALAR4)
+				    || (opCode == INST_STORE_ARRAY4))) {
+		int localCt = procPtr->numCompiledLocals;
+		CompiledLocal *localPtr = procPtr->firstLocalPtr;
+		if (opnd >= localCt) {
+		    panic("TclPrintInstruction: bad local var index %u (%u locals)\n",
+			     (unsigned int) opnd, localCt);
+		    return instDesc->numBytes;
+		}
+		for (j = 0;  j < opnd;  j++) {
+		    localPtr = localPtr->nextPtr;
+		}
+		if (TclIsVarTemporary(localPtr)) {
+		    fprintf(stdout, "%u	# temp var %u",
+			    (unsigned int) opnd, (unsigned int) opnd);
+		} else {
+		    fprintf(stdout, "%u	# var ", (unsigned int) opnd);
+		    TclPrintSource(stdout, localPtr->name, 40);
+		}
+	    } else {
+		fprintf(stdout, "%u ", (unsigned int) opnd);
+	    }
+	    break;
+	case OPERAND_NONE:
+	default:
+	    break;
+	}
+    }
+    fprintf(stdout, "\n");
+    return instDesc->numBytes;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPrintSource --
+ *
+ *	This procedure prints up to a specified number of characters from
+ *	the argument string to a specified file. It tries to produce legible
+ *	output by adding backslashes as necessary.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Outputs characters to the specified file.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclPrintSource(outFile, string, maxChars)
+    FILE *outFile;		/* The file to print the source to. */
+    char *string;		/* The string to print. */
+    int maxChars;		/* Maximum number of chars to print. */
+{
+    register char *p;
+    register int i = 0;
+
+    if (string == NULL) {
+	fprintf(outFile, "\"\"");
+	return;
+    }
+
+    fprintf(outFile, "\"");
+    p = string;
+    for (;  (*p != '\0') && (i < maxChars);  p++, i++) {
+	switch (*p) {
+	    case '"':
+		fprintf(outFile, "\\\"");
+		continue;
+	    case '\f':
+		fprintf(outFile, "\\f");
+		continue;
+	    case '\n':
+		fprintf(outFile, "\\n");
+		continue;
+            case '\r':
+		fprintf(outFile, "\\r");
+		continue;
+	    case '\t':
+		fprintf(outFile, "\\t");
+		continue;
+            case '\v':
+		fprintf(outFile, "\\v");
+		continue;
+	    default:
+		fprintf(outFile, "%c", *p);
+		continue;
+	}
+    }
+    fprintf(outFile, "\"");
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeByteCodeInternalRep --
+ *
+ *	Part of the bytecode Tcl object type implementation. Frees the
+ *	storage associated with a bytecode object's internal representation
+ *	unless its code is actively being executed.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The bytecode object's internal rep is marked invalid and its
+ *	code gets freed unless the code is actively being executed.
+ *	In that case the cleanup is delayed until the last execution
+ *	of the code completes.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeByteCodeInternalRep(objPtr)
+    register Tcl_Obj *objPtr;	/* Object whose internal rep to free. */
+{
+    register ByteCode *codePtr =
+	    (ByteCode *) objPtr->internalRep.otherValuePtr;
+
+    codePtr->refCount--;
+    if (codePtr->refCount <= 0) {
+	TclCleanupByteCode(codePtr);
+    }
+    objPtr->typePtr = NULL;
+    objPtr->internalRep.otherValuePtr = NULL;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCleanupByteCode --
+ *
+ *	This procedure does all the real work of freeing up a bytecode
+ *	object's ByteCode structure. It's called only when the structure's
+ *	reference count becomes zero.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Frees objPtr's bytecode internal representation and sets
+ *	its type and objPtr->internalRep.otherValuePtr NULL. Also
+ *	decrements the ref counts on each object in its object array,
+ *	and frees its auxiliary data items.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclCleanupByteCode(codePtr)
+    ByteCode *codePtr;		/* ByteCode to free. */
+{
+    Tcl_Obj **objArrayPtr = codePtr->objArrayPtr;
+    int numObjects = codePtr->numObjects;
+    int numAuxDataItems = codePtr->numAuxDataItems;
+    register AuxData *auxDataPtr;
+    register Tcl_Obj *elemPtr;
+    register int i;
+
+#ifdef TCL_COMPILE_STATS    
+    tclCurrentSourceBytes -= (double) codePtr->numSrcChars;
+    tclCurrentCodeBytes -= (double) codePtr->totalSize;
+#endif /* TCL_COMPILE_STATS */
+
+    /*
+     * A single heap object holds the ByteCode structure and its code,
+     * object, command location, and auxiliary data arrays. This means we
+     * only need to 1) decrement the ref counts on the objects in its
+     * object array, 2) call the free procs for the auxiliary data items,
+     * and 3) free the ByteCode structure's heap object.
+     */
+
+    for (i = 0;  i < numObjects;  i++) {
+	elemPtr = objArrayPtr[i];
+	TclDecrRefCount(elemPtr);
+    }
+
+    auxDataPtr = codePtr->auxDataArrayPtr;
+    for (i = 0;  i < numAuxDataItems;  i++) {
+	if (auxDataPtr->type->freeProc != NULL) {
+	    auxDataPtr->type->freeProc(auxDataPtr->clientData);
+	}
+	auxDataPtr++;
+    }
+    
+    ckfree((char *) codePtr);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupByteCodeInternalRep --
+ *
+ *	Part of the bytecode Tcl object type implementation. However, it
+ *	does not copy the internal representation of a bytecode Tcl_Obj, but
+ *	instead leaves the new object untyped (with a NULL type pointer).
+ *	Code will be compiled for the new object only if necessary.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupByteCodeInternalRep(srcPtr, copyPtr)
+    Tcl_Obj *srcPtr;		/* Object with internal rep to copy. */
+    Tcl_Obj *copyPtr;		/* Object with internal rep to set. */
+{
+    return;
+}
+
+
+/*
+ *-----------------------------------------------------------------------
+ *
+ * SetByteCodeFromAny --
+ *
+ *	Part of the bytecode Tcl object type implementation. Attempts to
+ *	generate an byte code internal form for the Tcl object "objPtr" by
+ *	compiling its string representation.
+ *
+ * Results:
+ *	The return value is a standard Tcl object result. If an error occurs
+ *	during compilation, an error message is left in the interpreter's
+ *	result unless "interp" is NULL.
+ *
+ * Side effects:
+ *	Frees the old internal representation. If no error occurs, then the
+ *	compiled code is stored as "objPtr"s bytecode representation.
+ *	Also, if debugging, initializes the "tcl_traceCompile" Tcl variable
+ *	used to trace compilations.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetByteCodeFromAny(interp, objPtr)
+    Tcl_Interp *interp;		/* The interpreter for which the code is
+				 * compiled. */
+    Tcl_Obj *objPtr;		/* The object to convert. */
+{
+    Interp *iPtr = (Interp *) interp;
+    char *string;
+    CompileEnv compEnv;		/* Compilation environment structure
+				 * allocated in frame. */
+    AuxData *auxDataPtr;
+    register int i;
+    int length, result;
+
+    if (!traceInitialized) {
+        if (Tcl_LinkVar(interp, "tcl_traceCompile",
+	            (char *) &tclTraceCompile,  TCL_LINK_INT) != TCL_OK) {
+            panic("SetByteCodeFromAny: unable to create link for tcl_traceCompile variable");
+        }
+        traceInitialized = 1;
+    }
+    
+    string = Tcl_GetStringFromObj(objPtr, &length);
+    TclInitCompileEnv(interp, &compEnv, string);
+    result = TclCompileString(interp, string, string+length,
+	    iPtr->evalFlags, &compEnv);
+    if (result == TCL_OK) {
+	/*
+	 * Add a "done" instruction at the end of the instruction sequence.
+	 */
+    
+	TclEmitOpcode(INST_DONE, &compEnv);
+	
+	/*
+	 * Convert the object to a ByteCode object.
+	 */
+
+	TclInitByteCodeObj(objPtr, &compEnv);
+    } else {
+	/*
+	 * Compilation errors. Decrement the ref counts on any objects in
+	 * the object array and free any aux data items prior to freeing
+	 * the compilation environment.
+	 */
+	
+	for (i = 0;  i < compEnv.objArrayNext;  i++) {
+	    Tcl_Obj *elemPtr = compEnv.objArrayPtr[i];
+	    Tcl_DecrRefCount(elemPtr);
+	}
+
+	auxDataPtr = compEnv.auxDataArrayPtr;
+	for (i = 0;  i < compEnv.auxDataArrayNext;  i++) {
+	    if (auxDataPtr->type->freeProc != NULL) {
+            auxDataPtr->type->freeProc(auxDataPtr->clientData);
+	    }
+	    auxDataPtr++;
+	}
+    }
+    TclFreeCompileEnv(&compEnv);
+
+    if (result == TCL_OK) {
+	if (tclTraceCompile == 2) {
+	    TclPrintByteCodeObj(interp, objPtr);
+	}
+    }
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfByteCode --
+ *
+ *	Part of the bytecode Tcl object type implementation. Called to
+ *	update the string representation for a byte code object.
+ *	Note: This procedure does not free an existing old string rep
+ *	so storage will be lost if this has not already been done.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Generates a panic. 
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfByteCode(objPtr)
+    register Tcl_Obj *objPtr;	/* ByteCode object with string rep that 
+				 * needs updating. */
+{
+    /*
+     * This procedure is never invoked since the internal representation of
+     * a bytecode object is never modified.
+     */
+
+    panic("UpdateStringOfByteCode should never be called.");
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInitCompileEnv --
+ *
+ *	Initializes a CompileEnv compilation environment structure for the
+ *	compilation of a string in an interpreter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The CompileEnv structure is initialized.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclInitCompileEnv(interp, envPtr, string)
+    Tcl_Interp *interp;		 /* The interpreter for which a CompileEnv
+				  * structure is initialized. */
+    register CompileEnv *envPtr; /* Points to the CompileEnv structure to
+				  * initialize. */
+    char *string;		 /* The source string to be compiled. */
+{
+    Interp *iPtr = (Interp *) interp;
+    
+    envPtr->iPtr = iPtr;
+    envPtr->source = string;
+    envPtr->procPtr = iPtr->compiledProcPtr;
+    envPtr->numCommands = 0;
+    envPtr->excRangeDepth = 0;
+    envPtr->maxExcRangeDepth = 0;
+    envPtr->maxStackDepth = 0;
+    Tcl_InitHashTable(&(envPtr->objTable), TCL_STRING_KEYS);
+    envPtr->pushSimpleWords = 1;
+    envPtr->wordIsSimple = 0;
+    envPtr->numSimpleWordChars = 0;
+    envPtr->exprIsJustVarRef = 0;
+    envPtr->exprIsComparison = 0;
+    envPtr->termOffset = 0;
+
+    envPtr->codeStart = envPtr->staticCodeSpace;
+    envPtr->codeNext = envPtr->codeStart;
+    envPtr->codeEnd = (envPtr->codeStart + COMPILEENV_INIT_CODE_BYTES);
+    envPtr->mallocedCodeArray = 0;
+
+    envPtr->objArrayPtr = envPtr->staticObjArraySpace;
+    envPtr->objArrayNext = 0;
+    envPtr->objArrayEnd = COMPILEENV_INIT_NUM_OBJECTS;
+    envPtr->mallocedObjArray = 0;
+    
+    envPtr->excRangeArrayPtr = envPtr->staticExcRangeArraySpace;
+    envPtr->excRangeArrayNext = 0;
+    envPtr->excRangeArrayEnd = COMPILEENV_INIT_EXCEPT_RANGES;
+    envPtr->mallocedExcRangeArray = 0;
+    
+    envPtr->cmdMapPtr = envPtr->staticCmdMapSpace;
+    envPtr->cmdMapEnd = COMPILEENV_INIT_CMD_MAP_SIZE;
+    envPtr->mallocedCmdMap = 0;
+    
+    envPtr->auxDataArrayPtr = envPtr->staticAuxDataArraySpace;
+    envPtr->auxDataArrayNext = 0;
+    envPtr->auxDataArrayEnd = COMPILEENV_INIT_AUX_DATA_SIZE;
+    envPtr->mallocedAuxDataArray = 0;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFreeCompileEnv --
+ *
+ *	Free the storage allocated in a CompileEnv compilation environment
+ *	structure.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Allocated storage in the CompileEnv structure is freed. Note that
+ *	ref counts for Tcl objects in its object table are not decremented.
+ *	In addition, any storage referenced by any auxiliary data items
+ *	in the CompileEnv structure are not freed either. The expectation
+ *	is that when compilation is successful, "ownership" (i.e., the
+ *	pointers to) these objects and aux data items will just be handed
+ *	over to the corresponding ByteCode structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFreeCompileEnv(envPtr)
+    register CompileEnv *envPtr; /* Points to the CompileEnv structure. */
+{
+    Tcl_DeleteHashTable(&(envPtr->objTable));
+    if (envPtr->mallocedCodeArray) {
+	ckfree((char *) envPtr->codeStart);
+    }
+    if (envPtr->mallocedObjArray) {
+	ckfree((char *) envPtr->objArrayPtr);
+    }
+    if (envPtr->mallocedExcRangeArray) {
+	ckfree((char *) envPtr->excRangeArrayPtr);
+    }
+    if (envPtr->mallocedCmdMap) {
+	ckfree((char *) envPtr->cmdMapPtr);
+    }
+    if (envPtr->mallocedAuxDataArray) {
+	ckfree((char *) envPtr->auxDataArrayPtr);
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInitByteCodeObj --
+ *
+ *	Create a ByteCode structure and initialize it from a CompileEnv
+ *	compilation environment structure. The ByteCode structure is
+ *	smaller and contains just that information needed to execute
+ *	the bytecode instructions resulting from compiling a Tcl script.
+ *	The resulting structure is placed in the specified object.
+ *
+ * Results:
+ *	A newly constructed ByteCode object is stored in the internal
+ *	representation of the objPtr.
+ *
+ * Side effects:
+ *	A single heap object is allocated to hold the new ByteCode structure
+ *	and its code, object, command location, and aux data arrays. Note
+ *	that "ownership" (i.e., the pointers to) the Tcl objects and aux
+ *	data items will be handed over to the new ByteCode structure from
+ *	the CompileEnv structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclInitByteCodeObj(objPtr, envPtr)
+    Tcl_Obj *objPtr;		 /* Points object that should be
+				  * initialized, and whose string rep
+				  * contains the source code. */
+    register CompileEnv *envPtr; /* Points to the CompileEnv structure from
+				  * which to create a ByteCode structure. */
+{
+    register ByteCode *codePtr;
+    size_t codeBytes, objArrayBytes, exceptArrayBytes, cmdLocBytes;
+    size_t auxDataArrayBytes;
+    register size_t size, objBytes, totalSize;
+    register unsigned char *p;
+    unsigned char *nextPtr;
+    int srcLen = envPtr->termOffset;
+    int numObjects, i;
+    Namespace *namespacePtr;
+#ifdef TCL_COMPILE_STATS
+    int srcLenLog2, sizeLog2;
+#endif /*TCL_COMPILE_STATS*/
+
+    codeBytes = (envPtr->codeNext - envPtr->codeStart);
+    numObjects = envPtr->objArrayNext;
+    objArrayBytes = (envPtr->objArrayNext * sizeof(Tcl_Obj *));
+    exceptArrayBytes = (envPtr->excRangeArrayNext * sizeof(ExceptionRange));
+    auxDataArrayBytes = (envPtr->auxDataArrayNext * sizeof(AuxData));
+    cmdLocBytes = GetCmdLocEncodingSize(envPtr);
+    
+    size = sizeof(ByteCode);
+    size += TCL_ALIGN(codeBytes);       /* align object array */
+    size += TCL_ALIGN(objArrayBytes);   /* align exception range array */
+    size += TCL_ALIGN(exceptArrayBytes); /* align AuxData array */
+    size += auxDataArrayBytes;
+    size += cmdLocBytes;
+
+    /*
+     * Compute the total number of bytes needed for this bytecode
+     * including the storage for the Tcl objects in its object array.
+     */
+
+    objBytes = (numObjects * sizeof(Tcl_Obj));
+    for (i = 0;  i < numObjects;  i++) {
+	Tcl_Obj *litObjPtr = envPtr->objArrayPtr[i];
+	if (litObjPtr->bytes != NULL) {
+	    objBytes += litObjPtr->length;
+	}
+    }
+    totalSize = (size + objBytes);
+
+#ifdef TCL_COMPILE_STATS
+    tclNumCompilations++;
+    tclTotalSourceBytes += (double) srcLen;
+    tclTotalCodeBytes += (double) totalSize;
+    
+    tclTotalInstBytes += (double) codeBytes;
+    tclTotalObjBytes += (double) objBytes;
+    tclTotalExceptBytes += exceptArrayBytes;
+    tclTotalAuxBytes += (double) auxDataArrayBytes;
+    tclTotalCmdMapBytes += (double) cmdLocBytes;
+
+    tclCurrentSourceBytes += (double) srcLen;
+    tclCurrentCodeBytes += (double) totalSize;
+
+    srcLenLog2 = TclLog2(srcLen);
+    sizeLog2 = TclLog2((int) totalSize);
+    if ((srcLenLog2 > 31) || (sizeLog2 > 31)) {
+	panic("TclInitByteCodeObj: bad source or code sizes\n");
+    }
+    tclSourceCount[srcLenLog2]++;
+    tclByteCodeCount[sizeLog2]++;
+#endif /* TCL_COMPILE_STATS */    
+
+    if (envPtr->iPtr->varFramePtr != NULL) {
+        namespacePtr = envPtr->iPtr->varFramePtr->nsPtr;
+    } else {
+        namespacePtr = envPtr->iPtr->globalNsPtr;
+    }
+    
+    p = (unsigned char *) ckalloc(size);
+    codePtr = (ByteCode *) p;
+    codePtr->iPtr = envPtr->iPtr;
+    codePtr->compileEpoch = envPtr->iPtr->compileEpoch;
+    codePtr->nsPtr = namespacePtr;
+    codePtr->nsEpoch = namespacePtr->resolverEpoch;
+    codePtr->refCount = 1;
+    codePtr->flags = 0;
+    codePtr->source = envPtr->source;
+    codePtr->procPtr = envPtr->procPtr;
+    codePtr->totalSize = totalSize;
+    codePtr->numCommands = envPtr->numCommands;
+    codePtr->numSrcChars = srcLen;
+    codePtr->numCodeBytes = codeBytes;
+    codePtr->numObjects = numObjects;
+    codePtr->numExcRanges = envPtr->excRangeArrayNext;
+    codePtr->numAuxDataItems = envPtr->auxDataArrayNext;
+    codePtr->auxDataArrayPtr = NULL;
+    codePtr->numCmdLocBytes = cmdLocBytes;
+    codePtr->maxExcRangeDepth = envPtr->maxExcRangeDepth;
+    codePtr->maxStackDepth = envPtr->maxStackDepth;
+    
+    p += sizeof(ByteCode);
+    codePtr->codeStart = p;
+    memcpy((VOID *) p, (VOID *) envPtr->codeStart, codeBytes);
+    
+    p += TCL_ALIGN(codeBytes);	      /* align object array */
+    codePtr->objArrayPtr = (Tcl_Obj **) p;
+    memcpy((VOID *) p, (VOID *) envPtr->objArrayPtr, objArrayBytes);
+
+    p += TCL_ALIGN(objArrayBytes);    /* align exception range array */
+    if (exceptArrayBytes > 0) {
+	codePtr->excRangeArrayPtr = (ExceptionRange *) p;
+	memcpy((VOID *) p, (VOID *) envPtr->excRangeArrayPtr,
+	        exceptArrayBytes);
+    }
+    
+    p += TCL_ALIGN(exceptArrayBytes); /* align AuxData array */
+    if (auxDataArrayBytes > 0) {
+	codePtr->auxDataArrayPtr = (AuxData *) p;
+	memcpy((VOID *) p, (VOID *) envPtr->auxDataArrayPtr,
+	        auxDataArrayBytes);
+    }
+
+    p += auxDataArrayBytes;
+    nextPtr = EncodeCmdLocMap(envPtr, codePtr, (unsigned char *) p);
+    if (((size_t)(nextPtr - p)) != cmdLocBytes) {	
+	panic("TclInitByteCodeObj: encoded cmd location bytes %d != expected size %d\n", (nextPtr - p), cmdLocBytes);
+    }
+    
+    /*
+     * Free the old internal rep then convert the object to a
+     * bytecode object by making its internal rep point to the just
+     * compiled ByteCode.
+     */
+	    
+    if ((objPtr->typePtr != NULL) &&
+	    (objPtr->typePtr->freeIntRepProc != NULL)) {
+	objPtr->typePtr->freeIntRepProc(objPtr);
+    }
+    objPtr->internalRep.otherValuePtr = (VOID *) codePtr;
+    objPtr->typePtr = &tclByteCodeType;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetCmdLocEncodingSize --
+ *
+ *	Computes the total number of bytes needed to encode the command
+ *	location information for some compiled code.
+ *
+ * Results:
+ *	The byte count needed to encode the compiled location information.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetCmdLocEncodingSize(envPtr)
+     CompileEnv *envPtr;	/* Points to compilation environment
+				 * structure containing the CmdLocation
+				 * structure to encode. */
+{
+    register CmdLocation *mapPtr = envPtr->cmdMapPtr;
+    int numCmds = envPtr->numCommands;
+    int codeDelta, codeLen, srcDelta, srcLen;
+    int codeDeltaNext, codeLengthNext, srcDeltaNext, srcLengthNext;
+				/* The offsets in their respective byte
+				 * sequences where the next encoded offset
+				 * or length should go. */
+    int prevCodeOffset, prevSrcOffset, i;
+
+    codeDeltaNext = codeLengthNext = srcDeltaNext = srcLengthNext = 0;
+    prevCodeOffset = prevSrcOffset = 0;
+    for (i = 0;  i < numCmds;  i++) {
+	codeDelta = (mapPtr[i].codeOffset - prevCodeOffset);
+	if (codeDelta < 0) {
+	    panic("GetCmdLocEncodingSize: bad code offset");
+	} else if (codeDelta <= 127) {
+	    codeDeltaNext++;
+	} else {
+	    codeDeltaNext += 5;	 /* 1 byte for 0xFF, 4 for positive delta */
+	}
+	prevCodeOffset = mapPtr[i].codeOffset;
+
+	codeLen = mapPtr[i].numCodeBytes;
+	if (codeLen < 0) {
+	    panic("GetCmdLocEncodingSize: bad code length");
+	} else if (codeLen <= 127) {
+	    codeLengthNext++;
+	} else {
+	    codeLengthNext += 5; /* 1 byte for 0xFF, 4 for length */
+	}
+
+	srcDelta = (mapPtr[i].srcOffset - prevSrcOffset);
+	if ((-127 <= srcDelta) && (srcDelta <= 127)) {
+	    srcDeltaNext++;
+	} else {
+	    srcDeltaNext += 5;	 /* 1 byte for 0xFF, 4 for delta */
+	}
+	prevSrcOffset = mapPtr[i].srcOffset;
+
+	srcLen = mapPtr[i].numSrcChars;
+	if (srcLen < 0) {
+	    panic("GetCmdLocEncodingSize: bad source length");
+	} else if (srcLen <= 127) {
+	    srcLengthNext++;
+	} else {
+	    srcLengthNext += 5;	 /* 1 byte for 0xFF, 4 for length */
+	}
+    }
+
+    return (codeDeltaNext + codeLengthNext + srcDeltaNext + srcLengthNext);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EncodeCmdLocMap --
+ *
+ *	Encode the command location information for some compiled code into
+ *	a ByteCode structure. The encoded command location map is stored as
+ *	three adjacent byte sequences.
+ *
+ * Results:
+ *	Pointer to the first byte after the encoded command location
+ *	information.
+ *
+ * Side effects:
+ *	The encoded information is stored into the block of memory headed
+ *	by codePtr. Also records pointers to the start of the four byte
+ *	sequences in fields in codePtr's ByteCode header structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static unsigned char *
+EncodeCmdLocMap(envPtr, codePtr, startPtr)
+     CompileEnv *envPtr;	/* Points to compilation environment
+				 * structure containing the CmdLocation
+				 * structure to encode. */
+     ByteCode *codePtr;		/* ByteCode in which to encode envPtr's
+				 * command location information. */
+     unsigned char *startPtr;	/* Points to the first byte in codePtr's
+				 * memory block where the location
+				 * information is to be stored. */
+{
+    register CmdLocation *mapPtr = envPtr->cmdMapPtr;
+    int numCmds = envPtr->numCommands;
+    register unsigned char *p = startPtr;
+    int codeDelta, codeLen, srcDelta, srcLen, prevOffset;
+    register int i;
+    
+    /*
+     * Encode the code offset for each command as a sequence of deltas.
+     */
+
+    codePtr->codeDeltaStart = p;
+    prevOffset = 0;
+    for (i = 0;  i < numCmds;  i++) {
+	codeDelta = (mapPtr[i].codeOffset - prevOffset);
+	if (codeDelta < 0) {
+	    panic("EncodeCmdLocMap: bad code offset");
+	} else if (codeDelta <= 127) {
+	    TclStoreInt1AtPtr(codeDelta, p);
+	    p++;
+	} else {
+	    TclStoreInt1AtPtr(0xFF, p);
+	    p++;
+	    TclStoreInt4AtPtr(codeDelta, p);
+	    p += 4;
+	}
+	prevOffset = mapPtr[i].codeOffset;
+    }
+
+    /*
+     * Encode the code length for each command.
+     */
+
+    codePtr->codeLengthStart = p;
+    for (i = 0;  i < numCmds;  i++) {
+	codeLen = mapPtr[i].numCodeBytes;
+	if (codeLen < 0) {
+	    panic("EncodeCmdLocMap: bad code length");
+	} else if (codeLen <= 127) {
+	    TclStoreInt1AtPtr(codeLen, p);
+	    p++;
+	} else {
+	    TclStoreInt1AtPtr(0xFF, p);
+	    p++;
+	    TclStoreInt4AtPtr(codeLen, p);
+	    p += 4;
+	}
+    }
+
+    /*
+     * Encode the source offset for each command as a sequence of deltas.
+     */
+
+    codePtr->srcDeltaStart = p;
+    prevOffset = 0;
+    for (i = 0;  i < numCmds;  i++) {
+	srcDelta = (mapPtr[i].srcOffset - prevOffset);
+	if ((-127 <= srcDelta) && (srcDelta <= 127)) {
+	    TclStoreInt1AtPtr(srcDelta, p);
+	    p++;
+	} else {
+	    TclStoreInt1AtPtr(0xFF, p);
+	    p++;
+	    TclStoreInt4AtPtr(srcDelta, p);
+	    p += 4;
+	}
+	prevOffset = mapPtr[i].srcOffset;
+    }
+
+    /*
+     * Encode the source length for each command.
+     */
+
+    codePtr->srcLengthStart = p;
+    for (i = 0;  i < numCmds;  i++) {
+	srcLen = mapPtr[i].numSrcChars;
+	if (srcLen < 0) {
+	    panic("EncodeCmdLocMap: bad source length");
+	} else if (srcLen <= 127) {
+	    TclStoreInt1AtPtr(srcLen, p);
+	    p++;
+	} else {
+	    TclStoreInt1AtPtr(0xFF, p);
+	    p++;
+	    TclStoreInt4AtPtr(srcLen, p);
+	    p += 4;
+	}
+    }
+    
+    return p;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileString --
+ *
+ *	Compile a Tcl script in a null-terminated binary string.
+ *
+ * Results:
+ *	The return value is TCL_OK on a successful compilation and TCL_ERROR
+ *	on failure. If TCL_ERROR is returned, then the interpreter's result
+ *	contains an error message.
+ *
+ *	envPtr->termOffset and interp->termOffset are filled in with the
+ *	offset of the character in the string just after the last one
+ *	successfully processed; this might be the offset of the ']' (if
+ *	flags & TCL_BRACKET_TERM), or the offset of the '\0' at the end of
+ *	the string. Also updates envPtr->maxStackDepth with the maximum
+ *	number of stack elements needed to execute the string's commands.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the string at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileString(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *string;		/* The source string to compile. */
+    char *lastChar;		/* Pointer to terminating character of
+				 * string. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    Interp *iPtr = (Interp *) interp;
+    register char *src = string;/* Points to current source char. */
+    register char c = *src;	/* The current char. */
+    register int type;		/* Current char's CHAR_TYPE type. */
+    char termChar = (char)((flags & TCL_BRACKET_TERM)? ']' : '\0');
+				/* Return when this character is found
+				 * (either ']' or '\0'). Zero means newlines
+				 * terminate cmds. */
+    int isFirstCmd = 1;		/* 1 if compiling the first cmd. */
+    char *cmdSrcStart = NULL;	/* Points to first non-blank char in each
+ 				 * command. Initialized to avoid compiler
+ 				 * warning. */
+    int cmdIndex;		/* The index of the current command in the
+ 				 * compilation environment's command
+ 				 * location table. */
+    int lastTopLevelCmdIndex = -1;
+    				/* Index of most recent toplevel command in
+ 				 * the command location table. Initialized
+				 * to avoid compiler warning. */
+    int cmdCodeOffset = -1;	/* Offset of first byte of current command's
+ 				 * code. Initialized to avoid compiler
+ 				 * warning. */
+    int cmdWords;		/* Number of words in current command. */
+    Tcl_Command cmd;		/* Used to search for commands. */
+    Command *cmdPtr;		/* Points to command's Command structure if
+				 * first word is simple and command was
+				 * found; else NULL. */
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute all cmds. */
+    char *termPtr;		/* Points to char that terminated word. */
+    char savedChar;		/* Holds the character from string
+				 * termporarily replaced by a null character
+				 * during processing of words. */
+    int objIndex = -1;		/* The object array index for a pushed
+ 				 * object holding a word or word part
+ 				 * Initialized to avoid compiler warning. */
+    unsigned char *entryCodeNext = envPtr->codeNext;
+    				/* Value of envPtr's current instruction
+				 * pointer at entry. Used to tell if any
+				 * instructions generated. */
+    char *ellipsis = "";	/* Used to set errorInfo variable; "..."
+				 * indicates that not all of offending
+				 * command is included in errorInfo. ""
+				 * means that the command is all there. */
+    Tcl_Obj *objPtr;
+    int numChars;
+    int result = TCL_OK;
+    int savePushSimpleWords = envPtr->pushSimpleWords;
+
+    /*
+     * commands: command {(';' | '\n') command}
+     */
+
+    while ((src != lastChar) && (c != termChar)) {
+	/*
+	 * Skip white space, semicolons, backslash-newlines (treated as
+	 * spaces), and comments before command.
+	 */
+
+	type = CHAR_TYPE(src, lastChar);
+	while ((type & (TCL_SPACE | TCL_BACKSLASH))
+	        || (c == '\n') || (c == ';')) {
+	    if (type == TCL_BACKSLASH) {
+		if (src[1] == '\n') {
+		    src += 2;
+		} else {
+		    break;
+		}
+	    } else {
+		src++;
+	    }
+	    c = *src;
+	    type = CHAR_TYPE(src, lastChar);
+	}
+
+	if (c == '#') {
+	    while (src != lastChar) {
+		if (c == '\\') {
+		    int numRead;
+		    Tcl_Backslash(src, &numRead);
+		    src += numRead;
+		} else if (c == '\n') {
+		    src++;
+		    c = *src;
+		    envPtr->termOffset = (src - string);
+		    break;
+		} else {
+		    src++;
+		}
+		c = *src;
+	    }
+	    continue;	/* end of comment, restart outer command loop */
+	}
+
+	/*
+	 * Compile one command: zero or more words terminated by a '\n',
+	 * ';', ']' (if command is terminated by close bracket), or
+	 * the end of string.
+	 *
+	 * command: word*
+	 */
+
+	type = CHAR_TYPE(src, lastChar);
+	if ((type == TCL_COMMAND_END) 
+	        && ((c != ']') || (flags & TCL_BRACKET_TERM))) {
+	    continue;  /* empty command; restart outer cmd loop */
+	}
+
+	/*
+	 * If not the first command, discard the previous command's result.
+	 */
+	
+	if (!isFirstCmd) {
+	    TclEmitOpcode(INST_POP, envPtr);
+	    if (!(flags & TCL_BRACKET_TERM)) {
+		/*
+		 * We are compiling a top level command. Update the number
+		 * of code bytes for the last command to account for the pop
+		 * instruction.
+		 */
+		
+	        (envPtr->cmdMapPtr[lastTopLevelCmdIndex]).numCodeBytes =
+		    (envPtr->codeNext-envPtr->codeStart) - cmdCodeOffset;
+	    }
+	}
+
+	/*
+	 * Compile the words of the command. Process the first word
+	 * specially, since it is the name of a command. If it is a "simple"
+	 * string (just a sequence of characters), look it up in the table
+	 * of compilation procedures. If a word other than the first is
+	 * simple and represents an integer whose formatted representation
+	 * is the same as the word, just push an integer object. Also record
+	 * starting source and object information for the command.
+	 */
+
+	envPtr->numCommands++;
+	cmdIndex = (envPtr->numCommands - 1);
+	if (!(flags & TCL_BRACKET_TERM)) {
+	    lastTopLevelCmdIndex = cmdIndex;
+	}
+	
+	cmdSrcStart = src;
+	cmdCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+	cmdWords = 0;
+	EnterCmdStartData(envPtr, cmdIndex, src-envPtr->source,
+		cmdCodeOffset);
+	    
+	if ((!(flags & TCL_BRACKET_TERM))
+	        && (tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {
+	    /*
+	     * Display a line summarizing the top level command we are about
+	     * to compile.
+	     */
+	    
+	    char *p = cmdSrcStart;
+	    int numChars, complete;
+	    
+	    while ((CHAR_TYPE(p, lastChar) != TCL_COMMAND_END)
+		   || ((*p == ']') && !(flags & TCL_BRACKET_TERM))) {
+		p++;
+	    }
+	    numChars = (p - cmdSrcStart);
+	    complete = 1;
+	    if (numChars > 60) {
+		numChars = 60;
+		complete = 0;
+	    } else if ((numChars >= 2) && (*p == '\n') && (*(p-1) == '{')) {
+		complete = 0;
+	    }
+	    fprintf(stdout, "Compiling: %.*s%s\n",
+		    numChars, cmdSrcStart, (complete? "" : " ..."));
+	}
+	
+	while ((type != TCL_COMMAND_END)
+	        || ((c == ']') && !(flags & TCL_BRACKET_TERM))) {
+	    /*
+	     * Skip any leading white space at the start of a word. Note
+	     * that a backslash-newline is treated as a space.
+	     */
+
+	    while (type & (TCL_SPACE | TCL_BACKSLASH)) {
+		if (type == TCL_BACKSLASH) {
+		    if (src[1] == '\n') {
+			src += 2;
+		    } else {
+			break;
+		    }
+		} else {
+		    src++;
+		}
+		c = *src;
+		type = CHAR_TYPE(src, lastChar);
+	    }
+	    if ((type == TCL_COMMAND_END) 
+	            && ((c != ']') || (flags & TCL_BRACKET_TERM))) {
+		break;		/* no words remain for command. */
+	    }
+
+	    /*
+	     * Compile one word. We use an inline version of CompileWord to
+	     * avoid an extra procedure call.
+	     */
+
+	    envPtr->pushSimpleWords = 0;
+	    if (type & (TCL_QUOTE | TCL_OPEN_BRACE)) {
+		src++;
+		if (type == TCL_QUOTE) {
+		    result = TclCompileQuotes(interp, src, lastChar,
+			    '"', flags, envPtr);
+		} else {
+		    result = CompileBraces(interp, src, lastChar,
+			    flags, envPtr);
+		}
+		termPtr = (src + envPtr->termOffset);
+		if (result != TCL_OK) {
+		    src = termPtr;
+		    goto done;
+		}
+
+		/*
+		 * Make sure terminating character of the quoted or braced
+		 * string is the end of word.
+		 */
+		
+		c = *termPtr;
+		if ((c == '\\') && (*(termPtr+1) == '\n')) {
+		    /*
+		     * Line is continued on next line; the backslash-
+		     * newline turns into space, which terminates the word.
+		     */
+		} else {
+		    type = CHAR_TYPE(termPtr, lastChar);
+		    if ((type != TCL_SPACE) && (type != TCL_COMMAND_END)) {
+			Tcl_ResetResult(interp);
+			if (*(src-1) == '"') {
+			    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+				    "extra characters after close-quote", -1);
+			} else {
+			    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+				    "extra characters after close-brace", -1);
+			}
+			result = TCL_ERROR;
+		    }
+		}
+	    } else {
+		result = CompileMultipartWord(interp, src, lastChar,
+			flags, envPtr);
+		termPtr = (src + envPtr->termOffset);
+	    }
+	    if (result != TCL_OK) {
+		ellipsis = "...";
+		src = termPtr;
+		goto done;
+	    }
+	    
+	    if (envPtr->wordIsSimple) {
+		/*
+		 * A simple word. Temporarily replace the terminating
+		 * character with a null character.
+		 */
+		
+		numChars = envPtr->numSimpleWordChars;
+		savedChar = src[numChars];
+		src[numChars] = '\0';
+
+		if ((cmdWords == 0)
+		        && (!(iPtr->flags & DONT_COMPILE_CMDS_INLINE))) {
+		    /*
+		     * The first word of a command and inline command
+		     * compilation has not been disabled (e.g., by command
+		     * traces). Look up the first word in the interpreter's
+		     * hashtable of commands. If a compilation procedure is
+		     * found, let it compile the command after resetting
+		     * error logging information. Note that if we are
+		     * compiling a procedure, we must look up the command
+		     * in the procedure's namespace and not the current
+		     * namespace.
+		     */
+
+		    Namespace *cmdNsPtr;
+
+		    if (envPtr->procPtr != NULL) {
+			cmdNsPtr = envPtr->procPtr->cmdPtr->nsPtr;
+		    } else {
+			cmdNsPtr = NULL;
+		    }
+
+		    cmdPtr = NULL;
+		    cmd = Tcl_FindCommand(interp, src,
+			    (Tcl_Namespace *) cmdNsPtr, /*flags*/ 0);
+                    if (cmd != (Tcl_Command) NULL) {
+                        cmdPtr = (Command *) cmd;
+                    }
+		    if ((cmdPtr != NULL) && (cmdPtr->compileProc != NULL)) {
+			char *firstArg = termPtr;
+			src[numChars] = savedChar;
+			iPtr->flags &= ~(ERR_ALREADY_LOGGED | ERR_IN_PROGRESS
+					 | ERROR_CODE_SET);
+			result = (*(cmdPtr->compileProc))(interp,
+				firstArg, lastChar, flags, envPtr);
+			if (result == TCL_OK) {
+			    src = (firstArg + envPtr->termOffset);
+			    maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+			    goto finishCommand;
+			} else if (result == TCL_OUT_LINE_COMPILE) {
+			    result = TCL_OK;
+			    src[numChars] = '\0';
+			} else {
+			    src = firstArg;
+			    goto done;           /* an error */
+			}
+		    }
+
+		    /*
+		     * No compile procedure was found for the command: push
+		     * the word and continue to compile the remaining
+		     * words. If a hashtable entry was found for the
+		     * command, push a CmdName object instead to avoid
+		     * runtime lookups. If necessary, convert the pushed
+		     * object to be a CmdName object. If this is the first
+		     * CmdName object in this code unit that refers to the
+		     * command, increment the reference count in the
+		     * Command structure to reflect the new reference from
+		     * the CmdName object and, if the command is deleted
+		     * later, to keep the Command structure from being freed
+		     * until TclExecuteByteCode has a chance to recognize
+		     * that the command was deleted.
+		     */
+
+		    objIndex = TclObjIndexForString(src, numChars,
+			    /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+		    if (cmdPtr != NULL) {
+			objPtr = envPtr->objArrayPtr[objIndex];
+			if ((objPtr->typePtr != &tclCmdNameType)
+			        && (objPtr->bytes != NULL)) {
+			    ResolvedCmdName *resPtr = (ResolvedCmdName *)
+                                    ckalloc(sizeof(ResolvedCmdName));
+                            Namespace *nsPtr = (Namespace *) 
+				    Tcl_GetCurrentNamespace(interp);
+
+                            resPtr->cmdPtr = cmdPtr;
+                            resPtr->refNsPtr = nsPtr;
+			    resPtr->refNsId = nsPtr->nsId;
+                            resPtr->refNsCmdEpoch = nsPtr->cmdRefEpoch;
+                            resPtr->cmdEpoch = cmdPtr->cmdEpoch;
+                            resPtr->refCount = 1;
+			    objPtr->internalRep.twoPtrValue.ptr1 =
+				(VOID *) resPtr;
+			    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+                            objPtr->typePtr = &tclCmdNameType;
+			    cmdPtr->refCount++;
+			}
+		    }
+		} else {
+		    /*
+		     * See if the word represents an integer whose formatted
+		     * representation is the same as the word (e.g., this is
+		     * true for 123 and -1 but not for 00005). If so, just
+		     * push an integer object.
+		     */
+
+		    int isCompilableInt = 0;
+		    long n;
+		    char buf[40];
+		    
+		    if (TclLooksLikeInt(src)) {
+			int code = TclGetLong(interp, src, &n);
+			if (code == TCL_OK) {
+			    TclFormatInt(buf, n);
+			    if (strcmp(src, buf) == 0) {
+				isCompilableInt = 1;
+				objIndex = TclObjIndexForString(src,
+					numChars, /*allocStrRep*/ 0,
+					/*inHeap*/ 0, envPtr);
+				objPtr = envPtr->objArrayPtr[objIndex];
+
+				Tcl_InvalidateStringRep(objPtr);
+				objPtr->internalRep.longValue = n;
+				objPtr->typePtr = &tclIntType;
+			    }
+			} else {
+			    Tcl_ResetResult(interp);
+			}
+		    }
+		    if (!isCompilableInt) {
+			objIndex = TclObjIndexForString(src, numChars,
+			        /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+		    }
+		}
+		src[numChars] = savedChar;
+		TclEmitPush(objIndex, envPtr);
+		maxDepth = TclMax((cmdWords + 1), maxDepth);
+	    } else {		/* not a simple word */
+		maxDepth = TclMax((cmdWords + envPtr->maxStackDepth),
+			       maxDepth);
+	    }
+	    src = termPtr;
+	    c = *src;
+	    type = CHAR_TYPE(src, lastChar);
+	    cmdWords++;
+	}
+	
+	/*
+	 * Emit an invoke instruction for the command. If a compile command
+	 * was found for the command we called it and skipped this.
+	 */
+
+	if (cmdWords > 0) {
+	    if (cmdWords <= 255) {
+	        TclEmitInstUInt1(INST_INVOKE_STK1, cmdWords, envPtr);
+            } else {
+	        TclEmitInstUInt4(INST_INVOKE_STK4, cmdWords, envPtr);
+            }
+	}
+
+	/*
+	 * Update the compilation environment structure. Record
+	 * source/object information for the command.
+	 */
+
+        finishCommand:
+	EnterCmdExtentData(envPtr, cmdIndex, src-cmdSrcStart,
+	        (envPtr->codeNext-envPtr->codeStart) - cmdCodeOffset);
+	
+	isFirstCmd = 0;
+	envPtr->termOffset = (src - string);
+	c = *src;
+    }
+
+    done:
+    if (result == TCL_OK) {
+	/*
+	 * If the source string yielded no instructions (e.g., if it was
+	 * empty), push an empty string object as the command's result.
+	 */
+    
+	if (entryCodeNext == envPtr->codeNext) {
+	    int objIndex = TclObjIndexForString("", 0, /*allocStrRep*/ 0,
+                                                /*inHeap*/ 0, envPtr);
+	    TclEmitPush(objIndex, envPtr);
+	    maxDepth = 1;
+	}
+    } else {
+	/*
+	 * Add additional error information. First compute the line number
+	 * where the error occurred.
+	 */
+
+	register char *p;
+	int numChars;
+	char buf[200];
+
+	iPtr->errorLine = 1;
+	for (p = string;  p != cmdSrcStart;  p++) {
+	    if (*p == '\n') {
+		iPtr->errorLine++;
+	    }
+	}
+	for (  ; isspace(UCHAR(*p)) || (*p == ';');  p++) {
+	    if (*p == '\n') {
+		iPtr->errorLine++;
+	    }
+	}
+
+	/*
+	 * Figure out how much of the command to print (up to a certain
+	 * number of characters, or up to the end of the command).
+	 */
+
+	p = cmdSrcStart;
+	while ((CHAR_TYPE(p, lastChar) != TCL_COMMAND_END)
+		|| ((*p == ']') && !(flags & TCL_BRACKET_TERM))) {
+	    p++;
+	}
+	numChars = (p - cmdSrcStart);
+	if (numChars > 150) {
+	    numChars = 150;
+	    ellipsis = " ...";
+	} else if ((numChars >= 2) && (*p == '\n') && (*(p-1) == '{')) {
+	    ellipsis = " ...";
+	}
+	
+	sprintf(buf, "\n    while compiling\n\"%.*s%s\"",
+		numChars, cmdSrcStart, ellipsis);
+	Tcl_AddObjErrorInfo(interp, buf, -1);
+    } 
+	
+    envPtr->termOffset = (src - string);
+    iPtr->termOffset = envPtr->termOffset;
+    envPtr->maxStackDepth = maxDepth;
+    envPtr->pushSimpleWords = savePushSimpleWords;
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileWord --
+ *
+ *	This procedure compiles one word from a command string. It skips
+ *	any leading white space.
+ *
+ *	Ordinarily, callers set envPtr->pushSimpleWords to 1 and this
+ *	procedure emits push and other instructions to compute the
+ *	word on the Tcl evaluation stack at execution time. If a caller sets
+ *	envPtr->pushSimpleWords to 0, CompileWord will _not_ compile
+ *	"simple" words: words that are just a sequence of characters without
+ *	backslashes. It will leave their compilation up to the caller.
+ *
+ *	As an important special case, if the word is simple, this procedure
+ *	sets envPtr->wordIsSimple to 1 and envPtr->numSimpleWordChars to the
+ *	number of characters in the simple word. This allows the caller to
+ *	process these words specially.
+ *
+ * Results:
+ *	The return value is a standard Tcl result. If an error occurs, an
+ *	error message is left in the interpreter's result.
+ *	
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed in the last
+ *	word. This is normally the character just after the last one in a
+ *	word (perhaps the command terminator), or the vicinity of an error
+ *	(if the result is not TCL_OK).
+ *
+ *	envPtr->wordIsSimple is set 1 if the word is simple: just a
+ *	sequence of characters without backslashes. If so, the word's
+ *	characters are the envPtr->numSimpleWordChars characters starting 
+ *	at string.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to evaluate the word. This is not changed if
+ *	the word is simple and envPtr->pushSimpleWords was 0 (false).
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to compute and push the word
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileWord(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		/* Interpreter to use for nested command
+				 * evaluations and error messages. */
+    char *string;		/* First character of word. */
+    char *lastChar;		 /* Pointer to terminating character of
+				  * string. */
+    int flags;			/* Flags to control compilation (same values
+				 * passed to Tcl_EvalObj). */
+    CompileEnv *envPtr;		/* Holds the resulting instructions. */
+{
+    /*
+     * Compile one word: approximately
+     *
+     * word:             quoted_string | braced_string | multipart_word
+     * quoted_string:    '"' char* '"'
+     * braced_string:    '{' char* '}'
+     * multipart_word    (see CompileMultipartWord below)
+     */
+    
+    register char *src = string; /* Points to current source char. */
+    register int type = CHAR_TYPE(src, lastChar);
+				 /* Current char's CHAR_TYPE type. */
+    int maxDepth = 0;		 /* Maximum number of stack elements needed
+				  * to compute and push the word. */
+    char *termPtr = src;	 /* Points to the character that terminated
+				  * the word. */
+    int result = TCL_OK;
+
+    /*
+     * Skip any leading white space at the start of a word. Note that a
+     * backslash-newline is treated as a space.
+     */
+
+    while (type & (TCL_SPACE | TCL_BACKSLASH)) {
+	if (type == TCL_BACKSLASH) {
+	    if (src[1] == '\n') {
+		src += 2;
+	    } else {
+		break;		/* no longer white space */
+	    }
+	} else {
+	    src++;
+	}
+	type = CHAR_TYPE(src, lastChar);
+    }
+    if (type == TCL_COMMAND_END) {
+	goto done;
+    }
+
+    /*
+     * Compile the word. Handle quoted and braced string words here in order
+     * to avoid an extra procedure call.
+     */
+
+    if (type & (TCL_QUOTE | TCL_OPEN_BRACE)) {
+	src++;
+	if (type == TCL_QUOTE) {
+	    result = TclCompileQuotes(interp, src, lastChar, '"', flags,
+		    envPtr);
+	} else {
+	    result = CompileBraces(interp, src, lastChar, flags, envPtr);
+	}
+	termPtr = (src + envPtr->termOffset);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	
+	/*
+	 * Make sure terminating character of the quoted or braced string is
+	 * the end of word.
+	 */
+	
+	if ((*termPtr == '\\') && (*(termPtr+1) == '\n')) {
+	    /*
+	     * Line is continued on next line; the backslash-newline turns
+	     * into space, which terminates the word.
+	     */
+	} else {
+	    type = CHAR_TYPE(termPtr, lastChar);
+	    if (!(type & (TCL_SPACE | TCL_COMMAND_END))) {
+		Tcl_ResetResult(interp);
+		if (*(src-1) == '"') {
+		    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		            "extra characters after close-quote", -1);
+		} else {
+		    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+			    "extra characters after close-brace", -1);
+		}
+		result = TCL_ERROR;
+		goto done;
+	    }
+	}
+	maxDepth = envPtr->maxStackDepth;
+    } else {
+	result = CompileMultipartWord(interp, src, lastChar, flags, envPtr);
+	termPtr = (src + envPtr->termOffset);
+	maxDepth = envPtr->maxStackDepth;
+    }
+
+    /*
+     * Done processing the word. The values of envPtr->wordIsSimple and
+     * envPtr->numSimpleWordChars are left at the values returned by
+     * TclCompileQuotes/Braces/MultipartWord.
+     */
+    
+    done:
+    envPtr->termOffset = (termPtr - string);
+    envPtr->maxStackDepth = maxDepth;
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileMultipartWord --
+ *
+ *	This procedure compiles one multipart word: a word comprised of some
+ *	number of nested commands, variable references, or arbitrary
+ *	characters. This procedure assumes that quoted string and braced
+ *	string words and the end of command have already been handled by its
+ *	caller. It also assumes that any leading white space has already
+ *	been consumed.
+ *
+ *	Ordinarily, callers set envPtr->pushSimpleWords to 1 and this
+ *	procedure emits push and other instructions to compute the word on
+ *	the Tcl evaluation stack at execution time. If a caller sets
+ *	envPtr->pushSimpleWords to 0, it will _not_ compile "simple" words:
+ *	words that are just a sequence of characters without backslashes.
+ *	It will leave their compilation up to the caller. This is done, for
+ *	example, to provide special support for the first word of commands,
+ *	which are almost always the (simple) name of a command.
+ *
+ *	As an important special case, if the word is simple, this procedure
+ *	sets envPtr->wordIsSimple to 1 and envPtr->numSimpleWordChars to the
+ *	number of characters in the simple word. This allows the caller to
+ *	process these words specially.
+ *
+ * Results:
+ *	The return value is a standard Tcl result. If an error occurs, an
+ *	error message is left in the interpreter's result.
+ *	
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed in the last
+ *	word. This is normally the character just after the last one in a
+ *	word (perhaps the command terminator), or the vicinity of an error
+ *	(if the result is not TCL_OK).
+ *
+ *	envPtr->wordIsSimple is set 1 if the word is simple: just a
+ *	sequence of characters without backslashes. If so, the word's
+ *	characters are the envPtr->numSimpleWordChars characters starting 
+ *	at string.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to evaluate the word. This is not changed if
+ *	the word is simple and envPtr->pushSimpleWords was 0 (false).
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to compute and push the word
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileMultipartWord(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		/* Interpreter to use for nested command
+				 * evaluations and error messages. */
+    char *string;		/* First character of word. */
+    char *lastChar;		 /* Pointer to terminating character of
+				  * string. */
+    int flags;			/* Flags to control compilation (same values
+				 * passed to Tcl_EvalObj). */
+    CompileEnv *envPtr;		/* Holds the resulting instructions. */
+{
+    /*
+     * Compile one multi_part word:
+     *
+     * multi_part_word:  word_part+
+     * word_part:        nested_cmd | var_reference | char+
+     * nested_cmd:       '[' command ']'
+     * var_reference:    '$' name | '$' name '(' index_string ')' |
+     *                   '$' '{' braced_name '}')
+     * name:             (letter | digit | underscore)+
+     * braced_name:      (non_close_brace_char)*
+     * index_string:     (non_close_paren_char)*
+     */
+    
+    register char *src = string; /* Points to current source char. */
+    register char c = *src;	/* The current char. */
+    register int type;		/* Current char's CHAR_TYPE type. */
+    int bracketNormal = !(flags & TCL_BRACKET_TERM);
+    int simpleWord = 0;		/* Set 1 if word is simple. */
+    int numParts = 0;		/* Count of word_part objs pushed. */
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to compute and push the word. */
+    char *start;		/* Starting position of char+ word_part. */
+    int hasBackslash;		/* Nonzero if '\' in char+ word_part. */
+    int numChars;		/* Number of chars in char+ word_part. */
+    char savedChar;		/* Holds the character from string
+				 * termporarily replaced by a null character
+				 * during word_part processing. */
+    int objIndex;		/* The object array index for a pushed
+				 * object holding a word_part. */
+    int savePushSimpleWords = envPtr->pushSimpleWords;
+    int result = TCL_OK;
+    int numRead;
+
+    type = CHAR_TYPE(src, lastChar);
+    while (1) {
+	/*
+	 * Process a word_part: a sequence of chars, a var reference, or
+	 * a nested command.
+	 */
+
+	if ((type & (TCL_NORMAL | TCL_CLOSE_BRACE | TCL_BACKSLASH |
+		     TCL_QUOTE | TCL_OPEN_BRACE)) ||
+	    ((c == ']') && bracketNormal)) {
+	    /*
+	     * A char+ word part. Scan first looking for any backslashes.
+	     * Note that a backslash-newline must be treated as a word
+	     * separator, as if the backslash-newline had been collapsed
+	     * before command parsing began.
+	     */
+	    
+	    start = src;
+	    hasBackslash = 0;
+	    do {
+		if (type == TCL_BACKSLASH) {
+		    hasBackslash = 1;
+		    Tcl_Backslash(src, &numRead);
+		    if (src[1] == '\n') {
+			src += numRead;
+			type = TCL_SPACE; /* force word end */
+			break;
+		    }
+		    src += numRead;
+		} else {
+		    src++;
+		}
+		c = *src;
+		type = CHAR_TYPE(src, lastChar);
+	    } while (type & (TCL_NORMAL | TCL_BACKSLASH | TCL_QUOTE |
+			    TCL_OPEN_BRACE | TCL_CLOSE_BRACE)
+			    || ((c == ']') && bracketNormal));
+
+	    if ((numParts == 0) && !hasBackslash
+		    && (type & (TCL_SPACE | TCL_COMMAND_END))) {
+		/*
+		 * The word is "simple": just a sequence of characters
+		 * without backslashes terminated by a TCL_SPACE or
+		 * TCL_COMMAND_END. Just return if we are not to compile
+		 * simple words.
+		 */
+
+		simpleWord = 1;
+		if (!envPtr->pushSimpleWords) {
+		    envPtr->wordIsSimple = 1;
+		    envPtr->numSimpleWordChars = (src - string);
+		    envPtr->termOffset = envPtr->numSimpleWordChars;
+		    envPtr->pushSimpleWords = savePushSimpleWords;
+		    return TCL_OK;
+		}
+	    }
+
+	    /*
+	     * Create and push a string object for the char+ word_part,
+	     * which starts at "start" and ends at the char just before
+	     * src. If backslashes were found, copy the word_part's
+	     * characters with substituted backslashes into a heap-allocated
+	     * buffer and use it to create the string object. Temporarily
+	     * replace the terminating character with a null character.
+	     */
+
+	    numChars = (src - start);
+	    savedChar = start[numChars];
+	    start[numChars] = '\0';
+	    if ((numChars > 0) && (hasBackslash)) {
+		char *buffer = ckalloc((unsigned) numChars + 1);
+		register char *dst = buffer;
+		register char *p = start;
+		while (p < src) {
+		    if (*p == '\\') {	
+			*dst = Tcl_Backslash(p, &numRead);
+			if (p[1] == '\n') {
+			    break;
+			}
+			p += numRead;
+			dst++;
+		    } else {
+			*dst++ = *p++;
+		    }
+		}
+		*dst = '\0';
+		objIndex = TclObjIndexForString(buffer, dst-buffer,
+			/*allocStrRep*/ 1, /*inHeap*/ 1, envPtr);
+	    } else {
+		objIndex = TclObjIndexForString(start, numChars,
+			/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+	    }
+	    start[numChars] = savedChar;
+	    TclEmitPush(objIndex, envPtr);
+	    maxDepth = TclMax((numParts + 1), maxDepth);
+	} else if (type == TCL_DOLLAR) {
+	    result = TclCompileDollarVar(interp, src, lastChar,
+		    flags, envPtr);
+	    src += envPtr->termOffset;
+	    if (result != TCL_OK) {
+		goto done;
+	    }
+	    maxDepth = TclMax((numParts + envPtr->maxStackDepth), maxDepth);
+	    c = *src;
+	    type = CHAR_TYPE(src, lastChar);
+	} else if (type == TCL_OPEN_BRACKET) {
+	    char *termPtr;
+	    envPtr->pushSimpleWords = 1;
+	    src++;
+	    result = TclCompileString(interp, src, lastChar,
+				      (flags | TCL_BRACKET_TERM), envPtr);
+	    termPtr = (src + envPtr->termOffset);
+	    if (*termPtr == ']') {
+		termPtr++;
+	    } else if (*termPtr == '\0') {
+		/*
+		 * Missing ] at end of nested command.
+		 */
+		
+		Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		        "missing close-bracket", -1);
+		result = TCL_ERROR;
+	    }
+	    src = termPtr;
+	    if (result != TCL_OK) {
+		goto done;
+	    }
+	    maxDepth = TclMax((numParts + envPtr->maxStackDepth), maxDepth);
+	    c = *src;
+	    type = CHAR_TYPE(src, lastChar);
+	} else if (type & (TCL_SPACE | TCL_COMMAND_END)) {
+	    goto wordEnd;
+	}
+	numParts++;
+    } /* end of infinite loop */
+
+    wordEnd:
+    /*
+     * End of a non-simple word: TCL_SPACE, TCL_COMMAND_END, or
+     * backslash-newline. Concatenate the word_parts if necessary.
+     */
+
+    while (numParts > 255) {
+	TclEmitInstUInt1(INST_CONCAT1, 255, envPtr);
+	numParts -= 254;  /* concat pushes 1 obj, the result */
+    }
+    if (numParts > 1) {
+	TclEmitInstUInt1(INST_CONCAT1, numParts, envPtr);
+    }
+
+    done:
+    if (simpleWord) {
+	envPtr->wordIsSimple = 1;
+	envPtr->numSimpleWordChars = (src - string);
+    } else {
+	envPtr->wordIsSimple = 0;
+	envPtr->numSimpleWordChars = 0;
+    }
+    envPtr->termOffset = (src - string);
+    envPtr->maxStackDepth = maxDepth;
+    envPtr->pushSimpleWords = savePushSimpleWords;
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileQuotes --
+ *
+ *	This procedure compiles a double-quoted string such as a quoted Tcl
+ *	command argument or a quoted value in a Tcl expression. This
+ *	procedure is also used to compile array element names within
+ *	parentheses (where the termChar will be ')' instead of '"'), or
+ *	anything else that needs the substitutions that happen in quotes.
+ *
+ *	Ordinarily, callers set envPtr->pushSimpleWords to 1 and
+ *	TclCompileQuotes always emits push and other instructions to compute
+ *	the word on the Tcl evaluation stack at execution time. If a caller
+ *	sets envPtr->pushSimpleWords to 0, TclCompileQuotes will not compile
+ *	"simple" words: words that are just a sequence of characters without
+ *	backslashes. It will leave their compilation up to the caller. This
+ *	is done to provide special support for the first word of commands,
+ *	which are almost always the (simple) name of a command.
+ *
+ *	As an important special case, if the word is simple, this procedure
+ *	sets envPtr->wordIsSimple to 1 and envPtr->numSimpleWordChars to the
+ *	number of characters in the simple word. This allows the caller to
+ *	process these words specially.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is TCL_OK unless
+ *	there was an error while parsing the quoted string. If an error
+ *	occurs then the interpreter's result contains a standard error
+ *	message.
+ *
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed; this is
+ *	usually the character just after the matching close-quote.
+ *
+ *	envPtr->wordIsSimple is set 1 if the word is simple: just a
+ *	sequence of characters without backslashes. If so, the word's
+ *	characters are the envPtr->numSimpleWordChars characters starting 
+ *	at string.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to evaluate the word. This is not changed if
+ *	the word is simple and envPtr->pushSimpleWords was 0 (false).
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to push the quoted-string
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileQuotes(interp, string, lastChar, termChar, flags, envPtr)
+    Tcl_Interp *interp;		 /* Interpreter to use for nested command
+				  * evaluations and error messages. */
+    char *string;		 /* Points to the character just after
+				  * the opening '"' or '('. */
+    char *lastChar;		 /* Pointer to terminating character of
+				  * string. */
+    int termChar;		 /* Character that terminates the "quoted"
+				  * string (usually double-quote, but might
+				  * be right-paren or something else). */
+    int flags;			 /* Flags to control compilation (same 
+				  * values passed to Tcl_Eval). */
+    CompileEnv *envPtr;		 /* Holds the resulting instructions. */
+{
+    register char *src = string; /* Points to current source char. */
+    register char c = *src;	 /* The current char. */
+    int simpleWord = 0;		 /* Set 1 if a simple quoted string word. */
+    char *start;		 /* Start position of char+ string_part. */
+    int hasBackslash; 	         /* 1 if '\' found in char+ string_part. */
+    int numRead;		 /* Count of chars read by Tcl_Backslash. */
+    int numParts = 0;	         /* Count of string_part objs pushed. */
+    int maxDepth = 0;		 /* Maximum number of stack elements needed
+				  * to compute and push the string. */
+    char savedChar;		 /* Holds the character from string
+				  * termporarily replaced by a null 
+				  * char during string_part processing. */
+    int objIndex;		 /* The object array index for a pushed
+				  * object holding a string_part. */
+    int numChars;		 /* Number of chars in string_part. */
+    int savePushSimpleWords = envPtr->pushSimpleWords;
+    int result = TCL_OK;
+    
+    /*
+     * quoted_string: '"' string_part* '"'   (or termChar instead of ")
+     * string_part:   var_reference | nested_cmd | char+
+     */
+
+
+    while ((src != lastChar) && (c != termChar)) {
+	if (c == '$') {
+	    result = TclCompileDollarVar(interp, src, lastChar, flags,
+		    envPtr);
+	    src += envPtr->termOffset;
+	    if (result != TCL_OK) {
+		goto done;
+	    }
+	    maxDepth = TclMax((numParts + envPtr->maxStackDepth), maxDepth);
+	    c = *src;
+        } else if (c == '[') {
+	    char *termPtr;
+	    envPtr->pushSimpleWords = 1;
+	    src++;
+	    result = TclCompileString(interp, src, lastChar,
+				      (flags | TCL_BRACKET_TERM), envPtr);
+	    termPtr = (src + envPtr->termOffset);
+	    if (*termPtr == ']') {
+		termPtr++;
+	    }
+	    src = termPtr;
+	    if (result != TCL_OK) {
+		goto done;
+	    }
+	    if (termPtr == lastChar) {
+		/*
+		 * Missing ] at end of nested command.
+		 */
+		
+		Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		        "missing close-bracket", -1);
+		result = TCL_ERROR;
+		goto done;
+	    }
+	    maxDepth = TclMax((numParts + envPtr->maxStackDepth), maxDepth);
+	    c = *src;
+        } else {
+	    /*
+	     * Start of a char+ string_part. Scan first looking for any
+	     * backslashes.
+	     */
+
+	    start = src;
+	    hasBackslash = 0;
+	    do {
+		if (c == '\\') {
+		    hasBackslash = 1;
+		    Tcl_Backslash(src, &numRead);
+		    src += numRead;
+		} else {
+		    src++;
+		}
+		c = *src;
+            } while ((src != lastChar) && (c != '$') && (c != '[')
+		    && (c != termChar));
+	    
+	    if ((numParts == 0) && !hasBackslash
+		    && ((src == lastChar) && (c == termChar))) {
+		/*
+		 * The quoted string is "simple": just a sequence of
+		 * characters without backslashes terminated by termChar or
+		 * a null character. Just return if we are not to compile
+		 * simple words.
+		 */
+
+		simpleWord = 1;
+		if (!envPtr->pushSimpleWords) {
+		    if ((src == lastChar) && (termChar != '\0')) {
+			char buf[40];
+			sprintf(buf, "missing %c", termChar);
+			Tcl_ResetResult(interp);
+			Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
+			result = TCL_ERROR;
+		    } else {
+			src++;
+		    }
+		    envPtr->wordIsSimple = 1;
+		    envPtr->numSimpleWordChars = (src - string - 1);
+		    envPtr->termOffset = (src - string);
+		    envPtr->pushSimpleWords = savePushSimpleWords;
+		    return result;
+		}
+	    }
+
+	    /*
+	     * Create and push a string object for the char+ string_part
+	     * that starts at "start" and ends at the char just before
+	     * src. If backslashes were found, copy the string_part's
+	     * characters with substituted backslashes into a heap-allocated
+	     * buffer and use it to create the string object. Temporarily
+	     * replace the terminating character with a null character.
+	     */
+	    
+	    numChars = (src - start);
+	    savedChar = start[numChars];
+	    start[numChars] = '\0';
+	    if ((numChars > 0) && (hasBackslash)) {
+		char *buffer = ckalloc((unsigned) numChars + 1);
+		register char *dst = buffer;
+		register char *p = start;
+		while (p < src) {
+		    if (*p == '\\') {
+			*dst++ = Tcl_Backslash(p, &numRead);
+			p += numRead;
+		    } else {
+			*dst++ = *p++;
+		    }
+		}
+		*dst = '\0';
+		objIndex = TclObjIndexForString(buffer, (dst - buffer),
+			/*allocStrRep*/ 1, /*inHeap*/ 1, envPtr);
+	    } else {
+		objIndex = TclObjIndexForString(start, numChars,
+			/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+	    }
+	    start[numChars] = savedChar;
+	    TclEmitPush(objIndex, envPtr);
+	    maxDepth = TclMax((numParts + 1), maxDepth);
+        }
+	numParts++;
+    } 
+	    
+    /*
+     * End of the quoted string: src points at termChar or '\0'. If
+     * necessary, concatenate the string_part objects on the stack.
+     */
+
+    if ((src == lastChar) && (termChar != '\0')) {
+	char buf[40];
+	sprintf(buf, "missing %c", termChar);
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
+	result = TCL_ERROR;
+	goto done;
+    } else {
+	src++;
+    }
+
+    if (numParts == 0) {
+	/*
+	 * The quoted string was empty. Push an empty string object.
+	 */
+
+	int objIndex = TclObjIndexForString("", 0, /*allocStrRep*/ 0,
+                                            /*inHeap*/ 0, envPtr);
+	TclEmitPush(objIndex, envPtr);
+    } else {
+	/*
+	 * Emit any needed concat instructions.
+	 */
+	
+	while (numParts > 255) {
+	    TclEmitInstUInt1(INST_CONCAT1, 255, envPtr);
+	    numParts -= 254;  /* concat pushes 1 obj, the result */
+	}
+	if (numParts > 1) {
+	    TclEmitInstUInt1(INST_CONCAT1, numParts, envPtr);
+	}
+    }
+
+    done:
+    if (simpleWord) {
+	envPtr->wordIsSimple = 1;
+	envPtr->numSimpleWordChars = (src - string - 1);
+    } else {
+	envPtr->wordIsSimple = 0;
+	envPtr->numSimpleWordChars = 0;
+    }
+    envPtr->termOffset = (src - string);
+    envPtr->maxStackDepth = maxDepth;
+    envPtr->pushSimpleWords = savePushSimpleWords;
+    return result;
+}
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CompileBraces --
+ *
+ *	This procedure compiles characters between matching curly braces.
+ *
+ *	Ordinarily, callers set envPtr->pushSimpleWords to 1 and
+ *	CompileBraces always emits a push instruction to compute the word on
+ *	the Tcl evaluation stack at execution time. However, if a caller
+ *	sets envPtr->pushSimpleWords to 0, CompileBraces will _not_ compile
+ *	"simple" words: words that are just a sequence of characters without
+ *	backslash-newlines. It will leave their compilation up to the
+ *	caller.
+ *
+ *	As an important special case, if the word is simple, this procedure
+ *	sets envPtr->wordIsSimple to 1 and envPtr->numSimpleWordChars to the
+ *	number of characters in the simple word. This allows the caller to
+ *	process these words specially.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is TCL_OK unless
+ *	there was an error while parsing string. If an error occurs then
+ *	the interpreter's result contains a standard error message.
+ *
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed. This is
+ *	usually the character just after the matching close-brace.
+ *
+ *	envPtr->wordIsSimple is set 1 if the word is simple: just a
+ *	sequence of characters without backslash-newlines. If so, the word's
+ *	characters are the envPtr->numSimpleWordChars characters starting 
+ *	at string.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to evaluate the word. This is not changed if
+ *	the word is simple and envPtr->pushSimpleWords was 0 (false).
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to push the braced string
+ *	at runtime.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CompileBraces(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		 /* Interpreter to use for nested command
+				  * evaluations and error messages. */
+    char *string;		 /* Character just after opening bracket. */
+    char *lastChar;		 /* Pointer to terminating character of
+				  * string. */
+    int flags;			 /* Flags to control compilation (same 
+				  * values passed to Tcl_Eval). */
+    CompileEnv *envPtr;		 /* Holds the resulting instructions. */
+{
+    register char *src = string; /* Points to current source char. */
+    register char c;		 /* The current char. */
+    int simpleWord = 0;		 /* Set 1 if a simple braced string word. */
+    int level = 1;		 /* {} nesting level. Initially 1 since {
+				  * was parsed before we were called. */
+    int hasBackslashNewline = 0; /* Nonzero if '\' found. */
+    char *last;			 /* Points just before terminating '}'. */
+    int numChars;		 /* Number of chars in braced string. */
+    char savedChar;		 /* Holds the character from string
+				  * termporarily replaced by a null 
+				  * char during braced string processing. */
+    int objIndex;		 /* The object array index for a pushed
+				  * object holding a braced string. */
+    int numRead;
+    int result = TCL_OK;
+
+    /*
+     * Check for any backslash-newlines, since we must treat
+     * backslash-newlines specially (they must be replaced by spaces).
+     */
+
+    while (1) {
+	c = *src;
+	if (src == lastChar) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		    "missing close-brace", -1);
+	    result = TCL_ERROR;
+	    goto done;
+	}
+	if (CHAR_TYPE(src, lastChar) != TCL_NORMAL) {
+	    if (c == '{') {
+		level++;
+	    } else if (c == '}') {
+		--level;
+		if (level == 0) {
+		    src++;
+		    last = (src - 2); /* point just before terminating } */
+		    break;
+		}
+	    } else if (c == '\\') {
+		if (*(src+1) == '\n') {
+		    hasBackslashNewline = 1;
+		}
+		(void) Tcl_Backslash(src, &numRead);
+		src += numRead - 1;
+	    }
+	}
+	src++;
+    }
+
+    if (!hasBackslashNewline) {
+	/*
+	 * The braced word is "simple": just a sequence of characters
+	 * without backslash-newlines. Just return if we are not to compile
+	 * simple words.
+	 */
+
+	simpleWord = 1;
+	if (!envPtr->pushSimpleWords) {
+	    envPtr->wordIsSimple = 1;
+	    envPtr->numSimpleWordChars = (src - string - 1);
+	    envPtr->termOffset = (src - string);
+	    return TCL_OK;
+	}
+    }
+
+    /*
+     * Create and push a string object for the braced string. This starts at
+     * "string" and ends just after "last" (which points to the final
+     * character before the terminating '}'). If backslash-newlines were
+     * found, we copy characters one at a time into a heap-allocated buffer
+     * and do backslash-newline substitutions.
+     */
+
+    numChars = (last - string + 1);
+    savedChar = string[numChars];
+    string[numChars] = '\0';
+    if ((numChars > 0) && (hasBackslashNewline)) {
+	char *buffer = ckalloc((unsigned) numChars + 1);
+	register char *dst = buffer;
+	register char *p = string;
+	while (p <= last) {
+	    c = *dst++ = *p++;
+	    if (c == '\\') {
+		if (*p == '\n') {
+		    dst[-1] = Tcl_Backslash(p-1, &numRead);
+		    p += numRead - 1;
+		} else {
+		    (void) Tcl_Backslash(p-1, &numRead);
+		    while (numRead > 1) {
+			*dst++ = *p++;
+			numRead--;
+		    }
+		}
+	    }
+	}
+	*dst = '\0';
+	objIndex = TclObjIndexForString(buffer, (dst - buffer),
+		/*allocStrRep*/ 1, /*inHeap*/ 1, envPtr);
+    } else {
+	objIndex = TclObjIndexForString(string, numChars, /*allocStrRep*/ 1,
+                                        /*inHeap*/ 0, envPtr);
+    }
+    string[numChars] = savedChar;
+    TclEmitPush(objIndex, envPtr);
+
+    done:
+    if (simpleWord) {
+	envPtr->wordIsSimple = 1;
+	envPtr->numSimpleWordChars = (src - string - 1);
+    } else {
+	envPtr->wordIsSimple = 0;
+	envPtr->numSimpleWordChars = 0;
+    }
+    envPtr->termOffset = (src - string);
+    envPtr->maxStackDepth = 1;
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileDollarVar --
+ *
+ *	Given a string starting with a $ sign, parse a variable name
+ *	and compile instructions to push its value. If the variable
+ *	reference is just a '$' (i.e. the '$' isn't followed by anything
+ *	that could possibly be a variable name), just push a string object
+ *	containing '$'.
+ *
+ * Results:
+ *	The return value is a standard Tcl result. If an error occurs
+ *	then an error message is left in the interpreter's result.
+ *
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one in the variable reference.
+ *
+ *	envPtr->wordIsSimple is set 0 (false) because the word is not
+ *	simple: it is not just a sequence of characters without backslashes.
+ *	For the same reason, envPtr->numSimpleWordChars is set 0.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the string's commands.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to look up the variable and
+ *	push its value at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+    
+int
+TclCompileDollarVar(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		 /* Interpreter to use for nested command
+				  * evaluations and error messages. */
+    char *string;		 /* First char (i.e. $) of var reference. */
+    char *lastChar;		 /* Pointer to terminating character of
+				  * string. */
+    int flags;			 /* Flags to control compilation (same
+				  * values passed to Tcl_Eval). */
+    CompileEnv *envPtr;		 /* Holds the resulting instructions. */
+{
+    register char *src = string; /* Points to current source char. */
+    register char c;		 /* The current char. */
+    char *name;			 /* Start of 1st part of variable name. */
+    int nameChars;		 /* Count of chars in name. */
+    int nameHasNsSeparators = 0; /* Set 1 if name contains "::"s. */
+    char savedChar;		 /* Holds the character from string
+				  * termporarily replaced by a null 
+				  * char during name processing. */
+    int objIndex;		 /* The object array index for a pushed
+				  * object holding a name part. */
+    int isArrayRef = 0;		 /* 1 if reference to array element. */
+    int localIndex = -1;	 /* Frame index of local if found.  */
+    int maxDepth = 0;		 /* Maximum number of stack elements needed
+				  * to push the variable. */
+    int savePushSimpleWords = envPtr->pushSimpleWords;
+    int result = TCL_OK;
+
+    /*
+     * var_reference: '$' '{' braced_name '}' |
+     *                '$' name ['(' index_string ')']
+     *
+     * There are three cases:
+     * 1. The $ sign is followed by an open curly brace. Then the variable
+     *    name is everything up to the next close curly brace, and the
+     *    variable is a scalar variable.
+     * 2. The $ sign is not followed by an open curly brace. Then the
+     *    variable name is everything up to the next character that isn't
+     *    a letter, digit, underscore, or a "::" namespace separator. If the
+     *    following character is an open parenthesis, then the information
+     *    between parentheses is the array element name, which can include
+     *    any of the substitutions permissible between quotes.
+     * 3. The $ sign is followed by something that isn't a letter, digit,
+     *    underscore, or a "::" namespace separator: in this case,
+     *    there is no variable name, and "$" is pushed.
+     */
+
+    src++;			/* advance over the '$'. */
+
+    /*
+     * Collect the first part of the variable's name into "name" and
+     * determine if it is an array reference and if it contains any
+     * namespace separator (::'s).
+     */
+    
+    if (*src == '{') {
+        /*
+	 * A scalar name in braces.
+	 */
+
+	char *p;
+
+	src++;
+        name = src;
+        c = *src;
+	while (c != '}') {
+	    if (src == lastChar) {
+		Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+			"missing close-brace for variable name", -1);
+		result = TCL_ERROR;
+		goto done;
+	    }
+	    src++;
+	    c = *src;
+	}
+	nameChars = (src - name);
+	for (p = name;  p < src;  p++) {
+	    if ((*p == ':') && (*(p+1) == ':')) {
+		nameHasNsSeparators = 1;
+		break;
+	    }
+	}
+	src++;			/* advance over the '}'. */
+    } else {
+	/*
+	 * Scalar name or array reference not in braces.
+	 */
+	
+        name = src;
+        c = *src;
+        while (isalnum(UCHAR(c)) || (c == '_') || (c == ':')) {
+	    if (c == ':') {
+                if (*(src+1) == ':') {
+		    nameHasNsSeparators = 1;
+                    src += 2;
+		    while (*src == ':') {
+			src++;
+		    }
+                    c = *src;
+                } else {
+                    break;	/* : by itself */
+                }
+            } else {
+                src++;
+                c = *src;
+            }
+	}
+	if (src == name) {
+	    /*
+	     * A '$' by itself, not a name reference. Push a "$" string.
+	     */
+
+	    objIndex = TclObjIndexForString("$", 1, /*allocStrRep*/ 1,
+                                            /*inHeap*/ 0, envPtr);
+	    TclEmitPush(objIndex, envPtr);
+	    maxDepth = 1;
+	    goto done;
+	}
+	nameChars = (src - name);
+	isArrayRef = (c == '(');
+    }
+
+    /*
+     * Now emit instructions to load the variable. First either push the
+     * name of the scalar or array, or determine its index in the array of
+     * local variables in a procedure frame. Push the name if we are not
+     * compiling a procedure body or if the name has namespace
+     * qualifiers ("::"s).
+     */
+    
+    if (!isArrayRef) {		/* scalar reference */
+	if ((envPtr->procPtr == NULL) || nameHasNsSeparators) {
+	    savedChar = name[nameChars];
+	    name[nameChars] = '\0';
+	    objIndex = TclObjIndexForString(name, nameChars,
+		    /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+	    name[nameChars] = savedChar;
+	    TclEmitPush(objIndex, envPtr);
+	    TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr);
+	    maxDepth = 1;
+	} else {
+	    localIndex = LookupCompiledLocal(name, nameChars,
+	            /*createIfNew*/ 0, /*flagsIfCreated*/ 0,
+		    envPtr->procPtr);
+	    if (localIndex >= 0) {
+		if (localIndex <= 255) {
+		    TclEmitInstUInt1(INST_LOAD_SCALAR1, localIndex, envPtr);
+		} else {
+		    TclEmitInstUInt4(INST_LOAD_SCALAR4, localIndex, envPtr);
+		}
+		maxDepth = 0;
+	    } else {
+		savedChar = name[nameChars];
+		name[nameChars] = '\0';
+		objIndex = TclObjIndexForString(name, nameChars,
+			/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+		name[nameChars] = savedChar;
+		TclEmitPush(objIndex, envPtr); 
+		TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr);
+		maxDepth = 1;
+	    }
+	}
+    } else {			/* array reference */
+	if ((envPtr->procPtr == NULL) || nameHasNsSeparators) {
+	    savedChar = name[nameChars];
+	    name[nameChars] = '\0';
+	    objIndex = TclObjIndexForString(name, nameChars,
+		    /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+	    name[nameChars] = savedChar;
+	    TclEmitPush(objIndex, envPtr);
+	    maxDepth = 1;
+	} else {
+	    localIndex = LookupCompiledLocal(name, nameChars,
+	            /*createIfNew*/ 0, /*flagsIfCreated*/ 0,
+		    envPtr->procPtr);
+	    if (localIndex < 0) {
+		savedChar = name[nameChars];
+		name[nameChars] = '\0';
+		objIndex = TclObjIndexForString(name, nameChars,
+			/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+		name[nameChars] = savedChar;
+		TclEmitPush(objIndex, envPtr);
+		maxDepth = 1;
+	    }
+	}
+
+	/*
+	 * Parse and push the array element. Perform substitutions on it,
+	 * just as is done for quoted strings.
+	 */
+
+	src++;
+	envPtr->pushSimpleWords = 1;
+	result = TclCompileQuotes(interp, src, lastChar, ')', flags,
+		envPtr);
+	src += envPtr->termOffset;
+	if (result != TCL_OK) {
+	    char msg[200];
+	    sprintf(msg, "\n    (parsing index for array \"%.*s\")",
+		    (nameChars > 100? 100 : nameChars), name);
+	    Tcl_AddObjErrorInfo(interp, msg, -1);
+	    goto done;
+	}
+	maxDepth += envPtr->maxStackDepth;
+
+	/*
+	 * Now emit the appropriate load instruction for the array element.
+	 */
+
+	if (localIndex < 0) {	/* a global or an unknown local */
+	    TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
+	} else {
+	    if (localIndex <= 255) {
+		TclEmitInstUInt1(INST_LOAD_ARRAY1, localIndex, envPtr);
+	    } else {
+		TclEmitInstUInt4(INST_LOAD_ARRAY4, localIndex, envPtr);
+	    }
+	}
+    }
+
+    done:
+    envPtr->termOffset = (src - string);
+    envPtr->wordIsSimple = 0;
+    envPtr->numSimpleWordChars = 0;
+    envPtr->maxStackDepth = maxDepth;
+    envPtr->pushSimpleWords = savePushSimpleWords;
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * IsLocalScalar --
+ *
+ *	Checks to see if a variable name refers to a local scalar.
+ *
+ * Results:
+ *	Returns 1 if the variable is a local scalar.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+IsLocalScalar(varName, length)
+    char *varName;		/* The name to check. */
+    int length;		/* The number of characters in the string.  */
+{
+    char *p;
+    char *lastChar = varName + (length - 1);
+
+    for (p = varName; p <= lastChar; p++) {
+	if ((CHAR_TYPE(p, lastChar) != TCL_NORMAL) &&
+	    (CHAR_TYPE(p, lastChar) != TCL_COMMAND_END)) {
+	    /*
+	     * TCL_COMMAND_END is returned for the last character
+	     * of the string.  By this point we know it isn't
+	     * an array or namespace reference.
+	     */
+
+	    return 0;
+	}
+	if  (*p == '(') {
+	    if (*lastChar == ')') { /* we have an array element */
+		return 0;
+	    }
+	} else if (*p == ':') {
+	    if ((p != lastChar) && *(p+1) == ':') { /* qualified name */
+		return 0;
+	    }
+	}
+    }
+	
+    return 1;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileBreakCmd --
+ *
+ *	Procedure called to compile the "break" command.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is TCL_OK unless
+ *	there was an error while parsing string. If an error occurs then
+ *	the interpreter's result contains a standard error message.
+ *
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the command.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to evaluate the "break" command
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileBreakCmd(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *string;		/* The source string to compile. */
+    char *lastChar;		/* Pointer to terminating character of
+				 * string. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    register char *src = string;/* Points to current source char. */
+    register int type;		/* Current char's CHAR_TYPE type. */
+    int result = TCL_OK;
+    
+    /*
+     * There should be no argument after the "break".
+     */
+
+    type = CHAR_TYPE(src, lastChar);
+    if (type != TCL_COMMAND_END) {
+	AdvanceToNextWord(src, envPtr);
+	src += envPtr->termOffset;
+	type = CHAR_TYPE(src, lastChar);
+	if (type != TCL_COMMAND_END) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	            "wrong # args: should be \"break\"", -1);
+	    result = TCL_ERROR;
+	    goto done;
+	}
+    }
+
+    /*
+     * Emit a break instruction.
+     */
+
+    TclEmitOpcode(INST_BREAK, envPtr);
+
+    done:
+    envPtr->termOffset = (src - string);
+    envPtr->maxStackDepth = 0;
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileCatchCmd --
+ *
+ *	Procedure called to compile the "catch" command.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is TCL_OK if
+ *	compilation was successful. If an error occurs then the
+ *	interpreter's result contains a standard error message and TCL_ERROR
+ *	is returned. If compilation failed because the command is too
+ *	complex for TclCompileCatchCmd, TCL_OUT_LINE_COMPILE is returned
+ *	indicating that the catch command should be compiled "out of line"
+ *	by emitting code to invoke its command procedure at runtime.
+ *
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the command.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to evaluate the "catch" command
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileCatchCmd(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *string;		/* The source string to compile. */
+    char *lastChar;		/* Pointer to terminating character of
+				 * string. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    Proc *procPtr = envPtr->procPtr;
+    				/* Points to structure describing procedure
+				 * containing the catch cmd, else NULL. */
+    int maxDepth = 0;           /* Maximum number of stack elements needed
+				 * to execute cmd. */
+    ArgInfo argInfo;		/* Structure holding information about the
+				 * start and end of each argument word. */
+    int range = -1;		/* If we compile the catch command, the
+				 * index for its catch range record in the
+				 * ExceptionRange array. -1 if we are not
+				 * compiling the command. */
+    char *name;			/* If a var name appears for a scalar local
+				 * to a procedure, this points to the name's
+				 * 1st char and nameChars is its length. */
+    int nameChars;		/* Length of the variable name, if any. */
+    int localIndex = -1;        /* Index of the variable in the current
+				 * procedure's array of local variables.
+				 * Otherwise -1 if not in a procedure or
+				 * the variable wasn't found. */
+    char savedChar;		/* Holds the character from string
+				 * termporarily replaced by a null character
+				 * during processing of words. */
+    JumpFixup jumpFixup;	/* Used to emit the jump after the "no
+				 * errors" epilogue code. */
+    int numWords, objIndex, jumpDist, result;
+    char *bodyStart, *bodyEnd;
+    Tcl_Obj *objPtr;
+    int savePushSimpleWords = envPtr->pushSimpleWords;
+
+    /*
+     * Scan the words of the command and record the start and finish of
+     * each argument word.
+     */
+
+    InitArgInfo(&argInfo);
+    result = CollectArgInfo(interp, string, lastChar, flags, &argInfo);
+    numWords = argInfo.numArgs;	  /* i.e., the # after the command name */
+    if (result != TCL_OK) {
+	goto done;
+    }
+    if ((numWords != 1) && (numWords != 2)) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	        "wrong # args: should be \"catch command ?varName?\"", -1);
+        result = TCL_ERROR;
+	goto done;
+    }
+
+    /*
+     * If a variable was specified and the catch command is at global level
+     * (not in a procedure), don't compile it inline: the payoff is
+     * too small.
+     */
+
+    if ((numWords == 2) && (procPtr == NULL)) {
+	result = TCL_OUT_LINE_COMPILE;
+        goto done;
+    }
+
+    /*
+     * Make sure the variable name, if any, has no substitutions and just
+     * refers to a local scaler.
+     */
+
+    if (numWords == 2) {
+	char *firstChar = argInfo.startArray[1];
+	char *lastChar  = argInfo.endArray[1];
+	
+	if (*firstChar == '{') {
+	    if (*lastChar != '}') {
+		Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		        "extra characters after close-brace", -1);
+		result = TCL_ERROR;
+		goto done;
+	    }
+	    firstChar++;
+	    lastChar--;
+	}
+
+	nameChars = (lastChar - firstChar + 1);
+	if (!IsLocalScalar(firstChar, nameChars)) {
+	    result = TCL_OUT_LINE_COMPILE;
+	    goto done;
+	}
+
+	name = firstChar;
+	localIndex = LookupCompiledLocal(name, nameChars,
+                    /*createIfNew*/ 1, /*flagsIfCreated*/ VAR_SCALAR,
+		    procPtr);
+    }
+
+    /*
+     *==== At this point we believe we can compile the catch command ====
+     */
+
+    /*
+     * Create and initialize a ExceptionRange record to hold information
+     * about this catch command.
+     */
+    
+    envPtr->excRangeDepth++;
+    envPtr->maxExcRangeDepth =
+	TclMax(envPtr->excRangeDepth, envPtr->maxExcRangeDepth);
+    range = CreateExceptionRange(CATCH_EXCEPTION_RANGE, envPtr);
+
+    /*
+     * Emit the instruction to mark the start of the catch command.
+     */
+    
+    TclEmitInstUInt4(INST_BEGIN_CATCH4, range, envPtr);
+    
+    /*
+     * Inline compile the catch's body word: the command it controls. Also
+     * register the body's starting PC offset and byte length in the
+     * ExceptionRange record.
+     */
+
+    envPtr->excRangeArrayPtr[range].codeOffset = TclCurrCodeOffset();
+
+    bodyStart = argInfo.startArray[0];
+    bodyEnd   = argInfo.endArray[0];
+    savedChar = *(bodyEnd+1);
+    *(bodyEnd+1) = '\0';
+    result = CompileCmdWordInline(interp, bodyStart, (bodyEnd+1),
+	    flags, envPtr);
+    *(bodyEnd+1) = savedChar;
+    
+    if (result != TCL_OK) {
+	if (result == TCL_ERROR) {
+	    char msg[60];
+	    sprintf(msg, "\n    (\"catch\" body line %d)",
+		    interp->errorLine);
+            Tcl_AddObjErrorInfo(interp, msg, -1);
+        }
+	goto done;
+    }
+    maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+    envPtr->excRangeArrayPtr[range].numCodeBytes =
+	TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range].codeOffset;
+
+    /*
+     * Now emit the "no errors" epilogue code for the catch. First, if a
+     * variable was specified, store the body's result into the
+     * variable; otherwise, just discard the body's result. Then push
+     * a "0" object as the catch command's "no error" TCL_OK result,
+     * and jump around the "error case" epilogue code.
+     */
+
+    if (localIndex != -1) {
+	if (localIndex <= 255) {
+	    TclEmitInstUInt1(INST_STORE_SCALAR1, localIndex, envPtr);
+	} else {
+	    TclEmitInstUInt4(INST_STORE_SCALAR4, localIndex, envPtr);
+	}
+    }
+    TclEmitOpcode(INST_POP, envPtr);
+
+    objIndex = TclObjIndexForString("0", 1, /*allocStrRep*/ 0, /*inHeap*/ 0,
+	    envPtr);
+    objPtr = envPtr->objArrayPtr[objIndex];
+    
+    Tcl_InvalidateStringRep(objPtr);
+    objPtr->internalRep.longValue = 0;
+    objPtr->typePtr = &tclIntType;
+    
+    TclEmitPush(objIndex, envPtr);
+    if (maxDepth == 0) {
+	maxDepth = 1;	/* since we just pushed one object */
+    }
+    
+    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
+
+    /*
+     * Now emit the "error case" epilogue code. First, if a variable was
+     * specified, emit instructions to push the interpreter's object result
+     * and store it into the variable. Then emit an instruction to push the
+     * nonzero error result. Note that the initial PC offset here is the
+     * catch's error target.
+     */
+
+    envPtr->excRangeArrayPtr[range].catchOffset = TclCurrCodeOffset();
+    if (localIndex != -1) {
+	TclEmitOpcode(INST_PUSH_RESULT, envPtr);
+	if (localIndex <= 255) {
+	    TclEmitInstUInt1(INST_STORE_SCALAR1, localIndex, envPtr);
+	} else {
+	    TclEmitInstUInt4(INST_STORE_SCALAR4, localIndex, envPtr);
+	}
+	TclEmitOpcode(INST_POP, envPtr);
+    }
+    TclEmitOpcode(INST_PUSH_RETURN_CODE, envPtr);
+
+    /*
+     * Now that we know the target of the jump after the "no errors"
+     * epilogue, update it with the correct distance. This is less
+     * than 127 bytes.
+     */
+
+    jumpDist = (TclCurrCodeOffset() - jumpFixup.codeOffset);
+    if (TclFixupForwardJump(envPtr, &jumpFixup, jumpDist, 127)) {
+	panic("TclCompileCatchCmd: bad jump distance %d\n", jumpDist);
+    }
+
+    /*
+     * Emit the instruction to mark the end of the catch command.
+     */
+
+    TclEmitOpcode(INST_END_CATCH, envPtr);
+
+    done:
+    if (numWords == 0) {
+	envPtr->termOffset = 0;
+    } else {
+	envPtr->termOffset = (argInfo.endArray[numWords-1] + 1 - string);
+    }
+    if (range != -1) {		/* we compiled the catch command */
+	envPtr->excRangeDepth--;
+    }
+    envPtr->pushSimpleWords = savePushSimpleWords;
+    envPtr->maxStackDepth = maxDepth;
+    FreeArgInfo(&argInfo);
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileContinueCmd --
+ *
+ *	Procedure called to compile the "continue" command.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is TCL_OK unless
+ *	there was an error while parsing string. If an error occurs then
+ *	the interpreter's result contains a standard error message.
+ *
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the command.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to evaluate the "continue" command
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileContinueCmd(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *string;		/* The source string to compile. */
+    char *lastChar;		/* Pointer to terminating character of
+				 * string. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    register char *src = string;/* Points to current source char. */
+    register int type;		/* Current char's CHAR_TYPE type. */
+    int result = TCL_OK;
+    
+    /*
+     * There should be no argument after the "continue".
+     */
+
+    type = CHAR_TYPE(src, lastChar);
+    if (type != TCL_COMMAND_END) {
+	AdvanceToNextWord(src, envPtr);
+	src += envPtr->termOffset;
+	type = CHAR_TYPE(src, lastChar);
+	if (type != TCL_COMMAND_END) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	            "wrong # args: should be \"continue\"", -1);
+	    result = TCL_ERROR;
+	    goto done;
+	}
+    }
+
+    /*
+     * Emit a continue instruction.
+     */
+
+    TclEmitOpcode(INST_CONTINUE, envPtr);
+
+    done:
+    envPtr->termOffset = (src - string);
+    envPtr->maxStackDepth = 0;
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileExprCmd --
+ *
+ *	Procedure called to compile the "expr" command.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is TCL_OK
+ *	unless there was an error while parsing string. If an error occurs
+ *	then the interpreter's result contains a standard error message.
+ *
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the "expr" command.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to evaluate the "expr" command
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileExprCmd(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *string;		/* The source string to compile. */
+    char *lastChar;		/* Pointer to terminating character of
+				 * string. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute cmd. */
+    ArgInfo argInfo;		/* Structure holding information about the
+				 * start and end of each argument word. */
+    Tcl_DString buffer;		/* Holds the concatenated expr command
+				 * argument words. */
+    int firstWord;		/* 1 if processing the first word; 0 if
+				 * processing subsequent words. */
+    char *first, *last;		/* Points to the first and last significant
+				 * chars of the concatenated expression. */
+    int inlineCode;		/* 1 if inline "optimistic" code is
+				 * emitted for the expression; else 0. */
+    int range = -1;		/* If we inline compile the concatenated
+				 * expression, the index for its catch range
+				 * record in the ExceptionRange array.
+				 * Initialized to avoid compile warning. */
+    JumpFixup jumpFixup;	/* Used to emit the "success" jump after
+				 * the inline concat. expression's code. */
+    char savedChar;		/* Holds the character termporarily replaced
+				 * by a null character during compilation
+				 * of the concatenated expression. */
+    int numWords, objIndex, i, result;
+    char *wordStart, *wordEnd, *p;
+    char c;
+    int savePushSimpleWords = envPtr->pushSimpleWords;
+    int saveExprIsJustVarRef = envPtr->exprIsJustVarRef;
+    int saveExprIsComparison = envPtr->exprIsComparison;
+
+    /*
+     * Scan the words of the command and record the start and finish of
+     * each argument word.
+     */
+
+    InitArgInfo(&argInfo);
+    result = CollectArgInfo(interp, string, lastChar, flags, &argInfo);
+    numWords = argInfo.numArgs;	  /* i.e., the # after the command name */
+    if (result != TCL_OK) {
+	goto done;
+    }
+    if (numWords == 0) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	        "wrong # args: should be \"expr arg ?arg ...?\"", -1);
+        result = TCL_ERROR;
+	goto done;
+    }
+
+    /*
+     * If there is a single argument word and it is enclosed in {}s, we may
+     * strip them off and safely compile the expr command into an inline
+     * sequence of instructions using TclCompileExpr. We know these
+     * instructions will have the right Tcl7.x expression semantics.
+     *
+     * Otherwise, if the word is not enclosed in {}s, or there are multiple
+     * words, we may need to call the expr command (Tcl_ExprObjCmd) at
+     * runtime. This recompiles the expression each time (typically) and so
+     * is slow. However, there are some circumstances where we can still
+     * compile inline instructions "optimistically" and check, during their
+     * execution, for double substitutions (these appear as nonnumeric
+     * operands). We check for any backslash or command substitutions. If
+     * none appear, and only variable substitutions are found, we generate
+     * inline instructions. If there is a compilation error, we must emit
+     * instructions that return the error at runtime, since this is when
+     * scripts in Tcl7.x would "see" the error.
+     *
+     * For now, if there are multiple words, or the single argument word is
+     * not in {}s, we concatenate the argument words and strip off any
+     * enclosing {}s or ""s. We call the expr command at runtime if
+     * either command or backslash substitutions appear (but not if
+     * only variable substitutions appear).
+     */
+
+    if (numWords == 1) {
+	wordStart = argInfo.startArray[0]; /* start of 1st arg word */
+	wordEnd   = argInfo.endArray[0];   /* last char of 1st arg word */
+	if ((*wordStart == '{') && (*wordEnd == '}')) {
+	    /*
+	     * Simple case: a single argument word in {}'s. 
+	     */
+
+	    *wordEnd = '\0';
+	    result = TclCompileExpr(interp, (wordStart + 1), wordEnd,
+		    flags, envPtr);
+	    *wordEnd = '}';
+	    
+	    envPtr->termOffset = (wordEnd + 1) - string;
+	    envPtr->pushSimpleWords = savePushSimpleWords;
+	    FreeArgInfo(&argInfo);
+	    return result;
+	}
+    }
+	
+    /*
+     * There are multiple words or no braces around the single word.
+     * Concatenate the expression's argument words while stripping off
+     * any enclosing {}s or ""s.
+     */
+    
+    Tcl_DStringInit(&buffer);
+    firstWord = 1;
+    for (i = 0;  i < numWords;  i++) {
+	wordStart = argInfo.startArray[i];
+	wordEnd   = argInfo.endArray[i];
+	if (((*wordStart == '{') && (*wordEnd == '}'))
+	        || ((*wordStart == '"') && (*wordEnd == '"'))) {
+	    wordStart++;
+	    wordEnd--;
+	}
+	if (!firstWord) {
+	    Tcl_DStringAppend(&buffer, " ", 1);
+	}
+	firstWord = 0;
+	if (wordEnd >= wordStart) {
+	    Tcl_DStringAppend(&buffer, wordStart, (wordEnd-wordStart+1));
+	}
+    }
+
+    /*
+     * Scan the concatenated expression's characters looking for any
+     * '['s or '\'s or '$'s. If any are found, just call the expr cmd
+     * at runtime.
+     */
+    
+    inlineCode = 1;
+    first = Tcl_DStringValue(&buffer);
+    last = first + (Tcl_DStringLength(&buffer) - 1);
+    for (p = first;  p <= last;  p++) {
+	c = *p;
+	if ((c == '[') || (c == '\\') || (c == '$')) {
+	    inlineCode = 0;
+	    break;
+	}
+    }
+
+    if (inlineCode) {
+	/*
+	 * Inline compile the concatenated expression inside a "catch"
+	 * so that a runtime error will back off to a (slow) call on expr.
+	 */
+	
+	int startCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+	int startRangeNext = envPtr->excRangeArrayNext;
+	
+	/*
+	 * Create a ExceptionRange record to hold information about the
+	 * "catch" range for the expression's inline code. Also emit the
+	 * instruction to mark the start of the range.
+	 */
+	
+	envPtr->excRangeDepth++;
+	envPtr->maxExcRangeDepth =
+	        TclMax(envPtr->excRangeDepth, envPtr->maxExcRangeDepth);
+	range = CreateExceptionRange(CATCH_EXCEPTION_RANGE, envPtr);
+	TclEmitInstUInt4(INST_BEGIN_CATCH4, range, envPtr);
+	
+	/*
+	 * Inline compile the concatenated expression.
+	 */
+	
+	envPtr->excRangeArrayPtr[range].codeOffset = TclCurrCodeOffset();
+	savedChar = *(last + 1);
+	*(last + 1) = '\0';
+	result = TclCompileExpr(interp, first, last + 1, flags, envPtr);
+	*(last + 1) = savedChar;
+	
+	maxDepth = envPtr->maxStackDepth;
+	envPtr->excRangeArrayPtr[range].numCodeBytes =
+	        TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range].codeOffset;
+	
+	if ((result != TCL_OK) || (envPtr->exprIsJustVarRef)
+	        || (envPtr->exprIsComparison)) {
+	    /*
+	     * We must call the expr command at runtime. Either there was a
+	     * compilation error or the inline code might fail to give the
+	     * correct 2 level substitution semantics.
+	     *
+	     * The latter can happen if the expression consisted of just a
+	     * single variable reference or if the top-level operator in the
+	     * expr is a comparison (which might operate on strings). In the
+	     * latter case, the expression's code might execute (apparently)
+	     * successfully but produce the wrong result. We depend on its
+	     * execution failing if a second level of substitutions is
+	     * required. This causes the "catch" code we generate around the
+	     * inline code to back off to a call on the expr command at
+	     * runtime, and this always gives the right 2 level substitution
+	     * semantics.
+	     *
+	     * We delete the inline code by backing up the code pc and catch
+	     * index. Note that if there was a compilation error, we can't
+	     * report the error yet since the expression might be valid
+	     * after the second round of substitutions.
+	     */
+	    
+	    envPtr->codeNext = (envPtr->codeStart + startCodeOffset);
+	    envPtr->excRangeArrayNext = startRangeNext;
+	    inlineCode = 0;
+	} else {
+	    TclEmitOpcode(INST_END_CATCH, envPtr); /* for ok case */
+	    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
+	    envPtr->excRangeArrayPtr[range].catchOffset = TclCurrCodeOffset();
+	    TclEmitOpcode(INST_END_CATCH, envPtr); /* for error case */
+	}
+    }
+	    
+    /*
+     * Emit code for the (slow) call on the expr command at runtime.
+     * Generate code to concatenate the (already substituted once)
+     * expression words with a space between each word.
+     */
+    
+    for (i = 0;  i < numWords;  i++) {
+	wordStart = argInfo.startArray[i];
+	wordEnd   = argInfo.endArray[i];
+	savedChar = *(wordEnd + 1);
+	*(wordEnd + 1) = '\0';
+	envPtr->pushSimpleWords = 1;
+	result = CompileWord(interp, wordStart, wordEnd+1, flags, envPtr);
+	*(wordEnd + 1) = savedChar;
+	if (result != TCL_OK) {
+	    break;
+	}
+	if (i != (numWords - 1)) {
+	    objIndex = TclObjIndexForString(" ", 1, /*allocStrRep*/ 1,
+					    /*inHeap*/ 0, envPtr);
+	    TclEmitPush(objIndex, envPtr);
+	    maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
+	} else {
+	    maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+	}
+    }
+    if (result == TCL_OK) {
+	int concatItems = 2*numWords - 1;
+	while (concatItems > 255) {
+	    TclEmitInstUInt1(INST_CONCAT1, 255, envPtr);
+	    concatItems -= 254;  /* concat pushes 1 obj, the result */
+	}
+	if (concatItems > 1) {
+	    TclEmitInstUInt1(INST_CONCAT1, concatItems, envPtr);
+	}
+	TclEmitOpcode(INST_EXPR_STK, envPtr);
+    }
+    
+    /*
+     * If emitting inline code, update the target of the jump after
+     * that inline code.
+     */
+    
+    if (inlineCode) {
+	int jumpDist = (TclCurrCodeOffset() - jumpFixup.codeOffset);
+	if (TclFixupForwardJump(envPtr, &jumpFixup, jumpDist, 127)) {
+	    /*
+	     * Update the inline expression code's catch ExceptionRange
+	     * target since it, being after the jump, also moved down.
+	     */
+	    
+	    envPtr->excRangeArrayPtr[range].catchOffset += 3;
+	}
+    }
+    Tcl_DStringFree(&buffer);
+    
+    done:
+    if (numWords == 0) {
+	envPtr->termOffset = 0;
+    } else {
+	envPtr->termOffset = (argInfo.endArray[numWords-1] + 1 - string);
+    }
+    if (range != -1) {		/* we inline compiled the expr */
+	envPtr->excRangeDepth--;
+    }
+    envPtr->pushSimpleWords = savePushSimpleWords;
+    envPtr->exprIsJustVarRef = saveExprIsJustVarRef;
+    envPtr->exprIsComparison = saveExprIsComparison;
+    envPtr->maxStackDepth = maxDepth;
+    FreeArgInfo(&argInfo);
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileForCmd --
+ *
+ *	Procedure called to compile the "for" command.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is TCL_OK unless
+ *	there was an error while parsing string. If an error occurs then
+ *	the interpreter's result contains a standard error message.
+ *
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the command.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to evaluate the "for" command
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileForCmd(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *string;		/* The source string to compile. */
+    char *lastChar;		/* Pointer to terminating character of
+				 * string. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute cmd. */
+    ArgInfo argInfo;		/* Structure holding information about the
+				 * start and end of each argument word. */
+    int range1 = -1, range2;	/* Indexes in the ExceptionRange array of
+				 * the loop ranges for this loop: one for
+				 * its body and one for its "next" cmd. */
+    JumpFixup jumpFalseFixup;	/* Used to update or replace the ifFalse
+				 * jump after the "for" test when its target
+				 * PC is determined. */
+    int jumpBackDist, jumpBackOffset, testCodeOffset, jumpDist, objIndex;
+    unsigned char *jumpPc;
+    int savePushSimpleWords = envPtr->pushSimpleWords;
+    int numWords, result;
+
+    /*
+     * Scan the words of the command and record the start and finish of
+     * each argument word.
+     */
+
+    InitArgInfo(&argInfo);
+    result = CollectArgInfo(interp, string, lastChar, flags, &argInfo);
+    numWords = argInfo.numArgs;	  /* i.e., the # after the command name */
+    if (result != TCL_OK) {
+	goto done;
+    }
+    if (numWords != 4) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	        "wrong # args: should be \"for start test next command\"", -1);
+	result = TCL_ERROR;
+	goto done;
+    }
+
+    /*
+     * If the test expression is not enclosed in braces, don't compile
+     * the for inline. As a result of Tcl's two level substitution
+     * semantics for expressions, the expression might have a constant
+     * value that results in the loop never executing, or executing forever.
+     * Consider "set x 0; for {} "$x > 5" {incr x} {}": the loop body 
+     * should never be executed.
+     * NOTE: This is an overly aggressive test, since there are legitimate
+     * literals that could be compiled but aren't in braces.  However, until
+     * the parser is integrated in 8.1, this is the simplest implementation.
+     */
+
+    if (*(argInfo.startArray[1]) != '{') {
+	result = TCL_OUT_LINE_COMPILE;
+	goto done;
+    }
+
+    /*
+     * Create a ExceptionRange record for the for loop's body. This is used
+     * to implement break and continue commands inside the body.
+     * Then create a second ExceptionRange record for the "next" command in 
+     * order to implement break (but not continue) inside it. The second,
+     * "next" ExceptionRange will always have a -1 continueOffset.
+     */
+
+    envPtr->excRangeDepth++;
+    envPtr->maxExcRangeDepth =
+	TclMax(envPtr->excRangeDepth, envPtr->maxExcRangeDepth);
+    range1 = CreateExceptionRange(LOOP_EXCEPTION_RANGE, envPtr);
+    range2 = CreateExceptionRange(LOOP_EXCEPTION_RANGE, envPtr);
+
+    /*
+     * Compile inline the next word: the initial command.
+     */
+
+    result = CompileCmdWordInline(interp, argInfo.startArray[0],
+	    (argInfo.endArray[0] + 1), flags, envPtr);
+    if (result != TCL_OK) {
+	if (result == TCL_ERROR) {
+            Tcl_AddObjErrorInfo(interp, "\n    (\"for\" initial command)", -1);
+        }
+	goto done;
+    }
+    maxDepth = envPtr->maxStackDepth;
+
+    /*
+     * Discard the start command's result.
+     */
+
+    TclEmitOpcode(INST_POP, envPtr);
+
+    /*
+     * Compile the next word: the test expression.
+     */
+
+    testCodeOffset = TclCurrCodeOffset();
+    envPtr->pushSimpleWords = 1;    /* process words normally */
+    result = CompileExprWord(interp, argInfo.startArray[1],
+	    (argInfo.endArray[1] + 1), flags, envPtr);
+    if (result != TCL_OK) {
+	if (result == TCL_ERROR) {
+            Tcl_AddObjErrorInfo(interp, "\n    (\"for\" test expression)", -1);
+        }
+	goto done;
+    }
+    maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+
+    /*
+     * Emit the jump that terminates the for command if the test was
+     * false. We emit a one byte (relative) jump here, and replace it later
+     * with a four byte jump if the jump target is > 127 bytes away.
+     */
+
+    TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
+
+    /*
+     * Compile the loop body word inline. Also register the loop body's
+     * starting PC offset and byte length in the its ExceptionRange record.
+     */
+
+    envPtr->excRangeArrayPtr[range1].codeOffset = TclCurrCodeOffset();
+    result = CompileCmdWordInline(interp, argInfo.startArray[3],
+	    (argInfo.endArray[3] + 1), flags, envPtr);
+    if (result != TCL_OK) {
+	if (result == TCL_ERROR) {
+	    char msg[60];
+	    sprintf(msg, "\n    (\"for\" body line %d)", interp->errorLine);
+            Tcl_AddObjErrorInfo(interp, msg, -1);
+        }
+	goto done;
+    }
+    maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+    envPtr->excRangeArrayPtr[range1].numCodeBytes =
+	(TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range1].codeOffset);
+
+    /*
+     * Discard the loop body's result.
+     */
+
+    TclEmitOpcode(INST_POP, envPtr);
+
+    /*
+     * Finally, compile the "next" subcommand word inline.
+     */
+
+    envPtr->excRangeArrayPtr[range1].continueOffset = TclCurrCodeOffset();
+    envPtr->excRangeArrayPtr[range2].codeOffset = TclCurrCodeOffset();
+    result = CompileCmdWordInline(interp, argInfo.startArray[2],
+	    (argInfo.endArray[2] + 1), flags, envPtr);
+    if (result != TCL_OK) {
+	if (result == TCL_ERROR) {
+	    Tcl_AddObjErrorInfo(interp, "\n    (\"for\" loop-end command)", -1);
+	}
+	goto done;
+    }
+    maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+    envPtr->excRangeArrayPtr[range2].numCodeBytes =
+	TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range2].codeOffset;
+
+    /*
+     * Discard the "next" subcommand's result.
+     */
+
+    TclEmitOpcode(INST_POP, envPtr);
+	
+    /*
+     * Emit the unconditional jump back to the test at the top of the for
+     * loop. We generate a four byte jump if the distance to the test is
+     * greater than 120 bytes. This is conservative, and ensures that we
+     * won't have to replace this unconditional jump if we later need to
+     * replace the ifFalse jump with a four-byte jump.
+     */
+
+    jumpBackOffset = TclCurrCodeOffset();
+    jumpBackDist = (jumpBackOffset - testCodeOffset);
+    if (jumpBackDist > 120) {
+	TclEmitInstInt4(INST_JUMP4, /*offset*/ -jumpBackDist, envPtr);
+    } else {
+	TclEmitInstInt1(INST_JUMP1, /*offset*/ -jumpBackDist, envPtr);
+    }
+
+    /*
+     * Now that we know the target of the jumpFalse after the test, update
+     * it with the correct distance. If the distance is too great (more
+     * than 127 bytes), replace that jump with a four byte instruction and
+     * move the instructions after the jump down.
+     */
+
+    jumpDist = (TclCurrCodeOffset() - jumpFalseFixup.codeOffset);
+    if (TclFixupForwardJump(envPtr, &jumpFalseFixup, jumpDist, 127)) {
+	/*
+	 * Update the loop body's ExceptionRange record since it moved down:
+	 * i.e., increment both its start and continue PC offsets. Also,
+	 * update the "next" command's start PC offset in its ExceptionRange
+	 * record since it also moved down.
+	 */
+
+	envPtr->excRangeArrayPtr[range1].codeOffset += 3;
+	envPtr->excRangeArrayPtr[range1].continueOffset += 3;
+	envPtr->excRangeArrayPtr[range2].codeOffset += 3;
+
+	/*
+	 * Update the distance for the unconditional jump back to the test
+	 * at the top of the loop since it moved down 3 bytes too.
+	 */
+
+	jumpBackOffset += 3;
+	jumpPc = (envPtr->codeStart + jumpBackOffset);
+	if (jumpBackDist > 120) {
+	    jumpBackDist += 3;
+	    TclUpdateInstInt4AtPc(INST_JUMP4, /*offset*/ -jumpBackDist,
+				   jumpPc);
+	} else {
+	    jumpBackDist += 3;
+	    TclUpdateInstInt1AtPc(INST_JUMP1, /*offset*/ -jumpBackDist,
+				   jumpPc);
+	}
+    }
+    
+    /*
+     * The current PC offset (after the loop's body and "next" subcommand)
+     * is the loop's break target.
+     */
+
+    envPtr->excRangeArrayPtr[range1].breakOffset =
+	envPtr->excRangeArrayPtr[range2].breakOffset = TclCurrCodeOffset();
+    
+    /*
+     * Push an empty string object as the for command's result.
+     */
+
+    objIndex = TclObjIndexForString("", 0, /*allocStrRep*/ 0, /*inHeap*/ 0,
+				    envPtr);
+    TclEmitPush(objIndex, envPtr);
+    if (maxDepth == 0) {
+	maxDepth = 1;
+    }
+
+    done:
+    if (numWords == 0) {
+	envPtr->termOffset = 0;
+    } else {
+	envPtr->termOffset = (argInfo.endArray[numWords-1] + 1 - string);
+    }
+    envPtr->pushSimpleWords = savePushSimpleWords;
+    envPtr->maxStackDepth = maxDepth;
+    if (range1 != -1) {
+	envPtr->excRangeDepth--;
+    }
+    FreeArgInfo(&argInfo);
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileForeachCmd --
+ *
+ *	Procedure called to compile the "foreach" command.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is TCL_OK if
+ *	compilation was successful. If an error occurs then the
+ *	interpreter's result contains a standard error message and TCL_ERROR
+ *	is returned. If complation failed because the command is too complex
+ *	for TclCompileForeachCmd, TCL_OUT_LINE_COMPILE is returned
+ *	indicating that the foreach command should be compiled "out of line"
+ *	by emitting code to invoke its command procedure at runtime.
+ *
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the "while" command.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to evaluate the "foreach" command
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileForeachCmd(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *string;		/* The source string to compile. */
+    char *lastChar;		/* Pointer to terminating character of
+				 * string. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    Proc *procPtr = envPtr->procPtr;
+    				/* Points to structure describing procedure
+				 * containing foreach command, else NULL. */
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute cmd. */
+    ArgInfo argInfo;		/* Structure holding information about the
+				 * start and end of each argument word. */
+    int numLists = 0;		/* Count of variable (and value) lists. */
+    int range = -1;		/* Index in the ExceptionRange array of the
+				 * ExceptionRange record for this loop. */
+    ForeachInfo *infoPtr;	/* Points to the structure describing this
+				 * foreach command. Stored in a AuxData
+				 * record in the ByteCode. */
+    JumpFixup jumpFalseFixup;	/* Used to update or replace the ifFalse
+				 * jump after test when its target PC is
+				 * determined. */
+    char savedChar;		/* Holds the char from string termporarily
+				 * replaced by a null character during
+				 * processing of argument words. */
+    int firstListTmp = -1;	/* If we decide to compile this foreach
+				 * command, this is the index or "slot
+				 * number" for the first temp var allocated
+				 * in the proc frame that holds a pointer to
+				 * a value list. Initialized to avoid a
+				 * compiler warning. */
+    int loopIterNumTmp;		/* If we decide to compile this foreach
+				 * command, the index for the temp var that
+				 * holds the current iteration count.  */
+    char *varListStart, *varListEnd, *valueListStart, *bodyStart, *bodyEnd;
+    unsigned char *jumpPc;
+    int jumpDist, jumpBackDist, jumpBackOffset;
+    int numWords, numVars, infoIndex, tmpIndex, objIndex, i, j, result;
+    int savePushSimpleWords = envPtr->pushSimpleWords;
+
+    /*
+     * We parse the variable list argument words and create two arrays:
+     *    varcList[i] gives the number of variables in the i-th var list
+     *    varvList[i] points to an array of the names in the i-th var list
+     * These are initially allocated on the stack, and are allocated on
+     * the heap if necessary.
+     */
+
+#define STATIC_VAR_LIST_SIZE 4
+    int varcListStaticSpace[STATIC_VAR_LIST_SIZE];
+    char **varvListStaticSpace[STATIC_VAR_LIST_SIZE];
+
+    int *varcList = varcListStaticSpace;
+    char ***varvList = varvListStaticSpace;
+
+    /*
+     * If the foreach command is at global level (not in a procedure),
+     * don't compile it inline: the payoff is too small.
+     */
+
+    if (procPtr == NULL) {
+	return TCL_OUT_LINE_COMPILE;
+    }
+
+    /*
+     * Scan the words of the command and record the start and finish of
+     * each argument word.
+     */
+
+    InitArgInfo(&argInfo);
+    result = CollectArgInfo(interp, string, lastChar, flags, &argInfo);
+    numWords = argInfo.numArgs;
+    if (result != TCL_OK) {
+	goto done;
+    }
+    if ((numWords < 3) || (numWords%2 != 1)) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	        "wrong # args: should be \"foreach varList list ?varList list ...? command\"", -1);
+        result = TCL_ERROR;
+	goto done;
+    }
+
+    /*
+     * Initialize the varcList and varvList arrays; allocate heap storage,
+     * if necessary, for them. Also make sure the variable names
+     * have no substitutions: that they're just "var" or "var(elem)"
+     */
+
+    numLists = (numWords - 1)/2;
+    if (numLists > STATIC_VAR_LIST_SIZE) {
+        varcList = (int *) ckalloc(numLists * sizeof(int));
+        varvList = (char ***) ckalloc(numLists * sizeof(char **));
+    }
+    for (i = 0;  i < numLists;  i++) {
+        varcList[i] = 0;
+        varvList[i] = (char **) NULL;
+    }
+    for (i = 0;  i < numLists;  i++) {
+	/*
+	 * Break each variable list into its component variables. If the
+	 * lists is enclosed in {}s or ""s, strip them off first.
+	 */
+
+	varListStart = argInfo.startArray[i*2];
+	varListEnd   = argInfo.endArray[i*2];
+	if ((*varListStart == '{') || (*varListStart == '"')) {
+	    if ((*varListEnd != '}') && (*varListEnd != '"')) {
+		Tcl_ResetResult(interp);
+		if (*varListStart == '"') {
+		    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+			    "extra characters after close-quote", -1);
+		} else {
+		    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		            "extra characters after close-brace", -1);
+		}
+		result = TCL_ERROR;
+		goto done;
+	    }
+	    varListStart++;
+	    varListEnd--;
+	}
+	    
+	/*
+	 * NOTE: THIS NEEDS TO BE CONVERTED TO AN OBJECT LIST.
+	 */
+
+	savedChar = *(varListEnd+1);
+	*(varListEnd+1) = '\0';
+	result = Tcl_SplitList(interp, varListStart,
+			       &varcList[i], &varvList[i]);
+	*(varListEnd+1) = savedChar;
+        if (result != TCL_OK) {
+            goto done;
+        }
+
+	/*
+	 * Check that each variable name has no substitutions and that
+	 * it is a local scalar name.
+	 */
+
+	numVars = varcList[i];
+	for (j = 0;  j < numVars;  j++) {
+	    char *varName = varvList[i][j];
+	    if (!IsLocalScalar(varName, (int) strlen(varName))) {
+		result = TCL_OUT_LINE_COMPILE;
+		goto done;
+	    }
+	}
+    }
+
+    /*
+     *==== At this point we believe we can compile the foreach command ====
+     */
+
+    /*
+     * Create and initialize a ExceptionRange record to hold information
+     * about this loop. This is used to implement break and continue.
+     */
+    
+    envPtr->excRangeDepth++;
+    envPtr->maxExcRangeDepth =
+	TclMax(envPtr->excRangeDepth, envPtr->maxExcRangeDepth);
+    range = CreateExceptionRange(LOOP_EXCEPTION_RANGE, envPtr);
+    
+    /*
+     * Reserve (numLists + 1) temporary variables:
+     *    - numLists temps for each value list
+     *    - a temp for the "next value" index into each value list
+     * At this time we don't try to reuse temporaries; if there are two
+     * nonoverlapping foreach loops, they don't share any temps.
+     */
+
+    for (i = 0;  i < numLists;  i++) {
+	tmpIndex = LookupCompiledLocal(NULL, /*nameChars*/ 0,
+		/*createIfNew*/ 1, /*flagsIfCreated*/ VAR_SCALAR, procPtr);
+	if (i == 0) {
+	    firstListTmp = tmpIndex;
+	}
+    }
+    loopIterNumTmp = LookupCompiledLocal(NULL, /*nameChars*/ 0,
+	    /*createIfNew*/ 1, /*flagsIfCreated*/ VAR_SCALAR, procPtr);
+    
+    /*
+     * Create and initialize the ForeachInfo and ForeachVarList data
+     * structures describing this command. Then create a AuxData record
+     * pointing to the ForeachInfo structure in the compilation environment.
+     */
+
+    infoPtr = (ForeachInfo *) ckalloc((unsigned)
+	    (sizeof(ForeachInfo) + (numLists * sizeof(ForeachVarList *))));
+    infoPtr->numLists = numLists;
+    infoPtr->firstListTmp = firstListTmp;
+    infoPtr->loopIterNumTmp = loopIterNumTmp;
+    for (i = 0;  i < numLists;  i++) {
+	ForeachVarList *varListPtr;
+	numVars = varcList[i];
+	varListPtr = (ForeachVarList *) ckalloc((unsigned)
+	        sizeof(ForeachVarList) + numVars*sizeof(int));
+	varListPtr->numVars = numVars;
+	for (j = 0;  j < numVars;  j++) {
+	    char *varName = varvList[i][j];
+	    int nameChars = strlen(varName);
+	    varListPtr->varIndexes[j] = LookupCompiledLocal(varName,
+		    nameChars, /*createIfNew*/ 1,
+                    /*flagsIfCreated*/ VAR_SCALAR, procPtr);
+	}
+	infoPtr->varLists[i] = varListPtr;
+    }
+    infoIndex = TclCreateAuxData((ClientData) infoPtr,
+            &tclForeachInfoType, envPtr);
+
+    /*
+     * Emit code to store each value list into the associated temporary.
+     */
+
+    for (i = 0;  i < numLists;  i++) {
+	valueListStart = argInfo.startArray[2*i + 1];
+	envPtr->pushSimpleWords = 1;
+	result = CompileWord(interp, valueListStart, lastChar, flags,
+		envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+
+	tmpIndex = (firstListTmp + i);
+	if (tmpIndex <= 255) {
+	    TclEmitInstUInt1(INST_STORE_SCALAR1, tmpIndex, envPtr);
+	} else {
+	    TclEmitInstUInt4(INST_STORE_SCALAR4, tmpIndex, envPtr);
+	}
+	TclEmitOpcode(INST_POP, envPtr);
+    }
+
+    /*
+     * Emit the instruction to initialize the foreach loop's index temp var.
+     */
+
+    TclEmitInstUInt4(INST_FOREACH_START4, infoIndex, envPtr);
+    
+    /*
+     * Emit the top of loop code that assigns each loop variable and checks
+     * whether to terminate the loop.
+     */
+
+    envPtr->excRangeArrayPtr[range].continueOffset = TclCurrCodeOffset();
+    TclEmitInstUInt4(INST_FOREACH_STEP4, infoIndex, envPtr);
+
+    /*
+     * Emit the ifFalse jump that terminates the foreach if all value lists
+     * are exhausted. We emit a one byte (relative) jump here, and replace
+     * it later with a four byte jump if the jump target is more than
+     * 127 bytes away.
+     */
+
+    TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
+    
+    /*
+     * Compile the loop body word inline. Also register the loop body's
+     * starting PC offset and byte length in the ExceptionRange record.
+     */
+
+    bodyStart = argInfo.startArray[numWords - 1];
+    bodyEnd   = argInfo.endArray[numWords - 1];
+    savedChar = *(bodyEnd+1);
+    *(bodyEnd+1) = '\0';
+    envPtr->excRangeArrayPtr[range].codeOffset = TclCurrCodeOffset();
+    result = CompileCmdWordInline(interp, bodyStart, bodyEnd+1, flags,
+	    envPtr);
+    *(bodyEnd+1) = savedChar;
+    if (result != TCL_OK) {
+	if (result == TCL_ERROR) {
+	    char msg[60];
+	    sprintf(msg, "\n    (\"foreach\" body line %d)",
+		    interp->errorLine);
+            Tcl_AddObjErrorInfo(interp, msg, -1);
+        }
+	goto done;
+    }
+    maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+    envPtr->excRangeArrayPtr[range].numCodeBytes =
+	TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range].codeOffset;
+
+    /*
+     * Discard the loop body's result.
+     */
+
+    TclEmitOpcode(INST_POP, envPtr);
+	
+    /*
+     * Emit the unconditional jump back to the test at the top of the
+     * loop. We generate a four byte jump if the distance to the to of
+     * the foreach is greater than 120 bytes. This is conservative and
+     * ensures that we won't have to replace this unconditional jump if
+     * we later need to replace the ifFalse jump with a four-byte jump.
+     */
+
+    jumpBackOffset = TclCurrCodeOffset();
+    jumpBackDist =
+	(jumpBackOffset - envPtr->excRangeArrayPtr[range].continueOffset);
+    if (jumpBackDist > 120) {
+	TclEmitInstInt4(INST_JUMP4, /*offset*/ -jumpBackDist, envPtr);
+    } else {
+	TclEmitInstInt1(INST_JUMP1, /*offset*/ -jumpBackDist, envPtr);
+    }
+
+    /*
+     * Now that we know the target of the jumpFalse after the foreach_step
+     * test, update it with the correct distance. If the distance is too
+     * great (more than 127 bytes), replace that jump with a four byte
+     * instruction and move the instructions after the jump down.
+     */
+
+    jumpDist = (TclCurrCodeOffset() - jumpFalseFixup.codeOffset);
+    if (TclFixupForwardJump(envPtr, &jumpFalseFixup, jumpDist, 127)) {
+	/*
+	 * Update the loop body's starting PC offset since it moved down.
+	 */
+
+	envPtr->excRangeArrayPtr[range].codeOffset += 3;
+
+	/*
+	 * Update the distance for the unconditional jump back to the test
+	 * at the top of the loop since it moved down 3 bytes too.
+	 */
+
+	jumpBackOffset += 3;
+	jumpPc = (envPtr->codeStart + jumpBackOffset);
+	if (jumpBackDist > 120) {
+	    jumpBackDist += 3;
+	    TclUpdateInstInt4AtPc(INST_JUMP4, /*offset*/ -jumpBackDist,
+				   jumpPc);
+	} else {
+	    jumpBackDist += 3;
+	    TclUpdateInstInt1AtPc(INST_JUMP1, /*offset*/ -jumpBackDist,
+				   jumpPc);
+	}
+    }
+
+    /*
+     * The current PC offset (after the loop's body) is the loop's
+     * break target.
+     */
+
+    envPtr->excRangeArrayPtr[range].breakOffset = TclCurrCodeOffset();
+    
+    /*
+     * Push an empty string object as the foreach command's result.
+     */
+
+    objIndex = TclObjIndexForString("", 0, /*allocStrRep*/ 0, /*inHeap*/ 0,
+				    envPtr);
+    TclEmitPush(objIndex, envPtr);
+    if (maxDepth == 0) {
+	maxDepth = 1;
+    }
+
+    done:
+    for (i = 0;  i < numLists;  i++) {
+        if (varvList[i] != (char **) NULL) {
+            ckfree((char *) varvList[i]);
+        }
+    }
+    if (varcList != varcListStaticSpace) {
+	ckfree((char *) varcList);
+        ckfree((char *) varvList);
+    }
+    envPtr->termOffset = (argInfo.endArray[numWords-1] + 1 - string);
+    envPtr->pushSimpleWords = savePushSimpleWords;
+    envPtr->maxStackDepth = maxDepth;
+    if (range != -1) {
+	envPtr->excRangeDepth--;
+    }
+    FreeArgInfo(&argInfo);
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupForeachInfo --
+ *
+ *	This procedure duplicates a ForeachInfo structure created as
+ *	auxiliary data during the compilation of a foreach command.
+ *
+ * Results:
+ *	A pointer to a newly allocated copy of the existing ForeachInfo
+ *	structure is returned.
+ *
+ * Side effects:
+ *	Storage for the copied ForeachInfo record is allocated. If the
+ *	original ForeachInfo structure pointed to any ForeachVarList
+ *	records, these structures are also copied and pointers to them
+ *	are stored in the new ForeachInfo record.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ClientData
+DupForeachInfo(clientData)
+    ClientData clientData;	/* The foreach command's compilation
+				 * auxiliary data to duplicate. */
+{
+    register ForeachInfo *srcPtr = (ForeachInfo *) clientData;
+    ForeachInfo *dupPtr;
+    register ForeachVarList *srcListPtr, *dupListPtr;
+    int numLists = srcPtr->numLists;
+    int numVars, i, j;
+    
+    dupPtr = (ForeachInfo *) ckalloc((unsigned)
+	    (sizeof(ForeachInfo) + (numLists * sizeof(ForeachVarList *))));
+    dupPtr->numLists = numLists;
+    dupPtr->firstListTmp = srcPtr->firstListTmp;
+    dupPtr->loopIterNumTmp = srcPtr->loopIterNumTmp;
+    
+    for (i = 0;  i < numLists;  i++) {
+	srcListPtr = srcPtr->varLists[i];
+	numVars = srcListPtr->numVars;
+	dupListPtr = (ForeachVarList *) ckalloc((unsigned)
+	        sizeof(ForeachVarList) + numVars*sizeof(int));
+	dupListPtr->numVars = numVars;
+	for (j = 0;  j < numVars;  j++) {
+	    dupListPtr->varIndexes[j] =	srcListPtr->varIndexes[j];
+	}
+	dupPtr->varLists[i] = dupListPtr;
+    }
+    return (ClientData) dupPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeForeachInfo --
+ *
+ *	Procedure to free a ForeachInfo structure created as auxiliary data
+ *	during the compilation of a foreach command.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Storage for the ForeachInfo structure pointed to by the ClientData
+ *	argument is freed as is any ForeachVarList record pointed to by the
+ *	ForeachInfo structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeForeachInfo(clientData)
+    ClientData clientData;	/* The foreach command's compilation
+				 * auxiliary data to free. */
+{
+    register ForeachInfo *infoPtr = (ForeachInfo *) clientData;
+    register ForeachVarList *listPtr;
+    int numLists = infoPtr->numLists;
+    register int i;
+
+    for (i = 0;  i < numLists;  i++) {
+	listPtr = infoPtr->varLists[i];
+	ckfree((char *) listPtr);
+    }
+    ckfree((char *) infoPtr);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileIfCmd --
+ *
+ *	Procedure called to compile the "if" command.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is TCL_OK unless
+ *	there was an error while parsing string. If an error occurs then
+ *	the interpreter's result contains a standard error message.
+ *
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the command.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to evaluate the "if" command
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileIfCmd(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *string;		/* The source string to compile. */
+    char *lastChar;		/* Pointer to terminating character of
+				 * string. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    register char *src = string;/* Points to current source char. */
+    register int type;		/* Current char's CHAR_TYPE type. */
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute cmd. */
+    JumpFixupArray jumpFalseFixupArray;
+    				/* Used to fix up the ifFalse jump after
+				 * each "if"/"elseif" test when its target
+				 * PC is determined. */
+    JumpFixupArray jumpEndFixupArray;
+				/* Used to fix up the unconditional jump
+				 * after each "then" command to the end of
+				 * the "if" when that PC is determined. */
+    char *testSrcStart;
+    int jumpDist, jumpFalseDist, jumpIndex, objIndex, j, result;
+    unsigned char *ifFalsePc;
+    unsigned char opCode;
+    int savePushSimpleWords = envPtr->pushSimpleWords;
+
+    /*
+     * Loop compiling "expr then body" clauses after an "if" or "elseif".
+     */
+
+    TclInitJumpFixupArray(&jumpFalseFixupArray);
+    TclInitJumpFixupArray(&jumpEndFixupArray);
+    while (1) {	
+	/*
+	 * At this point in the loop, we have an expression to test, either
+	 * the main expression or an expression following an "elseif".
+	 * The arguments after the expression must be "then" (optional) and
+	 * a script to execute if the expression is true.
+	 */
+
+	AdvanceToNextWord(src, envPtr);
+	src += envPtr->termOffset;
+	type = CHAR_TYPE(src, lastChar);
+	if (type == TCL_COMMAND_END) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		    "wrong # args: no expression after \"if\" argument", -1);
+	    result = TCL_ERROR;
+	    goto done;
+	}
+
+	/*
+	 * Compile the "if"/"elseif" test expression.
+	 */
+	
+	testSrcStart = src;
+	envPtr->pushSimpleWords = 1;
+	result = CompileExprWord(interp, src, lastChar, flags, envPtr);
+	if (result != TCL_OK) {
+	    if (result == TCL_ERROR) {
+		Tcl_AddObjErrorInfo(interp,
+		        "\n    (\"if\" test expression)", -1);
+	    }
+	    goto done;
+	}
+	maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+	src += envPtr->termOffset;
+
+	/*
+	 * Emit the ifFalse jump around the "then" part if the test was
+	 * false. We emit a one byte (relative) jump here, and replace it
+	 * later with a four byte jump if the jump target is more than 127
+	 * bytes away. 
+	 */
+
+	if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) {
+	    TclExpandJumpFixupArray(&jumpFalseFixupArray);
+	}
+	jumpIndex = jumpFalseFixupArray.next;
+	jumpFalseFixupArray.next++;
+	TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
+		&(jumpFalseFixupArray.fixup[jumpIndex]));
+	
+	/*
+	 * Skip over the optional "then" before the then clause.
+	 */
+
+	AdvanceToNextWord(src, envPtr);
+	src += envPtr->termOffset;
+	type = CHAR_TYPE(src, lastChar);
+	if (type == TCL_COMMAND_END) {
+	    char buf[100];
+	    sprintf(buf, "wrong # args: no script following \"%.20s\" argument", testSrcStart);
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
+	    result = TCL_ERROR;
+	    goto done;
+	}
+	if ((*src == 't') && (strncmp(src, "then", 4) == 0)) {
+	    type = CHAR_TYPE(src+4, lastChar);
+	    if ((type == TCL_SPACE) || (type == TCL_COMMAND_END)) {
+		src += 4;
+		AdvanceToNextWord(src, envPtr); 
+		src += envPtr->termOffset;
+		type = CHAR_TYPE(src, lastChar);
+		if (type == TCL_COMMAND_END) {
+		    Tcl_ResetResult(interp);
+		    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		            "wrong # args: no script following \"then\" argument", -1);
+		    result = TCL_ERROR;
+		    goto done;
+		}
+	    }
+	}
+
+	/*
+	 * Compile the "then" command word inline.
+	 */
+
+	result = CompileCmdWordInline(interp, src, lastChar, flags, envPtr);
+	if (result != TCL_OK) {
+	    if (result == TCL_ERROR) {
+		char msg[60];
+		sprintf(msg, "\n    (\"if\" then script line %d)",
+		        interp->errorLine);
+		Tcl_AddObjErrorInfo(interp, msg, -1);
+	    }
+	    goto done;
+	}
+	maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+	src += envPtr->termOffset;
+
+	/*
+	 * Emit an unconditional jump to the end of the "if" command. We
+	 * emit a one byte jump here, and replace it later with a four byte
+	 * jump if the jump target is more than 127 bytes away. Note that
+	 * both the jumpFalseFixupArray and the jumpEndFixupArray are
+	 * indexed by the same index, "jumpIndex".
+	 */
+
+	if (jumpEndFixupArray.next >= jumpEndFixupArray.end) {
+	    TclExpandJumpFixupArray(&jumpEndFixupArray);
+	}
+	jumpEndFixupArray.next++;
+	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
+		&(jumpEndFixupArray.fixup[jumpIndex]));
+
+ 	/*
+	 * Now that we know the target of the jumpFalse after the if test,
+         * update it with the correct distance. We generate a four byte
+	 * jump if the distance is greater than 120 bytes. This is
+	 * conservative, and ensures that we won't have to replace this
+	 * jump if we later also need to replace the preceeding
+	 * unconditional jump to the end of the "if" with a four-byte jump.
+         */
+
+	jumpDist = (TclCurrCodeOffset() - jumpFalseFixupArray.fixup[jumpIndex].codeOffset);
+	if (TclFixupForwardJump(envPtr,
+	        &(jumpFalseFixupArray.fixup[jumpIndex]), jumpDist, 120)) {
+	    /*
+	     * Adjust the code offset for the unconditional jump at the end
+	     * of the last "then" clause.
+	     */
+
+	    jumpEndFixupArray.fixup[jumpIndex].codeOffset += 3;
+	}
+
+	/*
+	 * Check now for a "elseif" word. If we find one, keep looping.
+	 */
+
+	AdvanceToNextWord(src, envPtr);
+	src += envPtr->termOffset;
+	type = CHAR_TYPE(src, lastChar);
+	if ((type != TCL_COMMAND_END)
+	        && ((*src == 'e') && (strncmp(src, "elseif", 6) == 0))) {
+	    type = CHAR_TYPE(src+6, lastChar);
+	    if ((type == TCL_SPACE) || (type == TCL_COMMAND_END)) {
+		src += 6;
+		AdvanceToNextWord(src, envPtr); 
+		src += envPtr->termOffset;
+		type = CHAR_TYPE(src, lastChar);
+		if (type == TCL_COMMAND_END) {
+		    Tcl_ResetResult(interp);
+		    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		            "wrong # args: no expression after \"elseif\" argument", -1);
+		    result = TCL_ERROR;
+		    goto done;
+		}
+		continue;	  /* continue the "expr then body" loop */
+	    }
+	}
+	break;
+    } /* end of the "expr then body" loop */
+
+    /*
+     * No more "elseif expr then body" clauses. Check now for an "else"
+     * clause. If there is another word, we are at its start.
+     */
+
+    if (type != TCL_COMMAND_END) {
+	if ((*src == 'e') && (strncmp(src, "else", 4) == 0)) {
+	    type = CHAR_TYPE(src+4, lastChar);
+	    if ((type == TCL_SPACE) || (type == TCL_COMMAND_END)) {
+		src += 4;
+		AdvanceToNextWord(src, envPtr); 
+		src += envPtr->termOffset;
+		type = CHAR_TYPE(src, lastChar);
+		if (type == TCL_COMMAND_END) {
+		    Tcl_ResetResult(interp);
+		    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		            "wrong # args: no script following \"else\" argument", -1);
+		    result = TCL_ERROR;
+		    goto done;
+		}
+	    }
+	}
+
+	/*
+	 * Compile the "else" command word inline.
+	 */
+
+	result = CompileCmdWordInline(interp, src, lastChar, flags, envPtr);
+	if (result != TCL_OK) {
+	    if (result == TCL_ERROR) {
+		char msg[60];
+		sprintf(msg, "\n    (\"if\" else script line %d)",
+		        interp->errorLine);
+		Tcl_AddObjErrorInfo(interp, msg, -1);
+	    }
+	    goto done;
+	}
+	maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+	src += envPtr->termOffset;
+    
+	/*
+	 * Skip over white space until the end of the command.
+	 */
+	
+	type = CHAR_TYPE(src, lastChar);
+	if (type != TCL_COMMAND_END) {
+	    AdvanceToNextWord(src, envPtr);
+	    src += envPtr->termOffset;
+	    type = CHAR_TYPE(src, lastChar);
+	    if (type != TCL_COMMAND_END) {
+		Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		        "wrong # args: extra words after \"else\" clause in \"if\" command", -1);
+		result = TCL_ERROR;
+		goto done;
+	    }
+	}
+    } else {
+	/*
+	 * The "if" command has no "else" clause: push an empty string
+	 * object as its result.
+	 */
+
+	objIndex = TclObjIndexForString("", 0, /*allocStrRep*/ 0,
+		/*inHeap*/ 0, envPtr);
+	TclEmitPush(objIndex, envPtr);
+	maxDepth = TclMax(1, maxDepth);
+    }
+
+    /*
+     * Now that we know the target of the unconditional jumps to the end of
+     * the "if" command, update them with the correct distance. If the
+     * distance is too great (> 127 bytes), replace the jump with a four
+     * byte instruction and move instructions after the jump down.
+     */
+    
+    for (j = jumpEndFixupArray.next;  j > 0;  j--) {
+	jumpIndex = (j - 1);	/* i.e. process the closest jump first */
+	jumpDist = (TclCurrCodeOffset() - jumpEndFixupArray.fixup[jumpIndex].codeOffset);
+	if (TclFixupForwardJump(envPtr,
+	        &(jumpEndFixupArray.fixup[jumpIndex]), jumpDist, 127)) {
+	    /*
+	     * Adjust the jump distance for the "ifFalse" jump that
+	     * immediately preceeds this jump. We've moved it's target
+	     * (just after this unconditional jump) three bytes down.
+	     */
+
+	    ifFalsePc = (envPtr->codeStart + jumpFalseFixupArray.fixup[jumpIndex].codeOffset);
+	    opCode = *ifFalsePc;
+	    if (opCode == INST_JUMP_FALSE1) {
+		jumpFalseDist = TclGetInt1AtPtr(ifFalsePc + 1);
+		jumpFalseDist += 3;
+		TclStoreInt1AtPtr(jumpFalseDist, (ifFalsePc + 1));
+	    } else if (opCode == INST_JUMP_FALSE4) {
+		jumpFalseDist = TclGetInt4AtPtr(ifFalsePc + 1);
+		jumpFalseDist += 3;
+		TclStoreInt4AtPtr(jumpFalseDist, (ifFalsePc + 1));
+	    } else {
+		panic("TclCompileIfCmd: unexpected opcode updating ifFalse jump");
+	    }
+	}
+    }
+	
+    /*
+     * Free the jumpFixupArray array if malloc'ed storage was used.
+     */
+
+    done:
+    TclFreeJumpFixupArray(&jumpFalseFixupArray);
+    TclFreeJumpFixupArray(&jumpEndFixupArray);
+    envPtr->termOffset = (src - string);
+    envPtr->maxStackDepth = maxDepth;
+    envPtr->pushSimpleWords = savePushSimpleWords;
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileIncrCmd --
+ *
+ *	Procedure called to compile the "incr" command.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is TCL_OK unless
+ *	there was an error while parsing string. If an error occurs then
+ *	the interpreter's result contains a standard error message.
+ *
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the "incr" command.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to evaluate the "incr" command
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileIncrCmd(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *string;		/* The source string to compile. */
+    char *lastChar;		/* Pointer to terminating character of
+				 * string. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    Proc *procPtr = envPtr->procPtr;
+    				/* Points to structure describing procedure
+				 * containing incr command, else NULL. */
+    register char *src = string;
+    				/* Points to current source char. */
+    register int type;		/* Current char's CHAR_TYPE type. */
+    int simpleVarName;		/* 1 if name is just sequence of chars with
+                                 * an optional element name in parens. */
+    char *name = NULL;		/* If simpleVarName, points to first char of
+				 * variable name and nameChars is length.
+				 * Otherwise NULL. */
+    char *elName = NULL;	/* If simpleVarName, points to first char of
+				 * element name and elNameChars is length.
+				 * Otherwise NULL. */
+    int nameChars = 0;		/* Length of the var name. Initialized to
+				 * avoid a compiler warning. */
+    int elNameChars = 0;	/* Length of array's element name, if any.
+				 * Initialized to avoid a compiler
+				 * warning. */
+    int incrementGiven;		/* 1 if an increment amount was given. */
+    int isImmIncrValue = 0;	/* 1 if increment amount is a literal
+				 * integer in [-127..127]. */
+    int immIncrValue = 0;	/* if isImmIncrValue is 1, the immediate
+				 * integer value. */
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute cmd. */
+    int localIndex = -1;	/* Index of the variable in the current
+				 * procedure's array of local variables.
+				 * Otherwise -1 if not in a procedure or
+				 * the variable wasn't found. */
+    char savedChar;		/* Holds the character from string
+				 * termporarily replaced by a null char
+				 * during name processing. */
+    int objIndex;		/* The object array index for a pushed
+				 * object holding a name part. */
+    int savePushSimpleWords = envPtr->pushSimpleWords;
+    char *p;
+    int i, result;
+
+    /*
+     * Parse the next word: the variable name. If it is "simple" (requires
+     * no substitutions at runtime), divide it up into a simple "name" plus
+     * an optional "elName". Otherwise, if not simple, just push the name.
+     */
+
+    AdvanceToNextWord(src, envPtr);
+    src += envPtr->termOffset;
+    type = CHAR_TYPE(src, lastChar);
+    if (type == TCL_COMMAND_END) {
+	badArgs:
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	        "wrong # args: should be \"incr varName ?increment?\"", -1);
+	result = TCL_ERROR;
+	goto done;
+    }
+    
+    envPtr->pushSimpleWords = 0;
+    result = CompileWord(interp, src, lastChar, flags, envPtr);
+    if (result != TCL_OK) {
+	goto done;
+    }
+    simpleVarName = envPtr->wordIsSimple;
+    if (simpleVarName) {
+	name = src;
+	nameChars = envPtr->numSimpleWordChars;
+	if (type & (TCL_QUOTE | TCL_OPEN_BRACE)) {
+	    name++;
+	}
+	elName = NULL;
+	elNameChars = 0;
+	p = name;
+	for (i = 0;  i < nameChars;  i++) {
+	    if (*p == '(') {
+		char *openParen = p;
+		p = (src + nameChars-1);	
+		if (*p == ')') { /* last char is ')' => array reference */
+		    nameChars = (openParen - name);
+		    elName = openParen+1;
+		    elNameChars = (p - elName);
+		}
+		break;
+	    }
+	    p++;
+	}
+    } else {
+        maxDepth = envPtr->maxStackDepth;
+    }
+    src += envPtr->termOffset;
+
+    /*
+     * See if there is a next word. If so, we are incrementing the variable
+     * by that value (which must be an integer).
+     */
+
+    incrementGiven = 0;
+    type = CHAR_TYPE(src, lastChar);
+    if (type != TCL_COMMAND_END) {
+	AdvanceToNextWord(src, envPtr);
+	src += envPtr->termOffset;
+	type = CHAR_TYPE(src, lastChar);
+	incrementGiven = (type != TCL_COMMAND_END);
+    }
+
+    /*
+     * Non-simple names have already been pushed. If this is a simple
+     * variable, either push its name (if a global or an unknown local
+     * variable) or look up the variable's local frame index. If a local is
+     * not found, push its name and do the lookup at runtime. If this is an
+     * array reference, also push the array element.
+     */
+
+    if (simpleVarName) {
+	if (procPtr == NULL) {
+	    savedChar = name[nameChars];
+	    name[nameChars] = '\0';
+	    objIndex = TclObjIndexForString(name, nameChars,
+		    /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+	    name[nameChars] = savedChar;
+	    TclEmitPush(objIndex, envPtr);
+	    maxDepth = 1;
+	} else {
+	    localIndex = LookupCompiledLocal(name, nameChars,
+	            /*createIfNew*/ 0, /*flagsIfCreated*/ 0,
+		    envPtr->procPtr);
+	    if ((localIndex < 0) || (localIndex > 255)) {
+		if (localIndex > 255) {	      /* we'll push the name */
+		    localIndex = -1;
+		}
+		savedChar = name[nameChars];
+		name[nameChars] = '\0';
+		objIndex = TclObjIndexForString(name, nameChars,
+			/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+		name[nameChars] = savedChar;
+		TclEmitPush(objIndex, envPtr);
+		maxDepth = 1;
+	    } else {
+		maxDepth = 0;
+	    }
+	}
+	
+	if (elName != NULL) {
+	    /*
+	     * Parse and push the array element's name. Perform
+	     * substitutions on it, just as is done for quoted strings.
+	     */
+
+	    savedChar = elName[elNameChars];
+	    elName[elNameChars] = '\0';
+	    envPtr->pushSimpleWords = 1;
+	    result = TclCompileQuotes(interp, elName, elName+elNameChars,
+		    0, flags, envPtr);
+	    elName[elNameChars] = savedChar;
+	    if (result != TCL_OK) {
+		char msg[200];
+		sprintf(msg, "\n    (parsing index for array \"%.*s\")",
+			TclMin(nameChars, 100), name);
+		Tcl_AddObjErrorInfo(interp, msg, -1);
+		goto done;
+	    }
+	    maxDepth += envPtr->maxStackDepth;
+	}
+    }
+
+    /*
+     * If an increment was given, push the new value.
+     */
+    
+    if (incrementGiven) {
+	type = CHAR_TYPE(src, lastChar);
+	envPtr->pushSimpleWords = 0;
+	result = CompileWord(interp, src, lastChar, flags, envPtr);
+	if (result != TCL_OK) {
+	    if (result == TCL_ERROR) {
+		Tcl_AddObjErrorInfo(interp,
+		        "\n    (increment expression)", -1);
+	    }
+	    goto done;
+	}
+	if (type & (TCL_QUOTE | TCL_OPEN_BRACE)) {
+	    src++;
+	}
+	if (envPtr->wordIsSimple) {
+	    /*
+	     * See if the word represents an integer whose formatted
+	     * representation is the same as the word (e.g., this is
+	     * true for 123 and -1 but not for 00005). If so, just
+	     * push an integer object.
+	     */
+	    
+	    int isCompilableInt = 0;
+	    int numChars = envPtr->numSimpleWordChars;
+	    char savedChar = src[numChars];
+	    char buf[40];
+	    Tcl_Obj *objPtr;
+	    long n;
+
+	    src[numChars] = '\0';
+	    if (TclLooksLikeInt(src)) {
+		int code = TclGetLong(interp, src, &n);
+		if (code == TCL_OK) {
+		    if ((-127 <= n) && (n <= 127)) {
+			isCompilableInt = 1;
+			isImmIncrValue = 1;
+			immIncrValue = n;
+		    } else {
+			TclFormatInt(buf, n);
+			if (strcmp(src, buf) == 0) {
+			    isCompilableInt = 1;
+			    isImmIncrValue = 0;
+			    objIndex = TclObjIndexForString(src, numChars,
+                                /*allocStrRep*/ 0, /*inHeap*/ 0, envPtr);
+			    objPtr = envPtr->objArrayPtr[objIndex];
+
+			    Tcl_InvalidateStringRep(objPtr);
+			    objPtr->internalRep.longValue = n;
+			    objPtr->typePtr = &tclIntType;
+			    
+			    TclEmitPush(objIndex, envPtr);
+			    maxDepth += 1;
+			}
+		    }
+		} else {
+		    Tcl_ResetResult(interp);
+		}
+	    }
+	    if (!isCompilableInt) {
+		objIndex = TclObjIndexForString(src, numChars,
+			/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+		TclEmitPush(objIndex, envPtr);
+		maxDepth += 1;
+	    }
+	    src[numChars] = savedChar;
+	} else {
+	    maxDepth += envPtr->maxStackDepth;
+	}
+	if (type & (TCL_QUOTE | TCL_OPEN_BRACE)) {
+	    src += (envPtr->termOffset - 1); /* already advanced 1 above */
+	} else {
+	    src += envPtr->termOffset;
+	}
+    } else {			/* no incr amount given so use 1 */
+	isImmIncrValue = 1;
+	immIncrValue = 1;
+    }
+    
+    /*
+     * Now emit instructions to increment the variable.
+     */
+
+    if (simpleVarName) {
+	if (elName == NULL) {  /* scalar */
+	    if (localIndex >= 0) {
+		if (isImmIncrValue) {
+		    TclEmitInstUInt1(INST_INCR_SCALAR1_IMM, localIndex,
+				    envPtr);
+		    TclEmitInt1(immIncrValue, envPtr);
+		} else {
+		    TclEmitInstUInt1(INST_INCR_SCALAR1, localIndex, envPtr);
+		}
+	    } else {
+		if (isImmIncrValue) {
+		    TclEmitInstInt1(INST_INCR_SCALAR_STK_IMM, immIncrValue,
+				   envPtr);
+		} else {
+		    TclEmitOpcode(INST_INCR_SCALAR_STK, envPtr);
+		}
+	    }
+	} else {		/* array */
+	    if (localIndex >= 0) {
+		if (isImmIncrValue) {
+		    TclEmitInstUInt1(INST_INCR_ARRAY1_IMM, localIndex,
+				    envPtr);
+		    TclEmitInt1(immIncrValue, envPtr);
+		} else {
+		    TclEmitInstUInt1(INST_INCR_ARRAY1, localIndex, envPtr);
+		}
+	    } else {
+		if (isImmIncrValue) {
+		    TclEmitInstInt1(INST_INCR_ARRAY_STK_IMM, immIncrValue,
+				   envPtr);
+		} else {
+		    TclEmitOpcode(INST_INCR_ARRAY_STK, envPtr);
+		}
+	    }
+	}
+    } else {			/* non-simple variable name */
+	if (isImmIncrValue) {
+	    TclEmitInstInt1(INST_INCR_STK_IMM, immIncrValue, envPtr);
+	} else {
+	    TclEmitOpcode(INST_INCR_STK, envPtr);
+	}
+    }
+	
+    /*
+     * Skip over white space until the end of the command.
+     */
+
+    type = CHAR_TYPE(src, lastChar);
+    if (type != TCL_COMMAND_END) {
+	AdvanceToNextWord(src, envPtr);
+	src += envPtr->termOffset;
+	type = CHAR_TYPE(src, lastChar);
+	if (type != TCL_COMMAND_END) {
+	    goto badArgs;
+	}
+    }
+
+    done:
+    envPtr->termOffset = (src - string);
+    envPtr->maxStackDepth = maxDepth;
+    envPtr->pushSimpleWords = savePushSimpleWords;
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileSetCmd --
+ *
+ *	Procedure called to compile the "set" command.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is normally TCL_OK
+ *	unless there was an error while parsing string. If an error occurs
+ *	then the interpreter's result contains a standard error message. If
+ *	complation fails because the set command requires a second level of
+ *	substitutions, TCL_OUT_LINE_COMPILE is returned indicating that the
+ *	set command should be compiled "out of line" by emitting code to
+ *	invoke its command procedure (Tcl_SetCmd) at runtime.
+ *
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the incr command.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to evaluate the "set" command
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileSetCmd(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *string;		/* The source string to compile. */
+    char *lastChar;		/* Pointer to terminating character of
+				 * string. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    Proc *procPtr = envPtr->procPtr;
+				/* Points to structure describing procedure
+				 * containing the set command, else NULL. */
+    ArgInfo argInfo;		/* Structure holding information about the
+				 * start and end of each argument word. */
+    int simpleVarName;		/* 1 if name is just sequence of chars with
+                                 * an optional element name in parens. */
+    char *elName = NULL;	/* If simpleVarName, points to first char of
+				 * element name and elNameChars is length.
+				 * Otherwise NULL. */
+    int isAssignment;		/* 1 if assigning value to var, else 0. */
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute cmd. */
+    int localIndex = -1;	/* Index of the variable in the current
+				 * procedure's array of local variables.
+				 * Otherwise -1 if not in a procedure, the
+				 * name contains "::"s, or the variable
+				 * wasn't found. */
+    char savedChar;		/* Holds the character from string
+				 * termporarily replaced by a null char
+				 * during name processing. */
+    int objIndex = -1;		/* The object array index for a pushed
+				 * object holding a name part. Initialized
+				 * to avoid a compiler warning. */
+    char *wordStart, *p;
+    int numWords, isCompilableInt, i, result;
+    Tcl_Obj *objPtr;
+    int savePushSimpleWords = envPtr->pushSimpleWords;
+
+    /*
+     * Scan the words of the command and record the start and finish of
+     * each argument word.
+     */
+
+    InitArgInfo(&argInfo);
+    result = CollectArgInfo(interp, string, lastChar, flags, &argInfo);
+    numWords = argInfo.numArgs;	  /* i.e., the # after the command name */
+    if (result != TCL_OK) {
+	goto done;
+    }
+    if ((numWords < 1) || (numWords > 2)) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	        "wrong # args: should be \"set varName ?newValue?\"", -1);
+        result = TCL_ERROR;
+	goto done;
+    }
+    isAssignment = (numWords == 2);
+
+    /*
+     * Parse the next word: the variable name. If the name is enclosed in
+     * quotes or braces, we return TCL_OUT_LINE_COMPILE and call the set
+     * command procedure at runtime since this makes sure that a second
+     * round of substitutions is done properly. 
+     */
+
+    wordStart = argInfo.startArray[0]; /* start of 1st arg word: varname */
+    if ((*wordStart == '{') || (*wordStart == '"')) {
+	result = TCL_OUT_LINE_COMPILE;
+	goto done;
+    }
+
+    /*
+     * Check whether the name is "simple": requires no substitutions at
+     * runtime.
+     */
+    
+    envPtr->pushSimpleWords = 0;
+    result = CompileWord(interp, wordStart, argInfo.endArray[0] + 1,
+	    flags, envPtr);
+    if (result != TCL_OK) {
+	goto done;
+    }
+    simpleVarName = envPtr->wordIsSimple;
+    
+    if (!simpleVarName) {
+	/*
+	 * The name isn't simple. CompileWord already pushed it.
+	 */
+	
+	maxDepth = envPtr->maxStackDepth;
+    } else {
+	char *name;		/* If simpleVarName, points to first char of
+				 * variable name and nameChars is length.
+				 * Otherwise NULL. */
+	int nameChars;		/* Length of the var name. */
+	int nameHasNsSeparators = 0;
+				/* Set 1 if name contains "::"s. */
+	int elNameChars;	/* Length of array's element name if any. */
+
+	/*
+	 * A simple name. First divide it up into "name" plus "elName"
+	 * for an array element name, if any.
+	 */
+	
+	name = wordStart;
+	nameChars = envPtr->numSimpleWordChars;
+	elName = NULL;
+	elNameChars = 0;
+	
+	p = name;
+	for (i = 0;  i < nameChars;  i++) {
+	    if (*p == '(') {
+		char *openParen = p;
+		p = (name + nameChars-1);	
+		if (*p == ')') { /* last char is ')' => array reference */
+		    nameChars = (openParen - name);
+		    elName = openParen+1;
+		    elNameChars = (p - elName);
+		}
+		break;
+	    }
+	    p++;
+	}
+
+	/*
+	 * Determine if name has any namespace separators (::'s).
+	 */
+
+	p = name;
+	for (i = 0;  i < nameChars;  i++) {
+	    if ((*p == ':') && ((i+1) < nameChars) && (*(p+1) == ':')) {
+		nameHasNsSeparators = 1;
+		break;
+	    }
+	    p++;
+	}
+
+	/*
+	 * Now either push the name or determine its index in the array of
+	 * local variables in a procedure frame. Note that if we are
+	 * compiling a procedure the variable must be local unless its
+	 * name has namespace separators ("::"s). Note also that global
+	 * variables are implemented by a local variable that "points" to
+	 * the real global. There are two cases:
+	 *   1) We are not compiling a procedure body. Push the global
+	 *      variable's name and do the lookup at runtime.
+	 *   2) We are compiling a procedure and the name has "::"s.
+	 *	Push the namespace variable's name and do the lookup at
+	 *	runtime.
+	 *   3) We are compiling a procedure and the name has no "::"s.
+	 *	If the variable has already been allocated an local index,
+	 *	just look it up. If the variable is unknown and we are
+	 *	doing an assignment, allocate a new index. Otherwise,
+	 *	push the name and try to do the lookup at runtime.
+	 */
+
+	if ((procPtr == NULL) || nameHasNsSeparators) {
+	    savedChar = name[nameChars];
+	    name[nameChars] = '\0';
+	    objIndex = TclObjIndexForString(name, nameChars,
+		    /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+	    name[nameChars] = savedChar;
+	    TclEmitPush(objIndex, envPtr);
+	    maxDepth = 1;
+	} else {
+	    localIndex = LookupCompiledLocal(name, nameChars,
+	            /*createIfNew*/ isAssignment,
+                    /*flagsIfCreated*/
+			((elName == NULL)? VAR_SCALAR : VAR_ARRAY),
+		    envPtr->procPtr);
+	    if (localIndex >= 0) {
+		maxDepth = 0;
+	    } else {
+		savedChar = name[nameChars];
+		name[nameChars] = '\0';
+		objIndex = TclObjIndexForString(name, nameChars,
+			/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+		name[nameChars] = savedChar;
+		TclEmitPush(objIndex, envPtr);
+		maxDepth = 1;
+	    }
+	}
+
+	/*
+	 * If we are dealing with a reference to an array element, push the
+	 * array element. Perform substitutions on it, just as is done
+	 * for quoted strings.
+	 */
+	
+	if (elName != NULL) {
+	    savedChar = elName[elNameChars];
+	    elName[elNameChars] = '\0';
+	    envPtr->pushSimpleWords = 1;
+	    result = TclCompileQuotes(interp, elName, elName+elNameChars,
+		    0, flags, envPtr);
+	    elName[elNameChars] = savedChar;
+	    if (result != TCL_OK) {
+		char msg[200];
+		sprintf(msg, "\n    (parsing index for array \"%.*s\")",
+			TclMin(nameChars, 100), name);
+		Tcl_AddObjErrorInfo(interp, msg, -1);
+		goto done;
+	    }
+	    maxDepth += envPtr->maxStackDepth;
+	}
+    }
+
+    /*
+     * If we are doing an assignment, push the new value.
+     */
+    
+    if (isAssignment) {
+	wordStart = argInfo.startArray[1]; /* start of 2nd arg word */
+	envPtr->pushSimpleWords = 0;       /* we will handle simple words */
+	result = CompileWord(interp, wordStart,	argInfo.endArray[1] + 1,
+		flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	if (!envPtr->wordIsSimple) {
+	    /*
+	     * The value isn't simple. CompileWord already pushed it.
+	     */
+
+	    maxDepth += envPtr->maxStackDepth;
+	} else {
+	    /*
+	     * The value is simple. See if the word represents an integer
+	     * whose formatted representation is the same as the word (e.g.,
+	     * this is true for 123 and -1 but not for 00005). If so, just
+	     * push an integer object.
+	     */
+	    
+	    char buf[40];
+	    long n;
+
+	    p = wordStart;
+	    if ((*wordStart == '"') || (*wordStart == '{')) {
+		p++;
+	    }
+	    savedChar = p[envPtr->numSimpleWordChars];
+	    p[envPtr->numSimpleWordChars] = '\0';
+	    isCompilableInt = 0;
+	    if (TclLooksLikeInt(p)) {
+		int code = TclGetLong(interp, p, &n);
+		if (code == TCL_OK) {
+		    TclFormatInt(buf, n);
+		    if (strcmp(p, buf) == 0) {
+			isCompilableInt = 1;
+			objIndex = TclObjIndexForString(p,
+				envPtr->numSimpleWordChars,
+                                /*allocStrRep*/ 0, /*inHeap*/ 0, envPtr);
+			objPtr = envPtr->objArrayPtr[objIndex];
+
+			Tcl_InvalidateStringRep(objPtr);
+			objPtr->internalRep.longValue = n;
+			objPtr->typePtr = &tclIntType;
+		    }
+		} else {
+		    Tcl_ResetResult(interp);
+		}
+	    }
+	    if (!isCompilableInt) {
+		objIndex = TclObjIndexForString(p,
+			envPtr->numSimpleWordChars, /*allocStrRep*/ 1,
+			/*inHeap*/ 0, envPtr);
+	    }
+	    p[envPtr->numSimpleWordChars] = savedChar;
+	    TclEmitPush(objIndex, envPtr);
+	    maxDepth += 1;
+	}
+    }
+    
+    /*
+     * Now emit instructions to set/retrieve the variable.
+     */
+
+    if (simpleVarName) {
+	if (elName == NULL) {  /* scalar */
+	    if (localIndex >= 0) {
+		if (localIndex <= 255) {
+		    TclEmitInstUInt1((isAssignment?
+			     INST_STORE_SCALAR1 : INST_LOAD_SCALAR1),
+			localIndex, envPtr);
+		} else {
+		    TclEmitInstUInt4((isAssignment?
+			     INST_STORE_SCALAR4 : INST_LOAD_SCALAR4),
+			localIndex, envPtr);
+		}
+	    } else {
+		TclEmitOpcode((isAssignment?
+			     INST_STORE_SCALAR_STK : INST_LOAD_SCALAR_STK),
+			    envPtr);
+	    }
+	} else {		/* array */
+	    if (localIndex >= 0) {
+		if (localIndex <= 255) {
+		    TclEmitInstUInt1((isAssignment?
+			     INST_STORE_ARRAY1 : INST_LOAD_ARRAY1),
+			localIndex, envPtr);
+		} else {
+		    TclEmitInstUInt4((isAssignment?
+			     INST_STORE_ARRAY4 : INST_LOAD_ARRAY4),
+			localIndex, envPtr);
+		}
+	    } else {
+		TclEmitOpcode((isAssignment?
+			     INST_STORE_ARRAY_STK : INST_LOAD_ARRAY_STK),
+			    envPtr);
+	    }
+	}
+    } else {			/* non-simple variable name */
+	TclEmitOpcode((isAssignment? INST_STORE_STK : INST_LOAD_STK), envPtr);
+    }
+	
+    done:
+    if (numWords == 0) {
+	envPtr->termOffset = 0;
+    } else {
+	envPtr->termOffset = (argInfo.endArray[numWords-1] + 1 - string);
+    }
+    envPtr->pushSimpleWords = savePushSimpleWords;
+    envPtr->maxStackDepth = maxDepth;
+    FreeArgInfo(&argInfo);
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileWhileCmd --
+ *
+ *	Procedure called to compile the "while" command.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is TCL_OK if
+ *	compilation was successful. If an error occurs then the
+ *	interpreter's result contains a standard error message and TCL_ERROR
+ *	is returned. If compilation failed because the command is too
+ *	complex for TclCompileWhileCmd, TCL_OUT_LINE_COMPILE is returned
+ *	indicating that the while command should be compiled "out of line"
+ *	by emitting code to invoke its command procedure at runtime.
+ *
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the "while" command.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to evaluate the "while" command
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileWhileCmd(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *string;		/* The source string to compile. */
+    char *lastChar;		 /* Pointer to terminating character of
+				  * string. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    register char *src = string;/* Points to current source char. */
+    register int type;		/* Current char's CHAR_TYPE type. */
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute cmd. */
+    int range = -1;		/* Index in the ExceptionRange array of the
+				 * ExceptionRange record for this loop. */
+    JumpFixup jumpFalseFixup;	/* Used to update or replace the ifFalse
+				 * jump after test when its target PC is
+				 * determined. */
+    unsigned char *jumpPc;
+    int jumpDist, jumpBackDist, jumpBackOffset, objIndex, result;
+    int savePushSimpleWords = envPtr->pushSimpleWords;
+
+    AdvanceToNextWord(src, envPtr);
+    src += envPtr->termOffset;
+    type = CHAR_TYPE(src, lastChar);
+    if (type == TCL_COMMAND_END) {
+	badArgs:
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	        "wrong # args: should be \"while test command\"", -1);
+	result = TCL_ERROR;
+	goto done;
+    }
+
+    /*
+     * If the test expression is not enclosed in braces, don't compile
+     * the while inline. As a result of Tcl's two level substitution
+     * semantics for expressions, the expression might have a constant
+     * value that results in the loop never executing, or executing forever.
+     * Consider "set x 0; whie "$x > 5" {incr x}": the loop body 
+     * should never be executed.
+     * NOTE: This is an overly aggressive test, since there are legitimate
+     * literals that could be compiled but aren't in braces.  However, until
+     * the parser is integrated in 8.1, this is the simplest implementation.
+     */
+
+    if (*src != '{') {
+	result = TCL_OUT_LINE_COMPILE;
+	goto done;
+    }
+
+    /*
+     * Create and initialize a ExceptionRange record to hold information
+     * about this loop. This is used to implement break and continue.
+     */
+
+    envPtr->excRangeDepth++;
+    envPtr->maxExcRangeDepth =
+	TclMax(envPtr->excRangeDepth, envPtr->maxExcRangeDepth);
+
+    range = CreateExceptionRange(LOOP_EXCEPTION_RANGE, envPtr);
+    envPtr->excRangeArrayPtr[range].continueOffset = TclCurrCodeOffset();
+
+    /*
+     * Compile the next word: the test expression.
+     */
+
+    envPtr->pushSimpleWords = 1;
+    result = CompileExprWord(interp, src, lastChar, flags, envPtr);
+    if (result != TCL_OK) {
+	if (result == TCL_ERROR) {
+            Tcl_AddObjErrorInfo(interp,
+		    "\n    (\"while\" test expression)", -1);
+        }
+	goto done;
+    }
+    maxDepth = envPtr->maxStackDepth;
+    src += envPtr->termOffset;
+
+    /*
+     * Emit the ifFalse jump that terminates the while if the test was
+     * false. We emit a one byte (relative) jump here, and replace it
+     * later with a four byte jump if the jump target is more than
+     * 127 bytes away.
+     */
+
+    TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
+    
+    /*
+     * Compile the loop body word inline. Also register the loop body's
+     * starting PC offset and byte length in the its ExceptionRange record.
+     */
+
+    AdvanceToNextWord(src, envPtr);
+    src += envPtr->termOffset;
+    type = CHAR_TYPE(src, lastChar);
+    if (type == TCL_COMMAND_END) {
+	goto badArgs;
+    }
+
+    envPtr->excRangeArrayPtr[range].codeOffset = TclCurrCodeOffset();
+    result = CompileCmdWordInline(interp, src, lastChar,
+	    flags, envPtr);
+    if (result != TCL_OK) {
+	if (result == TCL_ERROR) {
+	    char msg[60];
+	    sprintf(msg, "\n    (\"while\" body line %d)", interp->errorLine);
+            Tcl_AddObjErrorInfo(interp, msg, -1);
+        }
+	goto done;
+    }
+    maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+    src += envPtr->termOffset;
+    envPtr->excRangeArrayPtr[range].numCodeBytes =
+	(TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range].codeOffset);
+
+    /*
+     * Discard the loop body's result.
+     */
+
+    TclEmitOpcode(INST_POP, envPtr);
+	
+    /*
+     * Emit the unconditional jump back to the test at the top of the
+     * loop. We generate a four byte jump if the distance to the while's
+     * test is greater than 120 bytes. This is conservative, and ensures
+     * that we won't have to replace this unconditional jump if we later
+     * need to replace the ifFalse jump with a four-byte jump.
+     */
+
+    jumpBackOffset = TclCurrCodeOffset();
+    jumpBackDist =
+	(jumpBackOffset - envPtr->excRangeArrayPtr[range].continueOffset);
+    if (jumpBackDist > 120) {
+	TclEmitInstInt4(INST_JUMP4, /*offset*/ -jumpBackDist, envPtr);
+    } else {
+	TclEmitInstInt1(INST_JUMP1, /*offset*/ -jumpBackDist, envPtr);
+    }
+
+    /*
+     * Now that we know the target of the jumpFalse after the test, update
+     * it with the correct distance. If the distance is too great (more
+     * than 127 bytes), replace that jump with a four byte instruction and
+     * move the instructions after the jump down. 
+     */
+
+    jumpDist = (TclCurrCodeOffset() - jumpFalseFixup.codeOffset);
+    if (TclFixupForwardJump(envPtr, &jumpFalseFixup, jumpDist, 127)) {
+	/*
+	 * Update the loop body's starting PC offset since it moved down.
+	 */
+
+	envPtr->excRangeArrayPtr[range].codeOffset += 3;
+
+	/*
+	 * Update the distance for the unconditional jump back to the test
+	 * at the top of the loop since it moved down 3 bytes too.
+	 */
+
+	jumpBackOffset += 3;
+	jumpPc = (envPtr->codeStart + jumpBackOffset);
+	if (jumpBackDist > 120) {
+	    jumpBackDist += 3;
+	    TclUpdateInstInt4AtPc(INST_JUMP4, /*offset*/ -jumpBackDist,
+				   jumpPc);
+	} else {
+	    jumpBackDist += 3;
+	    TclUpdateInstInt1AtPc(INST_JUMP1, /*offset*/ -jumpBackDist,
+				   jumpPc);
+	}
+    }
+
+    /*
+     * The current PC offset (after the loop's body) is the loop's
+     * break target.
+     */
+
+    envPtr->excRangeArrayPtr[range].breakOffset = TclCurrCodeOffset();
+    
+    /*
+     * Push an empty string object as the while command's result.
+     */
+
+    objIndex = TclObjIndexForString("", 0, /*allocStrRep*/ 0, /*inHeap*/ 0,
+				    envPtr);
+    TclEmitPush(objIndex, envPtr);
+    if (maxDepth == 0) {
+	maxDepth = 1;
+    }
+
+    /*
+     * Skip over white space until the end of the command.
+     */
+
+    type = CHAR_TYPE(src, lastChar);
+    if (type != TCL_COMMAND_END) {
+	AdvanceToNextWord(src, envPtr);
+	src += envPtr->termOffset;
+	type = CHAR_TYPE(src, lastChar);
+	if (type != TCL_COMMAND_END) {
+	    goto badArgs;
+	}
+    }
+
+    done:
+    envPtr->termOffset = (src - string);
+    envPtr->pushSimpleWords = savePushSimpleWords;
+    envPtr->maxStackDepth = maxDepth;
+    if (range != -1) {
+	envPtr->excRangeDepth--;
+    }
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileExprWord --
+ *
+ *	Procedure that compiles a Tcl expression in a command word.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is TCL_OK unless
+ *	there was an error while compiling string. If an error occurs then
+ *	the interpreter's result contains a standard error message.
+ *
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the "expr" word.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to evaluate the expression word
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileExprWord(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *string;		/* The source string to compile. */
+    char *lastChar;		 /* Pointer to terminating character of
+				  * string. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    register char *src = string;/* Points to current source char. */
+    register int type;          /* Current char's CHAR_TYPE type. */
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute the expression. */
+    int nestedCmd = (flags & TCL_BRACKET_TERM);
+				/* 1 if script being compiled is a nested
+				 * command and is terminated by a ']';
+				 * otherwise 0. */
+    char *first, *last;		/* Points to the first and last significant
+				 * characters of the word. */
+    char savedChar;		/* Holds the character termporarily replaced
+				 * by a null character during compilation
+				 * of the expression. */
+    int inlineCode;		/* 1 if inline "optimistic" code is
+				 * emitted for the expression; else 0. */
+    int range = -1;		/* If we inline compile an un-{}'d
+				 * expression, the index for its catch range
+				 * record in the ExceptionRange array.
+				 * Initialized to enable proper cleanup. */
+    JumpFixup jumpFixup;	/* Used to emit the "success" jump after
+				 * the inline expression code. */
+    char *p;
+    char c;
+    int savePushSimpleWords = envPtr->pushSimpleWords;
+    int saveExprIsJustVarRef = envPtr->exprIsJustVarRef;
+    int saveExprIsComparison = envPtr->exprIsComparison;
+    int numChars, result;
+
+    /*
+     * Skip over leading white space.
+     */
+
+    AdvanceToNextWord(src, envPtr);
+    src += envPtr->termOffset;
+    type = CHAR_TYPE(src, lastChar);
+    if (type == TCL_COMMAND_END) {
+	badArgs:
+	Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		    "malformed expression word", -1);
+	result = TCL_ERROR;
+	goto done;
+    }
+
+    /*
+     * If the word is enclosed in {}s, we may strip them off and safely
+     * compile the expression into an inline sequence of instructions using
+     * TclCompileExpr. We know these instructions will have the right Tcl7.x
+     * expression semantics.
+     *
+     * Otherwise, if the word is not enclosed in {}s, we may need to call
+     * the expr command (Tcl_ExprObjCmd) at runtime. This recompiles the
+     * expression each time (typically) and so is slow. However, there are
+     * some circumstances where we can still compile inline instructions
+     * "optimistically" and check, during their execution, for double
+     * substitutions (these appear as nonnumeric operands). We check for any
+     * backslash or command substitutions. If none appear, and only variable
+     * substitutions are found, we generate inline instructions.
+     *
+     * For now, if the expression is not enclosed in {}s, we call the expr
+     * command at runtime if either command or backslash substitutions
+     * appear (but not if only variable substitutions appear).
+     */
+
+    if (*src == '{') {
+	/*
+	 * Inline compile the expression inside {}s.
+	 */
+	
+	first = src+1;
+	src = TclWordEnd(src, lastChar, nestedCmd, NULL);
+	if (*src == 0) {
+	    goto badArgs;
+	}
+	if (*src != '}') {
+	    goto badArgs;
+	}
+	last = (src-1);
+
+	numChars = (last - first + 1);
+	savedChar = first[numChars];
+	first[numChars] = '\0';
+	result = TclCompileExpr(interp, first, first+numChars,
+		flags, envPtr);
+	first[numChars] = savedChar;
+
+	src++;
+	maxDepth = envPtr->maxStackDepth;
+    } else {
+	/*
+	 * No braces. If the expression is enclosed in '"'s, call the expr
+	 * cmd at runtime. Otherwise, scan the word's characters looking for
+	 * any '['s or (for now) '\'s. If any are found, just call expr cmd
+	 * at runtime.
+	 */
+
+	first = src;
+	last = TclWordEnd(first, lastChar, nestedCmd, NULL);
+	if (*last == 0) {	/* word doesn't end properly. */
+	    src = last;
+	    goto badArgs;
+	}
+
+	inlineCode = 1;
+	if ((*first == '"') && (*last == '"')) {
+	    inlineCode = 0;
+	} else {
+	    for (p = first;  p <= last;  p++) {
+		c = *p;
+		if ((c == '[') || (c == '\\')) {
+		    inlineCode = 0;
+		    break;
+		}
+	    }
+	}
+	
+	if (inlineCode) {
+	    /*
+	     * Inline compile the expression inside a "catch" so that a
+	     * runtime error will back off to make a (slow) call on expr.
+	     */
+
+	    int startCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+	    int startRangeNext = envPtr->excRangeArrayNext;
+
+	    /*
+	     * Create a ExceptionRange record to hold information about
+	     * the "catch" range for the expression's inline code. Also
+	     * emit the instruction to mark the start of the range.
+	     */
+
+	    envPtr->excRangeDepth++;
+	    envPtr->maxExcRangeDepth =
+		TclMax(envPtr->excRangeDepth, envPtr->maxExcRangeDepth);
+	    range = CreateExceptionRange(CATCH_EXCEPTION_RANGE, envPtr);
+	    TclEmitInstUInt4(INST_BEGIN_CATCH4, range, envPtr);
+
+	    /*
+	     * Inline compile the expression.
+	     */
+
+	    envPtr->excRangeArrayPtr[range].codeOffset = TclCurrCodeOffset();
+	    numChars = (last - first + 1);
+	    savedChar = first[numChars];
+	    first[numChars] = '\0';
+	    result = TclCompileExpr(interp, first, first + numChars,
+		    flags, envPtr);
+	    first[numChars] = savedChar;
+	    
+	    envPtr->excRangeArrayPtr[range].numCodeBytes =
+		TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range].codeOffset;
+
+	    if ((result != TCL_OK) || (envPtr->exprIsJustVarRef)
+	            || (envPtr->exprIsComparison)) {
+		/*
+		 * We must call the expr command at runtime. Either there
+		 * was a compilation error or the inline code might fail to
+		 * give the correct 2 level substitution semantics.
+		 *
+		 * The latter can happen if the expression consisted of just
+		 * a single variable reference or if the top-level operator
+		 * in the expr is a comparison (which might operate on
+		 * strings). In the latter case, the expression's code might
+		 * execute (apparently) successfully but produce the wrong
+		 * result. We depend on its execution failing if a second
+		 * level of substitutions is required. This causes the
+		 * "catch" code we generate around the inline code to back
+		 * off to a call on the expr command at runtime, and this
+		 * always gives the right 2 level substitution semantics.
+		 *
+		 * We delete the inline code by backing up the code pc and
+		 * catch index. Note that if there was a compilation error,
+		 * we can't report the error yet since the expression might
+		 * be valid after the second round of substitutions.
+		 */
+		
+		envPtr->codeNext = (envPtr->codeStart + startCodeOffset);
+		envPtr->excRangeArrayNext = startRangeNext;
+		inlineCode = 0;
+	    } else {
+		TclEmitOpcode(INST_END_CATCH, envPtr); /* for ok case */
+		TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
+		envPtr->excRangeArrayPtr[range].catchOffset = TclCurrCodeOffset();
+		TclEmitOpcode(INST_END_CATCH, envPtr); /* for error case */
+	    }
+	}
+	    
+	/*
+	 * Arrange to call expr at runtime with the (already substituted
+	 * once) expression word on the stack.
+	 */
+
+	envPtr->pushSimpleWords = 1;
+	result = CompileWord(interp, first, lastChar, flags, envPtr);
+	src += envPtr->termOffset;
+	maxDepth = envPtr->maxStackDepth;
+	if (result == TCL_OK) {
+	    TclEmitOpcode(INST_EXPR_STK, envPtr);
+	}
+
+	/*
+	 * If emitting inline code for this non-{}'d expression, update
+	 * the target of the jump after that inline code.
+	 */
+
+	if (inlineCode) {
+	    int jumpDist = (TclCurrCodeOffset() - jumpFixup.codeOffset);
+	    if (TclFixupForwardJump(envPtr, &jumpFixup, jumpDist, 127)) {
+		/*
+		 * Update the inline expression code's catch ExceptionRange
+		 * target since it, being after the jump, also moved down.
+		 */
+
+		envPtr->excRangeArrayPtr[range].catchOffset += 3;
+	    }
+	}
+    } /* if expression isn't in {}s */
+    
+    done:
+    if (range != -1) {
+	envPtr->excRangeDepth--;
+    }
+    envPtr->termOffset = (src - string);
+    envPtr->maxStackDepth = maxDepth;
+    envPtr->pushSimpleWords = savePushSimpleWords;
+    envPtr->exprIsJustVarRef = saveExprIsJustVarRef;
+    envPtr->exprIsComparison = saveExprIsComparison;
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileCmdWordInline --
+ *
+ *	Procedure that compiles a Tcl command word inline. If the word is
+ *	enclosed in quotes or braces, we call TclCompileString to compile it
+ *	after stripping them off. Otherwise, we normally push the word's
+ *	value and call eval at runtime, but if the word is just a sequence
+ *	of alphanumeric characters, we emit an invoke instruction
+ *	directly. This procedure assumes that string points to the start of
+ *	the word to compile.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is TCL_OK unless
+ *	there was an error while compiling string. If an error occurs then
+ *	the interpreter's result contains a standard error message.
+ *
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the command.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the command word
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileCmdWordInline(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *string;		/* The source string to compile. */
+    char *lastChar;		/* Pointer to terminating character of
+				 * string. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    Interp *iPtr = (Interp *) interp;
+    register char *src = string;/* Points to current source char. */
+    register int type;          /* Current char's CHAR_TYPE type. */
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute cmd. */
+    char *termPtr;		/* Points to char that terminated braced
+				 * string. */
+    char savedChar;		/* Holds the character termporarily replaced
+				 * by a null character during compilation
+				 * of the command. */
+    int savePushSimpleWords = envPtr->pushSimpleWords;
+    int objIndex;
+    int result = TCL_OK;
+    register char c;
+
+    type = CHAR_TYPE(src, lastChar);
+    if (type & (TCL_QUOTE | TCL_OPEN_BRACE)) {
+	src++;
+	envPtr->pushSimpleWords = 0;
+	if (type == TCL_QUOTE) {
+	    result = TclCompileQuotes(interp, src, lastChar,
+		    '"', flags, envPtr);
+	} else {
+	    result = CompileBraces(interp, src, lastChar, flags, envPtr);
+	}
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	
+	/*
+	 * Make sure the terminating character is the end of word.
+	 */
+	
+	termPtr = (src + envPtr->termOffset);
+	c = *termPtr;
+	if ((c == '\\') && (*(termPtr+1) == '\n')) {
+	    /*
+	     * Line is continued on next line; the backslash-newline turns
+	     * into space, which terminates the word.
+	     */
+	} else {
+	    type = CHAR_TYPE(termPtr, lastChar);
+	    if ((type != TCL_SPACE) && (type != TCL_COMMAND_END)) {
+		Tcl_ResetResult(interp);
+		if (*(src-1) == '"') {
+		    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+			    "extra characters after close-quote", -1);
+		} else {
+		    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		            "extra characters after close-brace", -1);
+		}
+		result = TCL_ERROR;
+		goto done;
+	    }
+	}
+	
+	if (envPtr->wordIsSimple) {
+	    /*
+	     * A simple word enclosed in "" or {}s. Call TclCompileString to
+	     * compile it inline. Add a null character after the end of the
+	     * quoted or braced string: i.e., at the " or }. Turn the
+	     * flag bit TCL_BRACKET_TERM off since the recursively
+	     * compiled subcommand is now terminated by a null character.
+	     */
+	    char *closeCharPos = (termPtr - 1);
+	    
+	    savedChar = *closeCharPos;
+	    *closeCharPos = '\0';
+	    result = TclCompileString(interp, src, closeCharPos,
+		    (flags & ~TCL_BRACKET_TERM), envPtr);
+	    *closeCharPos = savedChar;
+	    if (result != TCL_OK) {
+		goto done;
+	    }
+	} else {
+            /*
+	     * The braced string contained a backslash-newline. Call eval
+	     * at runtime.
+	     */
+	    TclEmitOpcode(INST_EVAL_STK, envPtr);
+	}
+	src = termPtr;
+	maxDepth = envPtr->maxStackDepth;
+    } else {
+	/*
+	 * Not a braced or quoted string. We normally push the word's
+	 * value and call eval at runtime. However, if the word is just
+	 * a sequence of alphanumeric characters, we call its compile
+	 * procedure, if any, or otherwise just emit an invoke instruction.
+	 */
+
+	char *p = src;
+	c = *p;
+	while (isalnum(UCHAR(c)) || (c == '_')) {
+            p++;
+            c = *p;
+        }
+	type = CHAR_TYPE(p, lastChar);
+        if ((p > src) && (type == TCL_COMMAND_END)) {
+            /*
+	     * Look for a compile procedure and call it. Otherwise emit an
+	     * invoke instruction to call the command at runtime.
+	     */
+
+	    Tcl_Command cmd;
+	    Command *cmdPtr = NULL;
+	    int wasCompiled = 0;
+
+	    savedChar = *p;
+	    *p = '\0';
+
+	    cmd = Tcl_FindCommand(interp, src, (Tcl_Namespace *) NULL,
+		    /*flags*/ 0);
+	    if (cmd != (Tcl_Command) NULL) {
+                cmdPtr = (Command *) cmd;
+            }
+	    if (cmdPtr != NULL && cmdPtr->compileProc != NULL) {
+		*p = savedChar;
+		src = p;
+		iPtr->flags &= ~(ERR_ALREADY_LOGGED | ERR_IN_PROGRESS
+				 | ERROR_CODE_SET);
+		result = (*(cmdPtr->compileProc))(interp, src, lastChar, flags, envPtr);
+		if (result != TCL_OK) {
+		    goto done;
+		}
+		wasCompiled = 1;
+		src += envPtr->termOffset;
+		maxDepth = envPtr->maxStackDepth;
+	    }
+	    if (!wasCompiled) {
+		objIndex = TclObjIndexForString(src, p-src,
+			/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+		*p = savedChar;
+		TclEmitPush(objIndex, envPtr);
+		TclEmitInstUInt1(INST_INVOKE_STK1, 1, envPtr);
+		src = p;
+		maxDepth = 1;
+	    }
+        } else {
+	    /*
+	     * Push the word and call eval at runtime.
+	     */
+
+	    envPtr->pushSimpleWords = 1;
+	    result = CompileWord(interp, src, lastChar, flags, envPtr);
+	    if (result != TCL_OK) {
+		goto done;
+	    }
+	    TclEmitOpcode(INST_EVAL_STK, envPtr);
+	    src += envPtr->termOffset;
+	    maxDepth = envPtr->maxStackDepth;
+	}
+    }
+
+    done:
+    envPtr->termOffset = (src - string);
+    envPtr->maxStackDepth = maxDepth;
+    envPtr->pushSimpleWords = savePushSimpleWords;
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * LookupCompiledLocal --
+ *
+ *	This procedure is called at compile time to look up and optionally
+ *	allocate an entry ("slot") for a variable in a procedure's array of
+ *	local variables. If the variable's name is NULL, a new temporary
+ *	variable is always created. (Such temporary variables can only be
+ *	referenced using their slot index.)
+ *
+ * Results:
+ *	If createIfNew is 0 (false) and the name is non-NULL, then if the
+ *	variable is found, the index of its entry in the procedure's array
+ *	of local variables is returned; otherwise -1 is returned.
+ *	If name is NULL, the index of a new temporary variable is returned.
+ *	Finally, if createIfNew is 1 and name is non-NULL, the index of a
+ *	new entry is returned.
+ *
+ * Side effects:
+ *	Creates and registers a new local variable if createIfNew is 1 and
+ *	the variable is unknown, or if the name is NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+LookupCompiledLocal(name, nameChars, createIfNew, flagsIfCreated, procPtr)
+    register char *name;	/* Points to first character of the name of
+				 * a scalar or array variable. If NULL, a
+				 * temporary var should be created. */
+    int nameChars;		/* The length of the name excluding the
+				 * terminating null character. */
+    int createIfNew;		/* 1 to allocate a local frame entry for the
+				 * variable if it is new. */
+    int flagsIfCreated;		/* Flag bits for the compiled local if
+				 * created. Only VAR_SCALAR, VAR_ARRAY, and
+				 * VAR_LINK make sense. */
+    register Proc *procPtr;	/* Points to structure describing procedure
+				 * containing the variable reference. */
+{
+    register CompiledLocal *localPtr;
+    int localIndex = -1;
+    register int i;
+    int localCt;
+
+    /*
+     * If not creating a temporary, does a local variable of the specified
+     * name already exist?
+     */
+
+    if (name != NULL) {	
+	localCt = procPtr->numCompiledLocals;
+	localPtr = procPtr->firstLocalPtr;
+	for (i = 0;  i < localCt;  i++) {
+	    if (!TclIsVarTemporary(localPtr)) {
+		char *localName = localPtr->name;
+		if ((name[0] == localName[0])
+	                && (nameChars == localPtr->nameLength)
+	                && (strncmp(name, localName, (unsigned) nameChars) == 0)) {
+		    return i;
+		}
+	    }
+	    localPtr = localPtr->nextPtr;
+	}
+    }
+
+    /*
+     * Create a new variable if appropriate.
+     */
+    
+    if (createIfNew || (name == NULL)) {
+	localIndex = procPtr->numCompiledLocals;
+	localPtr = (CompiledLocal *) ckalloc((unsigned) 
+	        (sizeof(CompiledLocal) - sizeof(localPtr->name)
+		+ nameChars+1));
+	if (procPtr->firstLocalPtr == NULL) {
+	    procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
+	} else {
+	    procPtr->lastLocalPtr->nextPtr = localPtr;
+	    procPtr->lastLocalPtr = localPtr;
+	}
+	localPtr->nextPtr = NULL;
+	localPtr->nameLength = nameChars;
+	localPtr->frameIndex = localIndex;
+	localPtr->flags = flagsIfCreated;
+	if (name == NULL) {
+	    localPtr->flags |= VAR_TEMPORARY;
+	}
+	localPtr->defValuePtr = NULL;
+ 	localPtr->resolveInfo = NULL;
+ 	
+	if (name != NULL) {
+	    memcpy((VOID *) localPtr->name, (VOID *) name, (size_t) nameChars);
+	}
+	localPtr->name[nameChars] = '\0';
+	procPtr->numCompiledLocals++;
+    }
+    return localIndex;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInitCompiledLocals --
+ *
+ *	This routine is invoked in order to initialize the compiled
+ *	locals table for a new call frame.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May invoke various name resolvers in order to determine which
+ *	variables are being referenced at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclInitCompiledLocals(interp, framePtr, nsPtr)
+    Tcl_Interp *interp;		/* Current interpreter. */
+    CallFrame *framePtr;	/* Call frame to initialize. */
+    Namespace *nsPtr;		/* Pointer to current namespace. */
+{
+    register CompiledLocal *localPtr;
+    Interp *iPtr = (Interp*) interp;
+    Tcl_ResolvedVarInfo *vinfo, *resVarInfo;
+    Var *varPtr = framePtr->compiledLocals;
+    Var *resolvedVarPtr;
+    ResolverScheme *resPtr;
+    int result;
+
+    /*
+     * Initialize the array of local variables stored in the call frame.
+     * Some variables may have special resolution rules.  In that case,
+     * we call their "resolver" procs to get our hands on the variable,
+     * and we make the compiled local a link to the real variable.
+     */
+
+    for (localPtr = framePtr->procPtr->firstLocalPtr;
+	 localPtr != NULL;
+	 localPtr = localPtr->nextPtr) {
+
+	/*
+	 * Check to see if this local is affected by namespace or
+	 * interp resolvers.  The resolver to use is cached for the
+	 * next invocation of the procedure.
+	 */
+
+	if (!(localPtr->flags & (VAR_ARGUMENT|VAR_TEMPORARY|VAR_RESOLVED))
+		&& (nsPtr->compiledVarResProc || iPtr->resolverPtr)) {
+	    resPtr = iPtr->resolverPtr;
+
+	    if (nsPtr->compiledVarResProc) {
+		result = (*nsPtr->compiledVarResProc)(nsPtr->interp,
+			localPtr->name, localPtr->nameLength,
+			(Tcl_Namespace *) nsPtr, &vinfo);
+	    } else {
+		result = TCL_CONTINUE;
+	    }
+
+	    while ((result == TCL_CONTINUE) && resPtr) {
+		if (resPtr->compiledVarResProc) {
+		    result = (*resPtr->compiledVarResProc)(nsPtr->interp,
+			    localPtr->name, localPtr->nameLength,
+			    (Tcl_Namespace *) nsPtr, &vinfo);
+		}
+		resPtr = resPtr->nextPtr;
+	    }
+	    if (result == TCL_OK) {
+		localPtr->resolveInfo = vinfo;
+		localPtr->flags |= VAR_RESOLVED;
+	    }
+	}
+
+	/*
+	 * Now invoke the resolvers to determine the exact variables that
+	 * should be used.
+	 */
+
+        resVarInfo = localPtr->resolveInfo;
+        resolvedVarPtr = NULL;
+
+        if (resVarInfo && resVarInfo->fetchProc) {
+            resolvedVarPtr = (Var*) (*resVarInfo->fetchProc)(interp,
+                resVarInfo);
+        }
+
+        if (resolvedVarPtr) {
+	    varPtr->name = localPtr->name; /* will be just '\0' if temp var */
+	    varPtr->nsPtr = NULL;
+	    varPtr->hPtr = NULL;
+	    varPtr->refCount = 0;
+	    varPtr->tracePtr = NULL;
+	    varPtr->searchPtr = NULL;
+	    varPtr->flags = 0;
+            TclSetVarLink(varPtr);
+            varPtr->value.linkPtr = resolvedVarPtr;
+            resolvedVarPtr->refCount++;
+        } else {
+	    varPtr->value.objPtr = NULL;
+	    varPtr->name = localPtr->name; /* will be just '\0' if temp var */
+	    varPtr->nsPtr = NULL;
+	    varPtr->hPtr = NULL;
+	    varPtr->refCount = 0;
+	    varPtr->tracePtr = NULL;
+	    varPtr->searchPtr = NULL;
+	    varPtr->flags = (localPtr->flags | VAR_UNDEFINED);
+        }
+	varPtr++;
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AdvanceToNextWord --
+ *
+ *	This procedure is called to skip over any leading white space at the
+ *	start of a word. Note that a backslash-newline is treated as a
+ *	space.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Updates envPtr->termOffset with the offset of the first
+ *	character in "string" that was not white space or a
+ *	backslash-newline. This might be the offset of the character that
+ *	ends the command: a newline, null, semicolon, or close-bracket.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AdvanceToNextWord(string, envPtr)
+    char *string;		/* The source string to compile. */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    register char *src;		/* Points to current source char. */
+    register int type;		/* Current char's CHAR_TYPE type. */
+    
+    src = string;
+    type = CHAR_TYPE(src, src+1);
+    while (type & (TCL_SPACE | TCL_BACKSLASH)) {
+	if (type == TCL_BACKSLASH) {
+	    if (src[1] == '\n') {
+		src += 2;
+	    } else {
+		break;		/* exit loop; no longer white space */
+	    }
+	} else {
+	    src++;
+	}
+	type = CHAR_TYPE(src, src+1);
+    }
+    envPtr->termOffset = (src - string);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Backslash --
+ *
+ *	Figure out how to handle a backslash sequence.
+ *
+ * Results:
+ *	The return value is the character that should be substituted
+ *	in place of the backslash sequence that starts at src.  If
+ *	readPtr isn't NULL then it is filled in with a count of the
+ *	number of characters in the backslash sequence.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char
+Tcl_Backslash(src, readPtr)
+    CONST char *src;		/* Points to the backslash character of
+				 * a backslash sequence. */
+    int *readPtr;		/* Fill in with number of characters read
+				 * from src, unless NULL. */
+{
+    CONST char *p = src + 1;
+    char result;
+    int count;
+
+    count = 2;
+
+    switch (*p) {
+	/*
+         * Note: in the conversions below, use absolute values (e.g.,
+         * 0xa) rather than symbolic values (e.g. \n) that get converted
+         * by the compiler.  It's possible that compilers on some
+         * platforms will do the symbolic conversions differently, which
+         * could result in non-portable Tcl scripts.
+         */
+
+        case 'a':
+            result = 0x7;
+            break;
+        case 'b':
+            result = 0x8;
+            break;
+        case 'f':
+            result = 0xc;
+            break;
+        case 'n':
+            result = 0xa;
+            break;
+        case 'r':
+            result = 0xd;
+            break;
+        case 't':
+            result = 0x9;
+            break;
+        case 'v':
+            result = 0xb;
+            break;
+        case 'x':
+            if (isxdigit(UCHAR(p[1]))) {
+                char *end;
+
+                result = (char) strtoul(p+1, &end, 16);
+                count = end - src;
+            } else {
+                count = 2;
+                result = 'x';
+            }
+            break;
+        case '\n':
+            do {
+                p++;
+            } while ((*p == ' ') || (*p == '\t'));
+            result = ' ';
+            count = p - src;
+            break;
+        case 0:
+            result = '\\';
+            count = 1;
+            break;
+	default:
+	    if (isdigit(UCHAR(*p))) {
+		result = (char)(*p - '0');
+		p++;
+		if (!isdigit(UCHAR(*p))) {
+		    break;
+		}
+		count = 3;
+		result = (char)((result << 3) + (*p - '0'));
+		p++;
+		if (!isdigit(UCHAR(*p))) {
+		    break;
+		}
+		count = 4;
+		result = (char)((result << 3) + (*p - '0'));
+		break;
+	    }
+	    result = *p;
+	    count = 2;
+	    break;
+    }
+
+    if (readPtr != NULL) {
+	*readPtr = count;
+    }
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclObjIndexForString --
+ *
+ *	Procedure to find, or if necessary create, an object in a
+ *	CompileEnv's object array that has a string representation
+ *	matching the argument string.
+ *
+ * Results:
+ *	The index in the CompileEnv's object array of an object with a
+ *	string representation matching the argument "string". The object is
+ *	created if necessary. If inHeap is 1, then string is heap allocated
+ *	and ownership of the string is passed to TclObjIndexForString;
+ *	otherwise, the string is owned by the caller and must not be
+ *	modified or freed by TclObjIndexForString. Typically, a caller sets
+ *	inHeap 1 if string is an already heap-allocated buffer holding the
+ *	result of backslash substitutions.
+ *
+ * Side effects:
+ *	A new Tcl object will be created if no existing object matches the
+ *	input string. If allocStrRep is 1 then if a new object is created,
+ *	its string representation is allocated in the heap, else it is left
+ *	NULL. If inHeap is 1, this procedure is given ownership of the
+ * 	string: if an object is created and allocStrRep is 1 then its
+ *	string representation is set directly from string, otherwise
+ *	the string is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclObjIndexForString(string, length, allocStrRep, inHeap, envPtr)
+    register char *string;	/* Points to string for which an object is
+				 * found or created in CompileEnv's object
+				 * array. */
+    int length;			/* Length of string. */
+    int allocStrRep;		/* If 1 then the object's string rep should
+				 * be allocated in the heap. */
+    int inHeap;			/* If 1 then string is heap allocated and
+				 * its ownership is passed to
+				 * TclObjIndexForString. */
+    CompileEnv *envPtr;		/* Points to the CompileEnv in whose object
+				 * array an object is found or created. */
+{
+    register Tcl_Obj *objPtr;	/* Points to the object created for
+				 * the string, if one was created. */
+    int objIndex;		/* Index of matching object. */
+    Tcl_HashEntry *hPtr;
+    int strLength, new;
+    
+    /*
+     * Look up the string in the code's object hashtable. If found, just
+     * return the associated object array index.  Note that if the string
+     * has embedded nulls, we don't create a hash table entry.  This
+     * should be fixed, but we need to update hash tables, first.
+     */
+
+    strLength = strlen(string);
+    if (length == -1) {
+	length = strLength;
+    }
+    if (strLength != length) {
+	hPtr = NULL;
+    } else {
+	hPtr = Tcl_CreateHashEntry(&envPtr->objTable, string, &new);
+	if (!new) {		/* already in object table and array */
+	    objIndex = (int) Tcl_GetHashValue(hPtr);
+	    if (inHeap) {
+		ckfree(string);
+	    }
+	    return objIndex;
+	}
+    }    
+
+    /*
+     * Create a new object holding the string, add it to the object array,
+     * and register its index in the object hashtable.
+     */
+
+    objPtr = Tcl_NewObj();
+    if (allocStrRep) {
+	if (inHeap) {		/* use input string for obj's string rep */
+	    objPtr->bytes = string;
+	} else {
+	    if (length > 0) {
+		objPtr->bytes = ckalloc((unsigned) length + 1);
+		memcpy((VOID *) objPtr->bytes, (VOID *) string,
+			(size_t) length);
+		objPtr->bytes[length] = '\0';
+	    }
+	}
+	objPtr->length = length;
+    } else {			/* leave the string rep NULL */
+	if (inHeap) {
+	    ckfree(string);
+	}
+    }
+
+    if (envPtr->objArrayNext >= envPtr->objArrayEnd) {
+        ExpandObjectArray(envPtr);
+    }
+    objIndex = envPtr->objArrayNext;
+    envPtr->objArrayPtr[objIndex] = objPtr;
+    Tcl_IncrRefCount(objPtr);
+    envPtr->objArrayNext++;
+
+    if (hPtr) {
+	Tcl_SetHashValue(hPtr, objIndex);
+    }
+    return objIndex;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclExpandCodeArray --
+ *
+ *	Procedure that uses malloc to allocate more storage for a
+ *	CompileEnv's code array.
+ *
+ * Results:
+ *	None. 
+ *
+ * Side effects:
+ *	The byte code array in *envPtr is reallocated to a new array of
+ *	double the size, and if envPtr->mallocedCodeArray is non-zero the
+ *	old array is freed. Byte codes are copied from the old array to the
+ *	new one.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclExpandCodeArray(envPtr)
+    CompileEnv *envPtr;		/* Points to the CompileEnv whose code array
+				 * must be enlarged. */
+{
+    /*
+     * envPtr->codeNext is equal to envPtr->codeEnd. The currently defined
+     * code bytes are stored between envPtr->codeStart and
+     * (envPtr->codeNext - 1) [inclusive].
+     */
+    
+    size_t currBytes = TclCurrCodeOffset();
+    size_t newBytes  = 2*(envPtr->codeEnd  - envPtr->codeStart);
+    unsigned char *newPtr = (unsigned char *) ckalloc((unsigned) newBytes);
+
+    /*
+     * Copy from old code array to new, free old code array if needed, and
+     * mark new code array as malloced.
+     */
+ 
+    memcpy((VOID *) newPtr, (VOID *) envPtr->codeStart, currBytes);
+    if (envPtr->mallocedCodeArray) {
+        ckfree((char *) envPtr->codeStart);
+    }
+    envPtr->codeStart = newPtr;
+    envPtr->codeNext = (newPtr + currBytes);
+    envPtr->codeEnd  = (newPtr + newBytes);
+    envPtr->mallocedCodeArray = 1;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ExpandObjectArray --
+ *
+ *	Procedure that uses malloc to allocate more storage for a
+ *	CompileEnv's object array.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object array in *envPtr is reallocated to a new array of
+ *	double the size, and if envPtr->mallocedObjArray is non-zero the
+ *	old array is freed. Tcl_Obj pointers are copied from the old array
+ *	to the new one.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ExpandObjectArray(envPtr)
+    CompileEnv *envPtr;		/* Points to the CompileEnv whose object
+				 * array must be enlarged. */
+{
+    /*
+     * envPtr->objArrayNext is equal to envPtr->objArrayEnd. The currently
+     * allocated Tcl_Obj pointers are stored between elements
+     * 0 and (envPtr->objArrayNext - 1) [inclusive] in the object array
+     * pointed to by objArrayPtr.
+     */
+
+    size_t currBytes = envPtr->objArrayNext * sizeof(Tcl_Obj *);
+    int newElems = 2*envPtr->objArrayEnd;
+    size_t newBytes = newElems * sizeof(Tcl_Obj *);
+    Tcl_Obj **newPtr = (Tcl_Obj **) ckalloc((unsigned) newBytes);
+
+    /*
+     * Copy from old object array to new, free old object array if needed,
+     * and mark new object array as malloced.
+     */
+ 
+    memcpy((VOID *) newPtr, (VOID *) envPtr->objArrayPtr, currBytes);
+    if (envPtr->mallocedObjArray) {
+	ckfree((char *) envPtr->objArrayPtr);
+    }
+    envPtr->objArrayPtr = (Tcl_Obj **) newPtr;
+    envPtr->objArrayEnd = newElems;
+    envPtr->mallocedObjArray = 1;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EnterCmdStartData --
+ *
+ *	Registers the starting source and bytecode location of a
+ *	command. This information is used at runtime to map between
+ *	instruction pc and source locations.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Inserts source and code location information into the compilation
+ *	environment envPtr for the command at index cmdIndex. The
+ *	compilation environment's CmdLocation array is grown if necessary.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EnterCmdStartData(envPtr, cmdIndex, srcOffset, codeOffset)
+    CompileEnv *envPtr;		/* Points to the compilation environment
+				 * structure in which to enter command
+				 * location information. */
+    int cmdIndex;		/* Index of the command whose start data
+				 * is being set. */
+    int srcOffset;		/* Offset of first char of the command. */
+    int codeOffset;		/* Offset of first byte of command code. */
+{
+    CmdLocation *cmdLocPtr;
+    
+    if ((cmdIndex < 0) || (cmdIndex >= envPtr->numCommands)) {
+	panic("EnterCmdStartData: bad command index %d\n", cmdIndex);
+    }
+    
+    if (cmdIndex >= envPtr->cmdMapEnd) {
+	/*
+	 * Expand the command location array by allocating more storage from
+	 * the heap. The currently allocated CmdLocation entries are stored
+	 * from cmdMapPtr[0] up to cmdMapPtr[envPtr->cmdMapEnd] (inclusive).
+	 */
+
+	size_t currElems = envPtr->cmdMapEnd;
+	size_t newElems  = 2*currElems;
+	size_t currBytes = currElems * sizeof(CmdLocation);
+	size_t newBytes  = newElems  * sizeof(CmdLocation);
+	CmdLocation *newPtr = (CmdLocation *) ckalloc((unsigned) newBytes);
+	
+	/*
+	 * Copy from old command location array to new, free old command
+	 * location array if needed, and mark new array as malloced.
+	 */
+	
+	memcpy((VOID *) newPtr, (VOID *) envPtr->cmdMapPtr, currBytes);
+	if (envPtr->mallocedCmdMap) {
+	    ckfree((char *) envPtr->cmdMapPtr);
+	}
+	envPtr->cmdMapPtr = (CmdLocation *) newPtr;
+	envPtr->cmdMapEnd = newElems;
+	envPtr->mallocedCmdMap = 1;
+    }
+
+    if (cmdIndex > 0) {
+	if (codeOffset < envPtr->cmdMapPtr[cmdIndex-1].codeOffset) {
+	    panic("EnterCmdStartData: cmd map table not sorted by code offset");
+	}
+    }
+
+    cmdLocPtr = &(envPtr->cmdMapPtr[cmdIndex]);
+    cmdLocPtr->codeOffset = codeOffset;
+    cmdLocPtr->srcOffset = srcOffset;
+    cmdLocPtr->numSrcChars = -1;
+    cmdLocPtr->numCodeBytes = -1;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EnterCmdExtentData --
+ *
+ *	Registers the source and bytecode length for a command. This
+ *	information is used at runtime to map between instruction pc and
+ *	source locations.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Inserts source and code length information into the compilation
+ *	environment envPtr for the command at index cmdIndex. Starting
+ *	source and bytecode information for the command must already
+ *	have been registered.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EnterCmdExtentData(envPtr, cmdIndex, numSrcChars, numCodeBytes)
+    CompileEnv *envPtr;		/* Points to the compilation environment
+				 * structure in which to enter command
+				 * location information. */
+    int cmdIndex;		/* Index of the command whose source and
+				 * code length data is being set. */
+    int numSrcChars;		/* Number of command source chars. */
+    int numCodeBytes;		/* Offset of last byte of command code. */
+{
+    CmdLocation *cmdLocPtr;
+
+    if ((cmdIndex < 0) || (cmdIndex >= envPtr->numCommands)) {
+	panic("EnterCmdStartData: bad command index %d\n", cmdIndex);
+    }
+    
+    if (cmdIndex > envPtr->cmdMapEnd) {
+	panic("EnterCmdStartData: no start data registered for command with index %d\n", cmdIndex);
+    }
+
+    cmdLocPtr = &(envPtr->cmdMapPtr[cmdIndex]);
+    cmdLocPtr->numSrcChars = numSrcChars;
+    cmdLocPtr->numCodeBytes = numCodeBytes;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitArgInfo --
+ *
+ *	Initializes a ArgInfo structure to hold information about
+ *	some number of argument words in a command.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The ArgInfo structure is initialized.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitArgInfo(argInfoPtr)
+    register ArgInfo *argInfoPtr; /* Points to the ArgInfo structure
+				   * to initialize. */
+{
+    argInfoPtr->numArgs = 0;
+    argInfoPtr->startArray = argInfoPtr->staticStartSpace;
+    argInfoPtr->endArray   = argInfoPtr->staticEndSpace;
+    argInfoPtr->allocArgs = ARGINFO_INIT_ENTRIES;
+    argInfoPtr->mallocedArrays = 0;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CollectArgInfo --
+ *
+ *	Procedure to scan the argument words of a command and record the
+ *	start and finish of each argument word in a ArgInfo structure.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is TCL_OK unless
+ *	there was an error while scanning string. If an error occurs then
+ *	the interpreter's result contains a standard error message.
+ *
+ * Side effects:
+ *	If necessary, the argument start and end arrays in *argInfoPtr
+ *	are grown and reallocated to a new arrays of double the size, and
+ *	if argInfoPtr->mallocedArray is non-zero the old arrays are freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CollectArgInfo(interp, string, lastChar, flags, argInfoPtr)
+    Tcl_Interp *interp;         /* Used for error reporting. */
+    char *string;               /* The source command string to scan. */
+    char *lastChar;		 /* Pointer to terminating character of
+				  * string. */
+    int flags;                  /* Flags to control compilation (same as
+                                 * passed to Tcl_Eval). */
+    register ArgInfo *argInfoPtr;
+				/* Points to the ArgInfo structure in which
+				 * to record the arg word information. */
+{
+    register char *src = string;/* Points to current source char. */
+    register int type;		/* Current char's CHAR_TYPE type. */
+    int nestedCmd = (flags & TCL_BRACKET_TERM);
+                                /* 1 if string being scanned is a nested
+				 * command and is terminated by a ']';
+				 * otherwise 0. */
+    int scanningArgs;           /* 1 if still scanning argument words to
+				 * determine their start and end. */
+    char *wordStart, *wordEnd;  /* Points to the first and last significant
+				 * characters of each word. */
+    CompileEnv tempCompEnv;	/* Only used to hold the termOffset field
+				 * updated by AdvanceToNextWord. */
+    char *prev;
+
+    argInfoPtr->numArgs = 0;
+    scanningArgs = 1;
+    while (scanningArgs) {
+	AdvanceToNextWord(src, &tempCompEnv);
+	src += tempCompEnv.termOffset;
+	type = CHAR_TYPE(src, lastChar);
+
+	if ((type == TCL_COMMAND_END) && ((*src != ']') || nestedCmd)) {
+	    break;		    /* done collecting argument words */
+	} else if (*src == '"') {
+	    wordStart = src;
+	    src = TclWordEnd(src, lastChar, nestedCmd, NULL);
+	    if (src == lastChar) {
+	        badStringTermination:
+		Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	                "quoted string doesn't terminate properly", -1);
+		return TCL_ERROR;
+	    }
+	    prev = (src-1);
+	    if (*src == '"') {
+		wordEnd = src;
+		src++;
+	    } else if ((*src == ';') && (*prev == '"')) {
+		scanningArgs = 0;
+		wordEnd = prev;
+	    } else {
+		goto badStringTermination;
+	    }
+	} else if (*src == '{') {
+	    wordStart = src;
+	    src = TclWordEnd(src, lastChar, nestedCmd, NULL);
+	    if (src == lastChar) {
+		Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		        "missing close-brace", -1);
+		return TCL_ERROR;
+	    }
+	    prev = (src-1);
+	    if (*src == '}') {
+		wordEnd = src;
+		src++;
+	    } else if ((*src == ';') && (*prev == '}')) {
+		scanningArgs = 0;
+		wordEnd = prev;
+	    } else {
+		Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	                "argument word in braces doesn't terminate properly", -1);
+		return TCL_ERROR;
+	    }
+	} else {
+	    wordStart = src;
+	    src = TclWordEnd(src, lastChar, nestedCmd, NULL);
+	    prev = (src-1);
+	    if (src == lastChar) {
+		Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		        "missing close-bracket or close-brace", -1);
+		return TCL_ERROR;
+	    } else if (*src == ';') {
+		scanningArgs = 0;
+		wordEnd = prev;
+	    } else {
+		wordEnd = src;
+		src++;
+		if ((src == lastChar) || (*src == '\n')
+	                || ((*src == ']') && nestedCmd)) {
+		    scanningArgs = 0;
+		}
+	    }
+	} /* end of test on each kind of word */
+
+	if (argInfoPtr->numArgs == argInfoPtr->allocArgs) {
+	    int newArgs = 2*argInfoPtr->numArgs;
+	    size_t currBytes = argInfoPtr->numArgs * sizeof(char *);
+	    size_t newBytes  = newArgs * sizeof(char *);
+	    char **newStartArrayPtr =
+		    (char **) ckalloc((unsigned) newBytes);
+	    char **newEndArrayPtr =
+		    (char **) ckalloc((unsigned) newBytes);
+	    
+	    /*
+	     * Copy from the old arrays to the new, free the old arrays if
+	     * needed, and mark the new arrays as malloc'ed.
+	     */
+	    
+	    memcpy((VOID *) newStartArrayPtr,
+	            (VOID *) argInfoPtr->startArray, currBytes);
+	    memcpy((VOID *) newEndArrayPtr,
+		    (VOID *) argInfoPtr->endArray, currBytes);
+	    if (argInfoPtr->mallocedArrays) {
+		ckfree((char *) argInfoPtr->startArray);
+		ckfree((char *) argInfoPtr->endArray);
+	    }
+	    argInfoPtr->startArray = newStartArrayPtr;
+	    argInfoPtr->endArray   = newEndArrayPtr;
+	    argInfoPtr->allocArgs = newArgs;
+	    argInfoPtr->mallocedArrays = 1;
+	}
+	argInfoPtr->startArray[argInfoPtr->numArgs] = wordStart;
+	argInfoPtr->endArray[argInfoPtr->numArgs]   = wordEnd;
+	argInfoPtr->numArgs++;
+    }
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeArgInfo --
+ *
+ *	Free any storage allocated in a ArgInfo structure.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Allocated storage in the ArgInfo structure is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeArgInfo(argInfoPtr)
+    register ArgInfo *argInfoPtr; /* Points to the ArgInfo structure
+				   * to free. */
+{
+    if (argInfoPtr->mallocedArrays) {
+	ckfree((char *) argInfoPtr->startArray);
+	ckfree((char *) argInfoPtr->endArray);
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateExceptionRange --
+ *
+ *	Procedure that allocates and initializes a new ExceptionRange
+ *	structure of the specified kind in a CompileEnv's ExceptionRange
+ *	array.
+ *
+ * Results:
+ *	Returns the index for the newly created ExceptionRange.
+ *
+ * Side effects:
+ *	If there is not enough room in the CompileEnv's ExceptionRange
+ *	array, the array in expanded: a new array of double the size is
+ *	allocated, if envPtr->mallocedExcRangeArray is non-zero the old
+ *	array is freed, and ExceptionRange entries are copied from the old
+ *	array to the new one.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CreateExceptionRange(type, envPtr)
+    ExceptionRangeType type;	/* The kind of ExceptionRange desired. */
+    register CompileEnv *envPtr;/* Points to the CompileEnv for which a new
+				 * loop ExceptionRange structure is to be
+				 * allocated. */
+{
+    int index;			/* Index for the newly-allocated
+				 * ExceptionRange structure. */
+    register ExceptionRange *rangePtr;
+    				/* Points to the new ExceptionRange
+				 * structure */
+    
+    index = envPtr->excRangeArrayNext;
+    if (index >= envPtr->excRangeArrayEnd) {
+        /*
+	 * Expand the ExceptionRange array. The currently allocated entries
+	 * are stored between elements 0 and (envPtr->excRangeArrayNext - 1)
+	 * [inclusive].
+	 */
+	
+	size_t currBytes =
+	        envPtr->excRangeArrayNext * sizeof(ExceptionRange);
+	int newElems = 2*envPtr->excRangeArrayEnd;
+	size_t newBytes = newElems * sizeof(ExceptionRange);
+	ExceptionRange *newPtr = (ExceptionRange *)
+	        ckalloc((unsigned) newBytes);
+	
+	/*
+	 * Copy from old ExceptionRange array to new, free old
+	 * ExceptionRange array if needed, and mark the new ExceptionRange
+	 * array as malloced.
+	 */
+	
+	memcpy((VOID *) newPtr, (VOID *) envPtr->excRangeArrayPtr,
+	        currBytes);
+	if (envPtr->mallocedExcRangeArray) {
+	    ckfree((char *) envPtr->excRangeArrayPtr);
+	}
+	envPtr->excRangeArrayPtr = (ExceptionRange *) newPtr;
+	envPtr->excRangeArrayEnd = newElems;
+	envPtr->mallocedExcRangeArray = 1;
+    }
+    envPtr->excRangeArrayNext++;
+    
+    rangePtr = &(envPtr->excRangeArrayPtr[index]);
+    rangePtr->type = type;
+    rangePtr->nestingLevel = envPtr->excRangeDepth;
+    rangePtr->codeOffset = -1;
+    rangePtr->numCodeBytes = -1;
+    rangePtr->breakOffset = -1;
+    rangePtr->continueOffset = -1;
+    rangePtr->catchOffset = -1;
+    return index;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCreateAuxData --
+ *
+ *	Procedure that allocates and initializes a new AuxData structure in
+ *	a CompileEnv's array of compilation auxiliary data records. These
+ *	AuxData records hold information created during compilation by
+ *	CompileProcs and used by instructions during execution.
+ *
+ * Results:
+ *	Returns the index for the newly created AuxData structure.
+ *
+ * Side effects:
+ *	If there is not enough room in the CompileEnv's AuxData array,
+ *	the AuxData array in expanded: a new array of double the size
+ *	is allocated, if envPtr->mallocedAuxDataArray is non-zero
+ *	the old array is freed, and AuxData entries are copied from
+ *	the old array to the new one.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCreateAuxData(clientData, typePtr, envPtr)
+    ClientData clientData;	/* The compilation auxiliary data to store
+                             * in the new aux data record. */
+    AuxDataType *typePtr;	/* Pointer to the type to attach to this AuxData */
+    register CompileEnv *envPtr;/* Points to the CompileEnv for which a new
+                                 * aux data structure is to be allocated. */
+{
+    int index;			/* Index for the new AuxData structure. */
+    register AuxData *auxDataPtr;
+    				/* Points to the new AuxData structure */
+    
+    index = envPtr->auxDataArrayNext;
+    if (index >= envPtr->auxDataArrayEnd) {
+        /*
+	 * Expand the AuxData array. The currently allocated entries are
+	 * stored between elements 0 and (envPtr->auxDataArrayNext - 1)
+	 * [inclusive].
+	 */
+	
+	size_t currBytes = envPtr->auxDataArrayNext * sizeof(AuxData);
+	int newElems = 2*envPtr->auxDataArrayEnd;
+	size_t newBytes = newElems * sizeof(AuxData);
+	AuxData *newPtr = (AuxData *) ckalloc((unsigned) newBytes);
+	
+	/*
+	 * Copy from old AuxData array to new, free old AuxData array if
+	 * needed, and mark the new AuxData array as malloced.
+	 */
+	
+	memcpy((VOID *) newPtr, (VOID *) envPtr->auxDataArrayPtr,
+	        currBytes);
+	if (envPtr->mallocedAuxDataArray) {
+	    ckfree((char *) envPtr->auxDataArrayPtr);
+	}
+	envPtr->auxDataArrayPtr = newPtr;
+	envPtr->auxDataArrayEnd = newElems;
+	envPtr->mallocedAuxDataArray = 1;
+    }
+    envPtr->auxDataArrayNext++;
+    
+    auxDataPtr = &(envPtr->auxDataArrayPtr[index]);
+    auxDataPtr->type = typePtr;
+    auxDataPtr->clientData = clientData;
+    return index;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInitJumpFixupArray --
+ *
+ *	Initializes a JumpFixupArray structure to hold some number of
+ *	jump fixup entries.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The JumpFixupArray structure is initialized.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclInitJumpFixupArray(fixupArrayPtr)
+    register JumpFixupArray *fixupArrayPtr;
+				 /* Points to the JumpFixupArray structure
+				  * to initialize. */
+{
+    fixupArrayPtr->fixup = fixupArrayPtr->staticFixupSpace;
+    fixupArrayPtr->next = 0;
+    fixupArrayPtr->end = (JUMPFIXUP_INIT_ENTRIES - 1);
+    fixupArrayPtr->mallocedArray = 0;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclExpandJumpFixupArray --
+ *
+ *	Procedure that uses malloc to allocate more storage for a
+ *      jump fixup array.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The jump fixup array in *fixupArrayPtr is reallocated to a new array
+ *	of double the size, and if fixupArrayPtr->mallocedArray is non-zero
+ *	the old array is freed. Jump fixup structures are copied from the
+ *	old array to the new one.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclExpandJumpFixupArray(fixupArrayPtr)
+    register JumpFixupArray *fixupArrayPtr;
+				 /* Points to the JumpFixupArray structure
+				  * to enlarge. */
+{
+    /*
+     * The currently allocated jump fixup entries are stored from fixup[0]
+     * up to fixup[fixupArrayPtr->fixupNext] (*not* inclusive). We assume
+     * fixupArrayPtr->fixupNext is equal to fixupArrayPtr->fixupEnd.
+     */
+
+    size_t currBytes = fixupArrayPtr->next * sizeof(JumpFixup);
+    int newElems = 2*(fixupArrayPtr->end + 1);
+    size_t newBytes = newElems * sizeof(JumpFixup);
+    JumpFixup *newPtr = (JumpFixup *) ckalloc((unsigned) newBytes);
+
+    /*
+     * Copy from the old array to new, free the old array if needed,
+     * and mark the new array as malloced.
+     */
+ 
+    memcpy((VOID *) newPtr, (VOID *) fixupArrayPtr->fixup, currBytes);
+    if (fixupArrayPtr->mallocedArray) {
+	ckfree((char *) fixupArrayPtr->fixup);
+    }
+    fixupArrayPtr->fixup = (JumpFixup *) newPtr;
+    fixupArrayPtr->end = newElems;
+    fixupArrayPtr->mallocedArray = 1;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFreeJumpFixupArray --
+ *
+ *	Free any storage allocated in a jump fixup array structure.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Allocated storage in the JumpFixupArray structure is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFreeJumpFixupArray(fixupArrayPtr)
+    register JumpFixupArray *fixupArrayPtr;
+				 /* Points to the JumpFixupArray structure
+				  * to free. */
+{
+    if (fixupArrayPtr->mallocedArray) {
+	ckfree((char *) fixupArrayPtr->fixup);
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclEmitForwardJump --
+ *
+ *	Procedure to emit a two-byte forward jump of kind "jumpType". Since
+ *	the jump may later have to be grown to five bytes if the jump target
+ *	is more than, say, 127 bytes away, this procedure also initializes a
+ *	JumpFixup record with information about the jump. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The JumpFixup record pointed to by "jumpFixupPtr" is initialized
+ *	with information needed later if the jump is to be grown. Also,
+ *	a two byte jump of the designated type is emitted at the current
+ *	point in the bytecode stream.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclEmitForwardJump(envPtr, jumpType, jumpFixupPtr)
+    CompileEnv *envPtr;		/* Points to the CompileEnv structure that
+				 * holds the resulting instruction. */
+    TclJumpType jumpType;	/* Indicates the kind of jump: if true or
+				 * false or unconditional. */
+    JumpFixup *jumpFixupPtr;	/* Points to the JumpFixup structure to
+				 * initialize with information about this
+				 * forward jump. */
+{
+    /*
+     * Initialize the JumpFixup structure:
+     *    - codeOffset is offset of first byte of jump below
+     *    - cmdIndex is index of the command after the current one
+     *    - excRangeIndex is the index of the first ExceptionRange after
+     *      the current one.
+     */
+    
+    jumpFixupPtr->jumpType = jumpType;
+    jumpFixupPtr->codeOffset = TclCurrCodeOffset();
+    jumpFixupPtr->cmdIndex = envPtr->numCommands;
+    jumpFixupPtr->excRangeIndex = envPtr->excRangeArrayNext;
+    
+    switch (jumpType) {
+    case TCL_UNCONDITIONAL_JUMP:
+	TclEmitInstInt1(INST_JUMP1, /*offset*/ 0, envPtr);
+	break;
+    case TCL_TRUE_JUMP:
+	TclEmitInstInt1(INST_JUMP_TRUE1, /*offset*/ 0, envPtr);
+	break;
+    default:
+	TclEmitInstInt1(INST_JUMP_FALSE1, /*offset*/ 0, envPtr);
+	break;
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFixupForwardJump --
+ *
+ *	Procedure that updates a previously-emitted forward jump to jump
+ *	a specified number of bytes, "jumpDist". If necessary, the jump is
+ *      grown from two to five bytes; this is done if the jump distance is
+ *	greater than "distThreshold" (normally 127 bytes). The jump is
+ *	described by a JumpFixup record previously initialized by
+ *	TclEmitForwardJump.
+ *
+ * Results:
+ *	1 if the jump was grown and subsequent instructions had to be moved;
+ *	otherwise 0. This result is returned to allow callers to update
+ *	any additional code offsets they may hold.
+ *
+ * Side effects:
+ *	The jump may be grown and subsequent instructions moved. If this
+ *	happens, the code offsets for any commands and any ExceptionRange
+ *	records	between the jump and the current code address will be
+ *	updated to reflect the moved code. Also, the bytecode instruction
+ *	array in the CompileEnv structure may be grown and reallocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclFixupForwardJump(envPtr, jumpFixupPtr, jumpDist, distThreshold)
+    CompileEnv *envPtr;		/* Points to the CompileEnv structure that
+				 * holds the resulting instruction. */
+    JumpFixup *jumpFixupPtr;    /* Points to the JumpFixup structure that
+				 * describes the forward jump. */
+    int jumpDist;		/* Jump distance to set in jump
+				 * instruction. */
+    int distThreshold;		/* Maximum distance before the two byte
+				 * jump is grown to five bytes. */
+{
+    unsigned char *jumpPc, *p;
+    int firstCmd, lastCmd, firstRange, lastRange, k;
+    unsigned int numBytes;
+    
+    if (jumpDist <= distThreshold) {
+	jumpPc = (envPtr->codeStart + jumpFixupPtr->codeOffset);
+	switch (jumpFixupPtr->jumpType) {
+	case TCL_UNCONDITIONAL_JUMP:
+	    TclUpdateInstInt1AtPc(INST_JUMP1, jumpDist, jumpPc);
+	    break;
+	case TCL_TRUE_JUMP:
+	    TclUpdateInstInt1AtPc(INST_JUMP_TRUE1, jumpDist, jumpPc);
+	    break;
+	default:
+	    TclUpdateInstInt1AtPc(INST_JUMP_FALSE1, jumpDist, jumpPc);
+	    break;
+	}
+	return 0;
+    }
+
+    /*
+     * We must grow the jump then move subsequent instructions down.
+     */
+    
+    TclEnsureCodeSpace(3, envPtr);  /* NB: might change code addresses! */
+    jumpPc = (envPtr->codeStart + jumpFixupPtr->codeOffset);
+    for (numBytes = envPtr->codeNext-jumpPc-2, p = jumpPc+2+numBytes-1;
+	    numBytes > 0;  numBytes--, p--) {
+	p[3] = p[0];
+    }
+    envPtr->codeNext += 3;
+    jumpDist += 3;
+    switch (jumpFixupPtr->jumpType) {
+    case TCL_UNCONDITIONAL_JUMP:
+	TclUpdateInstInt4AtPc(INST_JUMP4, jumpDist, jumpPc);
+	break;
+    case TCL_TRUE_JUMP:
+	TclUpdateInstInt4AtPc(INST_JUMP_TRUE4, jumpDist, jumpPc);
+	break;
+    default:
+	TclUpdateInstInt4AtPc(INST_JUMP_FALSE4, jumpDist, jumpPc);
+	break;
+    }
+    
+    /*
+     * Adjust the code offsets for any commands and any ExceptionRange
+     * records between the jump and the current code address.
+     */
+    
+    firstCmd = jumpFixupPtr->cmdIndex;
+    lastCmd  = (envPtr->numCommands - 1);
+    if (firstCmd < lastCmd) {
+	for (k = firstCmd;  k <= lastCmd;  k++) {
+	    (envPtr->cmdMapPtr[k]).codeOffset += 3;
+	}
+    }
+    
+    firstRange = jumpFixupPtr->excRangeIndex;
+    lastRange  = (envPtr->excRangeArrayNext - 1);
+    for (k = firstRange;  k <= lastRange;  k++) {
+	ExceptionRange *rangePtr = &(envPtr->excRangeArrayPtr[k]);
+	rangePtr->codeOffset += 3;
+	
+	switch (rangePtr->type) {
+	case LOOP_EXCEPTION_RANGE:
+	    rangePtr->breakOffset += 3;
+	    if (rangePtr->continueOffset != -1) {
+		rangePtr->continueOffset += 3;
+	    }
+	    break;
+	case CATCH_EXCEPTION_RANGE:
+	    rangePtr->catchOffset += 3;
+	    break;
+	default:
+	    panic("TclFixupForwardJump: unrecognized ExceptionRange type %d\n", rangePtr->type);
+	}
+    }
+    return 1;			/* the jump was grown */
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetInstructionTable --
+ *
+ *  Returns a pointer to the table describing Tcl bytecode instructions.
+ *  This procedure is defined so that clients can access the pointer from
+ *  outside the TCL DLLs.
+ *
+ * Results:
+ *	Returns a pointer to the global instruction table, same as the expression
+ *  (&instructionTable[0]).
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+InstructionDesc *
+TclGetInstructionTable()
+{
+    return &instructionTable[0];
+}
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TclRegisterAuxDataType --
+ *
+ *	This procedure is called to register a new AuxData type
+ *	in the table of all AuxData types supported by Tcl.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The type is registered in the AuxData type table. If there was already
+ *	a type with the same name as in typePtr, it is replaced with the
+ *	new type.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TclRegisterAuxDataType(typePtr)
+    AuxDataType *typePtr;	/* Information about object type;
+                             * storage must be statically
+                             * allocated (must live forever). */
+{
+    register Tcl_HashEntry *hPtr;
+    int new;
+
+    if (!auxDataTypeTableInitialized) {
+        TclInitAuxDataTypeTable();
+    }
+
+    /*
+     * If there's already a type with the given name, remove it.
+     */
+
+    hPtr = Tcl_FindHashEntry(&auxDataTypeTable, typePtr->name);
+    if (hPtr != (Tcl_HashEntry *) NULL) {
+        Tcl_DeleteHashEntry(hPtr);
+    }
+
+    /*
+     * Now insert the new object type.
+     */
+
+    hPtr = Tcl_CreateHashEntry(&auxDataTypeTable, typePtr->name, &new);
+    if (new) {
+        Tcl_SetHashValue(hPtr, typePtr);
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetAuxDataType --
+ *
+ *	This procedure looks up an Auxdata type by name.
+ *
+ * Results:
+ *	If an AuxData type with name matching "typeName" is found, a pointer
+ *	to its AuxDataType structure is returned; otherwise, NULL is returned.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+AuxDataType *
+TclGetAuxDataType(typeName)
+    char *typeName;		/* Name of AuxData type to look up. */
+{
+    register Tcl_HashEntry *hPtr;
+    AuxDataType *typePtr = NULL;
+
+    if (!auxDataTypeTableInitialized) {
+        TclInitAuxDataTypeTable();
+    }
+
+    hPtr = Tcl_FindHashEntry(&auxDataTypeTable, typeName);
+    if (hPtr != (Tcl_HashEntry *) NULL) {
+        typePtr = (AuxDataType *) Tcl_GetHashValue(hPtr);
+    }
+
+    return typePtr;
+}
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TclInitAuxDataTypeTable --
+ *
+ *	This procedure is invoked to perform once-only initialization of
+ *	the AuxData type table. It also registers the AuxData types defined in 
+ *	this file.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Initializes the table of defined AuxData types "auxDataTypeTable" with
+ *	builtin AuxData types defined in this file.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TclInitAuxDataTypeTable()
+{
+    auxDataTypeTableInitialized = 1;
+
+    Tcl_InitHashTable(&auxDataTypeTable, TCL_STRING_KEYS);
+    TclRegisterAuxDataType(&tclForeachInfoType);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFinalizeAuxDataTypeTable --
+ *
+ *	This procedure is called by Tcl_Finalize after all exit handlers
+ *	have been run to free up storage associated with the table of AuxData
+ *	types.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Deletes all entries in the hash table of AuxData types, "auxDataTypeTable".
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFinalizeAuxDataTypeTable()
+{
+    if (auxDataTypeTableInitialized) {
+        Tcl_DeleteHashTable(&auxDataTypeTable);
+        auxDataTypeTableInitialized = 0;
+    }
+}
Index: /trunk/tcl/tclCompile.h
===================================================================
--- /trunk/tcl/tclCompile.h	(revision 2)
+++ /trunk/tcl/tclCompile.h	(revision 2)
@@ -0,0 +1,1054 @@
+/*
+ * tclCompile.h --
+ *
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclCompile.h,v 1.1 2008-06-04 13:58:05 demin Exp $
+ */
+
+#ifndef _TCLCOMPILATION
+#define _TCLCOMPILATION 1
+
+#ifndef _TCLINT
+#include "tclInt.h"
+#endif /* _TCLINT */
+
+#ifdef BUILD_tcl
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/*
+ *------------------------------------------------------------------------
+ * Variables related to compilation. These are used in tclCompile.c,
+ * tclExecute.c, tclBasic.c, and their clients.
+ *------------------------------------------------------------------------
+ */
+
+/*
+ * Variable that denotes the command name Tcl object type. Objects of this
+ * type cache the Command pointer that results from looking up command names
+ * in the command hashtable.
+ */
+
+extern Tcl_ObjType	tclCmdNameType;
+
+/*
+ * Variable that controls whether compilation tracing is enabled and, if so,
+ * what level of tracing is desired:
+ *    0: no compilation tracing
+ *    1: summarize compilation of top level cmds and proc bodies
+ *    2: display all instructions of each ByteCode compiled
+ * This variable is linked to the Tcl variable "tcl_traceCompile".
+ */
+
+extern int 		tclTraceCompile;
+
+/*
+ * Variable that controls whether execution tracing is enabled and, if so,
+ * what level of tracing is desired:
+ *    0: no execution tracing
+ *    1: trace invocations of Tcl procs only
+ *    2: trace invocations of all (not compiled away) commands
+ *    3: display each instruction executed
+ * This variable is linked to the Tcl variable "tcl_traceExec".
+ */
+
+extern int 		tclTraceExec;
+
+/*
+ * The number of bytecode compilations and various other compilation-related
+ * statistics. The tclByteCodeCount and tclSourceCount arrays are used to
+ * hold the count of ByteCodes and sources whose sizes fall into various
+ * binary decades; e.g., tclByteCodeCount[5] is a count of the ByteCodes
+ * with size larger than 2**4 and less than or equal to 2**5.
+ */
+
+#ifdef TCL_COMPILE_STATS
+extern long		tclNumCompilations;
+extern double		tclTotalSourceBytes;
+extern double		tclTotalCodeBytes;
+
+extern double		tclTotalInstBytes;
+extern double		tclTotalObjBytes;
+extern double		tclTotalExceptBytes;
+extern double		tclTotalAuxBytes;
+extern double		tclTotalCmdMapBytes;
+
+extern double		tclCurrentSourceBytes;
+extern double		tclCurrentCodeBytes;
+
+extern int		tclSourceCount[32];
+extern int		tclByteCodeCount[32];
+#endif /* TCL_COMPILE_STATS */
+
+/*
+ *------------------------------------------------------------------------
+ * Data structures related to compilation.
+ *------------------------------------------------------------------------
+ */
+
+/*
+ * The structure used to implement Tcl "exceptions" (exceptional returns):
+ * for example, those generated in loops by the break and continue commands,
+ * and those generated by scripts and caught by the catch command. This
+ * ExceptionRange structure describes a range of code (e.g., a loop body),
+ * the kind of exceptions (e.g., a break or continue) that might occur, and
+ * the PC offsets to jump to if a matching exception does occur. Exception
+ * ranges can nest so this structure includes a nesting level that is used
+ * at runtime to find the closest exception range surrounding a PC. For
+ * example, when a break command is executed, the ExceptionRange structure
+ * for the most deeply nested loop, if any, is found and used. These
+ * structures are also generated for the "next" subcommands of for loops
+ * since a break there terminates the for command. This means a for command
+ * actually generates two LoopInfo structures.
+ */
+
+typedef enum {
+    LOOP_EXCEPTION_RANGE,	/* Code range is part of a loop command.
+				 * break and continue "exceptions" cause
+				 * jumps to appropriate PC offsets. */
+    CATCH_EXCEPTION_RANGE	/* Code range is controlled by a catch
+				 * command. Errors in the range cause a
+				 * jump to a particular PC offset. */
+} ExceptionRangeType;
+
+typedef struct ExceptionRange {
+    ExceptionRangeType type;	/* The kind of ExceptionRange. */
+    int nestingLevel;		/* Static depth of the exception range.
+				 * Used to find the most deeply-nested
+				 * range surrounding a PC at runtime. */
+    int codeOffset;		/* Offset of the first instruction byte of
+				 * the code range. */
+    int numCodeBytes;		/* Number of bytes in the code range. */
+    int breakOffset;		/* If a LOOP_EXCEPTION_RANGE, the target
+				 * PC offset for a break command in the
+				 * range. */
+    int continueOffset;		/* If a LOOP_EXCEPTION_RANGE and not -1,
+				 * the target PC offset for a continue
+				 * command in the code range. Otherwise,
+				 * ignore this range when processing a
+				 * continue command. */
+    int catchOffset;		/* If a CATCH_EXCEPTION_RANGE, the target PC
+				 * offset for an "exception" in range. */
+} ExceptionRange;
+
+/*
+ * Structure used to map between instruction pc and source locations. It
+ * defines for each compiled Tcl command its code's starting offset and 
+ * its source's starting offset and length. Note that the code offset
+ * increases monotonically: that is, the table is sorted in code offset
+ * order. The source offset is not monotonic.
+ */
+
+typedef struct CmdLocation {
+    int codeOffset;		/* Offset of first byte of command code. */
+    int numCodeBytes;		/* Number of bytes for command's code. */
+    int srcOffset;		/* Offset of first char of the command. */
+    int numSrcChars;		/* Number of command source chars. */
+} CmdLocation;
+
+/*
+ * CompileProcs need the ability to record information during compilation
+ * that can be used by bytecode instructions during execution. The AuxData
+ * structure provides this "auxiliary data" mechanism. An arbitrary number
+ * of these structures can be stored in the ByteCode record (during
+ * compilation they are stored in a CompileEnv structure). Each AuxData
+ * record holds one word of client-specified data (often a pointer) and is
+ * given an index that instructions can later use to look up the structure
+ * and its data.
+ *
+ * The following definitions declare the types of procedures that are called
+ * to duplicate or free this auxiliary data when the containing ByteCode
+ * objects are duplicated and freed. Pointers to these procedures are kept
+ * in the AuxData structure.
+ */
+
+typedef ClientData (AuxDataDupProc)  _ANSI_ARGS_((ClientData clientData));
+typedef void       (AuxDataFreeProc) _ANSI_ARGS_((ClientData clientData));
+
+/*
+ * We define a separate AuxDataType struct to hold type-related information
+ * for the AuxData structure. This separation makes it possible for clients
+ * outside of the TCL core to manipulate (in a limited fashion!) AuxData;
+ * for example, it makes it possible to pickle and unpickle AuxData structs.
+ */
+
+typedef struct AuxDataType {
+    char *name;					/* the name of the type. Types can be
+                                 * registered and found by name */
+    AuxDataDupProc *dupProc;	/* Callback procedure to invoke when the
+                                 * aux data is duplicated (e.g., when the
+                                 * ByteCode structure containing the aux
+                                 * data is duplicated). NULL means just
+                                 * copy the source clientData bits; no
+                                 * proc need be called. */
+    AuxDataFreeProc *freeProc;	/* Callback procedure to invoke when the
+                                 * aux data is freed. NULL means no
+                                 * proc need be called. */
+} AuxDataType;
+
+/*
+ * The definition of the AuxData structure that holds information created
+ * during compilation by CompileProcs and used by instructions during
+ * execution.
+ */
+
+typedef struct AuxData {
+    AuxDataType *type;		/* pointer to the AuxData type associated with
+                             * this ClientData. */
+    ClientData clientData;	/* The compilation data itself. */
+} AuxData;
+
+/*
+ * Structure defining the compilation environment. After compilation, fields
+ * describing bytecode instructions are copied out into the more compact
+ * ByteCode structure defined below.
+ */
+
+#define COMPILEENV_INIT_CODE_BYTES    250
+#define COMPILEENV_INIT_NUM_OBJECTS    40
+#define COMPILEENV_INIT_EXCEPT_RANGES   5
+#define COMPILEENV_INIT_CMD_MAP_SIZE   40
+#define COMPILEENV_INIT_AUX_DATA_SIZE   5
+
+typedef struct CompileEnv {
+    Interp *iPtr;		/* Interpreter containing the code being
+				 * compiled. Commands and their compile
+				 * procs are specific to an interpreter so
+				 * the code emitted will depend on the
+				 * interpreter. */
+    char *source;		/* The source string being compiled by
+				 * SetByteCodeFromAny. This pointer is not
+				 * owned by the CompileEnv and must not be
+				 * freed or changed by it. */
+    Proc *procPtr;		/* If a procedure is being compiled, a
+				 * pointer to its Proc structure; otherwise
+				 * NULL. Used to compile local variables.
+				 * Set from information provided by
+				 * ObjInterpProc in tclProc.c. */
+    int numCommands;		/* Number of commands compiled. */
+    int excRangeDepth;		/* Current exception range nesting level;
+				 * -1 if not in any range currently. */
+    int maxExcRangeDepth;	/* Max nesting level of exception ranges;
+				 * -1 if no ranges have been compiled. */
+    int maxStackDepth;		/* Maximum number of stack elements needed
+				 * to execute the code. Set by compilation
+				 * procedures before returning. */
+    Tcl_HashTable objTable;	/* Contains all Tcl objects referenced by
+				 * the compiled code. Indexed by the string
+				 * representations of the objects. Used to
+				 * avoid creating duplicate objects. */
+    int pushSimpleWords;	/* Set 1 by callers of compilation routines
+				 * if they should emit instructions to push
+				 * "simple" command words (those that are
+				 * just a sequence of characters). If 0, the
+				 * callers are responsible for compiling
+				 * simple words. */
+    int wordIsSimple;		/* Set 1 by compilation procedures before
+				 * returning if the previous command word
+				 * was just a sequence of characters,
+				 * otherwise 0. Used to help determine the
+				 * command being compiled. */
+    int numSimpleWordChars;	/* If wordIsSimple is 1 then the number of
+				 * characters in the simple word, else 0. */
+    int exprIsJustVarRef;	/* Set 1 if the expression last compiled by
+				 * TclCompileExpr consisted of just a
+				 * variable reference as in the expression
+				 * of "if $b then...". Otherwise 0. Used
+				 * to implement expr's 2 level substitution
+				 * semantics properly. */
+    int exprIsComparison;	/* Set 1 if the top-level operator in the
+				 * expression last compiled is a comparison.
+				 * Otherwise 0. If 1, since the operands
+				 * might be strings, the expr is compiled
+				 * out-of-line to implement expr's 2 level
+				 * substitution semantics properly. */
+    int termOffset;		/* Offset of character just after the last
+				 * one compiled. Set by compilation
+				 * procedures before returning. */
+    unsigned char *codeStart;	/* Points to the first byte of the code. */
+    unsigned char *codeNext;	/* Points to next code array byte to use. */
+    unsigned char *codeEnd;	/* Points just after the last allocated
+				 * code array byte. */
+    int mallocedCodeArray;      /* Set 1 if code array was expanded 
+				 * and codeStart points into the heap.*/
+    Tcl_Obj **objArrayPtr;	/* Points to start of object array. */
+    int objArrayNext;		/* Index of next free object array entry. */
+    int objArrayEnd;		/* Index just after last obj array entry. */
+    int mallocedObjArray;       /* 1 if object array was expanded and
+                                 * objArray points into the heap, else 0. */
+    ExceptionRange *excRangeArrayPtr;
+    				/* Points to start of the ExceptionRange
+				 * array. */
+    int excRangeArrayNext;	/* Next free ExceptionRange array index.
+				 * excRangeArrayNext is the number of ranges
+				 * and (excRangeArrayNext-1) is the index of
+				 * the current range's array entry. */
+    int excRangeArrayEnd;	/* Index after the last ExceptionRange
+				 * array entry. */
+    int mallocedExcRangeArray;	/* 1 if ExceptionRange array was expanded
+				 * and excRangeArrayPtr points in heap,
+				 * else 0. */
+    CmdLocation *cmdMapPtr;	/* Points to start of CmdLocation array.
+				 * numCommands is the index of the next
+				 * entry to use; (numCommands-1) is the
+				 * entry index for the last command. */
+    int cmdMapEnd;		/* Index after last CmdLocation entry. */
+    int mallocedCmdMap;		/* 1 if command map array was expanded and
+				 * cmdMapPtr points in the heap, else 0. */
+    AuxData *auxDataArrayPtr;   /* Points to auxiliary data array start. */
+    int auxDataArrayNext;	/* Next free compile aux data array index.
+				 * auxDataArrayNext is the number of aux
+				 * data items and (auxDataArrayNext-1) is
+				 * index of current aux data array entry. */
+    int auxDataArrayEnd;	/* Index after last aux data array entry. */
+    int mallocedAuxDataArray;	/* 1 if aux data array was expanded and
+				 * auxDataArrayPtr points in heap else 0. */
+    unsigned char staticCodeSpace[COMPILEENV_INIT_CODE_BYTES];
+                                /* Initial storage for code. */
+    Tcl_Obj *staticObjArraySpace[COMPILEENV_INIT_NUM_OBJECTS];
+                                /* Initial storage for object array. */
+    ExceptionRange staticExcRangeArraySpace[COMPILEENV_INIT_EXCEPT_RANGES];
+                                /* Initial ExceptionRange array storage. */
+    CmdLocation staticCmdMapSpace[COMPILEENV_INIT_CMD_MAP_SIZE];
+                                /* Initial storage for cmd location map. */
+    AuxData staticAuxDataArraySpace[COMPILEENV_INIT_AUX_DATA_SIZE];
+                                /* Initial storage for aux data array. */
+} CompileEnv;
+
+/*
+ * The structure defining the bytecode instructions resulting from compiling
+ * a Tcl script. Note that this structure is variable length: a single heap
+ * object is allocated to hold the ByteCode structure immediately followed
+ * by the code bytes, the object array, the ExceptionRange array, the
+ * CmdLocation map, and the compilation AuxData array.
+ */
+
+/*
+ * A PRECOMPILED bytecode struct is one that was generated from a compiled
+ * image rather than implicitly compiled from source
+ */
+#define TCL_BYTECODE_PRECOMPILED		0x0001
+
+typedef struct ByteCode {
+    Interp *iPtr;		/* Interpreter containing the code being
+				 * compiled. Commands and their compile
+				 * procs are specific to an interpreter so
+				 * the code emitted will depend on the
+				 * interpreter. */
+    int compileEpoch;		/* Value of iPtr->compileEpoch when this
+				 * ByteCode was compiled. Used to invalidate
+				 * code when, e.g., commands with compile
+				 * procs are redefined. */
+    Namespace *nsPtr;		/* Namespace context in which this code
+				 * was compiled. If the code is executed
+				 * if a different namespace, it must be
+				 * recompiled. */
+    int nsEpoch;		/* Value of nsPtr->resolverEpoch when this
+				 * ByteCode was compiled. Used to invalidate
+				 * code when new namespace resolution rules
+				 * are put into effect. */
+    int refCount;		/* Reference count: set 1 when created
+				 * plus 1 for each execution of the code
+				 * currently active. This structure can be
+				 * freed when refCount becomes zero. */
+    unsigned int flags;		/* flags describing state for the codebyte.
+                                 * this variable holds ORed values from the
+                                 * TCL_BYTECODE_ masks defined above */
+    char *source;		/* The source string from which this
+				 * ByteCode was compiled. Note that this
+				 * pointer is not owned by the ByteCode and
+				 * must not be freed or modified by it. */
+    Proc *procPtr;		/* If the ByteCode was compiled from a
+				 * procedure body, this is a pointer to its
+				 * Proc structure; otherwise NULL. This
+				 * pointer is also not owned by the ByteCode
+				 * and must not be freed by it. Used for
+				 * debugging. */
+    size_t totalSize;		/* Total number of bytes required for this
+				 * ByteCode structure including the storage
+				 * for Tcl objects in its object array. */
+    int numCommands;		/* Number of commands compiled. */
+    int numSrcChars;		/* Number of source chars compiled. */
+    int numCodeBytes;		/* Number of code bytes. */
+    int numObjects;		/* Number of Tcl objects in object array. */
+    int numExcRanges;		/* Number of ExceptionRange array elems. */
+    int numAuxDataItems;	/* Number of AuxData items. */
+    int numCmdLocBytes;		/* Number of bytes needed for encoded
+				 * command location information. */
+    int maxExcRangeDepth;	/* Maximum nesting level of ExceptionRanges;
+				 * -1 if no ranges were compiled. */
+    int maxStackDepth;		/* Maximum number of stack elements needed
+				 * to execute the code. */
+    unsigned char *codeStart;	/* Points to the first byte of the code.
+				 * This is just after the final ByteCode
+				 * member cmdMapPtr. */
+    Tcl_Obj **objArrayPtr;	/* Points to the start of the object array.
+				 * This is just after the last code byte. */
+    ExceptionRange *excRangeArrayPtr;
+    				/* Points to the start of the ExceptionRange
+				 * array. This is just after the last
+				 * object in the object array. */
+    AuxData *auxDataArrayPtr;   /* Points to the start of the auxiliary data
+				 * array. This is just after the last entry
+				 * in the ExceptionRange array. */
+    unsigned char *codeDeltaStart;
+				/* Points to the first of a sequence of
+				 * bytes that encode the change in the
+				 * starting offset of each command's code.
+				 * If -127<=delta<=127, it is encoded as 1
+				 * byte, otherwise 0xFF (128) appears and
+				 * the delta is encoded by the next 4 bytes.
+				 * Code deltas are always positive. This
+				 * sequence is just after the last entry in
+				 * the AuxData array. */
+    unsigned char *codeLengthStart;
+				/* Points to the first of a sequence of
+				 * bytes that encode the length of each
+				 * command's code. The encoding is the same
+				 * as for code deltas. Code lengths are
+				 * always positive. This sequence is just
+				 * after the last entry in the code delta
+				 * sequence. */
+    unsigned char *srcDeltaStart;
+				/* Points to the first of a sequence of
+				 * bytes that encode the change in the
+				 * starting offset of each command's source.
+				 * The encoding is the same as for code
+				 * deltas. Source deltas can be negative.
+				 * This sequence is just after the last byte
+				 * in the code length sequence. */
+    unsigned char *srcLengthStart;
+				/* Points to the first of a sequence of
+				 * bytes that encode the length of each
+				 * command's source. The encoding is the
+				 * same as for code deltas. Source lengths
+				 * are always positive. This sequence is
+				 * just after the last byte in the source
+				 * delta sequence. */
+} ByteCode;
+
+/*
+ * Opcodes for the Tcl bytecode instructions. These opcodes must correspond
+ * to the entries in the table of instruction descriptions in tclCompile.c.
+ * Also, the order and number of the expression opcodes (e.g., INST_LOR)
+ * must match the entries in the array operatorStrings in tclExecute.c.
+ */
+
+/* Opcodes 0 to 9 */
+#define INST_DONE			0
+#define INST_PUSH1			(INST_DONE + 1)
+#define INST_PUSH4			(INST_DONE + 2)
+#define INST_POP			(INST_DONE + 3)
+#define INST_DUP			(INST_DONE + 4)
+#define INST_CONCAT1			(INST_DONE + 5)
+#define INST_INVOKE_STK1		(INST_DONE + 6)
+#define INST_INVOKE_STK4		(INST_DONE + 7)
+#define INST_EVAL_STK			(INST_DONE + 8)
+#define INST_EXPR_STK			(INST_DONE + 9)
+
+/* Opcodes 10 to 23 */
+#define INST_LOAD_SCALAR1		(INST_EXPR_STK + 1)
+#define INST_LOAD_SCALAR4		(INST_LOAD_SCALAR1 + 1)
+#define INST_LOAD_SCALAR_STK		(INST_LOAD_SCALAR1 + 2)
+#define INST_LOAD_ARRAY1		(INST_LOAD_SCALAR1 + 3)
+#define INST_LOAD_ARRAY4		(INST_LOAD_SCALAR1 + 4)
+#define INST_LOAD_ARRAY_STK		(INST_LOAD_SCALAR1 + 5)
+#define INST_LOAD_STK			(INST_LOAD_SCALAR1 + 6)
+#define INST_STORE_SCALAR1		(INST_LOAD_SCALAR1 + 7)
+#define INST_STORE_SCALAR4		(INST_LOAD_SCALAR1 + 8)
+#define INST_STORE_SCALAR_STK		(INST_LOAD_SCALAR1 + 9)
+#define INST_STORE_ARRAY1		(INST_LOAD_SCALAR1 + 10)
+#define INST_STORE_ARRAY4		(INST_LOAD_SCALAR1 + 11)
+#define INST_STORE_ARRAY_STK		(INST_LOAD_SCALAR1 + 12)
+#define INST_STORE_STK			(INST_LOAD_SCALAR1 + 13)
+
+/* Opcodes 24 to 33 */
+#define INST_INCR_SCALAR1		(INST_STORE_STK + 1)
+#define INST_INCR_SCALAR_STK		(INST_INCR_SCALAR1 + 1)
+#define INST_INCR_ARRAY1		(INST_INCR_SCALAR1 + 2)
+#define INST_INCR_ARRAY_STK		(INST_INCR_SCALAR1 + 3)
+#define INST_INCR_STK			(INST_INCR_SCALAR1 + 4)
+#define INST_INCR_SCALAR1_IMM		(INST_INCR_SCALAR1 + 5)
+#define INST_INCR_SCALAR_STK_IMM	(INST_INCR_SCALAR1 + 6)
+#define INST_INCR_ARRAY1_IMM		(INST_INCR_SCALAR1 + 7)
+#define INST_INCR_ARRAY_STK_IMM		(INST_INCR_SCALAR1 + 8)
+#define INST_INCR_STK_IMM		(INST_INCR_SCALAR1 + 9)
+
+/* Opcodes 34 to 39 */
+#define INST_JUMP1			(INST_INCR_STK_IMM + 1)
+#define INST_JUMP4			(INST_JUMP1 + 1)
+#define INST_JUMP_TRUE1			(INST_JUMP1 + 2)
+#define INST_JUMP_TRUE4			(INST_JUMP1 + 3)
+#define INST_JUMP_FALSE1		(INST_JUMP1 + 4)
+#define INST_JUMP_FALSE4	        (INST_JUMP1 + 5)
+
+/* Opcodes 40 to 64 */
+#define INST_LOR			(INST_JUMP_FALSE4 + 1)
+#define INST_LAND			(INST_LOR + 1)
+#define INST_BITOR			(INST_LOR + 2)
+#define INST_BITXOR			(INST_LOR + 3)
+#define INST_BITAND			(INST_LOR + 4)
+#define INST_EQ				(INST_LOR + 5)
+#define INST_NEQ			(INST_LOR + 6)
+#define INST_LT				(INST_LOR + 7)
+#define INST_GT				(INST_LOR + 8)
+#define INST_LE				(INST_LOR + 9)
+#define INST_GE				(INST_LOR + 10)
+#define INST_LSHIFT			(INST_LOR + 11)
+#define INST_RSHIFT			(INST_LOR + 12)
+#define INST_ADD			(INST_LOR + 13)
+#define INST_SUB			(INST_LOR + 14)
+#define INST_MULT			(INST_LOR + 15)
+#define INST_DIV			(INST_LOR + 16)
+#define INST_MOD			(INST_LOR + 17)
+#define INST_UPLUS			(INST_LOR + 18)
+#define INST_UMINUS			(INST_LOR + 19)
+#define INST_BITNOT			(INST_LOR + 20)
+#define INST_LNOT			(INST_LOR + 21)
+#define INST_CALL_BUILTIN_FUNC1		(INST_LOR + 22)
+#define INST_CALL_FUNC1			(INST_LOR + 23)
+#define INST_TRY_CVT_TO_NUMERIC		(INST_LOR + 24)
+
+/* Opcodes 65 to 66 */
+#define INST_BREAK			(INST_TRY_CVT_TO_NUMERIC + 1)
+#define INST_CONTINUE			(INST_BREAK + 1)
+
+/* Opcodes 67 to 68 */
+#define INST_FOREACH_START4		(INST_CONTINUE + 1)
+#define INST_FOREACH_STEP4		(INST_FOREACH_START4 + 1)
+
+/* Opcodes 69 to 72 */
+#define INST_BEGIN_CATCH4		(INST_FOREACH_STEP4 + 1)
+#define INST_END_CATCH			(INST_BEGIN_CATCH4 + 1)
+#define INST_PUSH_RESULT		(INST_BEGIN_CATCH4 + 2)
+#define INST_PUSH_RETURN_CODE		(INST_BEGIN_CATCH4 + 3)
+
+/* The last opcode */
+#define LAST_INST_OPCODE        	INST_PUSH_RETURN_CODE
+
+/*
+ * Table describing the Tcl bytecode instructions: their name (for
+ * displaying code), total number of code bytes required (including
+ * operand bytes), and a description of the type of each operand.
+ * These operand types include signed and unsigned integers of length
+ * one and four bytes. The unsigned integers are used for indexes or
+ * for, e.g., the count of objects to push in a "push" instruction.
+ */
+
+#define MAX_INSTRUCTION_OPERANDS 2
+
+typedef enum InstOperandType {
+    OPERAND_NONE,
+    OPERAND_INT1,		/* One byte signed integer. */
+    OPERAND_INT4,		/* Four byte signed integer. */
+    OPERAND_UINT1,		/* One byte unsigned integer. */
+    OPERAND_UINT4		/* Four byte unsigned integer. */
+} InstOperandType;
+
+typedef struct InstructionDesc {
+    char *name;			/* Name of instruction. */
+    int numBytes;		/* Total number of bytes for instruction. */
+    int numOperands;		/* Number of operands. */
+    InstOperandType opTypes[MAX_INSTRUCTION_OPERANDS];
+				/* The type of each operand. */
+} InstructionDesc;
+
+extern InstructionDesc instructionTable[];
+
+/*
+ * Definitions of the values of the INST_CALL_BUILTIN_FUNC instruction's
+ * operand byte. Each value denotes a builtin Tcl math function. These
+ * values must correspond to the entries in the builtinFuncTable array
+ * below and to the values stored in the tclInt.h MathFunc structure's
+ * builtinFuncIndex field.
+ */
+
+#define BUILTIN_FUNC_ACOS		0
+#define BUILTIN_FUNC_ASIN		1
+#define BUILTIN_FUNC_ATAN		2
+#define BUILTIN_FUNC_ATAN2		3
+#define BUILTIN_FUNC_CEIL		4
+#define BUILTIN_FUNC_COS		5
+#define BUILTIN_FUNC_COSH		6
+#define BUILTIN_FUNC_EXP		7
+#define BUILTIN_FUNC_FLOOR		8
+#define BUILTIN_FUNC_FMOD		9
+#define BUILTIN_FUNC_HYPOT		10
+#define BUILTIN_FUNC_LOG		11
+#define BUILTIN_FUNC_LOG10		12
+#define BUILTIN_FUNC_POW		13
+#define BUILTIN_FUNC_SIN		14
+#define BUILTIN_FUNC_SINH		15
+#define BUILTIN_FUNC_SQRT		16
+#define BUILTIN_FUNC_TAN		17
+#define BUILTIN_FUNC_TANH		18
+#define BUILTIN_FUNC_ABS		19
+#define BUILTIN_FUNC_DOUBLE		20
+#define BUILTIN_FUNC_INT		21
+#define BUILTIN_FUNC_RAND		22
+#define BUILTIN_FUNC_ROUND		23
+#define BUILTIN_FUNC_SRAND		24
+
+#define LAST_BUILTIN_FUNC        	BUILTIN_FUNC_SRAND
+
+/*
+ * Table describing the built-in math functions. Entries in this table are
+ * indexed by the values of the INST_CALL_BUILTIN_FUNC instruction's
+ * operand byte.
+ */
+
+typedef int (CallBuiltinFuncProc) _ANSI_ARGS_((Tcl_Interp *interp,
+        ExecEnv *eePtr, ClientData clientData));
+
+typedef struct {
+    char *name;			/* Name of function. */
+    int numArgs;		/* Number of arguments for function. */
+    Tcl_ValueType argTypes[MAX_MATH_ARGS];
+				/* Acceptable types for each argument. */
+    CallBuiltinFuncProc *proc;	/* Procedure implementing this function. */
+    ClientData clientData;	/* Additional argument to pass to the
+				 * function when invoking it. */
+} BuiltinFunc;
+
+extern BuiltinFunc builtinFuncTable[];
+
+/*
+ * The structure used to hold information about the start and end of each
+ * argument word in a command. 
+ */
+
+#define ARGINFO_INIT_ENTRIES 5
+
+typedef struct ArgInfo {
+    int numArgs;		/* Number of argument words in command. */
+    char **startArray;		/* Array of pointers to the first character
+				 * of each argument word. */
+    char **endArray;		/* Array of pointers to the last character
+				 * of each argument word. */
+    int allocArgs;		/* Number of array entries currently
+				 * allocated. */
+    int mallocedArrays;		/* 1 if the arrays were expanded and
+				 * wordStartArray/wordEndArray point into
+				 * the heap, else 0. */
+    char *staticStartSpace[ARGINFO_INIT_ENTRIES];
+                                /* Initial storage for word start array. */
+    char *staticEndSpace[ARGINFO_INIT_ENTRIES];
+                                /* Initial storage for word end array. */
+} ArgInfo;
+
+/*
+ * Compilation of some Tcl constructs such as if commands and the logical or
+ * (||) and logical and (&&) operators in expressions requires the
+ * generation of forward jumps. Since the PC target of these jumps isn't
+ * known when the jumps are emitted, we record the offset of each jump in an
+ * array of JumpFixup structures. There is one array for each sequence of
+ * jumps to one target PC. When we learn the target PC, we update the jumps
+ * with the correct distance. Also, if the distance is too great (> 127
+ * bytes), we replace the single-byte jump with a four byte jump
+ * instruction, move the instructions after the jump down, and update the
+ * code offsets for any commands between the jump and the target.
+ */
+
+typedef enum {
+    TCL_UNCONDITIONAL_JUMP,
+    TCL_TRUE_JUMP,
+    TCL_FALSE_JUMP
+} TclJumpType;
+
+typedef struct JumpFixup {
+    TclJumpType jumpType;	/* Indicates the kind of jump. */
+    int codeOffset;		/* Offset of the first byte of the one-byte
+				 * forward jump's code. */
+    int cmdIndex;		/* Index of the first command after the one
+				 * for which the jump was emitted. Used to
+				 * update the code offsets for subsequent
+				 * commands if the two-byte jump at jumpPc
+				 * must be replaced with a five-byte one. */
+    int excRangeIndex;		/* Index of the first range entry in the
+				 * ExceptionRange array after the current
+				 * one. This field is used to adjust the
+				 * code offsets in subsequent ExceptionRange
+				 * records when a jump is grown from 2 bytes
+				 * to 5 bytes. */
+} JumpFixup;
+
+#define JUMPFIXUP_INIT_ENTRIES    10
+
+typedef struct JumpFixupArray {
+    JumpFixup *fixup;		/* Points to start of jump fixup array. */
+    int next;			/* Index of next free array entry. */
+    int end;			/* Index of last usable entry in array. */
+    int mallocedArray;		/* 1 if array was expanded and fixups points
+				 * into the heap, else 0. */
+    JumpFixup staticFixupSpace[JUMPFIXUP_INIT_ENTRIES];
+				/* Initial storage for jump fixup array. */
+} JumpFixupArray;
+
+/*
+ * The structure describing one variable list of a foreach command. Note
+ * that only foreach commands inside procedure bodies are compiled inline so
+ * a ForeachVarList structure always describes local variables. Furthermore,
+ * only scalar variables are supported for inline-compiled foreach loops.
+ */
+
+typedef struct ForeachVarList {
+    int numVars;		/* The number of variables in the list. */
+    int varIndexes[1];		/* An array of the indexes ("slot numbers")
+				 * for each variable in the procedure's
+				 * array of local variables. Only scalar
+				 * variables are supported. The actual
+				 * size of this field will be large enough
+				 * to numVars indexes. THIS MUST BE THE
+				 * LAST FIELD IN THE STRUCTURE! */
+} ForeachVarList;
+
+/*
+ * Structure used to hold information about a foreach command that is needed
+ * during program execution. These structures are stored in CompileEnv and
+ * ByteCode structures as auxiliary data.
+ */
+
+typedef struct ForeachInfo {
+    int numLists;		/* The number of both the variable and value
+				 * lists of the foreach command. */
+    int firstListTmp;		/* The slot number of the first temporary
+				 * variable holding the lists themselves. */
+    int loopIterNumTmp;		/* The slot number of the temp var holding
+				 * the count of times the loop body has been
+				 * executed. This is used to determine which
+				 * list element to assign each loop var. */
+    ForeachVarList *varLists[1];/* An array of pointers to ForeachVarList
+				 * structures describing each var list. The
+				 * actual size of this field will be large
+				 * enough to numVars indexes. THIS MUST BE
+				 * THE LAST FIELD IN THE STRUCTURE! */
+} ForeachInfo;
+
+/*
+ * Structure containing a cached pointer to a command that is the result
+ * of resolving the command's name in some namespace. It is the internal
+ * representation for a cmdName object. It contains the pointer along
+ * with some information that is used to check the pointer's validity.
+ */
+
+typedef struct ResolvedCmdName {
+    Command *cmdPtr;		/* A cached Command pointer. */
+    Namespace *refNsPtr;	/* Points to the namespace containing the
+				 * reference (not the namespace that
+				 * contains the referenced command). */
+    long refNsId;		/* refNsPtr's unique namespace id. Used to
+				 * verify that refNsPtr is still valid
+				 * (e.g., it's possible that the cmd's
+				 * containing namespace was deleted and a
+				 * new one created at the same address). */
+    int refNsCmdEpoch;		/* Value of the referencing namespace's
+				 * cmdRefEpoch when the pointer was cached.
+				 * Before using the cached pointer, we check
+				 * if the namespace's epoch was incremented;
+				 * if so, this cached pointer is invalid. */
+    int cmdEpoch;		/* Value of the command's cmdEpoch when this
+				 * pointer was cached. Before using the
+				 * cached pointer, we check if the cmd's
+				 * epoch was incremented; if so, the cmd was
+				 * renamed, deleted, hidden, or exposed, and
+				 * so the pointer is invalid. */
+    int refCount;		/* Reference count: 1 for each cmdName
+				 * object that has a pointer to this
+				 * ResolvedCmdName structure as its internal
+				 * rep. This structure can be freed when
+				 * refCount becomes zero. */
+} ResolvedCmdName;
+
+/*
+ *----------------------------------------------------------------
+ * Procedures shared among Tcl bytecode compilation and execution
+ * modules but not used outside:
+ *----------------------------------------------------------------
+ */
+
+EXTERN void		TclCleanupByteCode _ANSI_ARGS_((ByteCode *codePtr));
+EXTERN int		TclCompileExpr _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, char *lastChar, int flags,
+			    CompileEnv *envPtr));
+EXTERN int		TclCompileQuotes _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, char *lastChar, int termChar,
+			    int flags, CompileEnv *envPtr));
+EXTERN int		TclCompileString _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, char *lastChar, int flags,
+			    CompileEnv *envPtr));
+EXTERN int		TclCompileDollarVar _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, char *lastChar, int flags,
+			    CompileEnv *envPtr));
+EXTERN int		TclCreateAuxData _ANSI_ARGS_((ClientData clientData,
+                AuxDataType *typePtr, CompileEnv *envPtr));
+EXTERN ExecEnv *	TclCreateExecEnv _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void		TclDeleteExecEnv _ANSI_ARGS_((ExecEnv *eePtr));
+EXTERN void		TclEmitForwardJump _ANSI_ARGS_((CompileEnv *envPtr,
+			    TclJumpType jumpType, JumpFixup *jumpFixupPtr));
+EXTERN AuxDataType *TclGetAuxDataType _ANSI_ARGS_((char *typeName));
+EXTERN ExceptionRange *	TclGetExceptionRangeForPc _ANSI_ARGS_((
+			    unsigned char *pc, int catchOnly,
+			    ByteCode* codePtr));
+EXTERN InstructionDesc * TclGetInstructionTable _ANSI_ARGS_(());
+EXTERN int		TclExecuteByteCode _ANSI_ARGS_((Tcl_Interp *interp,
+			    ByteCode *codePtr));
+EXTERN void		TclExpandCodeArray _ANSI_ARGS_((
+                            CompileEnv *envPtr));
+EXTERN void		TclExpandJumpFixupArray _ANSI_ARGS_((
+                            JumpFixupArray *fixupArrayPtr));
+EXTERN void		TclFinalizeAuxDataTypeTable _ANSI_ARGS_((void));
+EXTERN int		TclFixupForwardJump _ANSI_ARGS_((
+			    CompileEnv *envPtr, JumpFixup *jumpFixupPtr,
+			    int jumpDist, int distThreshold));
+EXTERN void		TclFreeCompileEnv _ANSI_ARGS_((CompileEnv *envPtr));
+EXTERN void		TclFreeJumpFixupArray _ANSI_ARGS_((
+  			    JumpFixupArray *fixupArrayPtr));
+EXTERN void		TclInitAuxDataTypeTable _ANSI_ARGS_((void));
+EXTERN void		TclInitByteCodeObj _ANSI_ARGS_((Tcl_Obj *objPtr,
+			    CompileEnv *envPtr));
+EXTERN void		TclInitCompileEnv _ANSI_ARGS_((Tcl_Interp *interp,
+			    CompileEnv *envPtr, char *string));
+EXTERN void		TclInitJumpFixupArray _ANSI_ARGS_((
+			    JumpFixupArray *fixupArrayPtr));
+#ifdef TCL_COMPILE_STATS
+EXTERN int		TclLog2 _ANSI_ARGS_((int value));
+#endif /*TCL_COMPILE_STATS*/
+EXTERN int		TclObjIndexForString _ANSI_ARGS_((char *start,
+			    int length, int allocStrRep, int inHeap,
+			    CompileEnv *envPtr));
+EXTERN int		TclPrintInstruction _ANSI_ARGS_((ByteCode* codePtr,
+			    unsigned char *pc));
+EXTERN void		TclPrintSource _ANSI_ARGS_((FILE *outFile,
+			    char *string, int maxChars));
+EXTERN void		TclRegisterAuxDataType _ANSI_ARGS_((AuxDataType *typePtr));
+
+/*
+ *----------------------------------------------------------------
+ * Macros used by Tcl bytecode compilation and execution modules
+ * inside the Tcl core but not used outside.
+ *----------------------------------------------------------------
+ */
+
+/*
+ * Macros to ensure there is enough room in a CompileEnv's code array.
+ * The ANSI C "prototypes" for these macros are:
+ *
+ * EXTERN void	TclEnsureCodeSpace1 _ANSI_ARGS_((CompileEnv *envPtr));
+ * EXTERN void	TclEnsureCodeSpace _ANSI_ARGS_((int nBytes,
+ *		    CompileEnv *envPtr));
+ */
+
+#define TclEnsureCodeSpace1(envPtr) \
+    if ((envPtr)->codeNext == (envPtr)->codeEnd) \
+        TclExpandCodeArray(envPtr)
+
+#define TclEnsureCodeSpace(nBytes, envPtr) \
+    if (((envPtr)->codeNext + nBytes) > (envPtr)->codeEnd) \
+        TclExpandCodeArray(envPtr)
+
+/*
+ * Macro to emit an opcode byte into a CompileEnv's code array.
+ * The ANSI C "prototype" for this macro is:
+ *
+ * EXTERN void	TclEmitOpcode _ANSI_ARGS_((unsigned char op,
+ *		    CompileEnv *envPtr));
+ */
+
+#define TclEmitOpcode(op, envPtr) \
+    TclEnsureCodeSpace1(envPtr); \
+    *(envPtr)->codeNext++ = (unsigned char) (op)
+
+/*
+ * Macros to emit a (signed or unsigned) int operand. The two variants
+ * depend on the number of bytes needed for the int. Four byte integers
+ * are stored in "big-endian" order with the high order byte stored at
+ * the lowest address. The ANSI C "prototypes" for these macros are:
+ *
+ * EXTERN void	TclEmitInt1 _ANSI_ARGS_((int i, CompileEnv *envPtr));
+ * EXTERN void	TclEmitInt4 _ANSI_ARGS_((int i, CompileEnv *envPtr));
+ */
+
+#define TclEmitInt1(i, envPtr) \
+    TclEnsureCodeSpace(1, (envPtr)); \
+    *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i))
+
+#define TclEmitInt4(i, envPtr) \
+    TclEnsureCodeSpace(4, (envPtr)); \
+    *(envPtr)->codeNext++ = \
+        (unsigned char) ((unsigned int) (i) >> 24); \
+    *(envPtr)->codeNext++ = \
+        (unsigned char) ((unsigned int) (i) >> 16); \
+    *(envPtr)->codeNext++ = \
+        (unsigned char) ((unsigned int) (i) >>  8); \
+    *(envPtr)->codeNext++ = \
+        (unsigned char) ((unsigned int) (i)      )
+
+/*
+ * Macros to emit an instruction with signed or unsigned int operands.
+ * The ANSI C "prototypes" for these macros are:
+ *
+ * EXTERN void	TclEmitInstInt1 _ANSI_ARGS_((unsigned char op, int i, 
+ *		    CompileEnv *envPtr));
+ * EXTERN void	TclEmitInstInt4 _ANSI_ARGS_((unsigned char op, int i, 
+ *		    CompileEnv *envPtr));
+ * EXTERN void	TclEmitInstUInt1 _ANSI_ARGS_((unsigned char op,
+ *		    unsigned int i, CompileEnv *envPtr));
+ * EXTERN void	TclEmitInstUInt4 _ANSI_ARGS_((unsigned char op,
+ *		    unsigned int i, CompileEnv *envPtr));
+ */
+
+#define TclEmitInstInt1(op, i, envPtr) \
+    TclEnsureCodeSpace(2, (envPtr)); \
+    *(envPtr)->codeNext++ = (unsigned char) (op); \
+    *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i))
+
+#define TclEmitInstInt4(op, i, envPtr) \
+    TclEnsureCodeSpace(5, (envPtr)); \
+    *(envPtr)->codeNext++ = (unsigned char) (op); \
+    *(envPtr)->codeNext++ = \
+        (unsigned char) ((unsigned int) (i) >> 24); \
+    *(envPtr)->codeNext++ = \
+        (unsigned char) ((unsigned int) (i) >> 16); \
+    *(envPtr)->codeNext++ = \
+        (unsigned char) ((unsigned int) (i) >>  8); \
+    *(envPtr)->codeNext++ = \
+        (unsigned char) ((unsigned int) (i)      )
+    
+#define TclEmitInstUInt1(op, i, envPtr) \
+    TclEmitInstInt1((op), (i), (envPtr))
+
+#define TclEmitInstUInt4(op, i, envPtr) \
+    TclEmitInstInt4((op), (i), (envPtr))
+    
+/*
+ * Macro to push a Tcl object onto the Tcl evaluation stack. It emits the
+ * object's one or four byte array index into the CompileEnv's code
+ * array. These support, respectively, a maximum of 256 (2**8) and 2**32
+ * objects in a CompileEnv. The ANSI C "prototype" for this macro is:
+ *
+ * EXTERN void	TclEmitPush _ANSI_ARGS_((int objIndex, CompileEnv *envPtr));
+ */
+
+#define TclEmitPush(objIndex, envPtr) \
+    if ((objIndex) <= 255) { \
+	TclEmitInstUInt1(INST_PUSH1, (objIndex), (envPtr)); \
+    } else { \
+	TclEmitInstUInt4(INST_PUSH4, (objIndex), (envPtr)); \
+    }
+
+/*
+ * Macros to update a (signed or unsigned) integer starting at a pointer.
+ * The two variants depend on the number of bytes. The ANSI C "prototypes"
+ * for these macros are:
+ *
+ * EXTERN void	TclStoreInt1AtPtr _ANSI_ARGS_((int i, unsigned char *p));
+ * EXTERN void	TclStoreInt4AtPtr _ANSI_ARGS_((int i, unsigned char *p));
+ */
+    
+#define TclStoreInt1AtPtr(i, p) \
+    *(p)   = (unsigned char) ((unsigned int) (i))
+    
+#define TclStoreInt4AtPtr(i, p) \
+    *(p)   = (unsigned char) ((unsigned int) (i) >> 24); \
+    *(p+1) = (unsigned char) ((unsigned int) (i) >> 16); \
+    *(p+2) = (unsigned char) ((unsigned int) (i) >>  8); \
+    *(p+3) = (unsigned char) ((unsigned int) (i)      )
+
+/*
+ * Macros to update instructions at a particular pc with a new op code
+ * and a (signed or unsigned) int operand. The ANSI C "prototypes" for
+ * these macros are:
+ *
+ * EXTERN void	TclUpdateInstInt1AtPc _ANSI_ARGS_((unsigned char op, int i,
+ *		    unsigned char *pc));
+ * EXTERN void	TclUpdateInstInt4AtPc _ANSI_ARGS_((unsigned char op, int i,
+ *		    unsigned char *pc));
+ */
+
+#define TclUpdateInstInt1AtPc(op, i, pc) \
+    *(pc) = (unsigned char) (op); \
+    TclStoreInt1AtPtr((i), ((pc)+1))
+
+#define TclUpdateInstInt4AtPc(op, i, pc) \
+    *(pc) = (unsigned char) (op); \
+    TclStoreInt4AtPtr((i), ((pc)+1))
+    
+/*
+ * Macros to get a signed integer (GET_INT{1,2}) or an unsigned int
+ * (GET_UINT{1,2}) from a pointer. There are two variants for each
+ * return type that depend on the number of bytes fetched.
+ * The ANSI C "prototypes" for these macros are:
+ *
+ * EXTERN int	        TclGetInt1AtPtr  _ANSI_ARGS_((unsigned char *p));
+ * EXTERN int	        TclGetInt4AtPtr  _ANSI_ARGS_((unsigned char *p));
+ * EXTERN unsigned int	TclGetUInt1AtPtr _ANSI_ARGS_((unsigned char *p));
+ * EXTERN unsigned int	TclGetUInt4AtPtr _ANSI_ARGS_((unsigned char *p));
+ */
+
+/*
+ * The TclGetInt1AtPtr macro is tricky because we want to do sign
+ * extension on the 1-byte value. Unfortunately the "char" type isn't
+ * signed on all platforms so sign-extension doesn't always happen
+ * automatically. Sometimes we can explicitly declare the pointer to be
+ * signed, but other times we have to explicitly sign-extend the value
+ * in software.
+ */
+
+#ifndef __CHAR_UNSIGNED__
+#   define TclGetInt1AtPtr(p) ((int) *((char *) p))
+#else
+#   ifdef HAVE_SIGNED_CHAR
+#	define TclGetInt1AtPtr(p) ((int) *((signed char *) p))
+#    else
+#	define TclGetInt1AtPtr(p) (((int) *((char *) p)) \
+		| ((*(p) & 0200) ? (-256) : 0))
+#    endif
+#endif
+
+#define TclGetInt4AtPtr(p) (((int) TclGetInt1AtPtr(p) << 24) | \
+		                  	    (*((p)+1) << 16) | \
+				  	    (*((p)+2) <<  8) | \
+				  	    (*((p)+3)))
+
+#define TclGetUInt1AtPtr(p) ((unsigned int) *(p))
+#define TclGetUInt4AtPtr(p) ((unsigned int) (*(p)     << 24) | \
+		                            (*((p)+1) << 16) | \
+				            (*((p)+2) <<  8) | \
+				            (*((p)+3)))
+
+/*
+ * Macros used to compute the minimum and maximum of two integers.
+ * The ANSI C "prototypes" for these macros are:
+ *
+ * EXTERN int  TclMin _ANSI_ARGS_((int i, int j));
+ * EXTERN int  TclMax _ANSI_ARGS_((int i, int j));
+ */
+
+#define TclMin(i, j)   ((((int) i) < ((int) j))? (i) : (j))
+#define TclMax(i, j)   ((((int) i) > ((int) j))? (i) : (j))
+
+/*
+ * Macro used to compute the offset of the current instruction in the
+ * bytecode instruction stream. The ANSI C "prototypes" for this macro is:
+ *
+ * EXTERN int  TclCurrCodeOffset _ANSI_ARGS_((void));
+ */
+
+#define TclCurrCodeOffset()  ((envPtr)->codeNext - (envPtr)->codeStart)
+
+/*
+ * Upper bound for legal jump distances. Checked during compilation if
+ * debugging.
+ */
+
+#define MAX_JUMP_DIST   5000
+
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TCLCOMPILATION */
Index: /trunk/tcl/tclExecute.c
===================================================================
--- /trunk/tcl/tclExecute.c	(revision 2)
+++ /trunk/tcl/tclExecute.c	(revision 2)
@@ -0,0 +1,4797 @@
+/* 
+ * tclExecute.c --
+ *
+ *	This file contains procedures that execute byte-compiled Tcl
+ *	commands.
+ *
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclExecute.c,v 1.1 2008-06-04 13:58:06 demin Exp $
+ */
+
+#include "tclInt.h"
+#include "tclCompile.h"
+
+#ifdef NO_FLOAT_H
+#   include "../compat/float.h"
+#else
+#   include <float.h>
+#endif
+#ifndef TCL_NO_MATH
+#include "tclMath.h"
+#endif
+
+/*
+ * The stuff below is a bit of a hack so that this file can be used
+ * in environments that include no UNIX, i.e. no errno.  Just define
+ * errno here.
+ */
+
+#ifndef TCL_GENERIC_ONLY
+#include "tclPort.h"
+#else
+#define NO_ERRNO_H
+#endif
+
+#ifdef NO_ERRNO_H
+int errno;
+#define EDOM 33
+#define ERANGE 34
+#endif
+
+/*
+ * Boolean flag indicating whether the Tcl bytecode interpreter has been
+ * initialized.
+ */
+
+static int execInitialized = 0;
+
+/*
+ * Variable that controls whether execution tracing is enabled and, if so,
+ * what level of tracing is desired:
+ *    0: no execution tracing
+ *    1: trace invocations of Tcl procs only
+ *    2: trace invocations of all (not compiled away) commands
+ *    3: display each instruction executed
+ * This variable is linked to the Tcl variable "tcl_traceExec".
+ */
+
+int tclTraceExec = 0;
+
+/*
+ * The following global variable is use to signal matherr that Tcl
+ * is responsible for the arithmetic, so errors can be handled in a
+ * fashion appropriate for Tcl.  Zero means no Tcl math is in
+ * progress;  non-zero means Tcl is doing math.
+ */
+
+int tcl_MathInProgress = 0;
+
+/*
+ * The variable below serves no useful purpose except to generate
+ * a reference to matherr, so that the Tcl version of matherr is
+ * linked in rather than the system version. Without this reference
+ * the need for matherr won't be discovered during linking until after
+ * libtcl.a has been processed, so Tcl's version won't be used.
+ */
+
+#ifdef NEED_MATHERR
+extern int matherr();
+int (*tclMatherrPtr)() = matherr;
+#endif
+
+/*
+ * Array of instruction names.
+ */
+
+static char *opName[256];
+
+/*
+ * Mapping from expression instruction opcodes to strings; used for error
+ * messages. Note that these entries must match the order and number of the
+ * expression opcodes (e.g., INST_LOR) in tclCompile.h.
+ */
+
+static char *operatorStrings[] = {
+    "||", "&&", "|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>",
+    "+", "-", "*", "/", "%", "+", "-", "~", "!",
+    "BUILTIN FUNCTION", "FUNCTION"
+};
+    
+/*
+ * Mapping from Tcl result codes to strings; used for error and debugging
+ * messages. 
+ */
+
+#ifdef TCL_COMPILE_DEBUG
+static char *resultStrings[] = {
+    "TCL_OK", "TCL_ERROR", "TCL_RETURN", "TCL_BREAK", "TCL_CONTINUE"
+};
+#endif /* TCL_COMPILE_DEBUG */
+
+/*
+ * The following are statistics-related variables that record information
+ * about the bytecode compiler and interpreter's operation. This includes
+ * an array that records for each instruction how often it is executed.
+ */
+
+#ifdef TCL_COMPILE_STATS
+static long numExecutions = 0;
+static int instructionCount[256];
+#endif /* TCL_COMPILE_STATS */
+
+/*
+ * Macros for testing floating-point values for certain special cases. Test
+ * for not-a-number by comparing a value against itself; test for infinity
+ * by comparing against the largest floating-point value.
+ */
+
+#define IS_NAN(v) ((v) != (v))
+#ifdef DBL_MAX
+#   define IS_INF(v) (((v) > DBL_MAX) || ((v) < -DBL_MAX))
+#else
+#   define IS_INF(v) 0
+#endif
+
+/*
+ * Macro to adjust the program counter and restart the instruction execution
+ * loop after each instruction is executed.
+ */
+
+#define ADJUST_PC(instBytes) \
+    pc += instBytes;  continue
+
+/*
+ * Macros used to cache often-referenced Tcl evaluation stack information
+ * in local variables. Note that a DECACHE_STACK_INFO()-CACHE_STACK_INFO()
+ * pair must surround any call inside TclExecuteByteCode (and a few other
+ * procedures that use this scheme) that could result in a recursive call
+ * to TclExecuteByteCode.
+ */
+
+#define CACHE_STACK_INFO() \
+    stackPtr = eePtr->stackPtr; \
+    stackTop = eePtr->stackTop
+
+#define DECACHE_STACK_INFO() \
+    eePtr->stackTop = stackTop
+
+/*
+ * Macros used to access items on the Tcl evaluation stack. PUSH_OBJECT
+ * increments the object's ref count since it makes the stack have another
+ * reference pointing to the object. However, POP_OBJECT does not decrement
+ * the ref count. This is because the stack may hold the only reference to
+ * the object, so the object would be destroyed if its ref count were
+ * decremented before the caller had a chance to, e.g., store it in a
+ * variable. It is the caller's responsibility to decrement the ref count
+ * when it is finished with an object.
+ */
+
+#define STK_ITEM(offset)    (stackPtr[stackTop + (offset)])
+#define STK_OBJECT(offset)  (STK_ITEM(offset).o)
+#define STK_INT(offset)     (STK_ITEM(offset).i)
+#define STK_POINTER(offset) (STK_ITEM(offset).p)
+
+/*
+ * WARNING! It is essential that objPtr only appear once in the PUSH_OBJECT
+ * macro. The actual parameter might be an expression with side effects,
+ * and this ensures that it will be executed only once. 
+ */
+    
+#define PUSH_OBJECT(objPtr) \
+    Tcl_IncrRefCount(stackPtr[++stackTop].o = (objPtr))
+    
+#define POP_OBJECT() \
+    (stackPtr[stackTop--].o)
+
+/*
+ * Macros used to trace instruction execution. The macros TRACE,
+ * TRACE_WITH_OBJ, and O2S are only used inside TclExecuteByteCode.
+ * O2S is only used in TRACE* calls to get a string from an object.
+ * 
+ * NOTE THAT CLIENTS OF O2S ARE LIKELY TO FAIL IF THE OBJECT'S
+ * STRING REP CONTAINS NULLS. 
+ */
+
+#ifdef TCL_COMPILE_DEBUG
+	
+#define O2S(objPtr) \
+    Tcl_GetStringFromObj((objPtr), &length)
+	
+#ifdef TCL_COMPILE_STATS
+#define TRACE(a) \
+    if (traceInstructions) { \
+        fprintf(stdout, "%d: %d,%ld (%u) ", iPtr->numLevels, \
+	       stackTop, (tclObjsAlloced - tclObjsFreed), \
+	       (unsigned int)(pc - codePtr->codeStart)); \
+	printf a; \
+        fflush(stdout); \
+    }
+#define TRACE_WITH_OBJ(a, objPtr) \
+    if (traceInstructions) { \
+        fprintf(stdout, "%d: %d,%ld (%u) ", iPtr->numLevels, \
+	       stackTop, (tclObjsAlloced - tclObjsFreed), \
+	       (unsigned int)(pc - codePtr->codeStart)); \
+	printf a; \
+	bytes = Tcl_GetStringFromObj((objPtr), &length); \
+        TclPrintSource(stdout, bytes, TclMin(length, 30)); \
+        fprintf(stdout, "\n"); \
+        fflush(stdout); \
+    }
+#else  /* not TCL_COMPILE_STATS */
+#define TRACE(a) \
+    if (traceInstructions) { \
+        fprintf(stdout, "%d: %d (%u) ", iPtr->numLevels, stackTop, \
+	       (unsigned int)(pc - codePtr->codeStart)); \
+	printf a; \
+        fflush(stdout); \
+    }
+#define TRACE_WITH_OBJ(a, objPtr) \
+    if (traceInstructions) { \
+        fprintf(stdout, "%d: %d (%u) ", iPtr->numLevels, stackTop, \
+	       (unsigned int)(pc - codePtr->codeStart)); \
+	printf a; \
+	bytes = Tcl_GetStringFromObj((objPtr), &length); \
+        TclPrintSource(stdout, bytes, TclMin(length, 30)); \
+        fprintf(stdout, "\n"); \
+        fflush(stdout); \
+    }
+#endif /* TCL_COMPILE_STATS */
+
+#else  /* not TCL_COMPILE_DEBUG */
+	
+#define TRACE(a)
+#define TRACE_WITH_OBJ(a, objPtr)
+#define O2S(objPtr)
+	
+#endif /* TCL_COMPILE_DEBUG */
+
+/*
+ * Declarations for local procedures to this file:
+ */
+
+static void		CallTraceProcedure _ANSI_ARGS_((Tcl_Interp *interp,
+			    Trace *tracePtr, Command *cmdPtr,
+			    char *command, int numChars,
+			    int objc, Tcl_Obj *objv[]));
+static void		DupCmdNameInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
+			    Tcl_Obj *copyPtr));
+static int		ExprAbsFunc _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExecEnv *eePtr, ClientData clientData));
+static int		ExprBinaryFunc _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExecEnv *eePtr, ClientData clientData));
+static int		ExprCallMathFunc _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExecEnv *eePtr, int objc, Tcl_Obj **objv));
+static int		ExprDoubleFunc _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExecEnv *eePtr, ClientData clientData));
+static int		ExprIntFunc _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExecEnv *eePtr, ClientData clientData));
+static int		ExprRoundFunc _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExecEnv *eePtr, ClientData clientData));
+static int		ExprUnaryFunc _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExecEnv *eePtr, ClientData clientData));
+#ifdef TCL_COMPILE_STATS
+static int              EvalStatsCmd _ANSI_ARGS_((ClientData clientData,
+                            Tcl_Interp *interp, int argc, char **argv));
+#endif /* TCL_COMPILE_STATS */
+static void		FreeCmdNameInternalRep _ANSI_ARGS_((
+    			    Tcl_Obj *objPtr));
+static char *		GetSrcInfoForPc _ANSI_ARGS_((unsigned char *pc,
+        		    ByteCode* codePtr, int *lengthPtr));
+static void		GrowEvaluationStack _ANSI_ARGS_((ExecEnv *eePtr));
+static void		IllegalExprOperandType _ANSI_ARGS_((
+			    Tcl_Interp *interp, unsigned int opCode,
+			    Tcl_Obj *opndPtr));
+static void		InitByteCodeExecution _ANSI_ARGS_((
+			    Tcl_Interp *interp));
+static void		PrintByteCodeInfo _ANSI_ARGS_((ByteCode *codePtr));
+static void		RecordTracebackInfo _ANSI_ARGS_((Tcl_Interp *interp,
+			    unsigned char *pc, ByteCode *codePtr));
+static int		SetCmdNameFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr));
+#ifdef TCL_COMPILE_DEBUG
+static char *		StringForResultCode _ANSI_ARGS_((int result));
+#endif /* TCL_COMPILE_DEBUG */
+static void		UpdateStringOfCmdName _ANSI_ARGS_((Tcl_Obj *objPtr));
+#ifdef TCL_COMPILE_DEBUG
+static void		ValidatePcAndStackTop _ANSI_ARGS_((
+			    ByteCode *codePtr, unsigned char *pc,
+			    int stackTop, int stackLowerBound,
+			    int stackUpperBound));
+#endif /* TCL_COMPILE_DEBUG */
+
+/*
+ * Table describing the built-in math functions. Entries in this table are
+ * indexed by the values of the INST_CALL_BUILTIN_FUNC instruction's
+ * operand byte.
+ */
+
+BuiltinFunc builtinFuncTable[] = {
+#ifndef TCL_NO_MATH
+    {"acos", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) acos},
+    {"asin", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) asin},
+    {"atan", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) atan},
+    {"atan2", 2, {TCL_DOUBLE, TCL_DOUBLE}, ExprBinaryFunc, (ClientData) atan2},
+    {"ceil", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) ceil},
+    {"cos", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) cos},
+    {"cosh", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) cosh},
+    {"exp", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) exp},
+    {"floor", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) floor},
+    {"fmod", 2, {TCL_DOUBLE, TCL_DOUBLE}, ExprBinaryFunc, (ClientData) fmod},
+    {"hypot", 2, {TCL_DOUBLE, TCL_DOUBLE}, ExprBinaryFunc, (ClientData) hypot},
+    {"log", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) log},
+    {"log10", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) log10},
+    {"pow", 2, {TCL_DOUBLE, TCL_DOUBLE}, ExprBinaryFunc, (ClientData) pow},
+    {"sin", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) sin},
+    {"sinh", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) sinh},
+    {"sqrt", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) sqrt},
+    {"tan", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) tan},
+    {"tanh", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) tanh},
+#endif
+    {"abs", 1, {TCL_EITHER}, ExprAbsFunc, 0},
+    {"double", 1, {TCL_EITHER}, ExprDoubleFunc, 0},
+    {"int", 1, {TCL_EITHER}, ExprIntFunc, 0},
+    {"round", 1, {TCL_EITHER}, ExprRoundFunc, 0},
+    {0},
+};
+
+/*
+ * The structure below defines the command name Tcl object type by means of
+ * procedures that can be invoked by generic object code. Objects of this
+ * type cache the Command pointer that results from looking up command names
+ * in the command hashtable. Such objects appear as the zeroth ("command
+ * name") argument in a Tcl command.
+ */
+
+Tcl_ObjType tclCmdNameType = {
+    "cmdName",				/* name */
+    FreeCmdNameInternalRep,		/* freeIntRepProc */
+    DupCmdNameInternalRep,		/* dupIntRepProc */
+    UpdateStringOfCmdName,		/* updateStringProc */
+    SetCmdNameFromAny			/* setFromAnyProc */
+};
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitByteCodeExecution --
+ *
+ *	This procedure is called once to initialize the Tcl bytecode
+ *	interpreter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	This procedure initializes the array of instruction names. If
+ *	compiling with the TCL_COMPILE_STATS flag, it initializes the
+ *	array that counts the executions of each instruction and it
+ *	creates the "evalstats" command. It also registers the command name
+ *	Tcl_ObjType. It also establishes the link between the Tcl
+ *	"tcl_traceExec" and C "tclTraceExec" variables.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitByteCodeExecution(interp)
+    Tcl_Interp *interp;		/* Interpreter for which the Tcl variable
+				 * "tcl_traceExec" is linked to control
+				 * instruction tracing. */
+{
+    int i;
+    
+    Tcl_RegisterObjType(&tclCmdNameType);
+
+    (VOID *) memset(opName, 0, sizeof(opName));
+    for (i = 0;  instructionTable[i].name != NULL;  i++) {
+	opName[i] = instructionTable[i].name;
+    }
+
+#ifdef TCL_COMPILE_STATS    
+    (VOID *) memset(instructionCount, 0, sizeof(instructionCount));
+    (VOID *) memset(tclByteCodeCount, 0, sizeof(tclByteCodeCount));
+    (VOID *) memset(tclSourceCount, 0, sizeof(tclSourceCount));
+
+    Tcl_CreateCommand(interp, "evalstats", EvalStatsCmd,
+		      (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
+#endif /* TCL_COMPILE_STATS */
+    
+    if (Tcl_LinkVar(interp, "tcl_traceExec", (char *) &tclTraceExec,
+		    TCL_LINK_INT) != TCL_OK) {
+	panic("InitByteCodeExecution: can't create link for tcl_traceExec variable");
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCreateExecEnv --
+ *
+ *	This procedure creates a new execution environment for Tcl bytecode
+ *	execution. An ExecEnv points to a Tcl evaluation stack. An ExecEnv
+ *	is typically created once for each Tcl interpreter (Interp
+ *	structure) and recursively passed to TclExecuteByteCode to execute
+ *	ByteCode sequences for nested commands.
+ *
+ * Results:
+ *	A newly allocated ExecEnv is returned. This points to an empty
+ *	evaluation stack of the standard initial size.
+ *
+ * Side effects:
+ *	The bytecode interpreter is also initialized here, as this
+ *	procedure will be called before any call to TclExecuteByteCode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#define TCL_STACK_INITIAL_SIZE 2000
+
+ExecEnv *
+TclCreateExecEnv(interp)
+    Tcl_Interp *interp;		/* Interpreter for which the execution
+				 * environment is being created. */
+{
+    ExecEnv *eePtr = (ExecEnv *) ckalloc(sizeof(ExecEnv));
+
+    eePtr->stackPtr = (StackItem *)
+	ckalloc((unsigned) (TCL_STACK_INITIAL_SIZE * sizeof(StackItem)));
+    eePtr->stackTop = -1;
+    eePtr->stackEnd = (TCL_STACK_INITIAL_SIZE - 1);
+
+    if (!execInitialized) {
+        TclInitAuxDataTypeTable();
+        InitByteCodeExecution(interp);
+        execInitialized = 1;
+    }
+
+    return eePtr;
+}
+#undef TCL_STACK_INITIAL_SIZE
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDeleteExecEnv --
+ *
+ *	Frees the storage for an ExecEnv.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Storage for an ExecEnv and its contained storage (e.g. the
+ *	evaluation stack) is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclDeleteExecEnv(eePtr)
+    ExecEnv *eePtr;		/* Execution environment to free. */
+{
+    ckfree((char *) eePtr->stackPtr);
+    ckfree((char *) eePtr);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFinalizeExecEnv --
+ *
+ *	Finalizes the execution environment setup so that it can be
+ *	later reinitialized.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	After this call, the next time TclCreateExecEnv will be called
+ *	it will call InitByteCodeExecution.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFinalizeExecEnv()
+{
+    execInitialized = 0;
+    TclFinalizeAuxDataTypeTable();
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GrowEvaluationStack --
+ *
+ *	This procedure grows a Tcl evaluation stack stored in an ExecEnv.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The size of the evaluation stack is doubled.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GrowEvaluationStack(eePtr)
+    register ExecEnv *eePtr; /* Points to the ExecEnv with an evaluation
+			      * stack to enlarge. */
+{
+    /*
+     * The current Tcl stack elements are stored from eePtr->stackPtr[0]
+     * to eePtr->stackPtr[eePtr->stackEnd] (inclusive).
+     */
+
+    int currElems = (eePtr->stackEnd + 1);
+    int newElems  = 2*currElems;
+    int currBytes = currElems * sizeof(StackItem);
+    int newBytes  = 2*currBytes;
+    StackItem *newStackPtr = (StackItem *) ckalloc((unsigned) newBytes);
+
+    /*
+     * Copy the existing stack items to the new stack space, free the old
+     * storage if appropriate, and mark new space as malloc'ed.
+     */
+ 
+    memcpy((VOID *) newStackPtr, (VOID *) eePtr->stackPtr,
+	   (size_t) currBytes);
+    ckfree((char *) eePtr->stackPtr);
+    eePtr->stackPtr = newStackPtr;
+    eePtr->stackEnd = (newElems - 1); /* i.e. index of last usable item */
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclExecuteByteCode --
+ *
+ *	This procedure executes the instructions of a ByteCode structure.
+ *	It returns when a "done" instruction is executed or an error occurs.
+ *
+ * Results:
+ *	The return value is one of the return codes defined in tcl.h
+ *	(such as TCL_OK), and interp->objResultPtr refers to a Tcl object
+ *	that either contains the result of executing the code or an
+ *	error message.
+ *
+ * Side effects:
+ *	Almost certainly, depending on the ByteCode's instructions.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclExecuteByteCode(interp, codePtr)
+    Tcl_Interp *interp;		/* Token for command interpreter. */
+    ByteCode *codePtr;		/* The bytecode sequence to interpret. */
+{
+    Interp *iPtr = (Interp *) interp;
+    ExecEnv *eePtr = iPtr->execEnvPtr;
+    				/* Points to the execution environment. */
+    register StackItem *stackPtr = eePtr->stackPtr;
+    				/* Cached evaluation stack base pointer. */
+    register int stackTop = eePtr->stackTop;
+    				/* Cached top index of evaluation stack. */
+    Tcl_Obj **objArrayPtr = codePtr->objArrayPtr;
+    				/* Points to the ByteCode's object array. */
+    unsigned char *pc = codePtr->codeStart;
+				/* The current program counter. */
+    unsigned char opCode;	/* The current instruction code. */
+    int opnd;			/* Current instruction's operand byte. */
+    int pcAdjustment;		/* Hold pc adjustment after instruction. */
+    int initStackTop = stackTop;/* Stack top at start of execution. */
+    ExceptionRange *rangePtr;	/* Points to closest loop or catch exception
+				 * range enclosing the pc. Used by various
+				 * instructions and processCatch to
+				 * process break, continue, and errors. */
+    int result = TCL_OK;	/* Return code returned after execution. */
+    int traceInstructions = (tclTraceExec == 3);
+    Tcl_Obj *valuePtr, *value2Ptr, *namePtr, *objPtr;
+    char *bytes;
+    int length;
+    long i;
+    Tcl_DString command;	/* Used for debugging. If tclTraceExec >= 2
+				 * holds a string representing the last
+				 * command invoked. */
+
+    /*
+     * This procedure uses a stack to hold information about catch commands.
+     * This information is the current operand stack top when starting to
+     * execute the code for each catch command. It starts out with stack-
+     * allocated space but uses dynamically-allocated storage if needed.
+     */
+
+#define STATIC_CATCH_STACK_SIZE 5
+    int (catchStackStorage[STATIC_CATCH_STACK_SIZE]);
+    int *catchStackPtr = catchStackStorage;
+    int catchTop = -1;
+
+    /*
+     * THIS PROC FAILS IF AN OBJECT'S STRING REP HAS A NULL BYTE.
+     */
+
+    if (tclTraceExec >= 2) {
+	PrintByteCodeInfo(codePtr);
+#ifdef TCL_COMPILE_STATS
+	fprintf(stdout, "  Starting stack top=%d, system objects=%ld\n",
+		eePtr->stackTop, (tclObjsAlloced - tclObjsFreed));
+#else
+	fprintf(stdout, "  Starting stack top=%d\n", eePtr->stackTop);
+#endif /* TCL_COMPILE_STATS */
+	fflush(stdout);
+    }
+
+#ifdef TCL_COMPILE_STATS
+    numExecutions++;
+#endif /* TCL_COMPILE_STATS */
+
+    /*
+     * Make sure the catch stack is large enough to hold the maximum number
+     * of catch commands that could ever be executing at the same time. This
+     * will be no more than the exception range array's depth.
+     */
+
+    if (codePtr->maxExcRangeDepth > STATIC_CATCH_STACK_SIZE) {
+	catchStackPtr = (int *)
+	        ckalloc(codePtr->maxExcRangeDepth * sizeof(int));
+    }
+
+    /*
+     * Make sure the stack has enough room to execute this ByteCode.
+     */
+
+    while ((stackTop + codePtr->maxStackDepth) > eePtr->stackEnd) {
+        GrowEvaluationStack(eePtr); 
+        stackPtr = eePtr->stackPtr;
+    }
+
+    /*
+     * Initialize the buffer that holds a string containing the name and
+     * arguments for the last invoked command.
+     */
+
+    Tcl_DStringInit(&command);
+
+    /*
+     * Loop executing instructions until a "done" instruction, a TCL_RETURN,
+     * or some error.
+     */
+
+    for (;;) {
+#ifdef TCL_COMPILE_DEBUG
+	ValidatePcAndStackTop(codePtr, pc, stackTop, initStackTop,
+		eePtr->stackEnd);
+#else /* not TCL_COMPILE_DEBUG */
+	if (traceInstructions) {
+#ifdef TCL_COMPILE_STATS
+	    fprintf(stdout, "%d: %d,%ld ", iPtr->numLevels, stackTop,
+		    (tclObjsAlloced - tclObjsFreed));
+#else /* TCL_COMPILE_STATS */
+	    fprintf(stdout, "%d: %d ", iPtr->numLevels, stackTop);
+#endif /* TCL_COMPILE_STATS */
+	    TclPrintInstruction(codePtr, pc);
+	    fflush(stdout);
+	}
+#endif /* TCL_COMPILE_DEBUG */
+	
+	opCode = *pc;
+#ifdef TCL_COMPILE_STATS    
+	instructionCount[opCode]++;
+#endif /* TCL_COMPILE_STATS */
+
+        switch (opCode) {
+	case INST_DONE:
+	    /*
+	     * Pop the topmost object from the stack, set the interpreter's
+	     * object result to point to it, and return.
+	     */
+	    valuePtr = POP_OBJECT();
+	    Tcl_SetObjResult(interp, valuePtr);
+	    TclDecrRefCount(valuePtr);
+	    if (stackTop != initStackTop) {
+		fprintf(stderr, "\nTclExecuteByteCode: done instruction at pc %u: stack top %d != entry stack top %d\n",
+			(unsigned int)(pc - codePtr->codeStart),
+			(unsigned int) stackTop,
+			(unsigned int) initStackTop);
+		fprintf(stderr, "  Source: ");
+		TclPrintSource(stderr, codePtr->source, 150);
+		panic("TclExecuteByteCode execution failure: end stack top != start stack top");
+	    }
+	    TRACE_WITH_OBJ(("done => return code=%d, result is ", result),
+		    iPtr->objResultPtr);
+	    goto done;
+	    
+	case INST_PUSH1:
+	    valuePtr = objArrayPtr[TclGetUInt1AtPtr(pc+1)];
+	    PUSH_OBJECT(valuePtr);
+	    TRACE_WITH_OBJ(("push1 %u => ", TclGetUInt1AtPtr(pc+1)),
+	            valuePtr);
+	    ADJUST_PC(2);
+	    
+	case INST_PUSH4:
+	    valuePtr = objArrayPtr[TclGetUInt4AtPtr(pc+1)];
+	    PUSH_OBJECT(valuePtr);
+	    TRACE_WITH_OBJ(("push4 %u => ", TclGetUInt4AtPtr(pc+1)),
+		    valuePtr);
+	    ADJUST_PC(5);
+	    
+	case INST_POP:
+	    valuePtr = POP_OBJECT();
+	    TRACE_WITH_OBJ(("pop => discarding "), valuePtr);
+	    TclDecrRefCount(valuePtr); /* finished with pop'ed object. */
+	    ADJUST_PC(1);
+
+	case INST_DUP:
+	    valuePtr = stackPtr[stackTop].o;
+	    PUSH_OBJECT(Tcl_DuplicateObj(valuePtr));
+	    TRACE_WITH_OBJ(("dup => "), valuePtr);
+	    ADJUST_PC(1);
+
+	case INST_CONCAT1:
+	    opnd = TclGetUInt1AtPtr(pc+1);
+	    {
+		Tcl_Obj *concatObjPtr;
+		int totalLen = 0;
+
+		/*
+		 * Concatenate strings (with no separators) from the top
+		 * opnd items on the stack starting with the deepest item.
+		 * First, determine how many characters are needed.
+		 */
+
+		for (i = (stackTop - (opnd-1));  i <= stackTop;  i++) {
+		    valuePtr = stackPtr[i].o;
+		    bytes = TclGetStringFromObj(valuePtr, &length);
+		    if (bytes != NULL) {
+			totalLen += length;
+		    }
+                }
+
+		/*
+		 * Initialize the new append string object by appending the
+		 * strings of the opnd stack objects. Also pop the objects. 
+		 */
+
+		TclNewObj(concatObjPtr);
+		if (totalLen > 0) {
+		    char *p = (char *) ckalloc((unsigned) (totalLen + 1));
+		    concatObjPtr->bytes = p;
+		    concatObjPtr->length = totalLen;
+		    for (i = (stackTop - (opnd-1));  i <= stackTop;  i++) {
+			valuePtr = stackPtr[i].o;
+			bytes = TclGetStringFromObj(valuePtr, &length);
+			if (bytes != NULL) {
+			    memcpy((VOID *) p, (VOID *) bytes,
+			            (size_t) length);
+			    p += length;
+			}
+			TclDecrRefCount(valuePtr);
+		    }
+		    *p = '\0';
+		} else {
+		    for (i = (stackTop - (opnd-1));  i <= stackTop;  i++) {
+			valuePtr = stackPtr[i].o;
+			Tcl_DecrRefCount(valuePtr);
+		    }
+		}
+		stackTop -= opnd;
+		
+		PUSH_OBJECT(concatObjPtr);
+		TRACE_WITH_OBJ(("concat %u => ", opnd), concatObjPtr);
+		ADJUST_PC(2);
+            }
+	    
+	case INST_INVOKE_STK4:
+	    opnd = TclGetUInt4AtPtr(pc+1);
+	    pcAdjustment = 5;
+	    goto doInvocation;
+
+	case INST_INVOKE_STK1:
+	    opnd = TclGetUInt1AtPtr(pc+1);
+	    pcAdjustment = 2;
+	    
+	    doInvocation:
+	    {
+		char *cmdName;
+		Command *cmdPtr;   /* Points to command's Command struct. */
+		int objc = opnd;   /* The number of arguments. */
+		Tcl_Obj **objv;	   /* The array of argument objects. */
+		Tcl_Obj *objv0Ptr; /* Holds objv[0], the command name. */
+		int newPcOffset = 0;
+				   /* Instruction offset computed during
+				    * break, continue, error processing.
+				    * Init. to avoid compiler warning. */
+		Tcl_Command cmd;
+#ifdef TCL_COMPILE_DEBUG
+		int isUnknownCmd = 0;
+		char cmdNameBuf[30];
+#endif /* TCL_COMPILE_DEBUG */
+		
+		/*
+		 * If the interpreter was deleted, return an error.
+		 */
+		
+		if (iPtr->flags & DELETED) {
+		    Tcl_ResetResult(interp);
+		    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		            "attempt to call eval in deleted interpreter", -1);
+		    Tcl_SetErrorCode(interp, "CORE", "IDELETE",
+			    "attempt to call eval in deleted interpreter",
+			    (char *) NULL);
+		    result = TCL_ERROR;
+		    goto checkForCatch;
+		}
+    
+		objv = &(stackPtr[stackTop - (objc-1)].o);
+		objv0Ptr = objv[0];
+		cmdName = TclGetStringFromObj(objv0Ptr, (int *) NULL);
+		
+		/*
+		 * Find the procedure to execute this command. If there
+		 * isn't one, then see if there is a command "unknown". If
+		 * so, invoke it, passing it the original command words as
+		 * arguments.
+		 *
+		 * We convert the objv[0] object to be a CmdName object.
+		 * This caches a pointer to the Command structure for the
+		 * command; this pointer is held in a ResolvedCmdName
+		 * structure the object's internal rep. points to.
+		 */
+
+		cmd = Tcl_GetCommandFromObj(interp, objv0Ptr);
+		cmdPtr = (Command *) cmd;
+		
+		/*
+		 * If the command is still not found, handle it with the
+		 * "unknown" proc.
+		 */
+
+		if (cmdPtr == NULL) {
+		    cmd = Tcl_FindCommand(interp, "unknown",
+                            (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY);
+                    if (cmd == (Tcl_Command) NULL) {
+			Tcl_ResetResult(interp);
+			Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+			        "invalid command name \"", cmdName, "\"",
+				(char *) NULL);
+			TRACE(("%s %u => unknown proc not found: ",
+			       opName[opCode], objc));
+			result = TCL_ERROR;
+			goto checkForCatch;
+		    }
+		    cmdPtr = (Command *) cmd;
+#ifdef TCL_COMPILE_DEBUG
+		    isUnknownCmd = 1;
+#endif /*TCL_COMPILE_DEBUG*/			
+		    stackTop++; /* need room for new inserted objv[0] */
+		    for (i = objc;  i >= 0;  i--) {
+			objv[i+1] = objv[i];
+		    }
+		    objc++;
+		    objv[0] = Tcl_NewStringObj("unknown", -1);
+		    Tcl_IncrRefCount(objv[0]);
+		}
+		
+		/*
+		 * Call any trace procedures.
+		 */
+
+		if (iPtr->tracePtr != NULL) {
+		    Trace *tracePtr, *nextTracePtr;
+
+		    for (tracePtr = iPtr->tracePtr;  tracePtr != NULL;
+		            tracePtr = nextTracePtr) {
+			nextTracePtr = tracePtr->nextPtr;
+			if (iPtr->numLevels <= tracePtr->level) {
+			    int numChars;
+			    char *cmd = GetSrcInfoForPc(pc, codePtr,
+				    &numChars);
+			    if (cmd != NULL) {
+				DECACHE_STACK_INFO();
+				CallTraceProcedure(interp, tracePtr, cmdPtr,
+				        cmd, numChars, objc, objv);
+				CACHE_STACK_INFO();
+			    }
+			}
+		    }
+		}
+		
+		/*
+		 * Finally, invoke the command's Tcl_ObjCmdProc. First reset
+		 * the interpreter's string and object results to their
+		 * default empty values since they could have gotten changed
+		 * by earlier invocations.
+		 */
+		
+		Tcl_ResetResult(interp);
+
+		if (tclTraceExec >= 2) {
+		    char buffer[50];
+
+		    sprintf(buffer, "%d: (%u) invoking ", iPtr->numLevels,
+			    (unsigned int)(pc - codePtr->codeStart));
+		    Tcl_DStringAppend(&command, buffer, -1);
+		    
+#ifdef TCL_COMPILE_DEBUG
+		    if (traceInstructions) { /* tclTraceExec == 3 */
+			strncpy(cmdNameBuf, cmdName, 20);
+			TRACE(("%s %u => call ", opName[opCode],
+			       (isUnknownCmd? objc-1 : objc)));
+		    } else {
+			fprintf(stdout, "%s", buffer);
+		    }
+#else /* TCL_COMPILE_DEBUG */
+		    fprintf(stdout, "%s", buffer);
+#endif /*TCL_COMPILE_DEBUG*/
+
+		    for (i = 0;  i < objc;  i++) {
+			bytes = TclGetStringFromObj(objv[i], &length);
+			TclPrintSource(stdout, bytes, TclMin(length, 15));
+			fprintf(stdout, " ");
+
+			sprintf(buffer, "\"%.*s\" ", TclMin(length, 15), bytes);
+			Tcl_DStringAppend(&command, buffer, -1);
+		    }
+		    fprintf(stdout, "\n");
+		    fflush(stdout);
+
+		    Tcl_DStringFree(&command);
+		}
+
+		iPtr->cmdCount++;
+		DECACHE_STACK_INFO();
+		result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp,
+					    objc, objv);
+		if (Tcl_AsyncReady()) {
+		    result = Tcl_AsyncInvoke(interp, result);
+		}
+		CACHE_STACK_INFO();
+
+		/*
+		 * If the interpreter has a non-empty string result, the
+		 * result object is either empty or stale because some
+		 * procedure set interp->result directly. If so, move the
+		 * string result to the result object, then reset the
+		 * string result.
+		 */
+
+		if (*(iPtr->result) != 0) {
+		    (void) Tcl_GetObjResult(interp);
+		}
+		
+		/*
+		 * Pop the objc top stack elements and decrement their ref
+		 * counts. 
+		 */
+		
+		i = (stackTop - (objc-1));
+		while (i <= stackTop) {
+		    valuePtr = stackPtr[i].o;
+		    TclDecrRefCount(valuePtr);
+		    i++;
+		}
+		stackTop -= objc;
+
+		/*
+		 * Process the result of the Tcl_ObjCmdProc call.
+		 */
+		
+		switch (result) {
+		case TCL_OK:
+		    /*
+		     * Push the call's object result and continue execution
+		     * with the next instruction.
+		     */
+		    PUSH_OBJECT(Tcl_GetObjResult(interp));
+		    TRACE_WITH_OBJ(("%s %u => ...after \"%.20s\", result=",
+		            opName[opCode], objc, cmdNameBuf),
+			    Tcl_GetObjResult(interp));
+		    ADJUST_PC(pcAdjustment);
+		    
+		case TCL_BREAK:
+		case TCL_CONTINUE:
+		    /*
+		     * The invoked command requested a break or continue.
+		     * Find the closest enclosing loop or catch exception
+		     * range, if any. If a loop is found, terminate its
+		     * execution or skip to its next iteration. If the
+		     * closest is a catch exception range, jump to its
+		     * catchOffset. If no enclosing range is found, stop
+		     * execution and return the TCL_BREAK or TCL_CONTINUE.
+		     */
+		    rangePtr = TclGetExceptionRangeForPc(pc,
+                            /*catchOnly*/ 0, codePtr);
+		    if (rangePtr == NULL) {
+		        TRACE(("%s %u => ... after \"%.20s\", no encl. loop or catch, returning %s\n",
+		                opName[opCode], objc, cmdNameBuf,
+			        StringForResultCode(result)));
+			goto abnormalReturn; /* no catch exists to check */
+		    }
+		    switch (rangePtr->type) {
+		    case LOOP_EXCEPTION_RANGE:
+			if (result == TCL_BREAK) {
+			    newPcOffset = rangePtr->breakOffset;
+			} else if (rangePtr->continueOffset == -1) {
+			    TRACE(("%s %u => ... after \"%.20s\", %s, loop w/o continue, checking for catch\n",
+				   opName[opCode], objc, cmdNameBuf,
+				   StringForResultCode(result)));
+			    goto checkForCatch;
+			} else {
+			    newPcOffset = rangePtr->continueOffset;
+			}
+			TRACE(("%s %u => ... after \"%.20s\", %s, range at %d, new pc %d\n",
+			       opName[opCode], objc, cmdNameBuf,
+			       StringForResultCode(result),
+			       rangePtr->codeOffset, newPcOffset));
+			break;
+		    case CATCH_EXCEPTION_RANGE:
+			TRACE(("%s %u => ... after \"%.20s\", %s...\n",
+			       opName[opCode], objc, cmdNameBuf,
+			       StringForResultCode(result)));
+			goto processCatch; /* it will use rangePtr */
+		    default:
+			panic("TclExecuteByteCode: unrecognized ExceptionRange type %d\n", rangePtr->type);
+		    }
+		    result = TCL_OK;
+		    pc = (codePtr->codeStart + newPcOffset);
+		    continue;	/* restart outer instruction loop at pc */
+		    
+		case TCL_ERROR:
+		    /*
+		     * The invoked command returned an error. Look for an
+		     * enclosing catch exception range, if any.
+		     */
+		    TRACE_WITH_OBJ(("%s %u => ... after \"%.20s\", TCL_ERROR ",
+		            opName[opCode], objc, cmdNameBuf),
+			    Tcl_GetObjResult(interp));
+		    goto checkForCatch;
+
+		case TCL_RETURN:
+		    /*
+		     * The invoked command requested that the current
+		     * procedure stop execution and return. First check
+		     * for an enclosing catch exception range, if any.
+		     */
+		    TRACE(("%s %u => ... after \"%.20s\", TCL_RETURN\n",
+		            opName[opCode], objc, cmdNameBuf));
+		    goto checkForCatch;
+
+		default:
+		    TRACE_WITH_OBJ(("%s %u => ... after \"%.20s\", OTHER RETURN CODE %d ",
+		            opName[opCode], objc, cmdNameBuf, result),
+			    Tcl_GetObjResult(interp));
+		    goto checkForCatch;
+		} /* end of switch on result from invoke instruction */
+	    }
+	    
+	case INST_EVAL_STK:
+	    objPtr = POP_OBJECT();
+	    DECACHE_STACK_INFO();
+	    result = Tcl_EvalObj(interp, objPtr);
+	    CACHE_STACK_INFO();
+	    if (result == TCL_OK) {
+		/*
+		 * Normal return; push the eval's object result.
+		 */
+		
+		PUSH_OBJECT(Tcl_GetObjResult(interp));
+		TRACE_WITH_OBJ(("evalStk \"%.30s\" => ", O2S(objPtr)),
+			Tcl_GetObjResult(interp));
+		TclDecrRefCount(objPtr);
+		ADJUST_PC(1);
+	    } else if ((result == TCL_BREAK) || (result == TCL_CONTINUE)) {
+		/*
+		 * Find the closest enclosing loop or catch exception range,
+		 * if any. If a loop is found, terminate its execution or
+		 * skip to its next iteration. If the closest is a catch
+		 * exception range, jump to its catchOffset. If no enclosing
+		 * range is found, stop execution and return that same
+		 * TCL_BREAK or TCL_CONTINUE.
+		 */
+
+		int newPcOffset = 0; /* Pc offset computed during break,
+				      * continue, error processing. Init.
+				      * to avoid compiler warning. */
+
+		rangePtr = TclGetExceptionRangeForPc(pc, /*catchOnly*/ 0,
+			codePtr);
+		if (rangePtr == NULL) {
+		    TRACE(("evalStk \"%.30s\" => no encl. loop or catch, returning %s\n",
+			    O2S(objPtr), StringForResultCode(result)));
+		    Tcl_DecrRefCount(objPtr);
+		    goto abnormalReturn;    /* no catch exists to check */
+		}
+		switch (rangePtr->type) {
+		case LOOP_EXCEPTION_RANGE:
+		    if (result == TCL_BREAK) {
+			newPcOffset = rangePtr->breakOffset;
+		    } else if (rangePtr->continueOffset == -1) {
+			TRACE(("evalStk \"%.30s\" => %s, loop w/o continue, checking for catch\n",
+			       O2S(objPtr), StringForResultCode(result)));
+			Tcl_DecrRefCount(objPtr);
+			goto checkForCatch;
+		    } else {
+			newPcOffset = rangePtr->continueOffset;
+		    }
+		    result = TCL_OK;
+		    TRACE_WITH_OBJ(("evalStk \"%.30s\" => %s, range at %d, new pc %d ",
+			    O2S(objPtr), StringForResultCode(result),
+			    rangePtr->codeOffset, newPcOffset), valuePtr);
+		    break;
+		case CATCH_EXCEPTION_RANGE:
+		    TRACE_WITH_OBJ(("evalStk \"%.30s\" => %s ",
+			    O2S(objPtr), StringForResultCode(result)),
+			    valuePtr);
+		    Tcl_DecrRefCount(objPtr);
+		    goto processCatch;  /* it will use rangePtr */
+		default:
+		    panic("TclExecuteByteCode: unrecognized ExceptionRange type %d\n", rangePtr->type);
+		}
+		Tcl_DecrRefCount(objPtr);
+		pc = (codePtr->codeStart + newPcOffset);
+		continue;	/* restart outer instruction loop at pc */
+	    } else { /* eval returned TCL_ERROR, TCL_RETURN, unknown code */
+		TRACE_WITH_OBJ(("evalStk \"%.30s\" => ERROR: ", O2S(objPtr)),
+		        Tcl_GetObjResult(interp));
+		Tcl_DecrRefCount(objPtr);
+		goto checkForCatch;
+	    }
+
+	case INST_EXPR_STK:
+	    objPtr = POP_OBJECT();
+	    Tcl_ResetResult(interp);
+	    DECACHE_STACK_INFO();
+	    result = Tcl_ExprObj(interp, objPtr, &valuePtr);
+	    CACHE_STACK_INFO();
+	    if (result != TCL_OK) {
+		TRACE_WITH_OBJ(("exprStk \"%.30s\" => ERROR: ", 
+		        O2S(objPtr)), Tcl_GetObjResult(interp));
+		Tcl_DecrRefCount(objPtr);
+		goto checkForCatch;
+	    }
+	    stackPtr[++stackTop].o = valuePtr; /* already has right refct */
+	    TRACE_WITH_OBJ(("exprStk \"%.30s\" => ", O2S(objPtr)), valuePtr);
+	    TclDecrRefCount(objPtr);
+	    ADJUST_PC(1);
+
+	case INST_LOAD_SCALAR4:
+	    opnd = TclGetInt4AtPtr(pc+1);
+	    pcAdjustment = 5;
+	    goto doLoadScalar;
+
+	case INST_LOAD_SCALAR1:
+	    opnd = TclGetUInt1AtPtr(pc+1);
+	    pcAdjustment = 2;
+	    
+	    doLoadScalar:
+	    DECACHE_STACK_INFO();
+	    valuePtr = TclGetIndexedScalar(interp, opnd,
+					   /*leaveErrorMsg*/ 1);
+	    CACHE_STACK_INFO();
+	    if (valuePtr == NULL) {
+		TRACE_WITH_OBJ(("%s %u => ERROR: ", opName[opCode], opnd),
+			Tcl_GetObjResult(interp));
+		result = TCL_ERROR;
+		goto checkForCatch;
+            }
+	    PUSH_OBJECT(valuePtr);
+	    TRACE_WITH_OBJ(("%s %u => ", opName[opCode], opnd), valuePtr);
+	    ADJUST_PC(pcAdjustment);
+
+	case INST_LOAD_SCALAR_STK:
+	    namePtr = POP_OBJECT();
+	    DECACHE_STACK_INFO();
+	    valuePtr = Tcl_ObjGetVar2(interp, namePtr, (Tcl_Obj *) NULL, 
+				      TCL_LEAVE_ERR_MSG);
+	    CACHE_STACK_INFO();
+	    if (valuePtr == NULL) {
+		TRACE_WITH_OBJ(("loadScalarStk \"%.30s\" => ERROR: ",
+		        O2S(namePtr)), Tcl_GetObjResult(interp));
+		Tcl_DecrRefCount(namePtr);
+		result = TCL_ERROR;
+		goto checkForCatch;
+            }
+	    PUSH_OBJECT(valuePtr);
+	    TRACE_WITH_OBJ(("loadScalarStk \"%.30s\" => ",
+		    O2S(namePtr)), valuePtr);
+	    TclDecrRefCount(namePtr);
+	    ADJUST_PC(1);
+
+	case INST_LOAD_ARRAY4:
+	    opnd = TclGetUInt4AtPtr(pc+1);
+	    pcAdjustment = 5;
+	    goto doLoadArray;
+
+	case INST_LOAD_ARRAY1:
+	    opnd = TclGetUInt1AtPtr(pc+1);
+	    pcAdjustment = 2;
+	    
+	    doLoadArray:
+	    {
+		Tcl_Obj *elemPtr = POP_OBJECT();
+		
+		DECACHE_STACK_INFO();
+		valuePtr = TclGetElementOfIndexedArray(interp, opnd,
+	                elemPtr, /*leaveErrorMsg*/ 1);
+		CACHE_STACK_INFO();
+		if (valuePtr == NULL) {
+		    TRACE_WITH_OBJ(("%s %u \"%.30s\" => ERROR: ",
+			    opName[opCode], opnd, O2S(elemPtr)),
+			    Tcl_GetObjResult(interp));
+		    Tcl_DecrRefCount(elemPtr);
+		    result = TCL_ERROR;
+		    goto checkForCatch;
+		}
+		PUSH_OBJECT(valuePtr);
+		TRACE_WITH_OBJ(("%s %u \"%.30s\" => ",
+		        opName[opCode], opnd, O2S(elemPtr)), valuePtr);
+		TclDecrRefCount(elemPtr);
+	    }
+	    ADJUST_PC(pcAdjustment);
+
+	case INST_LOAD_ARRAY_STK:
+	    {
+		Tcl_Obj *elemPtr = POP_OBJECT();
+		
+		namePtr = POP_OBJECT();
+		DECACHE_STACK_INFO();
+		valuePtr = Tcl_ObjGetVar2(interp, namePtr, elemPtr,
+		        TCL_LEAVE_ERR_MSG);
+		CACHE_STACK_INFO();
+		if (valuePtr == NULL) {
+		    TRACE_WITH_OBJ(("loadArrayStk \"%.30s(%.30s)\" => ERROR: ",
+		            O2S(namePtr), O2S(elemPtr)),
+			    Tcl_GetObjResult(interp));
+		    Tcl_DecrRefCount(namePtr);
+		    Tcl_DecrRefCount(elemPtr);
+		    result = TCL_ERROR;
+		    goto checkForCatch;
+		}
+		PUSH_OBJECT(valuePtr);
+		TRACE_WITH_OBJ(("loadArrayStk \"%.30s(%.30s)\" => ",
+		        O2S(namePtr), O2S(elemPtr)), valuePtr);
+		TclDecrRefCount(namePtr);
+		TclDecrRefCount(elemPtr);
+	    }
+	    ADJUST_PC(1);
+
+	case INST_LOAD_STK:
+	    namePtr = POP_OBJECT();
+	    DECACHE_STACK_INFO();
+	    valuePtr = Tcl_ObjGetVar2(interp, namePtr, NULL,
+		    TCL_PARSE_PART1|TCL_LEAVE_ERR_MSG);
+	    CACHE_STACK_INFO();
+	    if (valuePtr == NULL) {
+		TRACE_WITH_OBJ(("loadStk \"%.30s\" => ERROR: ",
+		        O2S(namePtr)), Tcl_GetObjResult(interp));
+		Tcl_DecrRefCount(namePtr);
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+	    PUSH_OBJECT(valuePtr);
+	    TRACE_WITH_OBJ(("loadStk \"%.30s\" => ", O2S(namePtr)),
+		    valuePtr);
+	    TclDecrRefCount(namePtr);
+	    ADJUST_PC(1);
+	    
+	case INST_STORE_SCALAR4:
+	    opnd = TclGetUInt4AtPtr(pc+1);
+	    pcAdjustment = 5;
+	    goto doStoreScalar;
+
+	case INST_STORE_SCALAR1:
+	    opnd = TclGetUInt1AtPtr(pc+1);
+	    pcAdjustment = 2;
+	    
+	  doStoreScalar:
+	    valuePtr = POP_OBJECT();
+	    DECACHE_STACK_INFO();
+	    value2Ptr = TclSetIndexedScalar(interp, opnd, valuePtr,
+					      /*leaveErrorMsg*/ 1);
+	    CACHE_STACK_INFO();
+	    if (value2Ptr == NULL) {
+		TRACE_WITH_OBJ(("%s %u <- \"%.30s\" => ERROR: ",
+			opName[opCode], opnd, O2S(valuePtr)),
+			Tcl_GetObjResult(interp));
+		Tcl_DecrRefCount(valuePtr);
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+	    PUSH_OBJECT(value2Ptr);
+	    TRACE_WITH_OBJ(("%s %u <- \"%.30s\" => ",
+		    opName[opCode], opnd, O2S(valuePtr)), value2Ptr);
+	    TclDecrRefCount(valuePtr);
+	    ADJUST_PC(pcAdjustment);
+
+	case INST_STORE_SCALAR_STK:
+	    valuePtr = POP_OBJECT();
+	    namePtr = POP_OBJECT();
+	    DECACHE_STACK_INFO();
+	    value2Ptr = Tcl_ObjSetVar2(interp, namePtr, NULL, valuePtr,
+	            TCL_LEAVE_ERR_MSG);
+	    CACHE_STACK_INFO();
+	    if (value2Ptr == NULL) {
+		TRACE_WITH_OBJ(
+			("storeScalarStk \"%.30s\" <- \"%.30s\" => ERROR: ",
+		        O2S(namePtr), O2S(valuePtr)),
+			Tcl_GetObjResult(interp));
+		Tcl_DecrRefCount(namePtr);
+		Tcl_DecrRefCount(valuePtr);
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+	    PUSH_OBJECT(value2Ptr);
+	    TRACE_WITH_OBJ(
+		    ("storeScalarStk \"%.30s\" <- \"%.30s\" => ",
+		    O2S(namePtr),
+		    O2S(valuePtr)),
+		    value2Ptr);
+	    TclDecrRefCount(namePtr);
+	    TclDecrRefCount(valuePtr);
+	    ADJUST_PC(1);
+
+	case INST_STORE_ARRAY4:
+	    opnd = TclGetUInt4AtPtr(pc+1);
+	    pcAdjustment = 5;
+	    goto doStoreArray;
+
+	case INST_STORE_ARRAY1:
+	    opnd = TclGetUInt1AtPtr(pc+1);
+	    pcAdjustment = 2;
+	    
+	    doStoreArray:
+	    {
+		Tcl_Obj *elemPtr;
+
+		valuePtr = POP_OBJECT();
+		elemPtr = POP_OBJECT();
+		DECACHE_STACK_INFO();
+		value2Ptr = TclSetElementOfIndexedArray(interp, opnd,
+		        elemPtr, valuePtr, TCL_LEAVE_ERR_MSG);
+		CACHE_STACK_INFO();
+		if (value2Ptr == NULL) {
+		    TRACE_WITH_OBJ(
+			    ("%s %u \"%.30s\" <- \"%.30s\" => ERROR: ",
+			    opName[opCode], opnd, O2S(elemPtr),
+			    O2S(valuePtr)), Tcl_GetObjResult(interp));
+		    Tcl_DecrRefCount(elemPtr);
+		    Tcl_DecrRefCount(valuePtr);
+		    result = TCL_ERROR;
+		    goto checkForCatch;
+		}
+		PUSH_OBJECT(value2Ptr);
+		TRACE_WITH_OBJ(("%s %u \"%.30s\" <- \"%.30s\" => ",
+		        opName[opCode], opnd, O2S(elemPtr), O2S(valuePtr)),
+		        value2Ptr);
+		TclDecrRefCount(elemPtr);
+		TclDecrRefCount(valuePtr);
+	    }
+	    ADJUST_PC(pcAdjustment);
+
+	case INST_STORE_ARRAY_STK:
+	    {
+		Tcl_Obj *elemPtr;
+
+		valuePtr = POP_OBJECT();
+		elemPtr = POP_OBJECT();
+		namePtr = POP_OBJECT();
+		DECACHE_STACK_INFO();
+		value2Ptr = Tcl_ObjSetVar2(interp, namePtr, elemPtr,
+		        valuePtr, TCL_LEAVE_ERR_MSG);
+		CACHE_STACK_INFO();
+		if (value2Ptr == NULL) {
+		    TRACE_WITH_OBJ(("storeArrayStk \"%.30s(%.30s)\" <- \"%.30s\" => ERROR: ",
+		            O2S(namePtr), O2S(elemPtr), O2S(valuePtr)),
+			    Tcl_GetObjResult(interp));
+		    Tcl_DecrRefCount(namePtr);
+		    Tcl_DecrRefCount(elemPtr);
+		    Tcl_DecrRefCount(valuePtr);
+		    result = TCL_ERROR;
+		    goto checkForCatch;
+		}
+		PUSH_OBJECT(value2Ptr);
+		TRACE_WITH_OBJ(("storeArrayStk \"%.30s(%.30s)\" <- \"%.30s\" => ",
+		        O2S(namePtr), O2S(elemPtr), O2S(valuePtr)),
+			value2Ptr);
+		TclDecrRefCount(namePtr);
+		TclDecrRefCount(elemPtr);
+		TclDecrRefCount(valuePtr);
+	    }
+	    ADJUST_PC(1);
+
+	case INST_STORE_STK:
+	    valuePtr = POP_OBJECT();
+	    namePtr = POP_OBJECT();
+	    DECACHE_STACK_INFO();
+	    value2Ptr = Tcl_ObjSetVar2(interp, namePtr, NULL, valuePtr,
+		    TCL_PARSE_PART1|TCL_LEAVE_ERR_MSG);
+	    CACHE_STACK_INFO();
+	    if (value2Ptr == NULL) {
+		TRACE_WITH_OBJ(("storeStk \"%.30s\" <- \"%.30s\" => ERROR: ",
+		        O2S(namePtr), O2S(valuePtr)),
+			Tcl_GetObjResult(interp));
+		Tcl_DecrRefCount(namePtr);
+		Tcl_DecrRefCount(valuePtr);
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+	    PUSH_OBJECT(value2Ptr);
+	    TRACE_WITH_OBJ(("storeStk \"%.30s\" <- \"%.30s\" => ",
+		    O2S(namePtr), O2S(valuePtr)), value2Ptr);
+	    TclDecrRefCount(namePtr);
+	    TclDecrRefCount(valuePtr);
+	    ADJUST_PC(1);
+
+	case INST_INCR_SCALAR1:
+	    opnd = TclGetUInt1AtPtr(pc+1);
+	    valuePtr = POP_OBJECT(); 
+	    if (valuePtr->typePtr != &tclIntType) {
+		result = tclIntType.setFromAnyProc(interp, valuePtr);
+		if (result != TCL_OK) {
+		    TRACE_WITH_OBJ(("incrScalar1 %u (by %s) => ERROR converting increment amount to int: ",
+		            opnd, O2S(valuePtr)), Tcl_GetObjResult(interp));
+		    Tcl_DecrRefCount(valuePtr);
+		    goto checkForCatch;
+		}
+	    }
+	    i = valuePtr->internalRep.longValue;
+	    DECACHE_STACK_INFO();
+	    value2Ptr = TclIncrIndexedScalar(interp, opnd, i);
+	    CACHE_STACK_INFO();
+	    if (value2Ptr == NULL) {
+		TRACE_WITH_OBJ(("incrScalar1 %u (by %ld) => ERROR: ",
+		        opnd, i), Tcl_GetObjResult(interp));
+		Tcl_DecrRefCount(valuePtr);
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+	    PUSH_OBJECT(value2Ptr);
+	    TRACE_WITH_OBJ(("incrScalar1 %u (by %ld) => ", opnd, i),
+		    value2Ptr);
+	    TclDecrRefCount(valuePtr);
+	    ADJUST_PC(2);
+
+	case INST_INCR_SCALAR_STK:
+	case INST_INCR_STK:
+	    valuePtr = POP_OBJECT();
+	    namePtr = POP_OBJECT();
+	    if (valuePtr->typePtr != &tclIntType) {
+		result = tclIntType.setFromAnyProc(interp, valuePtr);
+		if (result != TCL_OK) {
+		    TRACE_WITH_OBJ(("%s \"%.30s\" (by %s) => ERROR converting increment amount to int: ",
+		            opName[opCode], O2S(namePtr), O2S(valuePtr)),
+			    Tcl_GetObjResult(interp));
+		    Tcl_DecrRefCount(namePtr);
+		    Tcl_DecrRefCount(valuePtr);
+		    goto checkForCatch;
+		}
+	    }
+	    i = valuePtr->internalRep.longValue;
+	    DECACHE_STACK_INFO();
+	    value2Ptr = TclIncrVar2(interp, namePtr, (Tcl_Obj *) NULL, i,
+	        /*part1NotParsed*/ (opCode == INST_INCR_STK));
+	    CACHE_STACK_INFO();
+	    if (value2Ptr == NULL) {
+		TRACE_WITH_OBJ(("%s \"%.30s\" (by %ld) => ERROR: ",
+		        opName[opCode], O2S(namePtr), i),
+			Tcl_GetObjResult(interp));
+		Tcl_DecrRefCount(namePtr);
+		Tcl_DecrRefCount(valuePtr);
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+	    PUSH_OBJECT(value2Ptr);
+	    TRACE_WITH_OBJ(("%s \"%.30s\" (by %ld) => ",
+	            opName[opCode], O2S(namePtr), i), value2Ptr);
+	    Tcl_DecrRefCount(namePtr);
+	    Tcl_DecrRefCount(valuePtr);
+	    ADJUST_PC(1);
+
+	case INST_INCR_ARRAY1:
+	    {
+		Tcl_Obj *elemPtr;
+
+		opnd = TclGetUInt1AtPtr(pc+1);
+		valuePtr = POP_OBJECT();
+		elemPtr = POP_OBJECT();
+		if (valuePtr->typePtr != &tclIntType) {
+		    result = tclIntType.setFromAnyProc(interp, valuePtr);
+		    if (result != TCL_OK) {
+			TRACE_WITH_OBJ(("incrArray1 %u \"%.30s\" (by %s) => ERROR converting increment amount to int: ",
+		                opnd, O2S(elemPtr), O2S(valuePtr)),
+			        Tcl_GetObjResult(interp));
+			Tcl_DecrRefCount(elemPtr);
+			Tcl_DecrRefCount(valuePtr);
+			goto checkForCatch;
+		    }
+		}
+		i = valuePtr->internalRep.longValue;
+		DECACHE_STACK_INFO();
+		value2Ptr = TclIncrElementOfIndexedArray(interp, opnd,
+		        elemPtr, i);
+		CACHE_STACK_INFO();
+		if (value2Ptr == NULL) {
+		    TRACE_WITH_OBJ(("incrArray1 %u \"%.30s\" (by %ld) => ERROR: ",
+		            opnd, O2S(elemPtr), i),
+			    Tcl_GetObjResult(interp));
+		    Tcl_DecrRefCount(elemPtr);
+		    Tcl_DecrRefCount(valuePtr);
+		    result = TCL_ERROR;
+		    goto checkForCatch;
+		}
+		PUSH_OBJECT(value2Ptr);
+		TRACE_WITH_OBJ(("incrArray1 %u \"%.30s\" (by %ld) => ",
+	                opnd, O2S(elemPtr), i), value2Ptr);
+		Tcl_DecrRefCount(elemPtr);
+		Tcl_DecrRefCount(valuePtr);
+	    }
+	    ADJUST_PC(2);
+	    
+	case INST_INCR_ARRAY_STK:
+	    {
+		Tcl_Obj *elemPtr;
+
+		valuePtr = POP_OBJECT();
+		elemPtr = POP_OBJECT();
+		namePtr = POP_OBJECT();
+		if (valuePtr->typePtr != &tclIntType) {
+		    result = tclIntType.setFromAnyProc(interp, valuePtr);
+		    if (result != TCL_OK) {
+		        TRACE_WITH_OBJ(("incrArrayStk \"%.30s(%.30s)\" (by %s) => ERROR converting increment amount to int: ",
+		                O2S(namePtr), O2S(elemPtr), O2S(valuePtr)),
+			        Tcl_GetObjResult(interp));
+			Tcl_DecrRefCount(namePtr);
+			Tcl_DecrRefCount(elemPtr);
+			Tcl_DecrRefCount(valuePtr);
+			goto checkForCatch;
+		    }
+		}
+		i = valuePtr->internalRep.longValue;
+		DECACHE_STACK_INFO();
+		value2Ptr = TclIncrVar2(interp, namePtr, elemPtr, i,
+					/*part1NotParsed*/ 0);
+		CACHE_STACK_INFO();
+		if (value2Ptr == NULL) {
+		    TRACE_WITH_OBJ(("incrArrayStk \"%.30s(%.30s)\" (by %ld) => ERROR: ",
+		            O2S(namePtr), O2S(elemPtr), i),
+			    Tcl_GetObjResult(interp));
+		    Tcl_DecrRefCount(namePtr);
+		    Tcl_DecrRefCount(elemPtr);
+		    Tcl_DecrRefCount(valuePtr);
+		    result = TCL_ERROR;
+		    goto checkForCatch;
+		}
+		PUSH_OBJECT(value2Ptr);
+		TRACE_WITH_OBJ(("incrArrayStk \"%.30s(%.30s)\" (by %ld) => ",
+	                O2S(namePtr), O2S(elemPtr), i), value2Ptr);
+		Tcl_DecrRefCount(namePtr);
+		Tcl_DecrRefCount(elemPtr);
+		Tcl_DecrRefCount(valuePtr);
+	    }
+	    ADJUST_PC(1);
+	    
+	case INST_INCR_SCALAR1_IMM:
+	    opnd = TclGetUInt1AtPtr(pc+1);
+	    i = TclGetInt1AtPtr(pc+2);
+	    DECACHE_STACK_INFO();
+	    value2Ptr = TclIncrIndexedScalar(interp, opnd, i);
+	    CACHE_STACK_INFO();
+	    if (value2Ptr == NULL) {
+		TRACE_WITH_OBJ(("incrScalar1Imm %u %ld => ERROR: ",
+		        opnd, i), Tcl_GetObjResult(interp));
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+	    PUSH_OBJECT(value2Ptr);
+	    TRACE_WITH_OBJ(("incrScalar1Imm %u %ld => ", opnd, i),
+		    value2Ptr);
+	    ADJUST_PC(3);
+
+	case INST_INCR_SCALAR_STK_IMM:
+	case INST_INCR_STK_IMM:
+	    namePtr = POP_OBJECT();
+	    i = TclGetInt1AtPtr(pc+1);
+	    DECACHE_STACK_INFO();
+	    value2Ptr = TclIncrVar2(interp, namePtr, (Tcl_Obj *) NULL, i,
+		    /*part1NotParsed*/ (opCode == INST_INCR_STK_IMM));
+	    CACHE_STACK_INFO();
+	    if (value2Ptr == NULL) {
+		TRACE_WITH_OBJ(("%s \"%.30s\" %ld => ERROR: ",
+		        opName[opCode], O2S(namePtr), i),
+			Tcl_GetObjResult(interp));
+		result = TCL_ERROR;
+		Tcl_DecrRefCount(namePtr);
+		goto checkForCatch;
+	    }
+	    PUSH_OBJECT(value2Ptr);
+	    TRACE_WITH_OBJ(("%s \"%.30s\" %ld => ",
+	            opName[opCode], O2S(namePtr), i), value2Ptr);
+	    TclDecrRefCount(namePtr);
+	    ADJUST_PC(2);
+
+	case INST_INCR_ARRAY1_IMM:
+	    {
+		Tcl_Obj *elemPtr;
+
+		opnd = TclGetUInt1AtPtr(pc+1);
+		i = TclGetInt1AtPtr(pc+2);
+		elemPtr = POP_OBJECT();
+		DECACHE_STACK_INFO();
+		value2Ptr = TclIncrElementOfIndexedArray(interp, opnd,
+		        elemPtr, i);
+		CACHE_STACK_INFO();
+		if (value2Ptr == NULL) {
+		    TRACE_WITH_OBJ(("incrArray1Imm %u \"%.30s\" (by %ld) => ERROR: ",
+		            opnd, O2S(elemPtr), i),
+			    Tcl_GetObjResult(interp));
+		    Tcl_DecrRefCount(elemPtr);
+		    result = TCL_ERROR;
+		    goto checkForCatch;
+		}
+		PUSH_OBJECT(value2Ptr);
+		TRACE_WITH_OBJ(("incrArray1Imm %u \"%.30s\" (by %ld) => ",
+	                opnd, O2S(elemPtr), i), value2Ptr);
+		Tcl_DecrRefCount(elemPtr);
+	    }
+	    ADJUST_PC(3);
+	    
+	case INST_INCR_ARRAY_STK_IMM:
+	    {
+		Tcl_Obj *elemPtr;
+
+		i = TclGetInt1AtPtr(pc+1);
+		elemPtr = POP_OBJECT();
+		namePtr = POP_OBJECT();
+		DECACHE_STACK_INFO();
+		value2Ptr = TclIncrVar2(interp, namePtr, elemPtr, i,
+		        /*part1NotParsed*/ 0);
+		CACHE_STACK_INFO();
+		if (value2Ptr == NULL) {
+		    TRACE_WITH_OBJ(("incrArrayStkImm \"%.30s(%.30s)\" (by %ld) => ERROR: ",
+		            O2S(namePtr), O2S(elemPtr), i),
+			    Tcl_GetObjResult(interp));
+		    Tcl_DecrRefCount(namePtr);
+		    Tcl_DecrRefCount(elemPtr);
+		    result = TCL_ERROR;
+		    goto checkForCatch;
+		}
+		PUSH_OBJECT(value2Ptr);
+		TRACE_WITH_OBJ(("incrArrayStkImm \"%.30s(%.30s)\" (by %ld) => ",
+	                O2S(namePtr), O2S(elemPtr), i), value2Ptr);
+		Tcl_DecrRefCount(namePtr);
+		Tcl_DecrRefCount(elemPtr);
+	    }
+	    ADJUST_PC(2);
+
+	case INST_JUMP1:
+	    opnd = TclGetInt1AtPtr(pc+1);
+	    TRACE(("jump1 %d => new pc %u\n", opnd,
+		   (unsigned int)(pc + opnd - codePtr->codeStart)));
+	    ADJUST_PC(opnd);
+
+	case INST_JUMP4:
+	    opnd = TclGetInt4AtPtr(pc+1);
+	    TRACE(("jump4 %d => new pc %u\n", opnd,
+		   (unsigned int)(pc + opnd - codePtr->codeStart)));
+	    ADJUST_PC(opnd);
+
+	case INST_JUMP_TRUE4:
+	    opnd = TclGetInt4AtPtr(pc+1);
+	    pcAdjustment = 5;
+	    goto doJumpTrue;
+
+	case INST_JUMP_TRUE1:
+	    opnd = TclGetInt1AtPtr(pc+1);
+	    pcAdjustment = 2;
+	    
+	    doJumpTrue:
+	    {
+		int b;
+		
+		valuePtr = POP_OBJECT();
+		if (valuePtr->typePtr == &tclIntType) {
+		    b = (valuePtr->internalRep.longValue != 0);
+		} else if (valuePtr->typePtr == &tclDoubleType) {
+		    b = (valuePtr->internalRep.doubleValue != 0.0);
+		} else {
+		    result = Tcl_GetBooleanFromObj(interp, valuePtr, &b);
+		    if (result != TCL_OK) {
+			TRACE_WITH_OBJ(("%s %d => ERROR: ", opName[opCode],
+				opnd), Tcl_GetObjResult(interp));
+			Tcl_DecrRefCount(valuePtr);
+			goto checkForCatch;
+		    }
+		}
+		if (b) {
+		    TRACE(("%s %d => %.20s true, new pc %u\n",
+			    opName[opCode], opnd, O2S(valuePtr),
+		            (unsigned int)(pc+opnd - codePtr->codeStart)));
+		    TclDecrRefCount(valuePtr);
+		    ADJUST_PC(opnd);
+		} else {
+		    TRACE(("%s %d => %.20s false\n", opName[opCode], opnd,
+		            O2S(valuePtr)));
+		    TclDecrRefCount(valuePtr);
+		    ADJUST_PC(pcAdjustment);
+		}
+	    }
+	    
+	case INST_JUMP_FALSE4:
+	    opnd = TclGetInt4AtPtr(pc+1);
+	    pcAdjustment = 5;
+	    goto doJumpFalse;
+
+	case INST_JUMP_FALSE1:
+	    opnd = TclGetInt1AtPtr(pc+1);
+	    pcAdjustment = 2;
+	    
+	    doJumpFalse:
+	    {
+		int b;
+		
+		valuePtr = POP_OBJECT();
+		if (valuePtr->typePtr == &tclIntType) {
+		    b = (valuePtr->internalRep.longValue != 0);
+		} else if (valuePtr->typePtr == &tclDoubleType) {
+		    b = (valuePtr->internalRep.doubleValue != 0.0);
+		} else {
+		    result = Tcl_GetBooleanFromObj(interp, valuePtr, &b);
+		    if (result != TCL_OK) {
+			TRACE_WITH_OBJ(("%s %d => ERROR: ", opName[opCode],
+				opnd), Tcl_GetObjResult(interp));
+			Tcl_DecrRefCount(valuePtr);
+			goto checkForCatch;
+		    }
+		}
+		if (b) {
+		    TRACE(("%s %d => %.20s true\n", opName[opCode], opnd,
+		            O2S(valuePtr)));
+		    TclDecrRefCount(valuePtr);
+		    ADJUST_PC(pcAdjustment);
+		} else {
+		    TRACE(("%s %d => %.20s false, new pc %u\n",
+			    opName[opCode], opnd, O2S(valuePtr),
+			   (unsigned int)(pc + opnd - codePtr->codeStart)));
+		    TclDecrRefCount(valuePtr);
+		    ADJUST_PC(opnd);
+		}
+	    }
+	    
+	case INST_LOR:
+	case INST_LAND:
+	    {
+		/*
+		 * Operands must be boolean or numeric. No int->double
+		 * conversions are performed.
+		 */
+		
+		int i1, i2;
+		int iResult;
+		char *s;
+		Tcl_ObjType *t1Ptr, *t2Ptr;
+		
+		value2Ptr = POP_OBJECT();
+		valuePtr  = POP_OBJECT();
+		t1Ptr = valuePtr->typePtr;
+		t2Ptr = value2Ptr->typePtr;
+		
+		if ((t1Ptr == &tclIntType) || (t1Ptr == &tclBooleanType)) {
+		    i1 = (valuePtr->internalRep.longValue != 0);
+		} else if (t1Ptr == &tclDoubleType) {
+		    i1 = (valuePtr->internalRep.doubleValue != 0.0);
+		} else {	/* FAILS IF NULL STRING REP */
+		    s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
+		    if (TclLooksLikeInt(s)) {
+			result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
+				valuePtr, &i);
+			i1 = (i != 0);
+		    } else {
+			result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL,
+				valuePtr, &i1);
+			i1 = (i1 != 0);
+		    }
+		    if (result != TCL_OK) {
+			TRACE(("%s \"%.20s\" => ILLEGAL TYPE %s \n",
+			        opName[opCode], O2S(valuePtr),
+			        (t1Ptr? t1Ptr->name : "null")));
+			IllegalExprOperandType(interp, opCode, valuePtr);
+			Tcl_DecrRefCount(valuePtr);
+			Tcl_DecrRefCount(value2Ptr);
+			goto checkForCatch;
+		    }
+		}
+		
+		if ((t2Ptr == &tclIntType) || (t2Ptr == &tclBooleanType)) {
+		    i2 = (value2Ptr->internalRep.longValue != 0);
+		} else if (t2Ptr == &tclDoubleType) {
+		    i2 = (value2Ptr->internalRep.doubleValue != 0.0);
+		} else {	/* FAILS IF NULL STRING REP */
+		    s = Tcl_GetStringFromObj(value2Ptr, (int *) NULL);
+		    if (TclLooksLikeInt(s)) {
+			result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
+				value2Ptr, &i);
+			i2 = (i != 0);
+		    } else {
+			result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL,
+				value2Ptr, &i2);
+			i2 = (i2 != 0);
+		    }
+		    if (result != TCL_OK) {
+			TRACE(("%s \"%.20s\" => ILLEGAL TYPE %s \n",
+			        opName[opCode], O2S(value2Ptr),
+			        (t2Ptr? t2Ptr->name : "null")));
+			IllegalExprOperandType(interp, opCode, value2Ptr);
+			Tcl_DecrRefCount(valuePtr);
+			Tcl_DecrRefCount(value2Ptr);
+			goto checkForCatch;
+		    }
+		}
+		
+		/*
+		 * Reuse the valuePtr object already on stack if possible.
+		 */
+
+		if (opCode == INST_LOR) {
+		    iResult = (i1 || i2);
+		} else {
+		    iResult = (i1 && i2);
+		}
+		if (Tcl_IsShared(valuePtr)) {
+		    PUSH_OBJECT(Tcl_NewLongObj(iResult));
+		    TRACE(("%s %.20s %.20s => %d\n", opName[opCode],
+			   O2S(valuePtr), O2S(value2Ptr), iResult));
+		    TclDecrRefCount(valuePtr);
+		} else {	/* reuse the valuePtr object */
+		    TRACE(("%s %.20s %.20s => %d\n", 
+			   opName[opCode], /* NB: stack top is off by 1 */
+			   O2S(valuePtr), O2S(value2Ptr), iResult));
+		    Tcl_SetLongObj(valuePtr, iResult);
+		    ++stackTop; /* valuePtr now on stk top has right r.c. */
+		}
+		TclDecrRefCount(value2Ptr);
+	    }
+	    ADJUST_PC(1);
+
+	case INST_EQ:
+	case INST_NEQ:
+	case INST_LT:
+	case INST_GT:
+	case INST_LE:
+	case INST_GE:
+	    {
+		/*
+		 * Any type is allowed but the two operands must have the
+	         * same type. We will compute value op value2.
+		 */
+
+		Tcl_ObjType *t1Ptr, *t2Ptr;
+		char *s1 = NULL;   /* Init. avoids compiler warning. */
+		char *s2 = NULL;   /* Init. avoids compiler warning. */
+		long i2 = 0;	   /* Init. avoids compiler warning. */
+		double d1 = 0.0;   /* Init. avoids compiler warning. */
+		double d2 = 0.0;   /* Init. avoids compiler warning. */
+		long iResult = 0;  /* Init. avoids compiler warning. */
+
+		value2Ptr = POP_OBJECT();
+		valuePtr  = POP_OBJECT();
+		t1Ptr = valuePtr->typePtr;
+		t2Ptr = value2Ptr->typePtr;
+		
+		if ((t1Ptr != &tclIntType) && (t1Ptr != &tclDoubleType)) {
+		    s1 = Tcl_GetStringFromObj(valuePtr, &length);
+		    if (TclLooksLikeInt(s1)) { /* FAILS IF NULLS */
+			(void) Tcl_GetLongFromObj((Tcl_Interp *) NULL,
+				valuePtr, &i);
+		    } else {
+			(void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
+				valuePtr, &d1);
+		    }
+		    t1Ptr = valuePtr->typePtr;
+		}
+		if ((t2Ptr != &tclIntType) && (t2Ptr != &tclDoubleType)) {
+		    s2 = Tcl_GetStringFromObj(value2Ptr, &length);
+		    if (TclLooksLikeInt(s2)) { /* FAILS IF NULLS */
+			(void) Tcl_GetLongFromObj((Tcl_Interp *) NULL,
+				value2Ptr, &i2);
+		    } else {
+			(void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
+				value2Ptr, &d2);
+		    }
+		    t2Ptr = value2Ptr->typePtr;
+		}
+
+		if (((t1Ptr != &tclIntType) && (t1Ptr != &tclDoubleType))
+		        || ((t2Ptr != &tclIntType) && (t2Ptr != &tclDoubleType))) {
+		    /*
+		     * One operand is not numeric. Compare as strings.
+		     * THIS FAILS IF AN OBJECT'S STRING REP CONTAINS NULLS.
+		     */
+		    int cmpValue;
+		    s1 = TclGetStringFromObj(valuePtr, &length);
+		    s2 = TclGetStringFromObj(value2Ptr, &length);
+		    cmpValue = strcmp(s1, s2);
+		    switch (opCode) {
+		    case INST_EQ:
+			iResult = (cmpValue == 0);
+			break;
+		    case INST_NEQ:
+			iResult = (cmpValue != 0);
+			break;
+		    case INST_LT:
+			iResult = (cmpValue < 0);
+			break;
+		    case INST_GT:
+			iResult = (cmpValue > 0);
+			break;
+		    case INST_LE:
+			iResult = (cmpValue <= 0);
+			break;
+		    case INST_GE:
+			iResult = (cmpValue >= 0);
+			break;
+		    }
+		} else if ((t1Ptr == &tclDoubleType)
+		        || (t2Ptr == &tclDoubleType)) {
+		    /*
+		     * Compare as doubles.
+		     */
+		    if (t1Ptr == &tclDoubleType) {
+			d1 = valuePtr->internalRep.doubleValue;
+			if (t2Ptr == &tclIntType) {
+			    d2 = value2Ptr->internalRep.longValue;
+			} else {
+			    d2 = value2Ptr->internalRep.doubleValue;
+			}
+		    } else {	/* t1Ptr is int, t2Ptr is double */
+			d1 = valuePtr->internalRep.longValue;
+			d2 = value2Ptr->internalRep.doubleValue;
+		    }
+		    switch (opCode) {
+		    case INST_EQ:
+			iResult = d1 == d2;
+			break;
+		    case INST_NEQ:
+			iResult = d1 != d2;
+			break;
+		    case INST_LT:
+			iResult = d1 < d2;
+			break;
+		    case INST_GT:
+			iResult = d1 > d2;
+			break;
+		    case INST_LE:
+			iResult = d1 <= d2;
+			break;
+		    case INST_GE:
+			iResult = d1 >= d2;
+			break;
+		    }
+		} else {
+		    /*
+		     * Compare as ints.
+		     */
+		    i  = valuePtr->internalRep.longValue;
+		    i2 = value2Ptr->internalRep.longValue;
+		    switch (opCode) {
+		    case INST_EQ:
+			iResult = i == i2;
+			break;
+		    case INST_NEQ:
+			iResult = i != i2;
+			break;
+		    case INST_LT:
+			iResult = i < i2;
+			break;
+		    case INST_GT:
+			iResult = i > i2;
+			break;
+		    case INST_LE:
+			iResult = i <= i2;
+			break;
+		    case INST_GE:
+			iResult = i >= i2;
+			break;
+		    }
+		}
+
+		/*
+		 * Reuse the valuePtr object already on stack if possible.
+		 */
+		
+		if (Tcl_IsShared(valuePtr)) {
+		    PUSH_OBJECT(Tcl_NewLongObj(iResult));
+		    TRACE(("%s %.20s %.20s => %ld\n", opName[opCode],
+		        O2S(valuePtr), O2S(value2Ptr), iResult));
+		    TclDecrRefCount(valuePtr);
+		} else {	/* reuse the valuePtr object */
+		    TRACE(("%s %.20s %.20s => %ld\n",
+			opName[opCode], /* NB: stack top is off by 1 */
+		        O2S(valuePtr), O2S(value2Ptr), iResult));
+		    Tcl_SetLongObj(valuePtr, iResult);
+		    ++stackTop; /* valuePtr now on stk top has right r.c. */
+		}
+		TclDecrRefCount(value2Ptr);
+	    }
+	    ADJUST_PC(1);
+	    
+	case INST_MOD:
+	case INST_LSHIFT:
+	case INST_RSHIFT:
+	case INST_BITOR:
+	case INST_BITXOR:
+	case INST_BITAND:
+	    {
+		/*
+		 * Only integers are allowed. We compute value op value2.
+		 */
+
+		long i2, rem, negative;
+		long iResult = 0; /* Init. avoids compiler warning. */
+		
+		value2Ptr = POP_OBJECT();
+		valuePtr  = POP_OBJECT(); 
+		if (valuePtr->typePtr == &tclIntType) {
+		    i = valuePtr->internalRep.longValue;
+		} else {	/* try to convert to int */
+		    result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
+			    valuePtr, &i);
+		    if (result != TCL_OK) {
+			TRACE(("%s %.20s %.20s => ILLEGAL 1st TYPE %s\n",
+			      opName[opCode], O2S(valuePtr), O2S(value2Ptr),
+			      (valuePtr->typePtr?
+				   valuePtr->typePtr->name : "null")));
+			IllegalExprOperandType(interp, opCode, valuePtr);
+			Tcl_DecrRefCount(valuePtr);
+			Tcl_DecrRefCount(value2Ptr);
+			goto checkForCatch;
+		    }
+		}
+		if (value2Ptr->typePtr == &tclIntType) {
+		    i2 = value2Ptr->internalRep.longValue;
+		} else {
+		    result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
+			    value2Ptr, &i2);
+		    if (result != TCL_OK) {
+			TRACE(("%s %.20s %.20s => ILLEGAL 2nd TYPE %s\n",
+			      opName[opCode], O2S(valuePtr), O2S(value2Ptr),
+			      (value2Ptr->typePtr?
+				   value2Ptr->typePtr->name : "null")));
+			IllegalExprOperandType(interp, opCode, value2Ptr);
+			Tcl_DecrRefCount(valuePtr);
+			Tcl_DecrRefCount(value2Ptr);
+			goto checkForCatch;
+		    }
+		}
+
+		switch (opCode) {
+		case INST_MOD:
+		    /*
+		     * This code is tricky: C doesn't guarantee much about
+		     * the quotient or remainder, but Tcl does. The
+		     * remainder always has the same sign as the divisor and
+		     * a smaller absolute value.
+		     */
+		    if (i2 == 0) {
+			TRACE(("mod %ld %ld => DIVIDE BY ZERO\n", i, i2));
+			Tcl_DecrRefCount(valuePtr);
+			Tcl_DecrRefCount(value2Ptr);
+			goto divideByZero;
+		    }
+		    negative = 0;
+		    if (i2 < 0) {
+			i2 = -i2;
+			i = -i;
+			negative = 1;
+		    }
+		    rem  = i % i2;
+		    if (rem < 0) {
+			rem += i2;
+		    }
+		    if (negative) {
+			rem = -rem;
+		    }
+		    iResult = rem;
+		    break;
+		case INST_LSHIFT:
+		    iResult = i << i2;
+		    break;
+		case INST_RSHIFT:
+		    /*
+		     * The following code is a bit tricky: it ensures that
+		     * right shifts propagate the sign bit even on machines
+		     * where ">>" won't do it by default.
+		     */
+		    if (i < 0) {
+			iResult = ~((~i) >> i2);
+		    } else {
+			iResult = i >> i2;
+		    }
+		    break;
+		case INST_BITOR:
+		    iResult = i | i2;
+		    break;
+		case INST_BITXOR:
+		    iResult = i ^ i2;
+		    break;
+		case INST_BITAND:
+		    iResult = i & i2;
+		    break;
+		}
+
+		/*
+		 * Reuse the valuePtr object already on stack if possible.
+		 */
+		
+		if (Tcl_IsShared(valuePtr)) {
+		    PUSH_OBJECT(Tcl_NewLongObj(iResult));
+		    TRACE(("%s %ld %ld => %ld\n", opName[opCode], i, i2,
+			   iResult));
+		    TclDecrRefCount(valuePtr);
+		} else {	/* reuse the valuePtr object */
+		    TRACE(("%s %ld %ld => %ld\n", opName[opCode], i, i2,
+		        iResult)); /* NB: stack top is off by 1 */
+		    Tcl_SetLongObj(valuePtr, iResult);
+		    ++stackTop; /* valuePtr now on stk top has right r.c. */
+		}
+		TclDecrRefCount(value2Ptr);
+	    }
+	    ADJUST_PC(1);
+	    
+	case INST_ADD:
+	case INST_SUB:
+	case INST_MULT:
+	case INST_DIV:
+	    {
+		/*
+		 * Operands must be numeric and ints get converted to floats
+		 * if necessary. We compute value op value2.
+		 */
+
+		Tcl_ObjType *t1Ptr, *t2Ptr;
+		long i2, quot, rem;
+		double d1, d2;
+		long iResult = 0;     /* Init. avoids compiler warning. */
+		double dResult = 0.0; /* Init. avoids compiler warning. */
+		int doDouble = 0;     /* 1 if doing floating arithmetic */
+		
+		value2Ptr = POP_OBJECT();
+		valuePtr  = POP_OBJECT();
+		t1Ptr = valuePtr->typePtr;
+		t2Ptr = value2Ptr->typePtr;
+		
+		if (t1Ptr == &tclIntType) {
+		    i  = valuePtr->internalRep.longValue;
+		} else if (t1Ptr == &tclDoubleType) {
+		    d1 = valuePtr->internalRep.doubleValue;
+		} else {	     /* try to convert; FAILS IF NULLS */
+		    char *s = Tcl_GetStringFromObj(valuePtr, &length);
+		    if (TclLooksLikeInt(s)) {
+			result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
+				valuePtr, &i);
+		    } else {
+			result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
+				valuePtr, &d1);
+		    }
+		    if (result != TCL_OK) {
+			TRACE(("%s %.20s %.20s => ILLEGAL 1st TYPE %s\n",
+			       opName[opCode], s, O2S(value2Ptr),
+			       (valuePtr->typePtr?
+				    valuePtr->typePtr->name : "null")));
+			IllegalExprOperandType(interp, opCode, valuePtr);
+			Tcl_DecrRefCount(valuePtr);
+			Tcl_DecrRefCount(value2Ptr);
+			goto checkForCatch;
+		    }
+		    t1Ptr = valuePtr->typePtr;
+		}
+		
+		if (t2Ptr == &tclIntType) {
+		    i2 = value2Ptr->internalRep.longValue;
+		} else if (t2Ptr == &tclDoubleType) {
+		    d2 = value2Ptr->internalRep.doubleValue;
+		} else {	     /* try to convert; FAILS IF NULLS */
+		    char *s = Tcl_GetStringFromObj(value2Ptr, &length);
+		    if (TclLooksLikeInt(s)) {
+			result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
+				value2Ptr, &i2);
+		    } else {
+			result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
+				value2Ptr, &d2);
+		    }
+		    if (result != TCL_OK) {
+			TRACE(("%s %.20s %.20s => ILLEGAL 2nd TYPE %s\n",
+			       opName[opCode], O2S(valuePtr), s,
+			       (value2Ptr->typePtr?
+				    value2Ptr->typePtr->name : "null")));
+			IllegalExprOperandType(interp, opCode, value2Ptr);
+			Tcl_DecrRefCount(valuePtr);
+			Tcl_DecrRefCount(value2Ptr);
+			goto checkForCatch;
+		    }
+		    t2Ptr = value2Ptr->typePtr;
+		}
+
+		if ((t1Ptr == &tclDoubleType) || (t2Ptr == &tclDoubleType)) {
+		    /*
+		     * Do double arithmetic.
+		     */
+		    doDouble = 1;
+		    if (t1Ptr == &tclIntType) {
+			d1 = i;       /* promote value 1 to double */
+		    } else if (t2Ptr == &tclIntType) {
+			d2 = i2;      /* promote value 2 to double */
+		    }
+		    switch (opCode) {
+		    case INST_ADD:
+			dResult = d1 + d2;
+			break;
+		    case INST_SUB:
+			dResult = d1 - d2;
+			break;
+		    case INST_MULT:
+			dResult = d1 * d2;
+			break;
+		    case INST_DIV:
+			if (d2 == 0.0) {
+			    TRACE(("div %.6g %.6g => DIVIDE BY ZERO\n",
+				   d1, d2));
+			    Tcl_DecrRefCount(valuePtr);
+			    Tcl_DecrRefCount(value2Ptr);
+			    goto divideByZero;
+			}
+			dResult = d1 / d2;
+			break;
+		    }
+		    
+		    /*
+		     * Check now for IEEE floating-point error.
+		     */
+		    
+		    if (IS_NAN(dResult) || IS_INF(dResult)) {
+			TRACE(("%s %.20s %.20s => IEEE FLOATING PT ERROR\n",
+			       opName[opCode], O2S(valuePtr), O2S(value2Ptr)));
+			TclExprFloatError(interp, dResult);
+			result = TCL_ERROR;
+			Tcl_DecrRefCount(valuePtr);
+			Tcl_DecrRefCount(value2Ptr);
+			goto checkForCatch;
+		    }
+		} else {
+		    /*
+		     * Do integer arithmetic.
+		     */
+		    switch (opCode) {
+		    case INST_ADD:
+			iResult = i + i2;
+			break;
+		    case INST_SUB:
+			iResult = i - i2;
+			break;
+		    case INST_MULT:
+			iResult = i * i2;
+			break;
+		    case INST_DIV:
+			/*
+			 * This code is tricky: C doesn't guarantee much
+			 * about the quotient or remainder, but Tcl does.
+			 * The remainder always has the same sign as the
+			 * divisor and a smaller absolute value.
+			 */
+			if (i2 == 0) {
+			    TRACE(("div %ld %ld => DIVIDE BY ZERO\n",
+				    i, i2));
+			    Tcl_DecrRefCount(valuePtr);
+			    Tcl_DecrRefCount(value2Ptr);
+			    goto divideByZero;
+			}
+			if (i2 < 0) {
+			    i2 = -i2;
+			    i = -i;
+			}
+			quot = i / i2;
+			rem  = i % i2;
+			if (rem < 0) {
+			    quot -= 1;
+			}
+			iResult = quot;
+			break;
+		    }
+		}
+
+		/*
+		 * Reuse the valuePtr object already on stack if possible.
+		 */
+		
+		if (Tcl_IsShared(valuePtr)) {
+		    if (doDouble) {
+			PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
+			TRACE(("%s %.6g %.6g => %.6g\n", opName[opCode],
+			       d1, d2, dResult));
+		    } else {
+			PUSH_OBJECT(Tcl_NewLongObj(iResult));
+			TRACE(("%s %ld %ld => %ld\n", opName[opCode],
+			       i, i2, iResult));
+		    } 
+		    TclDecrRefCount(valuePtr);
+		} else {	    /* reuse the valuePtr object */
+		    if (doDouble) { /* NB: stack top is off by 1 */
+			TRACE(("%s %.6g %.6g => %.6g\n", opName[opCode],
+			       d1, d2, dResult));
+			Tcl_SetDoubleObj(valuePtr, dResult);
+		    } else {
+			TRACE(("%s %ld %ld => %ld\n", opName[opCode],
+			       i, i2, iResult));
+			Tcl_SetLongObj(valuePtr, iResult);
+		    }
+		    ++stackTop; /* valuePtr now on stk top has right r.c. */
+		}
+		TclDecrRefCount(value2Ptr);
+	    }
+	    ADJUST_PC(1);
+	    
+	case INST_UPLUS:
+	    {
+	        /*
+	         * Operand must be numeric.
+	         */
+
+		double d;
+		Tcl_ObjType *tPtr;
+		
+		valuePtr = stackPtr[stackTop].o;
+		tPtr = valuePtr->typePtr;
+		if ((tPtr != &tclIntType) && (tPtr != &tclDoubleType)) {
+		    char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
+		    if (TclLooksLikeInt(s)) { /* FAILS IF NULLS */
+			result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
+				valuePtr, &i);
+		    } else {
+			result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
+				valuePtr, &d);
+		    }
+		    if (result != TCL_OK) { 
+			TRACE(("%s \"%.20s\" => ILLEGAL TYPE %s \n",
+			        opName[opCode], s,
+			        (tPtr? tPtr->name : "null")));
+			IllegalExprOperandType(interp, opCode, valuePtr);
+			goto checkForCatch;
+		    }
+		}
+		TRACE_WITH_OBJ(("uplus %s => ", O2S(valuePtr)), valuePtr);
+	    }
+	    ADJUST_PC(1);
+	    
+	case INST_UMINUS:
+	case INST_LNOT:
+	    {
+		/*
+		 * The operand must be numeric. If the operand object is
+		 * unshared modify it directly, otherwise create a copy to
+		 * modify: this is "copy on write". free any old string
+		 * representation since it is now invalid.
+		 */
+		
+		double d;
+		Tcl_ObjType *tPtr;
+		
+		valuePtr = POP_OBJECT();
+		tPtr = valuePtr->typePtr;
+		if ((tPtr != &tclIntType) && (tPtr != &tclDoubleType)) {
+		    char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
+		    if (TclLooksLikeInt(s)) { /* FAILS IF NULLS */
+			result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
+				valuePtr, &i);
+		    } else {
+			result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
+				valuePtr, &d);
+		    }
+		    if (result != TCL_OK) {
+			TRACE(("%s \"%.20s\" => ILLEGAL TYPE %s\n",
+			        opName[opCode], s,
+			       (tPtr? tPtr->name : "null")));
+			IllegalExprOperandType(interp, opCode, valuePtr);
+			Tcl_DecrRefCount(valuePtr);
+			goto checkForCatch;
+		    }
+		    tPtr = valuePtr->typePtr;
+		}
+		
+		if (Tcl_IsShared(valuePtr)) {
+		    /*
+		     * Create a new object.
+		     */
+		    if (tPtr == &tclIntType) {
+			i = valuePtr->internalRep.longValue;
+			objPtr = Tcl_NewLongObj(
+			        (opCode == INST_UMINUS)? -i : !i);
+			TRACE_WITH_OBJ(("%s %ld => ", opName[opCode], i),
+		                objPtr); /* NB: stack top is off by 1 */
+		    } else {
+			d = valuePtr->internalRep.doubleValue;
+			if (opCode == INST_UMINUS) {
+			    objPtr = Tcl_NewDoubleObj(-d);
+			} else {
+			    /*
+			     * Should be able to use "!d", but apparently
+			     * some compilers can't handle it.
+			     */
+			    objPtr = Tcl_NewLongObj((d==0.0)? 1 : 0);
+			}
+			TRACE_WITH_OBJ(("%s %.6g => ", opName[opCode], d),
+		                objPtr); /* NB: stack top is off by 1 */
+		    }
+		    PUSH_OBJECT(objPtr);
+		    TclDecrRefCount(valuePtr);
+		} else {
+		    /*
+		     * valuePtr is unshared. Modify it directly.
+		     */
+		    if (tPtr == &tclIntType) {
+			i = valuePtr->internalRep.longValue;
+			Tcl_SetLongObj(valuePtr,
+			        (opCode == INST_UMINUS)? -i : !i);
+			TRACE_WITH_OBJ(("%s %ld => ", opName[opCode], i),
+		                valuePtr); /* NB: stack top is off by 1 */
+		    } else {
+			d = valuePtr->internalRep.doubleValue;
+			if (opCode == INST_UMINUS) {
+			    Tcl_SetDoubleObj(valuePtr, -d);
+			} else {
+			    /*
+			     * Should be able to use "!d", but apparently
+			     * some compilers can't handle it.
+			     */
+			    Tcl_SetLongObj(valuePtr, (d==0.0)? 1 : 0);
+			}
+			TRACE_WITH_OBJ(("%s %.6g => ", opName[opCode], d),
+		                valuePtr); /* NB: stack top is off by 1 */
+		    }
+		    ++stackTop; /* valuePtr now on stk top has right r.c. */
+		}
+	    }
+	    ADJUST_PC(1);
+	    
+	case INST_BITNOT:
+	    {
+		/*
+		 * The operand must be an integer. If the operand object is
+		 * unshared modify it directly, otherwise modify a copy. 
+		 * Free any old string representation since it is now
+		 * invalid.
+		 */
+		
+		Tcl_ObjType *tPtr;
+		
+		valuePtr = POP_OBJECT();
+		tPtr = valuePtr->typePtr;
+		if (tPtr != &tclIntType) {
+		    result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
+			    valuePtr, &i);
+		    if (result != TCL_OK) {   /* try to convert to double */
+			TRACE(("bitnot \"%.20s\" => ILLEGAL TYPE %s\n",
+			       O2S(valuePtr), (tPtr? tPtr->name : "null")));
+			IllegalExprOperandType(interp, opCode, valuePtr);
+			Tcl_DecrRefCount(valuePtr);
+			goto checkForCatch;
+		    }
+		}
+		
+		i = valuePtr->internalRep.longValue;
+		if (Tcl_IsShared(valuePtr)) {
+		    PUSH_OBJECT(Tcl_NewLongObj(~i));
+		    TRACE(("bitnot 0x%lx => (%lu)\n", i, ~i));
+		    TclDecrRefCount(valuePtr);
+		} else {
+		    /*
+		     * valuePtr is unshared. Modify it directly.
+		     */
+		    Tcl_SetLongObj(valuePtr, ~i);
+		    ++stackTop; /* valuePtr now on stk top has right r.c. */
+		    TRACE(("bitnot 0x%lx => (%lu)\n", i, ~i));
+		}
+	    }
+	    ADJUST_PC(1);
+	    
+	case INST_CALL_BUILTIN_FUNC1:
+	    opnd = TclGetUInt1AtPtr(pc+1);
+	    {
+		/*
+		 * Call one of the built-in Tcl math functions.
+		 */
+
+		BuiltinFunc *mathFuncPtr;
+
+		if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) {
+		    TRACE(("UNRECOGNIZED BUILTIN FUNC CODE %d\n", opnd));
+		    panic("TclExecuteByteCode: unrecognized builtin function code %d", opnd);
+		}
+		mathFuncPtr = &(builtinFuncTable[opnd]);
+		DECACHE_STACK_INFO();
+		tcl_MathInProgress++;
+		result = (*mathFuncPtr->proc)(interp, eePtr,
+		        mathFuncPtr->clientData);
+		tcl_MathInProgress--;
+		CACHE_STACK_INFO();
+		if (result != TCL_OK) {
+		    goto checkForCatch;
+		}
+		TRACE_WITH_OBJ(("callBuiltinFunc1 %d => ", opnd),
+		        stackPtr[stackTop].o);
+	    }
+	    ADJUST_PC(2);
+		    
+	case INST_CALL_FUNC1:
+	    opnd = TclGetUInt1AtPtr(pc+1);
+	    {
+		/*
+		 * Call a non-builtin Tcl math function previously
+		 * registered by a call to Tcl_CreateMathFunc.
+		 */
+		
+		int objc = opnd;   /* Number of arguments. The function name
+				    * is the 0-th argument. */
+		Tcl_Obj **objv;	   /* The array of arguments. The function
+				    * name is objv[0]. */
+		
+		objv = &(stackPtr[stackTop - (objc-1)].o); /* "objv[0]" */
+		DECACHE_STACK_INFO();
+		tcl_MathInProgress++;
+		result = ExprCallMathFunc(interp, eePtr, objc, objv);
+		tcl_MathInProgress--;
+		CACHE_STACK_INFO();
+		if (result != TCL_OK) {
+		    goto checkForCatch;
+		}
+		TRACE_WITH_OBJ(("callFunc1 %d => ", objc),
+		        stackPtr[stackTop].o);
+		ADJUST_PC(2);
+	    }
+
+	case INST_TRY_CVT_TO_NUMERIC:
+	    {
+		/*
+		 * Try to convert the topmost stack object to an int or
+		 * double object. This is done in order to support Tcl's
+		 * policy of interpreting operands if at all possible as
+		 * first integers, else floating-point numbers.
+		 */
+		
+		double d;
+		char *s;
+		Tcl_ObjType *tPtr;
+		int converted, shared;
+
+		valuePtr = stackPtr[stackTop].o;
+		tPtr = valuePtr->typePtr;
+		converted = 0;
+		if ((tPtr != &tclIntType) && (tPtr != &tclDoubleType)) {
+		    s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
+		    if (TclLooksLikeInt(s)) { /* FAILS IF NULLS */
+			result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
+				valuePtr, &i);
+		    } else {
+			result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
+				valuePtr, &d);
+		    }
+		    if (result == TCL_OK) {
+			converted = 1;
+		    }
+		    result = TCL_OK; /* reset the result variable */
+		    tPtr = valuePtr->typePtr;
+		}
+
+		/*
+		 * Ensure that the topmost stack object, if numeric, has a
+		 * string rep the same as the formatted version of its
+		 * internal rep. This is used, e.g., to make sure that "expr
+		 * {0001}" yields "1", not "0001". We implement this by
+		 * _discarding_ the string rep since we know it will be
+		 * regenerated, if needed later, by formatting the internal
+		 * rep's value. Also check if there has been an IEEE
+		 * floating point error.
+		 */
+
+		if ((tPtr == &tclIntType) || (tPtr == &tclDoubleType)) {
+		    shared = 0;
+		    if (Tcl_IsShared(valuePtr)) {
+			shared = 1;
+			if (tPtr == &tclIntType) {
+			    i = valuePtr->internalRep.longValue;
+			    objPtr = Tcl_NewLongObj(i);
+			} else {
+			    d = valuePtr->internalRep.doubleValue;
+			    objPtr = Tcl_NewDoubleObj(d);
+			}
+			Tcl_IncrRefCount(objPtr);
+			TclDecrRefCount(valuePtr);
+			valuePtr = objPtr;
+			tPtr = valuePtr->typePtr;
+		    } else {
+			Tcl_InvalidateStringRep(valuePtr);
+		    }
+		    stackPtr[stackTop].o = valuePtr;
+		
+		    if (tPtr == &tclDoubleType) {
+			d = valuePtr->internalRep.doubleValue;
+			if (IS_NAN(d) || IS_INF(d)) {
+			    TRACE(("tryCvtToNumeric \"%.20s\" => IEEE FLOATING PT ERROR\n",
+			           O2S(valuePtr)));
+			    TclExprFloatError(interp, d);
+			    result = TCL_ERROR;
+			    goto checkForCatch;
+			}
+		    }
+		    shared = shared;		/* lint, shared not used. */
+		    converted = converted;	/* lint, converted not used. */
+		    TRACE(("tryCvtToNumeric \"%.20s\" => numeric, %s, %s\n",
+			   O2S(valuePtr),
+			   (converted? "converted" : "not converted"),
+			   (shared? "shared" : "not shared")));
+		} else {
+		    TRACE(("tryCvtToNumeric \"%.20s\" => not numeric\n",
+			   O2S(valuePtr)));
+		}
+	    }
+	    ADJUST_PC(1);
+
+	case INST_BREAK:
+	    /*
+	     * First reset the interpreter's result. Then find the closest
+	     * enclosing loop or catch exception range, if any. If a loop is
+	     * found, terminate its execution. If the closest is a catch
+	     * exception range, jump to its catchOffset. If no enclosing
+	     * range is found, stop execution and return TCL_BREAK.
+	     */
+
+	    Tcl_ResetResult(interp);
+	    rangePtr = TclGetExceptionRangeForPc(pc, /*catchOnly*/ 0,
+		    codePtr);
+	    if (rangePtr == NULL) {
+		TRACE(("break => no encl. loop or catch, returning TCL_BREAK\n"));
+		result = TCL_BREAK;
+		goto abnormalReturn; /* no catch exists to check */
+	    }
+	    switch (rangePtr->type) {
+	    case LOOP_EXCEPTION_RANGE:
+		result = TCL_OK;
+		TRACE(("break => range at %d, new pc %d\n",
+		       rangePtr->codeOffset, rangePtr->breakOffset));
+		break;
+	    case CATCH_EXCEPTION_RANGE:
+		result = TCL_BREAK;
+		TRACE(("break => ...\n"));
+		goto processCatch; /* it will use rangePtr */
+	    default:
+		panic("TclExecuteByteCode: unrecognized ExceptionRange type %d\n", rangePtr->type);
+	    }
+	    pc = (codePtr->codeStart + rangePtr->breakOffset);
+	    continue;	/* restart outer instruction loop at pc */
+
+	case INST_CONTINUE:
+            /*
+	     * Find the closest enclosing loop or catch exception range,
+	     * if any. If a loop is found, skip to its next iteration.
+	     * If the closest is a catch exception range, jump to its
+	     * catchOffset. If no enclosing range is found, stop
+	     * execution and return TCL_CONTINUE.
+	     */
+
+	    Tcl_ResetResult(interp);
+	    rangePtr = TclGetExceptionRangeForPc(pc, /*catchOnly*/ 0,
+		    codePtr);
+	    if (rangePtr == NULL) {
+		TRACE(("continue => no encl. loop or catch, returning TCL_CONTINUE\n"));
+		result = TCL_CONTINUE;
+		goto abnormalReturn;
+	    }
+	    switch (rangePtr->type) {
+	    case LOOP_EXCEPTION_RANGE:
+		if (rangePtr->continueOffset == -1) {
+		    TRACE(("continue => loop w/o continue, checking for catch\n"));
+		    goto checkForCatch;
+		} else {
+		    result = TCL_OK;
+		    TRACE(("continue => range at %d, new pc %d\n",
+			   rangePtr->codeOffset, rangePtr->continueOffset));
+		}
+		break;
+	    case CATCH_EXCEPTION_RANGE:
+		result = TCL_CONTINUE;
+		TRACE(("continue => ...\n"));
+		goto processCatch; /* it will use rangePtr */
+	    default:
+		panic("TclExecuteByteCode: unrecognized ExceptionRange type %d\n", rangePtr->type);
+	    }
+	    pc = (codePtr->codeStart + rangePtr->continueOffset);
+	    continue;	/* restart outer instruction loop at pc */
+
+	case INST_FOREACH_START4:
+	    opnd = TclGetUInt4AtPtr(pc+1);
+	    {
+	        /*
+		 * Initialize the temporary local var that holds the count
+		 * of the number of iterations of the loop body to -1.
+		 */
+
+		ForeachInfo *infoPtr = (ForeachInfo *)
+		    codePtr->auxDataArrayPtr[opnd].clientData;
+		int iterTmpIndex = infoPtr->loopIterNumTmp;
+		CallFrame *varFramePtr = iPtr->varFramePtr;
+		Var *compiledLocals = varFramePtr->compiledLocals;
+		Var *iterVarPtr;
+		Tcl_Obj *oldValuePtr;
+
+		iterVarPtr = &(compiledLocals[iterTmpIndex]);
+		oldValuePtr = iterVarPtr->value.objPtr;
+		if (oldValuePtr == NULL) {
+		    iterVarPtr->value.objPtr = Tcl_NewLongObj(-1);
+		    Tcl_IncrRefCount(iterVarPtr->value.objPtr);
+		} else {
+		    Tcl_SetLongObj(oldValuePtr, -1);
+		}
+		TclSetVarScalar(iterVarPtr);
+		TclClearVarUndefined(iterVarPtr);
+		TRACE(("foreach_start4 %u => loop iter count temp %d\n", 
+		        opnd, iterTmpIndex));
+	    }
+	    ADJUST_PC(5);
+	
+	case INST_FOREACH_STEP4:
+	    opnd = TclGetUInt4AtPtr(pc+1);
+	    {
+	        /*
+		 * "Step" a foreach loop (i.e., begin its next iteration) by
+		 * assigning the next value list element to each loop var.
+		 */
+
+		ForeachInfo *infoPtr = (ForeachInfo *)
+		    codePtr->auxDataArrayPtr[opnd].clientData;
+		ForeachVarList *varListPtr;
+		int numLists = infoPtr->numLists;
+		int iterTmpIndex = infoPtr->loopIterNumTmp;
+		CallFrame *varFramePtr = iPtr->varFramePtr;
+		Var *compiledLocals = varFramePtr->compiledLocals;
+		int iterNum, listTmpIndex, listLen, numVars;
+		int varIndex, valIndex, j;
+		Tcl_Obj *listPtr, *elemPtr, *oldValuePtr;
+		List *listRepPtr;
+		Var *iterVarPtr, *listVarPtr;
+		int continueLoop = 0;
+
+		/*
+		 * Increment the temp holding the loop iteration number.
+		 */
+
+		iterVarPtr = &(compiledLocals[iterTmpIndex]);
+		oldValuePtr = iterVarPtr->value.objPtr;
+		iterNum = (oldValuePtr->internalRep.longValue + 1);
+		Tcl_SetLongObj(oldValuePtr, iterNum);
+		
+		/*
+		 * Check whether all value lists are exhausted and we should
+		 * stop the loop.
+		 */
+
+		listTmpIndex = infoPtr->firstListTmp;
+		for (i = 0;  i < numLists;  i++) {
+		    varListPtr = infoPtr->varLists[i];
+		    numVars = varListPtr->numVars;
+
+		    listVarPtr = &(compiledLocals[listTmpIndex]);
+		    listPtr = listVarPtr->value.objPtr;
+		    result = Tcl_ListObjLength(interp, listPtr, &listLen);
+		    if (result != TCL_OK) {
+			TRACE_WITH_OBJ(("foreach_step4 %u => ERROR converting list %ld, \"%s\": ",
+			        opnd, i, O2S(listPtr)),
+				Tcl_GetObjResult(interp));
+			goto checkForCatch;
+		    }
+		    if (listLen > (iterNum * numVars)) {
+			continueLoop = 1;
+		    }
+		    listTmpIndex++;
+		}
+
+		/*
+		 * If some var in some var list still has a remaining list
+		 * element iterate one more time. Assign to var the next
+		 * element from its value list. We already checked above
+		 * that each list temp holds a valid list object.
+		 */
+		
+		if (continueLoop) {
+		    listTmpIndex = infoPtr->firstListTmp;
+		    for (i = 0;  i < numLists;  i++) {
+			varListPtr = infoPtr->varLists[i];
+			numVars = varListPtr->numVars;
+
+			listVarPtr = &(compiledLocals[listTmpIndex]);
+			listPtr = listVarPtr->value.objPtr;
+			listRepPtr = (List *)
+			        listPtr->internalRep.otherValuePtr;
+			listLen = listRepPtr->elemCount;
+			
+			valIndex = (iterNum * numVars);
+			for (j = 0;  j < numVars;  j++) {
+			    int setEmptyStr = 0;
+			    if (valIndex >= listLen) {
+				setEmptyStr = 1;
+				elemPtr = Tcl_NewObj();
+			    } else {
+				elemPtr = listRepPtr->elements[valIndex];
+			    }
+			    
+			    varIndex = varListPtr->varIndexes[j];
+			    DECACHE_STACK_INFO();
+			    value2Ptr = TclSetIndexedScalar(interp,
+			           varIndex, elemPtr, /*leaveErrorMsg*/ 1);
+			    CACHE_STACK_INFO();
+			    if (value2Ptr == NULL) {
+				TRACE_WITH_OBJ(("foreach_step4 %u => ERROR init. index temp %d: ",
+				       opnd, varIndex),
+				       Tcl_GetObjResult(interp));
+				if (setEmptyStr) {
+				    Tcl_DecrRefCount(elemPtr); /* unneeded */
+				}
+				result = TCL_ERROR;
+				goto checkForCatch;
+			    }
+			    valIndex++;
+			}
+			listTmpIndex++;
+		    }
+		}
+		
+		/*
+		 * Now push a "1" object if at least one value list had a
+		 * remaining element and the loop should continue.
+		 * Otherwise push "0".
+		 */
+
+		PUSH_OBJECT(Tcl_NewLongObj(continueLoop));
+		TRACE(("foreach_step4 %u => %d lists, iter %d, %s loop\n", 
+		        opnd, numLists, iterNum,
+		        (continueLoop? "continue" : "exit")));
+	    }
+	    ADJUST_PC(5);
+
+	case INST_BEGIN_CATCH4:
+	    /*
+	     * Record start of the catch command with exception range index
+	     * equal to the operand. Push the current stack depth onto the
+	     * special catch stack.
+	     */
+	    catchStackPtr[++catchTop] = stackTop;
+	    TRACE(("beginCatch4 %u => catchTop=%d, stackTop=%d\n",
+		    TclGetUInt4AtPtr(pc+1), catchTop, stackTop));
+	    ADJUST_PC(5);
+
+	case INST_END_CATCH:
+	    catchTop--;
+	    result = TCL_OK;
+	    TRACE(("endCatch => catchTop=%d\n", catchTop));
+	    ADJUST_PC(1);
+
+	case INST_PUSH_RESULT:
+	    PUSH_OBJECT(Tcl_GetObjResult(interp));
+	    TRACE_WITH_OBJ(("pushResult => "), Tcl_GetObjResult(interp));
+	    ADJUST_PC(1);
+
+	case INST_PUSH_RETURN_CODE:
+	    PUSH_OBJECT(Tcl_NewLongObj(result));
+	    TRACE(("pushReturnCode => %u\n", result));
+	    ADJUST_PC(1);
+
+	default:
+	    TRACE(("UNRECOGNIZED INSTRUCTION %u\n", opCode));
+	    panic("TclExecuteByteCode: unrecognized opCode %u", opCode);
+	} /* end of switch on opCode */
+
+	/*
+	 * Division by zero in an expression. Control only reaches this
+	 * point by "goto divideByZero".
+	 */
+	
+        divideByZero:
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp), "divide by zero", -1);
+	Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero",
+			 (char *) NULL);
+	result = TCL_ERROR;
+	
+	/*
+	 * Execution has generated an "exception" such as TCL_ERROR. If the
+	 * exception is an error, record information about what was being
+	 * executed when the error occurred. Find the closest enclosing
+	 * catch range, if any. If no enclosing catch range is found, stop
+	 * execution and return the "exception" code.
+	 */
+	
+        checkForCatch:
+	if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
+	    RecordTracebackInfo(interp, pc, codePtr);
+        }
+	rangePtr = TclGetExceptionRangeForPc(pc, /*catchOnly*/ 1, codePtr);
+	if (rangePtr == NULL) {
+	    TRACE(("   ... no enclosing catch, returning %s\n",
+		    StringForResultCode(result)));
+	    goto abnormalReturn;
+	}
+
+	/*
+	 * A catch exception range (rangePtr) was found to handle an
+	 * "exception". It was found either by checkForCatch just above or
+	 * by an instruction during break, continue, or error processing.
+	 * Jump to its catchOffset after unwinding the operand stack to
+	 * the depth it had when starting to execute the range's catch
+	 * command.
+	 */
+
+        processCatch:
+	while (stackTop > catchStackPtr[catchTop]) {
+	    valuePtr = POP_OBJECT();
+	    TclDecrRefCount(valuePtr);
+	}
+	TRACE(("  ... found catch at %d, catchTop=%d, unwound to %d, new pc %u\n",
+	        rangePtr->codeOffset, catchTop, catchStackPtr[catchTop],
+	        (unsigned int)(rangePtr->catchOffset)));
+	pc = (codePtr->codeStart + rangePtr->catchOffset);
+	continue;		/* restart the execution loop at pc */
+    } /* end of infinite loop dispatching on instructions */
+
+    /*
+     * Abnormal return code. Restore the stack to state it had when starting
+     * to execute the ByteCode.
+     */
+
+    abnormalReturn:
+    while (stackTop > initStackTop) {
+	valuePtr = POP_OBJECT();
+	Tcl_DecrRefCount(valuePtr);
+    }
+
+    /*
+     * Free the catch stack array if malloc'ed storage was used.
+     */
+
+    done:
+    if (catchStackPtr != catchStackStorage) {
+	ckfree((char *) catchStackPtr);
+    }
+    eePtr->stackTop = initStackTop;
+    return result;
+#undef STATIC_CATCH_STACK_SIZE
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PrintByteCodeInfo --
+ *
+ *	This procedure prints a summary about a bytecode object to stdout.
+ *	It is called by TclExecuteByteCode when starting to execute the
+ *	bytecode object if tclTraceExec has the value 2 or more.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PrintByteCodeInfo(codePtr)
+    register ByteCode *codePtr;	/* The bytecode whose summary is printed
+				 * to stdout. */
+{
+    Proc *procPtr = codePtr->procPtr;
+    int numCmds = codePtr->numCommands;
+    int numObjs = codePtr->numObjects;
+    int objBytes, i;
+
+    objBytes = (numObjs * sizeof(Tcl_Obj));
+    for (i = 0;  i < numObjs;  i++) {
+	Tcl_Obj *litObjPtr = codePtr->objArrayPtr[i];
+	if (litObjPtr->bytes != NULL) {
+	    objBytes += litObjPtr->length;
+	}
+    }
+    
+    fprintf(stdout, "\nExecuting ByteCode 0x%x, ref ct %u, epoch %u, interp 0x%x(epoch %u)\n",
+	    (unsigned int) codePtr, codePtr->refCount,
+	    codePtr->compileEpoch, (unsigned int) codePtr->iPtr,
+	    codePtr->iPtr->compileEpoch);
+    
+    fprintf(stdout, "  Source: ");
+    TclPrintSource(stdout, codePtr->source, 70);
+
+    fprintf(stdout, "\n  Cmds %d, chars %d, inst %u, objs %u, aux %d, stk depth %u, code/src %.2fn",
+            numCmds, codePtr->numSrcChars, codePtr->numCodeBytes, numObjs,
+	    codePtr->numAuxDataItems, codePtr->maxStackDepth,
+	    (codePtr->numSrcChars?
+	            ((float)codePtr->totalSize)/((float)codePtr->numSrcChars) : 0.0));
+
+    fprintf(stdout, "  Code %zu = %u(header)+%d(inst)+%d(objs)+%u(exc)+%u(aux)+%d(cmd map)\n",
+	    codePtr->totalSize, sizeof(ByteCode), codePtr->numCodeBytes,
+	    objBytes, (codePtr->numExcRanges * sizeof(ExceptionRange)),
+	    (codePtr->numAuxDataItems * sizeof(AuxData)),
+	    codePtr->numCmdLocBytes);
+
+    if (procPtr != NULL) {
+	fprintf(stdout,
+		"  Proc 0x%x, ref ct %d, args %d, compiled locals %d\n",
+		(unsigned int) procPtr, procPtr->refCount,
+		procPtr->numArgs, procPtr->numCompiledLocals);
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ValidatePcAndStackTop --
+ *
+ *	This procedure is called by TclExecuteByteCode when debugging to
+ *	verify that the program counter and stack top are valid during
+ *	execution.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Prints a message to stderr and panics if either the pc or stack
+ *	top are invalid.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_COMPILE_DEBUG
+static void
+ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound, stackUpperBound)
+    register ByteCode *codePtr; /* The bytecode whose summary is printed
+				 * to stdout. */
+    unsigned char *pc;		/* Points to first byte of a bytecode
+				 * instruction. The program counter. */
+    int stackTop;		/* Current stack top. Must be between
+				 * stackLowerBound and stackUpperBound
+				 * (inclusive). */
+    int stackLowerBound;	/* Smallest legal value for stackTop. */
+    int stackUpperBound;	/* Greatest legal value for stackTop. */
+{
+    unsigned int relativePc = (unsigned int) (pc - codePtr->codeStart);
+    unsigned int codeStart = (unsigned int) codePtr->codeStart;
+    unsigned int codeEnd = (unsigned int)
+	    (codePtr->codeStart + codePtr->numCodeBytes);
+    unsigned char opCode = *pc;
+
+    if (((unsigned int) pc < codeStart) || ((unsigned int) pc > codeEnd)) {
+	fprintf(stderr, "\nBad instruction pc 0x%x in TclExecuteByteCode\n",
+		(unsigned int) pc);
+	panic("TclExecuteByteCode execution failure: bad pc");
+    }
+    if ((unsigned int) opCode > LAST_INST_OPCODE) {
+	fprintf(stderr, "\nBad opcode %d at pc %u in TclExecuteByteCode\n",
+		(unsigned int) opCode, relativePc);
+	panic("TclExecuteByteCode execution failure: bad opcode");
+    }
+    if ((stackTop < stackLowerBound) || (stackTop > stackUpperBound)) {
+	int numChars;
+	char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars);
+	char *ellipsis = "";
+	
+	fprintf(stderr, "\nBad stack top %d at pc %u in TclExecuteByteCode",
+		stackTop, relativePc);
+	if (cmd != NULL) {
+	    if (numChars > 100) {
+		numChars = 100;
+		ellipsis = "...";
+	    }
+	    fprintf(stderr, "\n executing %.*s%s\n", numChars, cmd,
+		    ellipsis);
+	} else {
+	    fprintf(stderr, "\n");
+	}
+	panic("TclExecuteByteCode execution failure: bad stack top");
+    }
+}
+#endif /* TCL_COMPILE_DEBUG */
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * IllegalExprOperandType --
+ *
+ *	Used by TclExecuteByteCode to add an error message to errorInfo
+ *	when an illegal operand type is detected by an expression
+ *	instruction. The argument opCode holds the failing instruction's
+ *	opcode and opndPtr holds the operand object in error.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	An error message is appended to errorInfo.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+IllegalExprOperandType(interp, opCode, opndPtr)
+    Tcl_Interp *interp;		/* Interpreter to which error information
+				 * pertains. */
+    unsigned int opCode;	/* The instruction opcode being executed
+				 * when the illegal type was found. */
+    Tcl_Obj *opndPtr;		/* Points to the operand holding the value
+				 * with the illegal type. */
+{
+    Tcl_ResetResult(interp);
+    if ((opndPtr->bytes == NULL) || (opndPtr->length == 0)) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"can't use empty string as operand of \"",
+		operatorStrings[opCode - INST_LOR], "\"", (char *) NULL);
+    } else {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "can't use ",
+		((opndPtr->typePtr == &tclDoubleType) ?
+		    "floating-point value" : "non-numeric string"),
+		" as operand of \"", operatorStrings[opCode - INST_LOR],
+		"\"", (char *) NULL);
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CallTraceProcedure --
+ *
+ *	Invokes a trace procedure registered with an interpreter. These
+ *	procedures trace command execution. Currently this trace procedure
+ *	is called with the address of the string-based Tcl_CmdProc for the
+ *	command, not the Tcl_ObjCmdProc.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Those side effects made by the trace procedure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CallTraceProcedure(interp, tracePtr, cmdPtr, command, numChars, objc, objv)
+    Tcl_Interp *interp;		/* The current interpreter. */
+    register Trace *tracePtr;	/* Describes the trace procedure to call. */
+    Command *cmdPtr;		/* Points to command's Command struct. */
+    char *command;		/* Points to the first character of the
+				 * command's source before substitutions. */
+    int numChars;		/* The number of characters in the
+				 * command's source. */
+    register int objc;		/* Number of arguments for the command. */
+    Tcl_Obj *objv[];		/* Pointers to Tcl_Obj of each argument. */
+{
+    Interp *iPtr = (Interp *) interp;
+    register char **argv;
+    register int i;
+    int length;
+    char *p;
+
+    /*
+     * Get the string rep from the objv argument objects and place their
+     * pointers in argv. First make sure argv is large enough to hold the
+     * objc args plus 1 extra word for the zero end-of-argv word.
+     * THIS FAILS IF AN OBJECT'S STRING REP CONTAINS NULLS.
+     */
+    
+    argv = (char **) ckalloc((unsigned)(objc + 1) * sizeof(char *));
+    for (i = 0;  i < objc;  i++) {
+	argv[i] = Tcl_GetStringFromObj(objv[i], &length);
+    }
+    argv[objc] = 0;
+
+    /*
+     * Copy the command characters into a new string.
+     */
+
+    p = (char *) ckalloc((unsigned) (numChars + 1));
+    memcpy((VOID *) p, (VOID *) command, (size_t) numChars);
+    p[numChars] = '\0';
+    
+    /*
+     * Call the trace procedure then free allocated storage.
+     */
+    
+    (*tracePtr->proc)(tracePtr->clientData, interp, iPtr->numLevels,
+                      p, cmdPtr->proc, cmdPtr->clientData, objc, argv);
+
+    ckfree((char *) argv);
+    ckfree((char *) p);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RecordTracebackInfo --
+ *
+ *      Procedure called by TclExecuteByteCode to record information
+ *      about what was being executed when the error occurred.
+ *
+ * Results:
+ *      None.
+ *
+ * Side effects:
+ *      Appends information about the command being executed to the
+ *      "errorInfo" variable. Sets the errorLine field in the interpreter
+ *      to the line number of that command. Sets the ERR_ALREADY_LOGGED
+ *      bit in the interpreter's execution flags.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RecordTracebackInfo(interp, pc, codePtr)
+    Tcl_Interp *interp;         /* The interpreter in which the error
+                                 * occurred. */
+    unsigned char *pc;          /* The program counter value where the error                                 * occurred. This points to a bytecode
+                                 * instruction in codePtr's code. */
+    ByteCode *codePtr;          /* The bytecode sequence being executed. */
+{
+    register Interp *iPtr = (Interp *) interp;
+    char *cmd, *ellipsis;
+    char buf[200];
+    register char *p;
+    int numChars;
+    
+    /*
+     * Record the command in errorInfo (up to a certain number of
+     * characters, or up to the first newline).
+     */
+    
+    iPtr->errorLine = 1;
+    cmd = GetSrcInfoForPc(pc, codePtr, &numChars);
+    if (cmd != NULL) {
+        for (p = codePtr->source;  p != cmd;  p++) {
+            if (*p == '\n') {
+                iPtr->errorLine++;
+            }
+        }
+        for ( ;  (isspace(UCHAR(*p)) || (*p == ';'));  p++) {
+            if (*p == '\n') {
+                iPtr->errorLine++;
+            }
+        }
+	
+        ellipsis = "";
+        if (numChars > 150) {
+            numChars = 150;
+            ellipsis = "...";
+        }
+        if (!(iPtr->flags & ERR_IN_PROGRESS)) {
+            sprintf(buf, "\n    while executing\n\"%.*s%s\"",
+                    numChars, cmd, ellipsis);
+        } else {
+            sprintf(buf, "\n    invoked from within\n\"%.*s%s\"",
+                    numChars, cmd, ellipsis);
+        }
+        Tcl_AddObjErrorInfo(interp, buf, -1);
+        iPtr->flags |= ERR_ALREADY_LOGGED;
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetSrcInfoForPc --
+ *
+ *	Given a program counter value, finds the closest command in the
+ *	bytecode code unit's CmdLocation array and returns information about
+ *	that command's source: a pointer to its first byte and the number of
+ *	characters.
+ *
+ * Results:
+ *	If a command is found that encloses the program counter value, a
+ *	pointer to the command's source is returned and the length of the
+ *	source is stored at *lengthPtr. If multiple commands resulted in
+ *	code at pc, information about the closest enclosing command is
+ *	returned. If no matching command is found, NULL is returned and
+ *	*lengthPtr is unchanged.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+GetSrcInfoForPc(pc, codePtr, lengthPtr)
+    unsigned char *pc;		/* The program counter value for which to
+				 * return the closest command's source info.
+				 * This points to a bytecode instruction
+				 * in codePtr's code. */
+    ByteCode *codePtr;		/* The bytecode sequence in which to look
+				 * up the command source for the pc. */
+    int *lengthPtr;		/* If non-NULL, the location where the
+				 * length of the command's source should be
+				 * stored. If NULL, no length is stored. */
+{
+    register int pcOffset = (pc - codePtr->codeStart);
+    int numCmds = codePtr->numCommands;
+    unsigned char *codeDeltaNext, *codeLengthNext;
+    unsigned char *srcDeltaNext, *srcLengthNext;
+    int codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i;
+    int bestDist = INT_MAX;	/* Distance of pc to best cmd's start pc. */
+    int bestSrcOffset = -1;	/* Initialized to avoid compiler warning. */
+    int bestSrcLength = -1;	/* Initialized to avoid compiler warning. */
+
+    if ((pcOffset < 0) || (pcOffset >= codePtr->numCodeBytes)) {
+	return NULL;
+    }
+
+    /*
+     * Decode the code and source offset and length for each command. The
+     * closest enclosing command is the last one whose code started before
+     * pcOffset.
+     */
+
+    codeDeltaNext = codePtr->codeDeltaStart;
+    codeLengthNext = codePtr->codeLengthStart;
+    srcDeltaNext  = codePtr->srcDeltaStart;
+    srcLengthNext = codePtr->srcLengthStart;
+    codeOffset = srcOffset = 0;
+    for (i = 0;  i < numCmds;  i++) {
+	if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) {
+	    codeDeltaNext++;
+	    delta = TclGetInt4AtPtr(codeDeltaNext);
+	    codeDeltaNext += 4;
+	} else {
+	    delta = TclGetInt1AtPtr(codeDeltaNext);
+	    codeDeltaNext++;
+	}
+	codeOffset += delta;
+
+	if ((unsigned int) (*codeLengthNext) == (unsigned int) 0xFF) {
+	    codeLengthNext++;
+	    codeLen = TclGetInt4AtPtr(codeLengthNext);
+	    codeLengthNext += 4;
+	} else {
+	    codeLen = TclGetInt1AtPtr(codeLengthNext);
+	    codeLengthNext++;
+	}
+	codeEnd = (codeOffset + codeLen - 1);
+
+	if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) {
+	    srcDeltaNext++;
+	    delta = TclGetInt4AtPtr(srcDeltaNext);
+	    srcDeltaNext += 4;
+	} else {
+	    delta = TclGetInt1AtPtr(srcDeltaNext);
+	    srcDeltaNext++;
+	}
+	srcOffset += delta;
+
+	if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) {
+	    srcLengthNext++;
+	    srcLen = TclGetInt4AtPtr(srcLengthNext);
+	    srcLengthNext += 4;
+	} else {
+	    srcLen = TclGetInt1AtPtr(srcLengthNext);
+	    srcLengthNext++;
+	}
+	
+	if (codeOffset > pcOffset) {      /* best cmd already found */
+	    break;
+	} else if (pcOffset <= codeEnd) { /* this cmd's code encloses pc */
+	    int dist = (pcOffset - codeOffset);
+	    if (dist <= bestDist) {
+		bestDist = dist;
+		bestSrcOffset = srcOffset;
+		bestSrcLength = srcLen;
+	    }
+	}
+    }
+
+    if (bestDist == INT_MAX) {
+	return NULL;
+    }
+    
+    if (lengthPtr != NULL) {
+	*lengthPtr = bestSrcLength;
+    }
+    return (codePtr->source + bestSrcOffset);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetExceptionRangeForPc --
+ *
+ *	Procedure that given a program counter value, returns the closest
+ *	enclosing ExceptionRange that matches the kind requested.
+ *
+ * Results:
+ *	In the normal case, catchOnly is 0 (false) and this procedure
+ *	returns a pointer to the most closely enclosing ExceptionRange
+ *	structure regardless of whether it is a loop or catch exception
+ *	range. This is appropriate when processing a TCL_BREAK or
+ *	TCL_CONTINUE, which will be "handled" either by a loop exception
+ *	range or a closer catch range. If catchOnly is nonzero (true), this
+ *	procedure ignores loop exception ranges and returns a pointer to the
+ *	closest catch range. If no matching ExceptionRange is found that
+ *	encloses pc, a NULL is returned.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ExceptionRange *
+TclGetExceptionRangeForPc(pc, catchOnly, codePtr)
+    unsigned char *pc;		/* The program counter value for which to
+				 * search for a closest enclosing exception
+				 * range. This points to a bytecode
+				 * instruction in codePtr's code. */
+    int catchOnly;		/* If 0, consider either loop or catch
+				 * ExceptionRanges in search. Otherwise
+				 * consider only catch ranges (and ignore
+				 * any closer loop ranges). */
+    ByteCode* codePtr;		/* Points to the ByteCode in which to search
+				 * for the enclosing ExceptionRange. */
+{
+    ExceptionRange *rangeArrayPtr;
+    int numRanges = codePtr->numExcRanges;
+    register ExceptionRange *rangePtr;
+    int codeOffset = (pc - codePtr->codeStart);
+    register int i, level;
+
+    if (numRanges == 0) {
+	return NULL;
+    }
+    rangeArrayPtr = codePtr->excRangeArrayPtr;
+
+    for (level = codePtr->maxExcRangeDepth;  level >= 0;  level--) {
+	for (i = 0;  i < numRanges;  i++) {
+	    rangePtr = &(rangeArrayPtr[i]);
+	    if (rangePtr->nestingLevel == level) {
+		int start = rangePtr->codeOffset;
+		int end   = (start + rangePtr->numCodeBytes);
+		if ((start <= codeOffset) && (codeOffset < end)) {
+		    if ((!catchOnly)
+			    || (rangePtr->type == CATCH_EXCEPTION_RANGE)) {
+			return rangePtr;
+		    }
+		}
+	    }
+	}
+    }
+    return NULL;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Math Functions --
+ *
+ *	This page contains the procedures that implement all of the
+ *	built-in math functions for expressions.
+ *
+ * Results:
+ *	Each procedure returns TCL_OK if it succeeds and pushes an
+ *	Tcl object holding the result. If it fails it returns TCL_ERROR
+ *	and leaves an error message in the interpreter's result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ExprUnaryFunc(interp, eePtr, clientData)
+    Tcl_Interp *interp;		/* The interpreter in which to execute the
+				 * function. */
+    ExecEnv *eePtr;		/* Points to the environment for executing
+				 * the function. */
+    ClientData clientData;	/* Contains the address of a procedure that
+				 * takes one double argument and returns a
+				 * double result. */
+{
+    StackItem *stackPtr;        /* Cached evaluation stack base pointer. */
+    register int stackTop;	/* Cached top index of evaluation stack. */
+    register Tcl_Obj *valuePtr;
+    Tcl_ObjType *tPtr;
+    double d, dResult;
+    long i;
+    int result = TCL_OK;
+    
+    double (*func) _ANSI_ARGS_((double)) =
+	(double (*)_ANSI_ARGS_((double))) clientData;
+
+    /*
+     * Set stackPtr and stackTop from eePtr.
+     */
+    
+    CACHE_STACK_INFO();
+
+    /*
+     * Pop the function's argument from the evaluation stack. Convert it
+     * to a double if necessary.
+     */
+
+    valuePtr = POP_OBJECT();
+    tPtr = valuePtr->typePtr;
+    
+    if (tPtr == &tclIntType) {
+	d = (double) valuePtr->internalRep.longValue;
+    } else if (tPtr == &tclDoubleType) {
+	d = valuePtr->internalRep.doubleValue;
+    } else {			/* FAILS IF STRING REP HAS NULLS */
+	char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
+	
+	if (TclLooksLikeInt(s)) {
+	    result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
+	    d = (double) valuePtr->internalRep.longValue;
+	} else {
+	    result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d);
+	}
+	if (result != TCL_OK) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	            "argument to math function didn't have numeric value", -1);
+	    goto done;
+	}
+    }
+
+    errno = 0;
+    dResult = (*func)(d);
+    if ((errno != 0) || IS_NAN(dResult) || IS_INF(dResult)) {
+	TclExprFloatError(interp, dResult);
+	result = TCL_ERROR;
+	goto done;
+    }
+    
+    /*
+     * Push a Tcl object holding the result.
+     */
+
+    PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
+    
+    /*
+     * Reflect the change to stackTop back in eePtr.
+     */
+
+    done:
+    Tcl_DecrRefCount(valuePtr);
+    DECACHE_STACK_INFO();
+    return result;
+}
+
+static int
+ExprBinaryFunc(interp, eePtr, clientData)
+    Tcl_Interp *interp;		/* The interpreter in which to execute the
+				 * function. */
+    ExecEnv *eePtr;		/* Points to the environment for executing
+				 * the function. */
+    ClientData clientData;	/* Contains the address of a procedure that
+				 * takes two double arguments and
+				 * returns a double result. */
+{
+    StackItem *stackPtr;        /* Cached evaluation stack base pointer. */
+    register int stackTop;	/* Cached top index of evaluation stack. */
+    register Tcl_Obj *valuePtr, *value2Ptr;
+    Tcl_ObjType *tPtr;
+    double d1, d2, dResult;
+    long i;
+    char *s;
+    int result = TCL_OK;
+    
+    double (*func) _ANSI_ARGS_((double, double))
+	= (double (*)_ANSI_ARGS_((double, double))) clientData;
+
+    /*
+     * Set stackPtr and stackTop from eePtr.
+     */
+    
+    CACHE_STACK_INFO();
+
+    /*
+     * Pop the function's two arguments from the evaluation stack. Convert
+     * them to doubles if necessary.
+     */
+
+    value2Ptr = POP_OBJECT();
+    valuePtr  = POP_OBJECT();
+
+    tPtr = valuePtr->typePtr;
+    if (tPtr == &tclIntType) {
+	d1 = (double) valuePtr->internalRep.longValue;
+    } else if (tPtr == &tclDoubleType) {
+	d1 = valuePtr->internalRep.doubleValue;
+    } else {			/* FAILS IF STRING REP HAS NULLS */
+	s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
+	if (TclLooksLikeInt(s)) {
+	    result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
+	    d1 = (double) valuePtr->internalRep.longValue;
+	} else {
+	    result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d1);
+	}
+	if (result != TCL_OK) {
+            badArg:
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	            "argument to math function didn't have numeric value", -1);
+	    goto done;
+	}
+    }
+
+    tPtr = value2Ptr->typePtr;
+    if (tPtr == &tclIntType) {
+	d2 = value2Ptr->internalRep.longValue;
+    } else if (tPtr == &tclDoubleType) {
+	d2 = value2Ptr->internalRep.doubleValue;
+    } else {			/* FAILS IF STRING REP HAS NULLS */
+	s = Tcl_GetStringFromObj(value2Ptr, (int *) NULL);
+	if (TclLooksLikeInt(s)) {
+	    result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, value2Ptr, &i);
+	    d2 = (double) value2Ptr->internalRep.longValue;
+	} else {
+	    result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, value2Ptr, &d2);
+	}
+	if (result != TCL_OK) {
+	    goto badArg;
+	}
+    }
+
+    errno = 0;
+    dResult = (*func)(d1, d2);
+    if ((errno != 0) || IS_NAN(dResult) || IS_INF(dResult)) {
+	TclExprFloatError(interp, dResult);
+	result = TCL_ERROR;
+	goto done;
+    }
+
+    /*
+     * Push a Tcl object holding the result.
+     */
+
+    PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
+    
+    /*
+     * Reflect the change to stackTop back in eePtr.
+     */
+
+    done:
+    Tcl_DecrRefCount(valuePtr);
+    Tcl_DecrRefCount(value2Ptr);
+    DECACHE_STACK_INFO();
+    return result;
+}
+
+static int
+ExprAbsFunc(interp, eePtr, clientData)
+    Tcl_Interp *interp;		/* The interpreter in which to execute the
+				 * function. */
+    ExecEnv *eePtr;		/* Points to the environment for executing
+				 * the function. */
+    ClientData clientData;	/* Ignored. */
+{
+    StackItem *stackPtr;        /* Cached evaluation stack base pointer. */
+    register int stackTop;	/* Cached top index of evaluation stack. */
+    register Tcl_Obj *valuePtr;
+    Tcl_ObjType *tPtr;
+    long i, iResult;
+    double d, dResult;
+    int result = TCL_OK;
+
+    /*
+     * Set stackPtr and stackTop from eePtr.
+     */
+    
+    CACHE_STACK_INFO();
+
+    /*
+     * Pop the argument from the evaluation stack.
+     */
+
+    valuePtr = POP_OBJECT();
+    tPtr = valuePtr->typePtr;
+    
+    if (tPtr == &tclIntType) {
+	i = valuePtr->internalRep.longValue;
+    } else if (tPtr == &tclDoubleType) {
+	d = valuePtr->internalRep.doubleValue;
+    } else {			/* FAILS IF STRING REP HAS NULLS */
+	char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
+	
+	if (TclLooksLikeInt(s)) {
+	    result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
+	} else {
+	    result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d);
+	}
+	if (result != TCL_OK) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	            "argument to math function didn't have numeric value", -1);
+	    goto done;
+	}
+	tPtr = valuePtr->typePtr;
+    }
+
+    /*
+     * Push a Tcl object with the result.
+     */
+    
+    if (tPtr == &tclIntType) {
+	if (i < 0) {
+	    iResult = -i;
+	    if (iResult < 0) {
+		Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		        "integer value too large to represent", -1);
+		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
+			"integer value too large to represent", (char *) NULL);
+		result = TCL_ERROR;
+		goto done;
+	    }
+	} else {
+	    iResult = i;
+	}	    
+	PUSH_OBJECT(Tcl_NewLongObj(iResult));
+    } else {
+	if (d < 0.0) {
+	    dResult = -d;
+	} else {
+	    dResult = d;
+	}
+	if (IS_NAN(dResult) || IS_INF(dResult)) {
+	    TclExprFloatError(interp, dResult);
+	    result = TCL_ERROR;
+	    goto done;
+	}
+	PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
+    }
+    
+    /*
+     * Reflect the change to stackTop back in eePtr.
+     */
+
+    done:
+    Tcl_DecrRefCount(valuePtr);
+    DECACHE_STACK_INFO();
+    return result;
+}
+
+static int
+ExprDoubleFunc(interp, eePtr, clientData)
+    Tcl_Interp *interp;		/* The interpreter in which to execute the
+				 * function. */
+    ExecEnv *eePtr;		/* Points to the environment for executing
+				 * the function. */
+    ClientData clientData;	/* Ignored. */
+{
+    StackItem *stackPtr;        /* Cached evaluation stack base pointer. */
+    register int stackTop;	/* Cached top index of evaluation stack. */
+    register Tcl_Obj *valuePtr;
+    double dResult;
+    long i;
+    int result = TCL_OK;
+
+    /*
+     * Set stackPtr and stackTop from eePtr.
+     */
+    
+    CACHE_STACK_INFO();
+
+    /*
+     * Pop the argument from the evaluation stack.
+     */
+
+    valuePtr = POP_OBJECT();
+    if (valuePtr->typePtr == &tclIntType) {
+	dResult = (double) valuePtr->internalRep.longValue;
+    } else if (valuePtr->typePtr == &tclDoubleType) {
+	dResult = valuePtr->internalRep.doubleValue;
+    } else {			/* FAILS IF STRING REP HAS NULLS */
+	char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
+	
+	if (TclLooksLikeInt(s)) {
+	    result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
+	    dResult = (double) valuePtr->internalRep.longValue;
+	} else {
+	    result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr,
+		    &dResult);
+	}
+	if (result != TCL_OK) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		    "argument to math function didn't have numeric value", -1);
+	    goto done;
+	}
+    }
+
+    /*
+     * Push a Tcl object with the result.
+     */
+
+    PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
+
+    /*
+     * Reflect the change to stackTop back in eePtr.
+     */
+
+    done:
+    Tcl_DecrRefCount(valuePtr);
+    DECACHE_STACK_INFO();
+    return result;
+}
+
+static int
+ExprIntFunc(interp, eePtr, clientData)
+    Tcl_Interp *interp;		/* The interpreter in which to execute the
+				 * function. */
+    ExecEnv *eePtr;		/* Points to the environment for executing
+				 * the function. */
+    ClientData clientData;	/* Ignored. */
+{
+    StackItem *stackPtr;        /* Cached evaluation stack base pointer. */
+    register int stackTop;	/* Cached top index of evaluation stack. */
+    register Tcl_Obj *valuePtr;
+    Tcl_ObjType *tPtr;
+    long i = 0;			/* Initialized to avoid compiler warning. */
+    long iResult;
+    double d;
+    int result = TCL_OK;
+
+    /*
+     * Set stackPtr and stackTop from eePtr.
+     */
+    
+    CACHE_STACK_INFO();
+
+    /*
+     * Pop the argument from the evaluation stack.
+     */
+
+    valuePtr = POP_OBJECT();
+    tPtr = valuePtr->typePtr;
+    
+    if (tPtr == &tclIntType) {
+	i = valuePtr->internalRep.longValue;
+    } else if (tPtr == &tclDoubleType) {
+	d = valuePtr->internalRep.doubleValue;
+    } else {			/* FAILS IF STRING REP HAS NULLS */
+	char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
+	
+	if (TclLooksLikeInt(s)) {
+	    result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
+	} else {
+	    result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d);
+	}
+	if (result != TCL_OK) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		    "argument to math function didn't have numeric value", -1);
+	    goto done;
+	}
+	tPtr = valuePtr->typePtr;
+    }
+
+    /*
+     * Push a Tcl object with the result.
+     */
+    
+    if (tPtr == &tclIntType) {
+	iResult = i;
+    } else {
+	if (d < 0.0) {
+	    if (d < (double) (long) LONG_MIN) {
+		tooLarge:
+		Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		        "integer value too large to represent", -1);
+		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
+			"integer value too large to represent", (char *) NULL);
+		result = TCL_ERROR;
+		goto done;
+	    }
+	} else {
+	    if (d > (double) LONG_MAX) {
+		goto tooLarge;
+	    }
+	}
+	if (IS_NAN(d) || IS_INF(d)) {
+	    TclExprFloatError(interp, d);
+	    result = TCL_ERROR;
+	    goto done;
+	}
+	iResult = (long) d;
+    }
+    PUSH_OBJECT(Tcl_NewLongObj(iResult));
+
+    /*
+     * Reflect the change to stackTop back in eePtr.
+     */
+
+    done:
+    Tcl_DecrRefCount(valuePtr);
+    DECACHE_STACK_INFO();
+    return result;
+}
+
+static int
+ExprRoundFunc(interp, eePtr, clientData)
+    Tcl_Interp *interp;		/* The interpreter in which to execute the
+				 * function. */
+    ExecEnv *eePtr;		/* Points to the environment for executing
+				 * the function. */
+    ClientData clientData;	/* Ignored. */
+{
+    StackItem *stackPtr;        /* Cached evaluation stack base pointer. */
+    register int stackTop;	/* Cached top index of evaluation stack. */
+    Tcl_Obj *valuePtr;
+    Tcl_ObjType *tPtr;
+    long i = 0;			/* Initialized to avoid compiler warning. */
+    long iResult;
+    double d, temp;
+    int result = TCL_OK;
+
+    /*
+     * Set stackPtr and stackTop from eePtr.
+     */
+    
+    CACHE_STACK_INFO();
+
+    /*
+     * Pop the argument from the evaluation stack.
+     */
+
+    valuePtr = POP_OBJECT();
+    tPtr = valuePtr->typePtr;
+    
+    if (tPtr == &tclIntType) {
+	i = valuePtr->internalRep.longValue;
+    } else if (tPtr == &tclDoubleType) {
+	d = valuePtr->internalRep.doubleValue;
+    } else {			/* FAILS IF STRING REP HAS NULLS */
+	char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
+	
+	if (TclLooksLikeInt(s)) {
+	    result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
+	} else {
+	    result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d);
+	}
+	if (result != TCL_OK) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		    "argument to math function didn't have numeric value", -1);
+	    goto done;
+	}
+	tPtr = valuePtr->typePtr;
+    }
+
+    /*
+     * Push a Tcl object with the result.
+     */
+    
+    if (tPtr == &tclIntType) {
+	iResult = i;
+    } else {
+	if (d < 0.0) {
+	    if (d <= (((double) (long) LONG_MIN) - 0.5)) {
+		tooLarge:
+		Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		        "integer value too large to represent", -1);
+		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
+			"integer value too large to represent",
+			(char *) NULL);
+		result = TCL_ERROR;
+		goto done;
+	    }
+	    temp = (long) (d - 0.5);
+	} else {
+	    if (d >= (((double) LONG_MAX + 0.5))) {
+		goto tooLarge;
+	    }
+	    temp = (long) (d + 0.5);
+	}
+	if (IS_NAN(temp) || IS_INF(temp)) {
+	    TclExprFloatError(interp, temp);
+	    result = TCL_ERROR;
+	    goto done;
+	}
+	iResult = (long) temp;
+    }
+    PUSH_OBJECT(Tcl_NewLongObj(iResult));
+
+    /*
+     * Reflect the change to stackTop back in eePtr.
+     */
+
+    done:
+    Tcl_DecrRefCount(valuePtr);
+    DECACHE_STACK_INFO();
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ExprCallMathFunc --
+ *
+ *	This procedure is invoked to call a non-builtin math function
+ *	during the execution of an expression. 
+ *
+ * Results:
+ *	TCL_OK is returned if all went well and the function's value
+ *	was computed successfully. If an error occurred, TCL_ERROR
+ *	is returned and an error message is left in the interpreter's
+ *	result.	After a successful return this procedure pushes a Tcl object
+ *	holding the result. 
+ *
+ * Side effects:
+ *	None, unless the called math function has side effects.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ExprCallMathFunc(interp, eePtr, objc, objv)
+    Tcl_Interp *interp;		/* The interpreter in which to execute the
+				 * function. */
+    ExecEnv *eePtr;		/* Points to the environment for executing
+				 * the function. */
+    int objc;			/* Number of arguments. The function name is
+				 * the 0-th argument. */
+    Tcl_Obj **objv;		/* The array of arguments. The function name
+				 * is objv[0]. */
+{
+    Interp *iPtr = (Interp *) interp;
+    StackItem *stackPtr;        /* Cached evaluation stack base pointer. */
+    register int stackTop;	/* Cached top index of evaluation stack. */
+    char *funcName;
+    Tcl_HashEntry *hPtr;
+    MathFunc *mathFuncPtr;	/* Information about math function. */
+    Tcl_Value args[MAX_MATH_ARGS]; /* Arguments for function call. */
+    Tcl_Value funcResult;	/* Result of function call as Tcl_Value. */
+    register Tcl_Obj *valuePtr;
+    Tcl_ObjType *tPtr;
+    long i;
+    double d;
+    int j, k, result;
+    
+    Tcl_ResetResult(interp);
+    
+    /*
+     * Set stackPtr and stackTop from eePtr.
+     */
+    
+    CACHE_STACK_INFO();
+
+    /*
+     * Look up the MathFunc record for the function.
+     * THIS FAILS IF THE OBJECT'S STRING REP CONTAINS NULLS.
+     */
+
+    funcName = Tcl_GetStringFromObj(objv[0], (int *) NULL);
+    hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcName);
+    if (hPtr == NULL) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"unknown math function \"", funcName, "\"", (char *) NULL);
+	result = TCL_ERROR;
+	goto done;
+    }
+    mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
+    if (mathFuncPtr->numArgs != (objc-1)) {
+	panic("ExprCallMathFunc: expected number of args %d != actual number %d",
+	        mathFuncPtr->numArgs, objc);
+	result = TCL_ERROR;
+	goto done;
+    }
+
+    /*
+     * Collect the arguments for the function, if there are any, into the
+     * array "args". Note that args[0] will have the Tcl_Value that
+     * corresponds to objv[1].
+     */
+
+    for (j = 1, k = 0;  j < objc;  j++, k++) {
+	valuePtr = objv[j];
+	tPtr = valuePtr->typePtr;
+	
+	if (tPtr == &tclIntType) {
+	    i = valuePtr->internalRep.longValue;
+	} else if (tPtr == &tclDoubleType) {
+	    d = valuePtr->internalRep.doubleValue;
+	} else {
+	    /*
+	     * Try to convert to int first then double.
+	     * FAILS IF STRING REP HAS NULLS.
+	     */
+	    
+	    char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
+	    
+	    if (TclLooksLikeInt(s)) {
+		result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
+	    } else {
+		result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
+			valuePtr, &d);
+	    }
+	    if (result != TCL_OK) {
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+			"argument to math function didn't have numeric value", -1);
+		goto done;
+	    }
+	    tPtr = valuePtr->typePtr;
+	}
+
+	/*
+	 * Copy the object's numeric value to the argument record,
+	 * converting it if necessary. 
+	 */
+	
+	if (tPtr == &tclIntType) {
+	    if (mathFuncPtr->argTypes[k] == TCL_DOUBLE) {
+		args[k].type = TCL_DOUBLE;
+		args[k].doubleValue = i;
+	    } else {
+		args[k].type = TCL_INT;
+		args[k].intValue = i;
+	    }
+	} else {
+	    if (mathFuncPtr->argTypes[k] == TCL_INT) {
+		args[k].type = TCL_INT;
+		args[k].intValue = (long) d;
+	    } else {
+		args[k].type = TCL_DOUBLE;
+		args[k].doubleValue = d;
+	    }
+	}
+    }
+
+    /*
+     * Invoke the function and copy its result back into valuePtr.
+     */
+
+    tcl_MathInProgress++;
+    result = (*mathFuncPtr->proc)(mathFuncPtr->clientData, interp, args,
+	    &funcResult);
+    tcl_MathInProgress--;
+    if (result != TCL_OK) {
+	goto done;
+    }
+
+    /*
+     * Pop the objc top stack elements and decrement their ref counts.
+     */
+		
+    i = (stackTop - (objc-1));
+    while (i <= stackTop) {
+	valuePtr = stackPtr[i].o;
+	Tcl_DecrRefCount(valuePtr);
+	i++;
+    }
+    stackTop -= objc;
+    
+    /*
+     * Push the call's object result.
+     */
+    
+    if (funcResult.type == TCL_INT) {
+	PUSH_OBJECT(Tcl_NewLongObj(funcResult.intValue));
+    } else {
+	d = funcResult.doubleValue;
+	if (IS_NAN(d) || IS_INF(d)) {
+	    TclExprFloatError(interp, d);
+	    result = TCL_ERROR;
+	    goto done;
+	}
+	PUSH_OBJECT(Tcl_NewDoubleObj(d));
+    }
+
+    /*
+     * Reflect the change to stackTop back in eePtr.
+     */
+
+    done:
+    DECACHE_STACK_INFO();
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclExprFloatError --
+ *
+ *	This procedure is called when an error occurs during a
+ *	floating-point operation. It reads errno and sets
+ *	interp->objResultPtr accordingly.
+ *
+ * Results:
+ *	interp->objResultPtr is set to hold an error message.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclExprFloatError(interp, value)
+    Tcl_Interp *interp;		/* Where to store error message. */
+    double value;		/* Value returned after error;  used to
+				 * distinguish underflows from overflows. */
+{
+    char *s;
+
+    Tcl_ResetResult(interp);
+    if ((errno == EDOM) || (value != value)) {
+	s = "domain error: argument not in valid range";
+	Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
+	Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", s, (char *) NULL);
+    } else if ((errno == ERANGE) || IS_INF(value)) {
+	if (value == 0.0) {
+	    s = "floating-point value too small to represent";
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
+	    Tcl_SetErrorCode(interp, "ARITH", "UNDERFLOW", s, (char *) NULL);
+	} else {
+	    s = "floating-point value too large to represent";
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
+	    Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, (char *) NULL);
+	}
+    } else {			/* FAILS IF STRING REP CONTAINS NULLS */
+	char msg[100];
+	
+	sprintf(msg, "unknown floating-point error, errno = %d", errno);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp), msg, -1);
+	Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN", msg, (char *) NULL);
+    }
+}
+
+
+#ifdef TCL_COMPILE_STATS
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLog2 --
+ *
+ *	Procedure used while collecting compilation statistics to determine
+ *	the log base 2 of an integer.
+ *
+ * Results:
+ *	Returns the log base 2 of the operand. If the argument is less
+ *	than or equal to zero, a zero is returned.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclLog2(value)
+    register int value;		/* The integer for which to compute the
+				 * log base 2. */
+{
+    register int n = value;
+    register int result = 0;
+
+    while (n > 1) {
+	n = n >> 1;
+	result++;
+    }
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EvalStatsCmd --
+ *
+ *	Implements the "evalstats" command that prints instruction execution
+ *	counts to stdout.
+ *
+ * Results:
+ *	Standard Tcl results.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+EvalStatsCmd(unused, interp, argc, argv)
+    ClientData unused;		/* Unused. */
+    Tcl_Interp *interp;		/* The current interpreter. */
+    int argc;			/* The number of arguments. */
+    char **argv;		/* The argument strings. */
+{
+    register double total = 0.0;
+    register int i;
+    int maxSizeDecade = 0;
+    double totalHeaderBytes = (tclNumCompilations * sizeof(ByteCode));
+
+    for (i = 0;  i < 256;  i++) {
+        if (instructionCount[i] != 0) {
+            total += instructionCount[i];
+        }
+    }
+
+    for (i = 31;  i >= 0;  i--) {
+        if ((tclSourceCount[i] > 0) && (tclByteCodeCount[i] > 0)) {
+            maxSizeDecade = i;
+	    break;
+        }
+    } 
+
+    fprintf(stdout, "\nNumber of compilations		%ld\n",
+	    tclNumCompilations);
+    fprintf(stdout, "Number of executions		%ld\n",
+	    numExecutions);
+    fprintf(stdout, "Average executions/compilation	%.0f\n",
+	    ((float) numExecutions/tclNumCompilations));
+    
+    fprintf(stdout, "\nInstructions executed		%.0f\n",
+	    total);
+    fprintf(stdout, "Average instructions/compile	%.0f\n",
+	    total/tclNumCompilations);
+    fprintf(stdout, "Average instructions/execution	%.0f\n",
+	    total/numExecutions);
+    
+    fprintf(stdout, "\nTotal source bytes		%.6g\n",
+	    tclTotalSourceBytes);
+    fprintf(stdout, "Total code bytes		%.6g\n",
+	    tclTotalCodeBytes);
+    fprintf(stdout, "Average code/compilation	%.0f\n",
+	    tclTotalCodeBytes/tclNumCompilations);
+    fprintf(stdout, "Average code/source		%.2f\n",
+	    tclTotalCodeBytes/tclTotalSourceBytes);
+    fprintf(stdout, "Current source bytes		%.6g\n",
+	    tclCurrentSourceBytes);
+    fprintf(stdout, "Current code bytes		%.6g\n",
+	    tclCurrentCodeBytes);
+    fprintf(stdout, "Current code/source		%.2f\n",
+	    tclCurrentCodeBytes/tclCurrentSourceBytes);
+    
+    fprintf(stdout, "\nTotal objects allocated		%ld\n",
+	    tclObjsAlloced);
+    fprintf(stdout, "Total objects freed		%ld\n",
+	    tclObjsFreed);
+    fprintf(stdout, "Current objects:	 	%ld\n",
+	    (tclObjsAlloced - tclObjsFreed));
+
+    fprintf(stdout, "\nBreakdown of code byte requirements:\n");
+    fprintf(stdout, "                   Total bytes      Pct of    Avg per\n");
+    fprintf(stdout, "                                  all code    compile\n");
+    fprintf(stdout, "Total code        %12.6g        100%%   %8.2f\n",
+	    tclTotalCodeBytes, tclTotalCodeBytes/tclNumCompilations);
+    fprintf(stdout, "Header            %12.6g   %8.2f%%   %8.2f\n",
+	    totalHeaderBytes,
+	    ((totalHeaderBytes * 100.0) / tclTotalCodeBytes),
+	    totalHeaderBytes/tclNumCompilations);
+    fprintf(stdout, "Instructions      %12.6g   %8.2f%%   %8.2f\n",
+	    tclTotalInstBytes,
+	    ((tclTotalInstBytes * 100.0) / tclTotalCodeBytes),
+	    tclTotalInstBytes/tclNumCompilations);
+    fprintf(stdout, "Objects           %12.6g   %8.2f%%   %8.2f\n",
+	    tclTotalObjBytes,
+	    ((tclTotalObjBytes * 100.0) / tclTotalCodeBytes),
+	    tclTotalObjBytes/tclNumCompilations);
+    fprintf(stdout, "Exception table   %12.6g   %8.2f%%   %8.2f\n",
+	    tclTotalExceptBytes,
+	    ((tclTotalExceptBytes * 100.0) / tclTotalCodeBytes),
+	    tclTotalExceptBytes/tclNumCompilations);
+    fprintf(stdout, "Auxiliary data    %12.6g   %8.2f%%   %8.2f\n",
+	    tclTotalAuxBytes,
+	    ((tclTotalAuxBytes * 100.0) / tclTotalCodeBytes),
+	    tclTotalAuxBytes/tclNumCompilations);
+    fprintf(stdout, "Command map       %12.6g   %8.2f%%   %8.2f\n",
+	    tclTotalCmdMapBytes,
+	    ((tclTotalCmdMapBytes * 100.0) / tclTotalCodeBytes),
+	    tclTotalCmdMapBytes/tclNumCompilations);
+    
+    fprintf(stdout, "\nSource and ByteCode size distributions:\n");
+    fprintf(stdout, "	 binary decade		source	  code\n");
+    for (i = 0;  i <= maxSizeDecade;  i++) {
+	int decadeLow, decadeHigh;
+
+	if (i == 0) {
+	    decadeLow = 0;
+	} else {
+	    decadeLow = 1 << i;
+	}
+	decadeHigh = (1 << (i+1)) - 1;
+        fprintf(stdout,	"	%6d -%6d		%6d	%6d\n",
+		decadeLow, decadeHigh,
+		tclSourceCount[i], tclByteCodeCount[i]);
+    }
+
+    fprintf(stdout, "\nInstruction counts:\n");
+    for (i = 0;  i < 256;  i++) {
+        if (instructionCount[i]) {
+            fprintf(stdout, "%20s %8d %6.2f%%\n",
+		    opName[i], instructionCount[i],
+		    (instructionCount[i] * 100.0)/total);
+        }
+    }
+
+#ifdef TCL_MEM_DEBUG
+    fprintf(stdout, "\nHeap Statistics:\n");
+    TclDumpMemoryInfo(stdout);
+#endif /* TCL_MEM_DEBUG */
+
+    return TCL_OK;
+}
+#endif /* TCL_COMPILE_STATS */
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetCommandFromObj --
+ *
+ *      Returns the command specified by the name in a Tcl_Obj.
+ *
+ * Results:
+ *	Returns a token for the command if it is found. Otherwise, if it
+ *	can't be found or there is an error, returns NULL.
+ *
+ * Side effects:
+ *      May update the internal representation for the object, caching
+ *      the command reference so that the next time this procedure is
+ *	called with the same object, the command can be found quickly.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Command
+Tcl_GetCommandFromObj(interp, objPtr)
+    Tcl_Interp *interp;		/* The interpreter in which to resolve the
+				 * command and to report errors. */
+    register Tcl_Obj *objPtr;	/* The object containing the command's
+				 * name. If the name starts with "::", will
+				 * be looked up in global namespace. Else,
+				 * looked up first in the current namespace
+				 * if contextNsPtr is NULL, then in global
+				 * namespace. */
+{
+    Interp *iPtr = (Interp *) interp;
+    register ResolvedCmdName *resPtr;
+    register Command *cmdPtr;
+    Namespace *currNsPtr;
+    int result;
+
+    /*
+     * Get the internal representation, converting to a command type if
+     * needed. The internal representation is a ResolvedCmdName that points
+     * to the actual command.
+     */
+    
+    if (objPtr->typePtr != &tclCmdNameType) {
+        result = tclCmdNameType.setFromAnyProc(interp, objPtr);
+        if (result != TCL_OK) {
+            return (Tcl_Command) NULL;
+        }
+    }
+    resPtr = (ResolvedCmdName *) objPtr->internalRep.otherValuePtr;
+
+    /*
+     * Get the current namespace.
+     */
+    
+    if (iPtr->varFramePtr != NULL) {
+	currNsPtr = iPtr->varFramePtr->nsPtr;
+    } else {
+	currNsPtr = iPtr->globalNsPtr;
+    }
+
+    /*
+     * Check the context namespace and the namespace epoch of the resolved
+     * symbol to make sure that it is fresh. If not, then force another
+     * conversion to the command type, to discard the old rep and create a
+     * new one. Note that we verify that the namespace id of the context
+     * namespace is the same as the one we cached; this insures that the
+     * namespace wasn't deleted and a new one created at the same address
+     * with the same command epoch.
+     */
+    
+    cmdPtr = NULL;
+    if ((resPtr != NULL)
+	    && (resPtr->refNsPtr == currNsPtr)
+	    && (resPtr->refNsId == currNsPtr->nsId)
+	    && (resPtr->refNsCmdEpoch == currNsPtr->cmdRefEpoch)) {
+        cmdPtr = resPtr->cmdPtr;
+        if (cmdPtr->cmdEpoch != resPtr->cmdEpoch) {
+            cmdPtr = NULL;
+        }
+    }
+
+    if (cmdPtr == NULL) {
+        result = tclCmdNameType.setFromAnyProc(interp, objPtr);
+        if (result != TCL_OK) {
+            return (Tcl_Command) NULL;
+        }
+        resPtr = (ResolvedCmdName *) objPtr->internalRep.otherValuePtr;
+        if (resPtr != NULL) {
+            cmdPtr = resPtr->cmdPtr;
+        }
+    }
+
+    if (cmdPtr == NULL) {
+	return (Tcl_Command) NULL;
+    }
+    return (Tcl_Command) cmdPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeCmdNameInternalRep --
+ *
+ *	Frees the resources associated with a cmdName object's internal
+ *	representation.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Decrements the ref count of any cached ResolvedCmdName structure
+ *	pointed to by the cmdName's internal representation. If this is 
+ *	the last use of the ResolvedCmdName, it is freed. This in turn
+ *	decrements the ref count of the Command structure pointed to by 
+ *	the ResolvedSymbol, which may free the Command structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeCmdNameInternalRep(objPtr)
+    register Tcl_Obj *objPtr;	/* CmdName object with internal
+				 * representation to free. */
+{
+    register ResolvedCmdName *resPtr =
+	(ResolvedCmdName *) objPtr->internalRep.otherValuePtr;
+
+    if (resPtr != NULL) {
+	/*
+	 * Decrement the reference count of the ResolvedCmdName structure.
+	 * If there are no more uses, free the ResolvedCmdName structure.
+	 */
+    
+        resPtr->refCount--;
+        if (resPtr->refCount == 0) {
+            /*
+	     * Now free the cached command, unless it is still in its
+             * hash table or if there are other references to it
+             * from other cmdName objects.
+	     */
+	    
+            Command *cmdPtr = resPtr->cmdPtr;
+            TclCleanupCommand(cmdPtr);
+            ckfree((char *) resPtr);
+        }
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupCmdNameInternalRep --
+ *
+ *	Initialize the internal representation of an cmdName Tcl_Obj to a
+ *	copy of the internal representation of an existing cmdName object. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	"copyPtr"s internal rep is set to point to the ResolvedCmdName
+ *	structure corresponding to "srcPtr"s internal rep. Increments the
+ *	ref count of the ResolvedCmdName structure pointed to by the
+ *	cmdName's internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupCmdNameInternalRep(srcPtr, copyPtr)
+    Tcl_Obj *srcPtr;		/* Object with internal rep to copy. */
+    register Tcl_Obj *copyPtr;	/* Object with internal rep to set. */
+{
+    register ResolvedCmdName *resPtr =
+        (ResolvedCmdName *) srcPtr->internalRep.otherValuePtr;
+
+    copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
+    copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
+    if (resPtr != NULL) {
+        resPtr->refCount++;
+    }
+    copyPtr->typePtr = &tclCmdNameType;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetCmdNameFromAny --
+ *
+ *	Generate an cmdName internal form for the Tcl object "objPtr".
+ *
+ * Results:
+ *	The return value is a standard Tcl result. The conversion always
+ *	succeeds and TCL_OK is returned.
+ *
+ * Side effects:
+ *	A pointer to a ResolvedCmdName structure that holds a cached pointer
+ *	to the command with a name that matches objPtr's string rep is
+ *	stored as objPtr's internal representation. This ResolvedCmdName
+ *	pointer will be NULL if no matching command was found. The ref count
+ *	of the cached Command's structure (if any) is also incremented.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetCmdNameFromAny(interp, objPtr)
+    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr;	/* The object to convert. */
+{
+    Interp *iPtr = (Interp *) interp;
+    char *name;
+    Tcl_Command cmd;
+    register Command *cmdPtr;
+    Namespace *currNsPtr;
+    register ResolvedCmdName *resPtr;
+
+    /*
+     * Get "objPtr"s string representation. Make it up-to-date if necessary.
+     */
+
+    name = objPtr->bytes;
+    if (name == NULL) {
+	name = Tcl_GetStringFromObj(objPtr, (int *) NULL);
+    }
+
+    /*
+     * Find the Command structure, if any, that describes the command called
+     * "name". Build a ResolvedCmdName that holds a cached pointer to this
+     * Command, and bump the reference count in the referenced Command
+     * structure. A Command structure will not be deleted as long as it is
+     * referenced from a CmdName object.
+     */
+
+    cmd = Tcl_FindCommand(interp, name, (Tcl_Namespace *) NULL,
+	    /*flags*/ 0);
+    cmdPtr = (Command *) cmd;
+    if (cmdPtr != NULL) {
+	/*
+	 * Get the current namespace.
+	 */
+	
+	if (iPtr->varFramePtr != NULL) {
+	    currNsPtr = iPtr->varFramePtr->nsPtr;
+	} else {
+	    currNsPtr = iPtr->globalNsPtr;
+	}
+	
+	cmdPtr->refCount++;
+        resPtr = (ResolvedCmdName *) ckalloc(sizeof(ResolvedCmdName));
+        resPtr->cmdPtr        = cmdPtr;
+        resPtr->refNsPtr      = currNsPtr;
+        resPtr->refNsId       = currNsPtr->nsId;
+        resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
+        resPtr->cmdEpoch      = cmdPtr->cmdEpoch;
+        resPtr->refCount      = 1;
+    } else {
+	resPtr = NULL;	/* no command named "name" was found */
+    }
+
+    /*
+     * Free the old internalRep before setting the new one. We do this as
+     * late as possible to allow the conversion code, in particular
+     * GetStringFromObj, to use that old internalRep. If no Command
+     * structure was found, leave NULL as the cached value.
+     */
+
+    if ((objPtr->typePtr != NULL)
+	    && (objPtr->typePtr->freeIntRepProc != NULL)) {
+	objPtr->typePtr->freeIntRepProc(objPtr);
+    }
+    
+    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
+    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+    objPtr->typePtr = &tclCmdNameType;
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfCmdName --
+ *
+ *	Update the string representation for an cmdName object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Generates a panic. 
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfCmdName(objPtr)
+    Tcl_Obj *objPtr;		/* CmdName obj to update string rep. */
+{
+    /*
+     * This procedure is never invoked since the internal representation of
+     * a cmdName object is never modified.
+     */
+
+    panic("UpdateStringOfCmdName should never be invoked");
+}
+
+
+#ifdef TCL_COMPILE_DEBUG
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringForResultCode --
+ *
+ *	Procedure that returns a human-readable string representing a
+ *	Tcl result code such as TCL_ERROR. 
+ *
+ * Results:
+ *	If the result code is one of the standard Tcl return codes, the
+ *	result is a string representing that code such as "TCL_ERROR".
+ *	Otherwise, the result string is that code formatted as a
+ *	sequence of decimal digit characters. Note that the resulting
+ *	string must not be modified by the caller.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+StringForResultCode(result)
+    int result;			/* The Tcl result code for which to
+				 * generate a string. */
+{
+    static char buf[20];
+    
+    if ((result >= TCL_OK) && (result <= TCL_CONTINUE)) {
+	return resultStrings[result];
+    }
+    TclFormatInt(buf, result);
+    return buf;
+}
+#endif /* TCL_COMPILE_DEBUG */
Index: /trunk/tcl/tclGet.c
===================================================================
--- /trunk/tcl/tclGet.c	(revision 2)
+++ /trunk/tcl/tclGet.c	(revision 2)
@@ -0,0 +1,332 @@
+/* 
+ * tclGet.c --
+ *
+ *	This file contains procedures to convert strings into
+ *	other forms, like integers or floating-point numbers or
+ *	booleans, doing syntax checking along the way.
+ *
+ * Copyright (c) 1990-1993 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclGet.c,v 1.1 2008-06-04 13:58:06 demin Exp $
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetInt --
+ *
+ *	Given a string, produce the corresponding integer value.
+ *
+ * Results:
+ *	The return value is normally TCL_OK;  in this case *intPtr
+ *	will be set to the integer value equivalent to string.  If
+ *	string is improperly formed then TCL_ERROR is returned and
+ *	an error message will be left in interp->result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetInt(interp, string, intPtr)
+    Tcl_Interp *interp;		/* Interpreter to use for error reporting. */
+    char *string;		/* String containing a (possibly signed)
+				 * integer in a form acceptable to strtol. */
+    int *intPtr;		/* Place to store converted result. */
+{
+    char *end, *p;
+    long i;
+
+    /*
+     * Note: use strtoul instead of strtol for integer conversions
+     * to allow full-size unsigned numbers, but don't depend on strtoul
+     * to handle sign characters;  it won't in some implementations.
+     */
+
+    errno = 0;
+    for (p = string; isspace(UCHAR(*p)); p++) {
+	/* Empty loop body. */
+    }
+    if (*p == '-') {
+	p++;
+	i = -((long)strtoul(p, &end, 0));
+    } else if (*p == '+') {
+	p++;
+	i = strtoul(p, &end, 0);
+    } else {
+	i = strtoul(p, &end, 0);
+    }
+    if (end == p) {
+	badInteger:
+        if (interp != (Tcl_Interp *) NULL) {
+            Tcl_AppendResult(interp, "expected integer but got \"", string,
+                    "\"", (char *) NULL);
+        }
+	return TCL_ERROR;
+    }
+
+    /*
+     * The second test below is needed on platforms where "long" is
+     * larger than "int" to detect values that fit in a long but not in
+     * an int.
+     */
+
+    if ((errno == ERANGE) || (((long)(int) i) != i)) {
+        if (interp != (Tcl_Interp *) NULL) {
+	    Tcl_SetResult(interp, "integer value too large to represent",
+		    TCL_STATIC);
+            Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
+                    interp->result, (char *) NULL);
+        }
+	return TCL_ERROR;
+    }
+    while ((*end != '\0') && isspace(UCHAR(*end))) {
+	end++;
+    }
+    if (*end != 0) {
+	goto badInteger;
+    }
+    *intPtr = (int) i;
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetLong --
+ *
+ *	Given a string, produce the corresponding long integer value.
+ *	This routine is a version of Tcl_GetInt but returns a "long"
+ *	instead of an "int".
+ *
+ * Results:
+ *	The return value is normally TCL_OK; in this case *longPtr
+ *	will be set to the long integer value equivalent to string. If
+ *	string is improperly formed then TCL_ERROR is returned and
+ *	an error message will be left in interp->result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclGetLong(interp, string, longPtr)
+    Tcl_Interp *interp;		/* Interpreter used for error reporting. */
+    char *string;		/* String containing a (possibly signed)
+				 * long integer in a form acceptable to
+				 * strtoul. */
+    long *longPtr;		/* Place to store converted long result. */
+{
+    char *end, *p;
+    long i;
+
+    /*
+     * Note: don't depend on strtoul to handle sign characters; it won't
+     * in some implementations.
+     */
+
+    errno = 0;
+    for (p = string; isspace(UCHAR(*p)); p++) {
+	/* Empty loop body. */
+    }
+    if (*p == '-') {
+	p++;
+	i = -(int)strtoul(p, &end, 0);
+    } else if (*p == '+') {
+	p++;
+	i = strtoul(p, &end, 0);
+    } else {
+	i = strtoul(p, &end, 0);
+    }
+    if (end == p) {
+	badInteger:
+        if (interp != (Tcl_Interp *) NULL) {
+            Tcl_AppendResult(interp, "expected integer but got \"", string,
+                    "\"", (char *) NULL);
+        }
+	return TCL_ERROR;
+    }
+    if (errno == ERANGE) {
+        if (interp != (Tcl_Interp *) NULL) {
+	    Tcl_SetResult(interp, "integer value too large to represent",
+		    TCL_STATIC);
+            Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
+                    interp->result, (char *) NULL);
+        }
+	return TCL_ERROR;
+    }
+    while ((*end != '\0') && isspace(UCHAR(*end))) {
+	end++;
+    }
+    if (*end != 0) {
+	goto badInteger;
+    }
+    *longPtr = i;
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetDouble --
+ *
+ *	Given a string, produce the corresponding double-precision
+ *	floating-point value.
+ *
+ * Results:
+ *	The return value is normally TCL_OK; in this case *doublePtr
+ *	will be set to the double-precision value equivalent to string.
+ *	If string is improperly formed then TCL_ERROR is returned and
+ *	an error message will be left in interp->result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetDouble(interp, string, doublePtr)
+    Tcl_Interp *interp;		/* Interpreter used for error reporting. */
+    char *string;		/* String containing a floating-point number
+				 * in a form acceptable to strtod. */
+    double *doublePtr;		/* Place to store converted result. */
+{
+    char *end;
+    double d;
+
+    errno = 0;
+    d = strtod(string, &end);
+    if (end == string) {
+	badDouble:
+        if (interp != (Tcl_Interp *) NULL) {
+            Tcl_AppendResult(interp,
+                    "expected floating-point number but got \"",
+                    string, "\"", (char *) NULL);
+        }
+	return TCL_ERROR;
+    }
+    if (errno != 0) {
+        if (interp != (Tcl_Interp *) NULL) {
+            TclExprFloatError(interp, d); /* sets interp->objResult */
+
+	    /*
+	     * Move the interpreter's object result to the string result, 
+	     * then reset the object result.
+	     * FAILS IF OBJECT RESULT'S STRING REPRESENTATION HAS NULLS.
+	     */
+
+	    Tcl_SetResult(interp,
+	            TclGetStringFromObj(Tcl_GetObjResult(interp),
+			    (int *) NULL),
+	            TCL_VOLATILE);
+        }
+	return TCL_ERROR;
+    }
+    while ((*end != 0) && isspace(UCHAR(*end))) {
+	end++;
+    }
+    if (*end != 0) {
+	goto badDouble;
+    }
+    *doublePtr = d;
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetBoolean --
+ *
+ *	Given a string, return a 0/1 boolean value corresponding
+ *	to the string.
+ *
+ * Results:
+ *	The return value is normally TCL_OK;  in this case *boolPtr
+ *	will be set to the 0/1 value equivalent to string.  If
+ *	string is improperly formed then TCL_ERROR is returned and
+ *	an error message will be left in interp->result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetBoolean(interp, string, boolPtr)
+    Tcl_Interp *interp;		/* Interpreter used for error reporting. */
+    char *string;		/* String containing a boolean number
+				 * specified either as 1/0 or true/false or
+				 * yes/no. */
+    int *boolPtr;		/* Place to store converted result, which
+				 * will be 0 or 1. */
+{
+    int i;
+    char lowerCase[10], c;
+    size_t length;
+
+    /*
+     * Convert the input string to all lower-case.
+     */
+
+    for (i = 0; i < 9; i++) {
+	c = string[i];
+	if (c == 0) {
+	    break;
+	}
+	if ((c >= 'A') && (c <= 'Z')) {
+	    c += (char) ('a' - 'A');
+	}
+	lowerCase[i] = c;
+    }
+    lowerCase[i] = 0;
+
+    length = strlen(lowerCase);
+    c = lowerCase[0];
+    if ((c == '0') && (lowerCase[1] == '\0')) {
+	*boolPtr = 0;
+    } else if ((c == '1') && (lowerCase[1] == '\0')) {
+	*boolPtr = 1;
+    } else if ((c == 'y') && (strncmp(lowerCase, "yes", length) == 0)) {
+	*boolPtr = 1;
+    } else if ((c == 'n') && (strncmp(lowerCase, "no", length) == 0)) {
+	*boolPtr = 0;
+    } else if ((c == 't') && (strncmp(lowerCase, "true", length) == 0)) {
+	*boolPtr = 1;
+    } else if ((c == 'f') && (strncmp(lowerCase, "false", length) == 0)) {
+	*boolPtr = 0;
+    } else if ((c == 'o') && (length >= 2)) {
+	if (strncmp(lowerCase, "on", length) == 0) {
+	    *boolPtr = 1;
+	} else if (strncmp(lowerCase, "off", length) == 0) {
+	    *boolPtr = 0;
+	} else {
+	    goto badBoolean;
+	}
+    } else {
+	badBoolean:
+        if (interp != (Tcl_Interp *) NULL) {
+            Tcl_AppendResult(interp, "expected boolean value but got \"",
+                    string, "\"", (char *) NULL);
+        }
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
Index: /trunk/tcl/tclHash.c
===================================================================
--- /trunk/tcl/tclHash.c	(revision 2)
+++ /trunk/tcl/tclHash.c	(revision 2)
@@ -0,0 +1,937 @@
+/* 
+ * tclHash.c --
+ *
+ *	Implementation of in-memory hash tables for Tcl and Tcl-based
+ *	applications.
+ *
+ * Copyright (c) 1991-1993 The Regents of the University of California.
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclHash.c,v 1.1 2008-06-04 13:58:06 demin Exp $
+ */
+
+#include "tclInt.h"
+
+/*
+ * When there are this many entries per bucket, on average, rebuild
+ * the hash table to make it larger.
+ */
+
+#define REBUILD_MULTIPLIER	3
+
+
+/*
+ * The following macro takes a preliminary integer hash value and
+ * produces an index into a hash tables bucket list.  The idea is
+ * to make it so that preliminary values that are arbitrarily similar
+ * will end up in different buckets.  The hash function was taken
+ * from a random-number generator.
+ */
+
+#define RANDOM_INDEX(tablePtr, i) \
+    (((((long) (i))*1103515245) >> (tablePtr)->downShift) & (tablePtr)->mask)
+
+/*
+ * Procedure prototypes for static procedures in this file:
+ */
+
+static Tcl_HashEntry *	ArrayFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
+			    CONST char *key));
+static Tcl_HashEntry *	ArrayCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
+			    CONST char *key, int *newPtr));
+static Tcl_HashEntry *	BogusFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
+			    CONST char *key));
+static Tcl_HashEntry *	BogusCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
+			    CONST char *key, int *newPtr));
+static unsigned int	HashString _ANSI_ARGS_((CONST char *string));
+static void		RebuildTable _ANSI_ARGS_((Tcl_HashTable *tablePtr));
+static Tcl_HashEntry *	StringFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
+			    CONST char *key));
+static Tcl_HashEntry *	StringCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
+			    CONST char *key, int *newPtr));
+static Tcl_HashEntry *	OneWordFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
+			    CONST char *key));
+static Tcl_HashEntry *	OneWordCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
+			    CONST char *key, int *newPtr));
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_InitHashTable --
+ *
+ *	Given storage for a hash table, set up the fields to prepare
+ *	the hash table for use.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	TablePtr is now ready to be passed to Tcl_FindHashEntry and
+ *	Tcl_CreateHashEntry.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_InitHashTable(tablePtr, keyType)
+    register Tcl_HashTable *tablePtr;	/* Pointer to table record, which
+					 * is supplied by the caller. */
+    int keyType;			/* Type of keys to use in table:
+					 * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,
+					 * or an integer >= 2. */
+{
+    tablePtr->buckets = tablePtr->staticBuckets;
+    tablePtr->staticBuckets[0] = tablePtr->staticBuckets[1] = 0;
+    tablePtr->staticBuckets[2] = tablePtr->staticBuckets[3] = 0;
+    tablePtr->numBuckets = TCL_SMALL_HASH_TABLE;
+    tablePtr->numEntries = 0;
+    tablePtr->rebuildSize = TCL_SMALL_HASH_TABLE*REBUILD_MULTIPLIER;
+    tablePtr->downShift = 28;
+    tablePtr->mask = 3;
+    tablePtr->keyType = keyType;
+    if (keyType == TCL_STRING_KEYS) {
+	tablePtr->findProc = StringFind;
+	tablePtr->createProc = StringCreate;
+    } else if (keyType == TCL_ONE_WORD_KEYS) {
+	tablePtr->findProc = OneWordFind;
+	tablePtr->createProc = OneWordCreate;
+    } else {
+	tablePtr->findProc = ArrayFind;
+	tablePtr->createProc = ArrayCreate;
+    };
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteHashEntry --
+ *
+ *	Remove a single entry from a hash table.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The entry given by entryPtr is deleted from its table and
+ *	should never again be used by the caller.  It is up to the
+ *	caller to free the clientData field of the entry, if that
+ *	is relevant.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DeleteHashEntry(entryPtr)
+    Tcl_HashEntry *entryPtr;
+{
+    register Tcl_HashEntry *prevPtr;
+
+    if (*entryPtr->bucketPtr == entryPtr) {
+	*entryPtr->bucketPtr = entryPtr->nextPtr;
+    } else {
+	for (prevPtr = *entryPtr->bucketPtr; ; prevPtr = prevPtr->nextPtr) {
+	    if (prevPtr == NULL) {
+		panic("malformed bucket chain in Tcl_DeleteHashEntry");
+	    }
+	    if (prevPtr->nextPtr == entryPtr) {
+		prevPtr->nextPtr = entryPtr->nextPtr;
+		break;
+	    }
+	}
+    }
+    entryPtr->tablePtr->numEntries--;
+    ckfree((char *) entryPtr);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteHashTable --
+ *
+ *	Free up everything associated with a hash table except for
+ *	the record for the table itself.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The hash table is no longer useable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DeleteHashTable(tablePtr)
+    register Tcl_HashTable *tablePtr;		/* Table to delete. */
+{
+    register Tcl_HashEntry *hPtr, *nextPtr;
+    int i;
+
+    /*
+     * Free up all the entries in the table.
+     */
+
+    for (i = 0; i < tablePtr->numBuckets; i++) {
+	hPtr = tablePtr->buckets[i];
+	while (hPtr != NULL) {
+	    nextPtr = hPtr->nextPtr;
+	    ckfree((char *) hPtr);
+	    hPtr = nextPtr;
+	}
+    }
+
+    /*
+     * Free up the bucket array, if it was dynamically allocated.
+     */
+
+    if (tablePtr->buckets != tablePtr->staticBuckets) {
+	ckfree((char *) tablePtr->buckets);
+    }
+
+    /*
+     * Arrange for panics if the table is used again without
+     * re-initialization.
+     */
+
+    tablePtr->findProc = BogusFind;
+    tablePtr->createProc = BogusCreate;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FirstHashEntry --
+ *
+ *	Locate the first entry in a hash table and set up a record
+ *	that can be used to step through all the remaining entries
+ *	of the table.
+ *
+ * Results:
+ *	The return value is a pointer to the first entry in tablePtr,
+ *	or NULL if tablePtr has no entries in it.  The memory at
+ *	*searchPtr is initialized so that subsequent calls to
+ *	Tcl_NextHashEntry will return all of the entries in the table,
+ *	one at a time.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_HashEntry *
+Tcl_FirstHashEntry(tablePtr, searchPtr)
+    Tcl_HashTable *tablePtr;		/* Table to search. */
+    Tcl_HashSearch *searchPtr;		/* Place to store information about
+					 * progress through the table. */
+{
+    searchPtr->tablePtr = tablePtr;
+    searchPtr->nextIndex = 0;
+    searchPtr->nextEntryPtr = NULL;
+    return Tcl_NextHashEntry(searchPtr);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NextHashEntry --
+ *
+ *	Once a hash table enumeration has been initiated by calling
+ *	Tcl_FirstHashEntry, this procedure may be called to return
+ *	successive elements of the table.
+ *
+ * Results:
+ *	The return value is the next entry in the hash table being
+ *	enumerated, or NULL if the end of the table is reached.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_HashEntry *
+Tcl_NextHashEntry(searchPtr)
+    register Tcl_HashSearch *searchPtr;	/* Place to store information about
+					 * progress through the table.  Must
+					 * have been initialized by calling
+					 * Tcl_FirstHashEntry. */
+{
+    Tcl_HashEntry *hPtr;
+
+    while (searchPtr->nextEntryPtr == NULL) {
+	if (searchPtr->nextIndex >= searchPtr->tablePtr->numBuckets) {
+	    return NULL;
+	}
+	searchPtr->nextEntryPtr =
+		searchPtr->tablePtr->buckets[searchPtr->nextIndex];
+	searchPtr->nextIndex++;
+    }
+    hPtr = searchPtr->nextEntryPtr;
+    searchPtr->nextEntryPtr = hPtr->nextPtr;
+    return hPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_HashStats --
+ *
+ *	Return statistics describing the layout of the hash table
+ *	in its hash buckets.
+ *
+ * Results:
+ *	The return value is a malloc-ed string containing information
+ *	about tablePtr.  It is the caller's responsibility to free
+ *	this string.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_HashStats(tablePtr)
+    Tcl_HashTable *tablePtr;		/* Table for which to produce stats. */
+{
+#define NUM_COUNTERS 10
+    int count[NUM_COUNTERS], overflow, i, j;
+    double average, tmp;
+    register Tcl_HashEntry *hPtr;
+    char *result, *p;
+
+    /*
+     * Compute a histogram of bucket usage.
+     */
+
+    for (i = 0; i < NUM_COUNTERS; i++) {
+	count[i] = 0;
+    }
+    overflow = 0;
+    average = 0.0;
+    for (i = 0; i < tablePtr->numBuckets; i++) {
+	j = 0;
+	for (hPtr = tablePtr->buckets[i]; hPtr != NULL; hPtr = hPtr->nextPtr) {
+	    j++;
+	}
+	if (j < NUM_COUNTERS) {
+	    count[j]++;
+	} else {
+	    overflow++;
+	}
+	tmp = j;
+	average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0;
+    }
+
+    /*
+     * Print out the histogram and a few other pieces of information.
+     */
+
+    result = (char *) ckalloc((unsigned) ((NUM_COUNTERS*60) + 300));
+    sprintf(result, "%d entries in table, %d buckets\n",
+	    tablePtr->numEntries, tablePtr->numBuckets);
+    p = result + strlen(result);
+    for (i = 0; i < NUM_COUNTERS; i++) {
+	sprintf(p, "number of buckets with %d entries: %d\n",
+		i, count[i]);
+	p += strlen(p);
+    }
+    sprintf(p, "number of buckets with %d or more entries: %d\n",
+	    NUM_COUNTERS, overflow);
+    p += strlen(p);
+    sprintf(p, "average search distance for entry: %.1f", average);
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * HashString --
+ *
+ *	Compute a one-word summary of a text string, which can be
+ *	used to generate a hash index.
+ *
+ * Results:
+ *	The return value is a one-word summary of the information in
+ *	string.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static unsigned int
+HashString(string)
+    register CONST char *string;/* String from which to compute hash value. */
+{
+    register unsigned int result;
+    register int c;
+
+    /*
+     * I tried a zillion different hash functions and asked many other
+     * people for advice.  Many people had their own favorite functions,
+     * all different, but no-one had much idea why they were good ones.
+     * I chose the one below (multiply by 9 and add new character)
+     * because of the following reasons:
+     *
+     * 1. Multiplying by 10 is perfect for keys that are decimal strings,
+     *    and multiplying by 9 is just about as good.
+     * 2. Times-9 is (shift-left-3) plus (old).  This means that each
+     *    character's bits hang around in the low-order bits of the
+     *    hash value for ever, plus they spread fairly rapidly up to
+     *    the high-order bits to fill out the hash value.  This seems
+     *    works well both for decimal and non-decimal strings.
+     */
+
+    result = 0;
+    while (1) {
+	c = *string;
+	string++;
+	if (c == 0) {
+	    break;
+	}
+	result += (result<<3) + c;
+    }
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringFind --
+ *
+ *	Given a hash table with string keys, and a string key, find
+ *	the entry with a matching key.
+ *
+ * Results:
+ *	The return value is a token for the matching entry in the
+ *	hash table, or NULL if there was no matching entry.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_HashEntry *
+StringFind(tablePtr, key)
+    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
+    CONST char *key;		/* Key to use to find matching entry. */
+{
+    register Tcl_HashEntry *hPtr;
+    register CONST char *p1, *p2;
+    int index;
+
+    index = HashString(key) & tablePtr->mask;
+
+    /*
+     * Search all of the entries in the appropriate bucket.
+     */
+
+    for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
+	    hPtr = hPtr->nextPtr) {
+	for (p1 = key, p2 = hPtr->key.string; ; p1++, p2++) {
+	    if (*p1 != *p2) {
+		break;
+	    }
+	    if (*p1 == '\0') {
+		return hPtr;
+	    }
+	}
+    }
+    return NULL;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringCreate --
+ *
+ *	Given a hash table with string keys, and a string key, find
+ *	the entry with a matching key.  If there is no matching entry,
+ *	then create a new entry that does match.
+ *
+ * Results:
+ *	The return value is a pointer to the matching entry.  If this
+ *	is a newly-created entry, then *newPtr will be set to a non-zero
+ *	value;  otherwise *newPtr will be set to 0.  If this is a new
+ *	entry the value stored in the entry will initially be 0.
+ *
+ * Side effects:
+ *	A new entry may be added to the hash table.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_HashEntry *
+StringCreate(tablePtr, key, newPtr)
+    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
+    CONST char *key;		/* Key to use to find or create matching
+				 * entry. */
+    int *newPtr;		/* Store info here telling whether a new
+				 * entry was created. */
+{
+    register Tcl_HashEntry *hPtr;
+    register CONST char *p1, *p2;
+    int index;
+
+    index = HashString(key) & tablePtr->mask;
+
+    /*
+     * Search all of the entries in this bucket.
+     */
+
+    for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
+	    hPtr = hPtr->nextPtr) {
+	for (p1 = key, p2 = hPtr->key.string; ; p1++, p2++) {
+	    if (*p1 != *p2) {
+		break;
+	    }
+	    if (*p1 == '\0') {
+		*newPtr = 0;
+		return hPtr;
+	    }
+	}
+    }
+
+    /*
+     * Entry not found.  Add a new one to the bucket.
+     */
+
+    *newPtr = 1;
+    hPtr = (Tcl_HashEntry *) ckalloc((unsigned)
+	    (sizeof(Tcl_HashEntry) + strlen(key) - (sizeof(hPtr->key) -1)));
+    hPtr->tablePtr = tablePtr;
+    hPtr->bucketPtr = &(tablePtr->buckets[index]);
+    hPtr->nextPtr = *hPtr->bucketPtr;
+    hPtr->clientData = 0;
+    strcpy(hPtr->key.string, key);
+    *hPtr->bucketPtr = hPtr;
+    tablePtr->numEntries++;
+
+    /*
+     * If the table has exceeded a decent size, rebuild it with many
+     * more buckets.
+     */
+
+    if (tablePtr->numEntries >= tablePtr->rebuildSize) {
+	RebuildTable(tablePtr);
+    }
+    return hPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * OneWordFind --
+ *
+ *	Given a hash table with one-word keys, and a one-word key, find
+ *	the entry with a matching key.
+ *
+ * Results:
+ *	The return value is a token for the matching entry in the
+ *	hash table, or NULL if there was no matching entry.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_HashEntry *
+OneWordFind(tablePtr, key)
+    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
+    register CONST char *key;	/* Key to use to find matching entry. */
+{
+    register Tcl_HashEntry *hPtr;
+    int index;
+
+    index = RANDOM_INDEX(tablePtr, key);
+
+    /*
+     * Search all of the entries in the appropriate bucket.
+     */
+
+    for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
+	    hPtr = hPtr->nextPtr) {
+	if (hPtr->key.oneWordValue == key) {
+	    return hPtr;
+	}
+    }
+    return NULL;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * OneWordCreate --
+ *
+ *	Given a hash table with one-word keys, and a one-word key, find
+ *	the entry with a matching key.  If there is no matching entry,
+ *	then create a new entry that does match.
+ *
+ * Results:
+ *	The return value is a pointer to the matching entry.  If this
+ *	is a newly-created entry, then *newPtr will be set to a non-zero
+ *	value;  otherwise *newPtr will be set to 0.  If this is a new
+ *	entry the value stored in the entry will initially be 0.
+ *
+ * Side effects:
+ *	A new entry may be added to the hash table.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_HashEntry *
+OneWordCreate(tablePtr, key, newPtr)
+    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
+    register CONST char *key;	/* Key to use to find or create matching
+				 * entry. */
+    int *newPtr;		/* Store info here telling whether a new
+				 * entry was created. */
+{
+    register Tcl_HashEntry *hPtr;
+    int index;
+
+    index = RANDOM_INDEX(tablePtr, key);
+
+    /*
+     * Search all of the entries in this bucket.
+     */
+
+    for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
+	    hPtr = hPtr->nextPtr) {
+	if (hPtr->key.oneWordValue == key) {
+	    *newPtr = 0;
+	    return hPtr;
+	}
+    }
+
+    /*
+     * Entry not found.  Add a new one to the bucket.
+     */
+
+    *newPtr = 1;
+    hPtr = (Tcl_HashEntry *) ckalloc(sizeof(Tcl_HashEntry));
+    hPtr->tablePtr = tablePtr;
+    hPtr->bucketPtr = &(tablePtr->buckets[index]);
+    hPtr->nextPtr = *hPtr->bucketPtr;
+    hPtr->clientData = 0;
+    hPtr->key.oneWordValue = (char *) key;	/* CONST XXXX */
+    *hPtr->bucketPtr = hPtr;
+    tablePtr->numEntries++;
+
+    /*
+     * If the table has exceeded a decent size, rebuild it with many
+     * more buckets.
+     */
+
+    if (tablePtr->numEntries >= tablePtr->rebuildSize) {
+	RebuildTable(tablePtr);
+    }
+    return hPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ArrayFind --
+ *
+ *	Given a hash table with array-of-int keys, and a key, find
+ *	the entry with a matching key.
+ *
+ * Results:
+ *	The return value is a token for the matching entry in the
+ *	hash table, or NULL if there was no matching entry.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_HashEntry *
+ArrayFind(tablePtr, key)
+    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
+    CONST char *key;		/* Key to use to find matching entry. */
+{
+    register Tcl_HashEntry *hPtr;
+    int *arrayPtr = (int *) key;
+    register int *iPtr1, *iPtr2;
+    int index, count;
+
+    for (index = 0, count = tablePtr->keyType, iPtr1 = arrayPtr;
+	    count > 0; count--, iPtr1++) {
+	index += *iPtr1;
+    }
+    index = RANDOM_INDEX(tablePtr, index);
+
+    /*
+     * Search all of the entries in the appropriate bucket.
+     */
+
+    for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
+	    hPtr = hPtr->nextPtr) {
+	for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words,
+		count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) {
+	    if (count == 0) {
+		return hPtr;
+	    }
+	    if (*iPtr1 != *iPtr2) {
+		break;
+	    }
+	}
+    }
+    return NULL;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ArrayCreate --
+ *
+ *	Given a hash table with one-word keys, and a one-word key, find
+ *	the entry with a matching key.  If there is no matching entry,
+ *	then create a new entry that does match.
+ *
+ * Results:
+ *	The return value is a pointer to the matching entry.  If this
+ *	is a newly-created entry, then *newPtr will be set to a non-zero
+ *	value;  otherwise *newPtr will be set to 0.  If this is a new
+ *	entry the value stored in the entry will initially be 0.
+ *
+ * Side effects:
+ *	A new entry may be added to the hash table.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_HashEntry *
+ArrayCreate(tablePtr, key, newPtr)
+    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
+    register CONST char *key;	/* Key to use to find or create matching
+				 * entry. */
+    int *newPtr;		/* Store info here telling whether a new
+				 * entry was created. */
+{
+    register Tcl_HashEntry *hPtr;
+    int *arrayPtr = (int *) key;
+    register int *iPtr1, *iPtr2;
+    int index, count;
+
+    for (index = 0, count = tablePtr->keyType, iPtr1 = arrayPtr;
+	    count > 0; count--, iPtr1++) {
+	index += *iPtr1;
+    }
+    index = RANDOM_INDEX(tablePtr, index);
+
+    /*
+     * Search all of the entries in the appropriate bucket.
+     */
+
+    for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
+	    hPtr = hPtr->nextPtr) {
+	for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words,
+		count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) {
+	    if (count == 0) {
+		*newPtr = 0;
+		return hPtr;
+	    }
+	    if (*iPtr1 != *iPtr2) {
+		break;
+	    }
+	}
+    }
+
+    /*
+     * Entry not found.  Add a new one to the bucket.
+     */
+
+    *newPtr = 1;
+    hPtr = (Tcl_HashEntry *) ckalloc((unsigned) (sizeof(Tcl_HashEntry)
+	    + (tablePtr->keyType*sizeof(int)) - 4));
+    hPtr->tablePtr = tablePtr;
+    hPtr->bucketPtr = &(tablePtr->buckets[index]);
+    hPtr->nextPtr = *hPtr->bucketPtr;
+    hPtr->clientData = 0;
+    for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words, count = tablePtr->keyType;
+	    count > 0; count--, iPtr1++, iPtr2++) {
+	*iPtr2 = *iPtr1;
+    }
+    *hPtr->bucketPtr = hPtr;
+    tablePtr->numEntries++;
+
+    /*
+     * If the table has exceeded a decent size, rebuild it with many
+     * more buckets.
+     */
+
+    if (tablePtr->numEntries >= tablePtr->rebuildSize) {
+	RebuildTable(tablePtr);
+    }
+    return hPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BogusFind --
+ *
+ *	This procedure is invoked when an Tcl_FindHashEntry is called
+ *	on a table that has been deleted.
+ *
+ * Results:
+ *	If panic returns (which it shouldn't) this procedure returns
+ *	NULL.
+ *
+ * Side effects:
+ *	Generates a panic.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static Tcl_HashEntry *
+BogusFind(tablePtr, key)
+    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
+    CONST char *key;		/* Key to use to find matching entry. */
+{
+    panic("called Tcl_FindHashEntry on deleted table");
+    return NULL;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BogusCreate --
+ *
+ *	This procedure is invoked when an Tcl_CreateHashEntry is called
+ *	on a table that has been deleted.
+ *
+ * Results:
+ *	If panic returns (which it shouldn't) this procedure returns
+ *	NULL.
+ *
+ * Side effects:
+ *	Generates a panic.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static Tcl_HashEntry *
+BogusCreate(tablePtr, key, newPtr)
+    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
+    CONST char *key;		/* Key to use to find or create matching
+				 * entry. */
+    int *newPtr;		/* Store info here telling whether a new
+				 * entry was created. */
+{
+    panic("called Tcl_CreateHashEntry on deleted table");
+    return NULL;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RebuildTable --
+ *
+ *	This procedure is invoked when the ratio of entries to hash
+ *	buckets becomes too large.  It creates a new table with a
+ *	larger bucket array and moves all of the entries into the
+ *	new table.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Memory gets reallocated and entries get re-hashed to new
+ *	buckets.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RebuildTable(tablePtr)
+    register Tcl_HashTable *tablePtr;	/* Table to enlarge. */
+{
+    int oldSize, count, index;
+    Tcl_HashEntry **oldBuckets;
+    register Tcl_HashEntry **oldChainPtr, **newChainPtr;
+    register Tcl_HashEntry *hPtr;
+
+    oldSize = tablePtr->numBuckets;
+    oldBuckets = tablePtr->buckets;
+
+    /*
+     * Allocate and initialize the new bucket array, and set up
+     * hashing constants for new array size.
+     */
+
+    tablePtr->numBuckets *= 4;
+    tablePtr->buckets = (Tcl_HashEntry **) ckalloc((unsigned)
+	    (tablePtr->numBuckets * sizeof(Tcl_HashEntry *)));
+    for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
+	    count > 0; count--, newChainPtr++) {
+	*newChainPtr = NULL;
+    }
+    tablePtr->rebuildSize *= 4;
+    tablePtr->downShift -= 2;
+    tablePtr->mask = (tablePtr->mask << 2) + 3;
+
+    /*
+     * Rehash all of the existing entries into the new bucket array.
+     */
+
+    for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) {
+	for (hPtr = *oldChainPtr; hPtr != NULL; hPtr = *oldChainPtr) {
+	    *oldChainPtr = hPtr->nextPtr;
+	    if (tablePtr->keyType == TCL_STRING_KEYS) {
+		index = HashString(hPtr->key.string) & tablePtr->mask;
+	    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
+		index = RANDOM_INDEX(tablePtr, hPtr->key.oneWordValue);
+	    } else {
+		register int *iPtr;
+		int count;
+
+		for (index = 0, count = tablePtr->keyType,
+			iPtr = hPtr->key.words; count > 0; count--, iPtr++) {
+		    index += *iPtr;
+		}
+		index = RANDOM_INDEX(tablePtr, index);
+	    }
+	    hPtr->bucketPtr = &(tablePtr->buckets[index]);
+	    hPtr->nextPtr = *hPtr->bucketPtr;
+	    *hPtr->bucketPtr = hPtr;
+	}
+    }
+
+    /*
+     * Free up the old bucket array, if it was dynamically allocated.
+     */
+
+    if (oldBuckets != tablePtr->staticBuckets) {
+	ckfree((char *) oldBuckets);
+    }
+}
Index: /trunk/tcl/tclHistory.c
===================================================================
--- /trunk/tcl/tclHistory.c	(revision 2)
+++ /trunk/tcl/tclHistory.c	(revision 2)
@@ -0,0 +1,157 @@
+/* 
+ * tclHistory.c --
+ *
+ *	This module and the Tcl library file history.tcl together implement
+ *	Tcl command history. Tcl_RecordAndEval(Obj) can be called to record
+ *	commands ("events") before they are executed. Commands defined in
+ *	history.tcl may be used to perform history substitutions.
+ *
+ * Copyright (c) 1990-1993 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclHistory.c,v 1.1 2008-06-04 13:58:06 demin Exp $
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_RecordAndEval --
+ *
+ *	This procedure adds its command argument to the current list of
+ *	recorded events and then executes the command by calling
+ *	Tcl_Eval.
+ *
+ * Results:
+ *	The return value is a standard Tcl return value, the result of
+ *	executing cmd.
+ *
+ * Side effects:
+ *	The command is recorded and executed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_RecordAndEval(interp, cmd, flags)
+    Tcl_Interp *interp;		/* Token for interpreter in which command
+				 * will be executed. */
+    char *cmd;			/* Command to record. */
+    int flags;			/* Additional flags.  TCL_NO_EVAL means
+				 * only record: don't execute command.
+				 * TCL_EVAL_GLOBAL means use Tcl_GlobalEval
+				 * instead of Tcl_Eval. */
+{
+    register Tcl_Obj *cmdPtr;
+    int length = strlen(cmd);
+    int result;
+
+    if (length > 0) {
+	/*
+	 * Call Tcl_RecordAndEvalObj to do the actual work.
+	 */
+
+	TclNewObj(cmdPtr);
+	TclInitStringRep(cmdPtr, cmd, length);
+	Tcl_IncrRefCount(cmdPtr);
+
+	result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags);
+
+	/*
+	 * Move the interpreter's object result to the string result, 
+	 * then reset the object result.
+	 * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
+	 */
+
+	Tcl_SetResult(interp,
+	        TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
+	        TCL_VOLATILE);
+
+	/*
+	 * Discard the Tcl object created to hold the command.
+	 */
+	
+	Tcl_DecrRefCount(cmdPtr);	
+    } else {
+	/*
+	 * An empty string. Just reset the interpreter's result.
+	 */
+
+	Tcl_ResetResult(interp);
+	result = TCL_OK;
+    }
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_RecordAndEvalObj --
+ *
+ *	This procedure adds the command held in its argument object to the
+ *	current list of recorded events and then executes the command by
+ *	calling Tcl_EvalObj.
+ *
+ * Results:
+ *	The return value is a standard Tcl return value, the result of
+ *	executing the command.
+ *
+ * Side effects:
+ *	The command is recorded and executed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_RecordAndEvalObj(interp, cmdPtr, flags)
+    Tcl_Interp *interp;		/* Token for interpreter in which command
+				 * will be executed. */
+    Tcl_Obj *cmdPtr;		/* Points to object holding the command to
+				 * record and execute. */
+    int flags;			/* Additional flags. TCL_NO_EVAL means
+				 * record only: don't execute the command.
+				 * TCL_EVAL_GLOBAL means use
+				 * Tcl_GlobalEvalObj instead of
+				 * Tcl_EvalObj. */
+{
+    Interp *iPtr = (Interp *) interp;
+    int result;
+    Tcl_Obj *list[3];
+    register Tcl_Obj *objPtr;
+
+    /*
+     * Do recording by eval'ing a tcl history command: history add $cmd.
+     */
+
+    list[0] = Tcl_NewStringObj("history", -1);
+    list[1] = Tcl_NewStringObj("add", -1);
+    list[2] = cmdPtr;
+    
+    objPtr = Tcl_NewListObj(3, list);
+    Tcl_IncrRefCount(objPtr);
+    (void) Tcl_GlobalEvalObj(interp, objPtr);
+    Tcl_DecrRefCount(objPtr);
+
+    /*
+     * Execute the command.
+     */
+
+    result = TCL_OK;
+    if (!(flags & TCL_NO_EVAL)) {
+	iPtr->evalFlags = (flags & ~TCL_EVAL_GLOBAL);
+	if (flags & TCL_EVAL_GLOBAL) {
+	    result = Tcl_GlobalEvalObj(interp, cmdPtr);
+	} else {
+	    result = Tcl_EvalObj(interp, cmdPtr);
+	}
+    }
+    return result;
+}
Index: /trunk/tcl/tclIndexObj.c
===================================================================
--- /trunk/tcl/tclIndexObj.c	(revision 2)
+++ /trunk/tcl/tclIndexObj.c	(revision 2)
@@ -0,0 +1,313 @@
+/* 
+ * tclIndexObj.c --
+ *
+ *	This file implements objects of type "index".  This object type
+ *	is used to lookup a keyword in a table of valid values and cache
+ *	the index of the matching entry.
+ *
+ * Copyright (c) 1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclIndexObj.c,v 1.1 2008-06-04 13:58:07 demin Exp $
+ */
+
+#include "tclInt.h"
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static void		DupIndexInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
+			    Tcl_Obj *copyPtr));
+static int		SetIndexFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr));
+static void		UpdateStringOfIndex _ANSI_ARGS_((Tcl_Obj *listPtr));
+
+/*
+ * The structure below defines the index Tcl object type by means of
+ * procedures that can be invoked by generic object code.
+ */
+
+Tcl_ObjType tclIndexType = {
+    "index",				/* name */
+    (Tcl_FreeInternalRepProc *) NULL,	/* freeIntRepProc */
+    DupIndexInternalRep,	        /* dupIntRepProc */
+    UpdateStringOfIndex,		/* updateStringProc */
+    SetIndexFromAny			/* setFromAnyProc */
+};
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetIndexFromObj --
+ *
+ *	This procedure looks up an object's value in a table of strings
+ *	and returns the index of the matching string, if any.
+ *
+ * Results:
+
+ *	If the value of objPtr is identical to or a unique abbreviation
+ *	for one of the entries in objPtr, then the return value is
+ *	TCL_OK and the index of the matching entry is stored at
+ *	*indexPtr.  If there isn't a proper match, then TCL_ERROR is
+ *	returned and an error message is left in interp's result (unless
+ *	interp is NULL).  The msg argument is used in the error
+ *	message; for example, if msg has the value "option" then the
+ *	error message will say something flag 'bad option "foo": must be
+ *	...'
+ *
+ * Side effects:
+ *	The result of the lookup is cached as the internal rep of
+ *	objPtr, so that repeated lookups can be done quickly.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr)
+    Tcl_Interp *interp; 	/* Used for error reporting if not NULL. */
+    Tcl_Obj *objPtr;		/* Object containing the string to lookup. */
+    char **tablePtr;		/* Array of strings to compare against the
+				 * value of objPtr; last entry must be NULL
+				 * and there must not be duplicate entries. */
+    char *msg;			/* Identifying word to use in error messages. */
+    int flags;			/* 0 or TCL_EXACT */
+    int *indexPtr;		/* Place to store resulting integer index. */
+{
+    int index, length, i, numAbbrev;
+    char *key, *p1, *p2, **entryPtr;
+    Tcl_Obj *resultPtr;
+
+    /*
+     * See if there is a valid cached result from a previous lookup.
+     */
+
+    if ((objPtr->typePtr == &tclIndexType)
+	    && (objPtr->internalRep.twoPtrValue.ptr1 == (VOID *) tablePtr)) {
+	*indexPtr = (int) objPtr->internalRep.twoPtrValue.ptr2;
+	return TCL_OK;
+    }
+
+    /*
+     * Lookup the value of the object in the table.  Accept unique
+     * abbreviations unless TCL_EXACT is set in flags.
+     */
+
+    key = Tcl_GetStringFromObj(objPtr, &length);
+    index = -1;
+    numAbbrev = 0;
+    for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
+	for (p1 = key, p2 = *entryPtr; *p1 == *p2; p1++, p2++) {
+	    if (*p1 == 0) {
+		index = i;
+		goto done;
+	    }
+	}
+	if (*p1 == 0) {
+	    /*
+	     * The value is an abbreviation for this entry.  Continue
+	     * checking other entries to make sure it's unique.  If we
+	     * get more than one unique abbreviation, keep searching to
+	     * see if there is an exact match, but remember the number
+	     * of unique abbreviations and don't allow either.
+	     */
+
+	    numAbbrev++;
+	    index = i;
+	}
+    }
+    if ((flags & TCL_EXACT) || (numAbbrev != 1)) {
+	goto error;
+    }
+
+    done:
+    if ((objPtr->typePtr != NULL)
+	    && (objPtr->typePtr->freeIntRepProc != NULL)) {
+	objPtr->typePtr->freeIntRepProc(objPtr);
+    }
+    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tablePtr;
+    objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) index;
+    objPtr->typePtr = &tclIndexType;
+    *indexPtr = index;
+    return TCL_OK;
+
+    error:
+    if (interp != NULL) {
+	resultPtr = Tcl_GetObjResult(interp);
+	Tcl_AppendStringsToObj(resultPtr,
+		(numAbbrev > 1) ? "ambiguous " : "bad ", msg, " \"",
+		key, "\": must be ", *tablePtr, (char *) NULL);
+	for (entryPtr = tablePtr+1; *entryPtr != NULL; entryPtr++) {
+	    if (entryPtr[1] == NULL) {
+		Tcl_AppendStringsToObj(resultPtr, ", or ", *entryPtr,
+			(char *) NULL);
+	    } else {
+		Tcl_AppendStringsToObj(resultPtr, ", ", *entryPtr,
+			(char *) NULL);
+	    }
+	}
+    }
+    return TCL_ERROR;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupIndexInternalRep --
+ *
+ *	Copy the internal representation of an index Tcl_Obj from one
+ *	object to another.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	"copyPtr"s internal rep is set to same value as "srcPtr"s
+ *	internal rep.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupIndexInternalRep(srcPtr, copyPtr)
+    register Tcl_Obj *srcPtr;	/* Object with internal rep to copy. */
+    register Tcl_Obj *copyPtr;	/* Object with internal rep to set. */
+{
+    copyPtr->internalRep.twoPtrValue.ptr1
+	    = srcPtr->internalRep.twoPtrValue.ptr1;
+    copyPtr->internalRep.twoPtrValue.ptr2
+	    = srcPtr->internalRep.twoPtrValue.ptr2;
+    copyPtr->typePtr = &tclIndexType;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetIndexFromAny --
+ *
+ *	This procedure is called to convert a Tcl object to index
+ *	internal form. However, this doesn't make sense (need to have a
+ *	table of keywords in order to do the conversion) so the
+ *	procedure always generates an error.
+ *
+ * Results:
+ *	The return value is always TCL_ERROR, and an error message is
+ *	left in interp's result if interp isn't NULL. 
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetIndexFromAny(interp, objPtr)
+    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr;	/* The object to convert. */
+{
+    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	    "can't convert value to index except via Tcl_GetIndexFromObj API",
+	    -1);
+    return TCL_ERROR;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfIndex --
+ *
+ *	This procedure is called to update the string representation for
+ *	an index object.  It should never be called, because we never
+ *	invalidate the string representation for an index object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	A panic is added
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfIndex(objPtr)
+    register Tcl_Obj *objPtr;	/* Int object whose string rep to update. */
+{
+    panic("UpdateStringOfIndex should never be invoked");
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_WrongNumArgs --
+ *
+ *	This procedure generates a "wrong # args" error message in an
+ *	interpreter.  It is used as a utility function by many command
+ *	procedures.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	An error message is generated in interp's result object to
+ *	indicate that a command was invoked with the wrong number of
+ *	arguments.  The message has the form
+ *		wrong # args: should be "foo bar additional stuff"
+ *	where "foo" and "bar" are the initial objects in objv (objc
+ *	determines how many of these are printed) and "additional stuff"
+ *	is the contents of the message argument.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_WrongNumArgs(interp, objc, objv, message)
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int objc;				/* Number of arguments to print
+					 * from objv. */
+    Tcl_Obj *CONST objv[];		/* Initial argument objects, which
+					 * should be included in the error
+					 * message. */
+    char *message;			/* Error message to print after the
+					 * leading objects in objv. The
+					 * message may be NULL. */
+{
+    Tcl_Obj *objPtr;
+    char **tablePtr;
+    int i;
+
+    objPtr = Tcl_GetObjResult(interp);
+    Tcl_AppendToObj(objPtr, "wrong # args: should be \"", -1);
+    for (i = 0; i < objc; i++) {
+	/*
+	 * If the object is an index type use the index table which allows
+	 * for the correct error message even if the subcommand was
+	 * abbreviated.  Otherwise, just use the string rep.
+	 */
+	
+	if (objv[i]->typePtr == &tclIndexType) {
+	    tablePtr = ((char **) objv[i]->internalRep.twoPtrValue.ptr1);
+	    Tcl_AppendStringsToObj(objPtr,
+		    tablePtr[(int) objv[i]->internalRep.twoPtrValue.ptr2],
+		    (char *) NULL);
+	} else {
+	    Tcl_AppendStringsToObj(objPtr,
+		    Tcl_GetStringFromObj(objv[i], (int *) NULL),
+		    (char *) NULL);
+	}
+	if (i < (objc - 1)) {
+	    Tcl_AppendStringsToObj(objPtr, " ", (char *) NULL);
+	}
+    }
+    if (message) {
+      Tcl_AppendStringsToObj(objPtr, " ", message, (char *) NULL);
+    }
+    Tcl_AppendStringsToObj(objPtr, "\"", (char *) NULL);
+}
Index: /trunk/tcl/tclInt.h
===================================================================
--- /trunk/tcl/tclInt.h	(revision 2)
+++ /trunk/tcl/tclInt.h	(revision 2)
@@ -0,0 +1,1915 @@
+/*
+ * tclInt.h --
+ *
+ *	Declarations of things used internally by the Tcl interpreter.
+ *
+ * Copyright (c) 1987-1993 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1993-1997 Lucent Technologies.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclInt.h,v 1.1 2008-06-04 13:58:07 demin Exp $
+ */
+
+#ifndef _TCLINT
+#define _TCLINT
+
+/*
+ * Common include files needed by most of the Tcl source files are
+ * included here, so that system-dependent personalizations for the
+ * include files only have to be made in once place.  This results
+ * in a few extra includes, but greater modularity.  The order of
+ * the three groups of #includes is important.	For example, stdio.h
+ * is needed by tcl.h, and the _ANSI_ARGS_ declaration in tcl.h is
+ * needed by stdlib.h in some configurations.
+ */
+
+#include <stdio.h>
+
+#ifndef _TCL
+#include "tcl.h"
+#endif
+
+#include <ctype.h>
+#ifdef NO_LIMITS_H
+#   include "../compat/limits.h"
+#else
+#   include <limits.h>
+#endif
+#ifdef NO_STDLIB_H
+#   include "../compat/stdlib.h"
+#else
+#   include <stdlib.h>
+#endif
+#ifdef NO_STRING_H
+#include "../compat/string.h"
+#else
+#include <string.h>
+#endif
+#if defined(__STDC__) || defined(HAS_STDARG)
+#   include <stdarg.h>
+#else
+#   include <varargs.h>
+#endif
+
+#ifdef BUILD_tcl
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/*
+ * The following procedures allow namespaces to be customized to
+ * support special name resolution rules for commands/variables.
+ * 
+ */
+
+struct Tcl_ResolvedVarInfo;
+
+typedef Tcl_Var (Tcl_ResolveRuntimeVarProc) _ANSI_ARGS_((
+    Tcl_Interp* interp, struct Tcl_ResolvedVarInfo *vinfoPtr));
+
+typedef void (Tcl_ResolveVarDeleteProc) _ANSI_ARGS_((
+    struct Tcl_ResolvedVarInfo *vinfoPtr));
+
+/*
+ * The following structure encapsulates the routines needed to resolve a
+ * variable reference at runtime.  Any variable specific state will typically
+ * be appended to this structure.
+ */
+
+
+typedef struct Tcl_ResolvedVarInfo {
+    Tcl_ResolveRuntimeVarProc *fetchProc;
+    Tcl_ResolveVarDeleteProc *deleteProc;
+} Tcl_ResolvedVarInfo;
+
+
+
+typedef int (Tcl_ResolveCompiledVarProc) _ANSI_ARGS_((
+    Tcl_Interp* interp, char* name, int length,
+    Tcl_Namespace *context, Tcl_ResolvedVarInfo **rPtr));
+
+typedef int (Tcl_ResolveVarProc) _ANSI_ARGS_((
+    Tcl_Interp* interp, char* name, Tcl_Namespace *context,
+    int flags, Tcl_Var *rPtr));
+
+typedef int (Tcl_ResolveCmdProc) _ANSI_ARGS_((Tcl_Interp* interp,
+	char* name, Tcl_Namespace *context, int flags,
+	Tcl_Command *rPtr));
+ 
+typedef struct Tcl_ResolverInfo {
+    Tcl_ResolveCmdProc *cmdResProc;	/* Procedure handling command name
+					 * resolution. */
+    Tcl_ResolveVarProc *varResProc;	/* Procedure handling variable name
+					 * resolution for variables that
+					 * can only be handled at runtime. */
+    Tcl_ResolveCompiledVarProc *compiledVarResProc;
+					/* Procedure handling variable name
+					 * resolution at compile time. */
+} Tcl_ResolverInfo;
+
+/*
+ *----------------------------------------------------------------
+ * Data structures related to namespaces.
+ *----------------------------------------------------------------
+ */
+
+/*
+ * The structure below defines a namespace.
+ * Note: the first five fields must match exactly the fields in a
+ * Tcl_Namespace structure (see tcl.h). If you change one, be sure to
+ * change the other.
+ */
+
+typedef struct Namespace {
+    char *name;			 /* The namespace's simple (unqualified)
+				  * name. This contains no ::'s. The name of
+				  * the global namespace is "" although "::"
+				  * is an synonym. */
+    char *fullName;		 /* The namespace's fully qualified name.
+				  * This starts with ::. */
+    ClientData clientData;	 /* An arbitrary value associated with this
+				  * namespace. */
+    Tcl_NamespaceDeleteProc *deleteProc;
+				 /* Procedure invoked when deleting the
+				  * namespace to, e.g., free clientData. */
+    struct Namespace *parentPtr; /* Points to the namespace that contains
+				  * this one. NULL if this is the global
+				  * namespace. */
+    Tcl_HashTable childTable;	 /* Contains any child namespaces. Indexed
+				  * by strings; values have type
+				  * (Namespace *). */
+    long nsId;			 /* Unique id for the namespace. */
+    Tcl_Interp *interp;		 /* The interpreter containing this
+				  * namespace. */
+    int flags;			 /* OR-ed combination of the namespace
+				  * status flags NS_DYING and NS_DEAD
+				  * listed below. */
+    int activationCount;	 /* Number of "activations" or active call
+				  * frames for this namespace that are on
+				  * the Tcl call stack. The namespace won't
+				  * be freed until activationCount becomes
+				  * zero. */
+    int refCount;		 /* Count of references by namespaceName *
+				  * objects. The namespace can't be freed
+				  * until refCount becomes zero. */
+    Tcl_HashTable cmdTable;	 /* Contains all the commands currently
+				  * registered in the namespace. Indexed by
+				  * strings; values have type (Command *).
+				  * Commands imported by Tcl_Import have
+				  * Command structures that point (via an
+				  * ImportedCmdRef structure) to the
+				  * Command structure in the source
+				  * namespace's command table. */
+    Tcl_HashTable varTable;	 /* Contains all the (global) variables
+				  * currently in this namespace. Indexed
+				  * by strings; values have type (Var *). */
+    char **exportArrayPtr;	 /* Points to an array of string patterns
+				  * specifying which commands are exported.
+				  * A pattern may include "string match"
+				  * style wildcard characters to specify
+				  * multiple commands; however, no namespace
+				  * qualifiers are allowed. NULL if no
+				  * export patterns are registered. */
+    int numExportPatterns;	 /* Number of export patterns currently
+				  * registered using "namespace export". */
+    int maxExportPatterns;	 /* Mumber of export patterns for which
+				  * space is currently allocated. */
+    int cmdRefEpoch;		 /* Incremented if a newly added command
+				  * shadows a command for which this
+				  * namespace has already cached a Command *
+				  * pointer; this causes all its cached
+				  * Command* pointers to be invalidated. */
+    int resolverEpoch;		 /* Incremented whenever the name resolution
+				  * rules change for this namespace; this
+				  * invalidates all byte codes compiled in
+				  * the namespace, causing the code to be
+				  * recompiled under the new rules. */
+    Tcl_ResolveCmdProc *cmdResProc;
+				 /* If non-null, this procedure overrides
+				  * the usual command resolution mechanism
+				  * in Tcl.  This procedure is invoked
+				  * within Tcl_FindCommand to resolve all
+				  * command references within the namespace. */
+    Tcl_ResolveVarProc *varResProc;
+				 /* If non-null, this procedure overrides
+				  * the usual variable resolution mechanism
+				  * in Tcl.  This procedure is invoked
+				  * within Tcl_FindNamespaceVar to resolve all
+				  * variable references within the namespace
+				  * at runtime. */
+    Tcl_ResolveCompiledVarProc *compiledVarResProc;
+				 /* If non-null, this procedure overrides
+				  * the usual variable resolution mechanism
+				  * in Tcl.  This procedure is invoked
+				  * within LookupCompiledLocal to resolve
+				  * variable references within the namespace
+				  * at compile time. */
+} Namespace;
+
+/*
+ * Flags used to represent the status of a namespace:
+ *
+ * NS_DYING -	1 means Tcl_DeleteNamespace has been called to delete the
+ *		namespace but there are still active call frames on the Tcl
+ *		stack that refer to the namespace. When the last call frame
+ *		referring to it has been popped, it's variables and command
+ *		will be destroyed and it will be marked "dead" (NS_DEAD).
+ *		The namespace can no longer be looked up by name.
+ * NS_DEAD -	1 means Tcl_DeleteNamespace has been called to delete the
+ *		namespace and no call frames still refer to it. Its
+ *		variables and command have already been destroyed. This bit
+ *		allows the namespace resolution code to recognize that the
+ *		namespace is "deleted". When the last namespaceName object
+ *		in any byte code code unit that refers to the namespace has
+ *		been freed (i.e., when the namespace's refCount is 0), the
+ *		namespace's storage will be freed.
+ */
+
+#define NS_DYING	0x01
+#define NS_DEAD		0x02
+
+/*
+ * Flag passed to TclGetNamespaceForQualName to have it create all namespace
+ * components of a namespace-qualified name that cannot be found. The new
+ * namespaces are created within their specified parent. Note that this
+ * flag's value must not conflict with the values of the flags
+ * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, and FIND_ONLY_NS (defined in
+ * tclNamesp.c).
+ */
+
+#define CREATE_NS_IF_UNKNOWN 0x800
+
+/*
+ *----------------------------------------------------------------
+ * Data structures related to variables.   These are used primarily
+ * in tclVar.c
+ *----------------------------------------------------------------
+ */
+
+/*
+ * The following structure defines a variable trace, which is used to
+ * invoke a specific C procedure whenever certain operations are performed
+ * on a variable.
+ */
+
+typedef struct VarTrace {
+    Tcl_VarTraceProc *traceProc;/* Procedure to call when operations given
+				 * by flags are performed on variable. */
+    ClientData clientData;	/* Argument to pass to proc. */
+    int flags;			/* What events the trace procedure is
+				 * interested in:  OR-ed combination of
+				 * TCL_TRACE_READS, TCL_TRACE_WRITES, and
+				 * TCL_TRACE_UNSETS. */
+    struct VarTrace *nextPtr;	/* Next in list of traces associated with
+				 * a particular variable. */
+} VarTrace;
+
+/*
+ * When a variable trace is active (i.e. its associated procedure is
+ * executing), one of the following structures is linked into a list
+ * associated with the variable's interpreter.	The information in
+ * the structure is needed in order for Tcl to behave reasonably
+ * if traces are deleted while traces are active.
+ */
+
+typedef struct ActiveVarTrace {
+    struct Var *varPtr;		/* Variable that's being traced. */
+    struct ActiveVarTrace *nextPtr;
+				/* Next in list of all active variable
+				 * traces for the interpreter, or NULL
+				 * if no more. */
+    VarTrace *nextTracePtr;	/* Next trace to check after current
+				 * trace procedure returns;  if this
+				 * trace gets deleted, must update pointer
+				 * to avoid using free'd memory. */
+} ActiveVarTrace;
+
+/*
+ * The following structure describes an enumerative search in progress on
+ * an array variable;  this are invoked with options to the "array"
+ * command.
+ */
+
+typedef struct ArraySearch {
+    int id;			/* Integer id used to distinguish among
+				 * multiple concurrent searches for the
+				 * same array. */
+    struct Var *varPtr;		/* Pointer to array variable that's being
+				 * searched. */
+    Tcl_HashSearch search;	/* Info kept by the hash module about
+				 * progress through the array. */
+    Tcl_HashEntry *nextEntry;	/* Non-null means this is the next element
+				 * to be enumerated (it's leftover from
+				 * the Tcl_FirstHashEntry call or from
+				 * an "array anymore" command).	 NULL
+				 * means must call Tcl_NextHashEntry
+				 * to get value to return. */
+    struct ArraySearch *nextPtr;/* Next in list of all active searches
+				 * for this variable, or NULL if this is
+				 * the last one. */
+} ArraySearch;
+
+/*
+ * The structure below defines a variable, which associates a string name
+ * with a Tcl_Obj value. These structures are kept in procedure call frames
+ * (for local variables recognized by the compiler) or in the heap (for
+ * global variables and any variable not known to the compiler). For each
+ * Var structure in the heap, a hash table entry holds the variable name and
+ * a pointer to the Var structure.
+ */
+
+typedef struct Var {
+    union {
+	Tcl_Obj *objPtr;	/* The variable's object value. Used for 
+				 * scalar variables and array elements. */
+	Tcl_HashTable *tablePtr;/* For array variables, this points to
+				 * information about the hash table used
+				 * to implement the associative array. 
+				 * Points to malloc-ed data. */
+	struct Var *linkPtr;	/* If this is a global variable being
+				 * referred to in a procedure, or a variable
+				 * created by "upvar", this field points to
+				 * the referenced variable's Var struct. */
+    } value;
+    char *name;			/* NULL if the variable is in a hashtable,
+				 * otherwise points to the variable's
+				 * name. It is used, e.g., by TclLookupVar
+				 * and "info locals". The storage for the
+				 * characters of the name is not owned by
+				 * the Var and must not be freed when
+				 * freeing the Var. */
+    Namespace *nsPtr;		/* Points to the namespace that contains
+				 * this variable or NULL if the variable is
+				 * a local variable in a Tcl procedure. */
+    Tcl_HashEntry *hPtr;	/* If variable is in a hashtable, either the
+				 * hash table entry that refers to this
+				 * variable or NULL if the variable has been
+				 * detached from its hash table (e.g. an
+				 * array is deleted, but some of its
+				 * elements are still referred to in
+				 * upvars). NULL if the variable is not in a
+				 * hashtable. This is used to delete an
+				 * variable from its hashtable if it is no
+				 * longer needed. */
+    int refCount;		/* Counts number of active uses of this
+				 * variable, not including its entry in the
+				 * call frame or the hash table: 1 for each
+				 * additional variable whose linkPtr points
+				 * here, 1 for each nested trace active on
+				 * variable, and 1 if the variable is a 
+				 * namespace variable. This record can't be
+				 * deleted until refCount becomes 0. */
+    VarTrace *tracePtr;		/* First in list of all traces set for this
+				 * variable. */
+    ArraySearch *searchPtr;	/* First in list of all searches active
+				 * for this variable, or NULL if none. */
+    int flags;			/* Miscellaneous bits of information about
+				 * variable. See below for definitions. */
+} Var;
+
+/*
+ * Flag bits for variables. The first three (VAR_SCALAR, VAR_ARRAY, and
+ * VAR_LINK) are mutually exclusive and give the "type" of the variable.
+ * VAR_UNDEFINED is independent of the variable's type. 
+ *
+ * VAR_SCALAR -			1 means this is a scalar variable and not
+ *				an array or link. The "objPtr" field points
+ *				to the variable's value, a Tcl object.
+ * VAR_ARRAY -			1 means this is an array variable rather
+ *				than a scalar variable or link. The
+ *				"tablePtr" field points to the array's
+ *				hashtable for its elements.
+ * VAR_LINK -			1 means this Var structure contains a
+ *				pointer to another Var structure that
+ *				either has the real value or is itself
+ *				another VAR_LINK pointer. Variables like
+ *				this come about through "upvar" and "global"
+ *				commands, or through references to variables
+ *				in enclosing namespaces.
+ * VAR_UNDEFINED -		1 means that the variable is in the process
+ *				of being deleted. An undefined variable
+ *				logically does not exist and survives only
+ *				while it has a trace, or if it is a global
+ *				variable currently being used by some
+ *				procedure.
+ * VAR_IN_HASHTABLE -		1 means this variable is in a hashtable and
+ *				the Var structure is malloced. 0 if it is
+ *				a local variable that was assigned a slot
+ *				in a procedure frame by	the compiler so the
+ *				Var storage is part of the call frame.
+ * VAR_TRACE_ACTIVE -		1 means that trace processing is currently
+ *				underway for a read or write access, so
+ *				new read or write accesses should not cause
+ *				trace procedures to be called and the
+ *				variable can't be deleted.
+ * VAR_ARRAY_ELEMENT -		1 means that this variable is an array
+ *				element, so it is not legal for it to be
+ *				an array itself (the VAR_ARRAY flag had
+ *				better not be set).
+ * VAR_NAMESPACE_VAR -		1 means that this variable was declared
+ *				as a namespace variable. This flag ensures
+ *				it persists until its namespace is
+ *				destroyed or until the variable is unset;
+ *				it will persist even if it has not been
+ *				initialized and is marked undefined.
+ *				The variable's refCount is incremented to
+ *				reflect the "reference" from its namespace.
+ *
+ * The following additional flags are used with the CompiledLocal type
+ * defined below:
+ *
+ * VAR_ARGUMENT -		1 means that this variable holds a procedure
+ *				argument. 
+ * VAR_TEMPORARY -		1 if the local variable is an anonymous
+ *				temporary variable. Temporaries have a NULL
+ *				name.
+ * VAR_RESOLVED -		1 if name resolution has been done for this
+ *				variable.
+ */
+
+#define VAR_SCALAR		0x1
+#define VAR_ARRAY		0x2
+#define VAR_LINK		0x4
+#define VAR_UNDEFINED		0x8
+#define VAR_IN_HASHTABLE	0x10
+#define VAR_TRACE_ACTIVE	0x20
+#define VAR_ARRAY_ELEMENT	0x40
+#define VAR_NAMESPACE_VAR	0x80
+
+#define VAR_ARGUMENT		0x100
+#define VAR_TEMPORARY		0x200
+#define VAR_RESOLVED		0x400	
+
+/*
+ * Macros to ensure that various flag bits are set properly for variables.
+ * The ANSI C "prototypes" for these macros are:
+ *
+ * EXTERN void	TclSetVarScalar _ANSI_ARGS_((Var *varPtr));
+ * EXTERN void	TclSetVarArray _ANSI_ARGS_((Var *varPtr));
+ * EXTERN void	TclSetVarLink _ANSI_ARGS_((Var *varPtr));
+ * EXTERN void	TclSetVarArrayElement _ANSI_ARGS_((Var *varPtr));
+ * EXTERN void	TclSetVarUndefined _ANSI_ARGS_((Var *varPtr));
+ * EXTERN void	TclClearVarUndefined _ANSI_ARGS_((Var *varPtr));
+ */
+
+#define TclSetVarScalar(varPtr) \
+    (varPtr)->flags = ((varPtr)->flags & ~(VAR_ARRAY|VAR_LINK)) | VAR_SCALAR
+
+#define TclSetVarArray(varPtr) \
+    (varPtr)->flags = ((varPtr)->flags & ~(VAR_SCALAR|VAR_LINK)) | VAR_ARRAY
+
+#define TclSetVarLink(varPtr) \
+    (varPtr)->flags = ((varPtr)->flags & ~(VAR_SCALAR|VAR_ARRAY)) | VAR_LINK
+
+#define TclSetVarArrayElement(varPtr) \
+    (varPtr)->flags = ((varPtr)->flags & ~VAR_ARRAY) | VAR_ARRAY_ELEMENT
+
+#define TclSetVarUndefined(varPtr) \
+    (varPtr)->flags |= VAR_UNDEFINED
+
+#define TclClearVarUndefined(varPtr) \
+    (varPtr)->flags &= ~VAR_UNDEFINED
+
+/*
+ * Macros to read various flag bits of variables.
+ * The ANSI C "prototypes" for these macros are:
+ *
+ * EXTERN int	TclIsVarScalar _ANSI_ARGS_((Var *varPtr));
+ * EXTERN int	TclIsVarLink _ANSI_ARGS_((Var *varPtr));
+ * EXTERN int	TclIsVarArray _ANSI_ARGS_((Var *varPtr));
+ * EXTERN int	TclIsVarUndefined _ANSI_ARGS_((Var *varPtr));
+ * EXTERN int	TclIsVarArrayElement _ANSI_ARGS_((Var *varPtr));
+ * EXTERN int	TclIsVarTemporary _ANSI_ARGS_((Var *varPtr));
+ * EXTERN int	TclIsVarArgument _ANSI_ARGS_((Var *varPtr));
+ * EXTERN int	TclIsVarResolved _ANSI_ARGS_((Var *varPtr));
+ */
+    
+#define TclIsVarScalar(varPtr) \
+    ((varPtr)->flags & VAR_SCALAR)
+
+#define TclIsVarLink(varPtr) \
+    ((varPtr)->flags & VAR_LINK)
+
+#define TclIsVarArray(varPtr) \
+    ((varPtr)->flags & VAR_ARRAY)
+
+#define TclIsVarUndefined(varPtr) \
+    ((varPtr)->flags & VAR_UNDEFINED)
+
+#define TclIsVarArrayElement(varPtr) \
+    ((varPtr)->flags & VAR_ARRAY_ELEMENT)
+
+#define TclIsVarTemporary(varPtr) \
+    ((varPtr)->flags & VAR_TEMPORARY)
+    
+#define TclIsVarArgument(varPtr) \
+    ((varPtr)->flags & VAR_ARGUMENT)
+    
+#define TclIsVarResolved(varPtr) \
+    ((varPtr)->flags & VAR_RESOLVED)
+
+/*
+ *----------------------------------------------------------------
+ * Data structures related to procedures.  These are used primarily
+ * in tclProc.c, tclCompile.c, and tclExecute.c.
+ *----------------------------------------------------------------
+ */
+
+/*
+ * Forward declaration to prevent an error when the forward reference to
+ * Command is encountered in the Proc and ImportRef types declared below.
+ */
+
+struct Command;
+
+/*
+ * The variable-length structure below describes a local variable of a
+ * procedure that was recognized by the compiler. These variables have a
+ * name, an element in the array of compiler-assigned local variables in the
+ * procedure's call frame, and various other items of information. If the
+ * local variable is a formal argument, it may also have a default value.
+ * The compiler can't recognize local variables whose names are
+ * expressions (these names are only known at runtime when the expressions
+ * are evaluated) or local variables that are created as a result of an
+ * "upvar" or "uplevel" command. These other local variables are kept
+ * separately in a hash table in the call frame.
+ */
+
+typedef struct CompiledLocal {
+    struct CompiledLocal *nextPtr;
+				/* Next compiler-recognized local variable
+				 * for this procedure, or NULL if this is
+				 * the last local. */
+    int nameLength;		/* The number of characters in local
+				 * variable's name. Used to speed up
+				 * variable lookups. */
+    int frameIndex;		/* Index in the array of compiler-assigned
+				 * variables in the procedure call frame. */
+    int flags;			/* Flag bits for the local variable. Same as
+				 * the flags for the Var structure above,
+				 * although only VAR_SCALAR, VAR_ARRAY, 
+				 * VAR_LINK, VAR_ARGUMENT, VAR_TEMPORARY, and
+				 * VAR_RESOLVED make sense. */
+    Tcl_Obj *defValuePtr;	/* Pointer to the default value of an
+				 * argument, if any. NULL if not an argument
+				 * or, if an argument, no default value. */
+    Tcl_ResolvedVarInfo *resolveInfo;
+				/* Customized variable resolution info
+				 * supplied by the Tcl_ResolveCompiledVarProc
+				 * associated with a namespace. Each variable
+				 * is marked by a unique ClientData tag
+				 * during compilation, and that same tag
+				 * is used to find the variable at runtime. */
+    char name[4];		/* Name of the local variable starts here.
+				 * If the name is NULL, this will just be
+				 * '\0'. The actual size of this field will
+				 * be large enough to hold the name. MUST
+				 * BE THE LAST FIELD IN THE STRUCTURE! */
+} CompiledLocal;
+
+/*
+ * The structure below defines a command procedure, which consists of a
+ * collection of Tcl commands plus information about arguments and other
+ * local variables recognized at compile time.
+ */
+
+typedef struct Proc {
+    struct Interp *iPtr;	  /* Interpreter for which this command
+				   * is defined. */
+    int refCount;		  /* Reference count: 1 if still present
+				   * in command table plus 1 for each call
+				   * to the procedure that is currently
+				   * active. This structure can be freed
+				   * when refCount becomes zero. */
+    struct Command *cmdPtr;	  /* Points to the Command structure for
+				   * this procedure. This is used to get
+				   * the namespace in which to execute
+				   * the procedure. */
+    Tcl_Obj *bodyPtr;		  /* Points to the ByteCode object for
+				   * procedure's body command. */
+    int numArgs;		  /* Number of formal parameters. */
+    int numCompiledLocals;	  /* Count of local variables recognized by
+				   * the compiler including arguments and
+				   * temporaries. */
+    CompiledLocal *firstLocalPtr; /* Pointer to first of the procedure's
+				   * compiler-allocated local variables, or
+				   * NULL if none. The first numArgs entries
+				   * in this list describe the procedure's
+				   * formal arguments. */
+    CompiledLocal *lastLocalPtr;  /* Pointer to the last allocated local
+				   * variable or NULL if none. This has
+				   * frame index (numCompiledLocals-1). */
+} Proc;
+
+/*
+ * The structure below defines a command trace.	 This is used to allow Tcl
+ * clients to find out whenever a command is about to be executed.
+ */
+
+typedef struct Trace {
+    int level;			/* Only trace commands at nesting level
+				 * less than or equal to this. */
+    Tcl_CmdTraceProc *proc;	/* Procedure to call to trace command. */
+    ClientData clientData;	/* Arbitrary value to pass to proc. */
+    struct Trace *nextPtr;	/* Next in list of traces for this interp. */
+} Trace;
+
+/*
+ * The structure below defines an entry in the assocData hash table which
+ * is associated with an interpreter. The entry contains a pointer to a
+ * function to call when the interpreter is deleted, and a pointer to
+ * a user-defined piece of data.
+ */
+
+typedef struct AssocData {
+    Tcl_InterpDeleteProc *proc;	/* Proc to call when deleting. */
+    ClientData clientData;	/* Value to pass to proc. */
+} AssocData;	
+
+/*
+ * The structure below defines a call frame. A call frame defines a naming
+ * context for a procedure call: its local naming scope (for local
+ * variables) and its global naming scope (a namespace, perhaps the global
+ * :: namespace). A call frame can also define the naming context for a
+ * namespace eval or namespace inscope command: the namespace in which the
+ * command's code should execute. The Tcl_CallFrame structures exist only
+ * while procedures or namespace eval/inscope's are being executed, and
+ * provide a kind of Tcl call stack.
+ * 
+ * WARNING!! The structure definition must be kept consistent with the
+ * Tcl_CallFrame structure in tcl.h. If you change one, change the other.
+ */
+
+typedef struct CallFrame {
+    Namespace *nsPtr;		/* Points to the namespace used to resolve
+				 * commands and global variables. */
+    int isProcCallFrame;	/* If nonzero, the frame was pushed to
+				 * execute a Tcl procedure and may have
+				 * local vars. If 0, the frame was pushed
+				 * to execute a namespace command and var
+				 * references are treated as references to
+				 * namespace vars; varTablePtr and
+				 * compiledLocals are ignored. */
+    int objc;			/* This and objv below describe the
+				 * arguments for this procedure call. */
+    Tcl_Obj *CONST *objv;	/* Array of argument objects. */
+    struct CallFrame *callerPtr;
+				/* Value of interp->framePtr when this
+				 * procedure was invoked (i.e. next higher
+				 * in stack of all active procedures). */
+    struct CallFrame *callerVarPtr;
+				/* Value of interp->varFramePtr when this
+				 * procedure was invoked (i.e. determines
+				 * variable scoping within caller). Same
+				 * as callerPtr unless an "uplevel" command
+				 * or something equivalent was active in
+				 * the caller). */
+    int level;			/* Level of this procedure, for "uplevel"
+				 * purposes (i.e. corresponds to nesting of
+				 * callerVarPtr's, not callerPtr's). 1 for
+				 * outermost procedure, 0 for top-level. */
+    Proc *procPtr;		/* Points to the structure defining the
+				 * called procedure. Used to get information
+				 * such as the number of compiled local
+				 * variables (local variables assigned
+				 * entries ["slots"] in the compiledLocals
+				 * array below). */
+    Tcl_HashTable *varTablePtr;	/* Hash table containing local variables not
+				 * recognized by the compiler, or created at
+				 * execution time through, e.g., upvar.
+				 * Initially NULL and created if needed. */
+    int numCompiledLocals;	/* Count of local variables recognized by
+				 * the compiler including arguments. */
+    Var* compiledLocals;	/* Points to the array of local variables
+				 * recognized by the compiler. The compiler
+				 * emits code that refers to these variables
+				 * using an index into this array. */
+} CallFrame;
+
+/*
+ *----------------------------------------------------------------
+ * Data structures related to history.	 These are used primarily
+ * in tclHistory.c
+ *----------------------------------------------------------------
+ */
+
+/*
+ * The structure below defines one history event (a previously-executed
+ * command that can be re-executed in whole or in part).
+ */
+
+typedef struct {
+    char *command;		/* String containing previously-executed
+				 * command. */
+    int bytesAvl;		/* Total # of bytes available at *event (not
+				 * all are necessarily in use now). */
+} HistoryEvent;
+
+/*
+ * The structure below defines a pending revision to the most recent
+ * history event.  Changes are linked together into a list and applied
+ * during the next call to Tcl_RecordHistory.  See the comments at the
+ * beginning of tclHistory.c for information on revisions.
+ */
+
+typedef struct HistoryRev {
+    int firstIndex;		/* Index of the first byte to replace in
+				 * current history event. */
+    int lastIndex;		/* Index of last byte to replace in
+				 * current history event. */
+    int newSize;		/* Number of bytes in newBytes. */
+    char *newBytes;		/* Replacement for the range given by
+				 * firstIndex and lastIndex (malloced). */
+    struct HistoryRev *nextPtr;	/* Next in chain of revisions to apply, or
+				 * NULL for end of list. */
+} HistoryRev;
+
+/*
+ *----------------------------------------------------------------
+ * Data structures related to expressions.  These are used only in
+ * tclExpr.c.
+ *----------------------------------------------------------------
+ */
+
+/*
+ * The data structure below defines a math function (e.g. sin or hypot)
+ * for use in Tcl expressions.
+ */
+
+#define MAX_MATH_ARGS 5
+typedef struct MathFunc {
+    int builtinFuncIndex;	/* If this is a builtin math function, its
+				 * index in the array of builtin functions.
+				 * (tclCompilation.h lists these indices.)
+				 * The value is -1 if this is a new function
+				 * defined by Tcl_CreateMathFunc. The value
+				 * is also -1 if a builtin function is
+				 * replaced by a Tcl_CreateMathFunc call. */
+    int numArgs;		/* Number of arguments for function. */
+    Tcl_ValueType argTypes[MAX_MATH_ARGS];
+				/* Acceptable types for each argument. */
+    Tcl_MathProc *proc;		/* Procedure that implements this function.
+				 * NULL if isBuiltinFunc is 1. */
+    ClientData clientData;	/* Additional argument to pass to the
+				 * function when invoking it. NULL if
+				 * isBuiltinFunc is 1. */
+} MathFunc;
+
+/*
+ *----------------------------------------------------------------
+ * Data structures related to bytecode compilation and execution.
+ * These are used primarily in tclCompile.c, tclExecute.c, and
+ * tclBasic.c.
+ *----------------------------------------------------------------
+ */
+
+/*
+ * Forward declaration to prevent an error when the forward reference to
+ * CompileEnv is encountered in the procedure type CompileProc declared
+ * below.
+ */
+
+struct CompileEnv;
+
+/*
+ * The type of procedures called by the Tcl bytecode compiler to compile
+ * commands. Pointers to these procedures are kept in the Command structure
+ * describing each command. When a CompileProc returns, the interpreter's
+ * result is set to error information, if any. In addition, the CompileProc
+ * returns an integer value, which is one of the following:
+ *
+ * TCL_OK		Compilation completed normally.
+ * TCL_ERROR		Compilation failed because of an error;
+ *			the interpreter's result describes what went wrong.
+ * TCL_OUT_LINE_COMPILE	Compilation failed because, e.g., the command is
+ *			too complex for effective inline compilation. The
+ *			CompileProc believes the command is legal but 
+ *			should be compiled "out of line" by emitting code
+ *			to invoke its command procedure at runtime.
+ */
+
+#define TCL_OUT_LINE_COMPILE	(TCL_CONTINUE + 1)
+
+typedef int (CompileProc) _ANSI_ARGS_((Tcl_Interp *interp, char *string,
+	char *lastChar, int compileFlags, struct CompileEnv *compEnvPtr));
+
+/*
+ * The data structure defining the execution environment for ByteCode's.
+ * There is one ExecEnv structure per Tcl interpreter. It holds the
+ * evaluation stack that holds command operands and results. The stack grows
+ * towards increasing addresses. The "stackTop" member is cached by
+ * TclExecuteByteCode in a local variable: it must be set before calling
+ * TclExecuteByteCode and will be restored by TclExecuteByteCode before it
+ * returns.
+ */
+
+typedef union StackItem {
+    Tcl_Obj *o;			/* Stack item as a pointer to a Tcl_Obj. */
+    int	     i;			/* Stack item as an integer. */
+    VOID    *p;			/* Stack item as an arbitrary pointer. */
+} StackItem;
+
+typedef struct ExecEnv {
+    StackItem *stackPtr;	/* Points to the first item in the
+				 * evaluation stack on the heap. */
+    int stackTop;		/* Index of current top of stack; -1 when
+				 * the stack is empty. */
+    int stackEnd;		/* Index of last usable item in stack. */
+} ExecEnv;
+
+/*
+ *----------------------------------------------------------------
+ * Data structures related to commands.
+ *----------------------------------------------------------------
+ */
+
+/*
+ * An imported command is created in an namespace when it imports a "real"
+ * command from another namespace. An imported command has a Command
+ * structure that points (via its ClientData value) to the "real" Command
+ * structure in the source namespace's command table. The real command
+ * records all the imported commands that refer to it in a list of ImportRef
+ * structures so that they can be deleted when the real command is deleted.  */
+
+typedef struct ImportRef {
+    struct Command *importedCmdPtr;
+				/* Points to the imported command created in
+				 * an importing namespace; this command
+				 * redirects its invocations to the "real"
+				 * command. */
+    struct ImportRef *nextPtr;	/* Next element on the linked list of
+				 * imported commands that refer to the
+				 * "real" command. The real command deletes
+				 * these imported commands on this list when
+				 * it is deleted. */
+} ImportRef;
+
+/*
+ * Data structure used as the ClientData of imported commands: commands
+ * created in an namespace when it imports a "real" command from another
+ * namespace.
+ */
+
+typedef struct ImportedCmdData {
+    struct Command *realCmdPtr;	/* "Real" command that this imported command
+				 * refers to. */
+    struct Command *selfPtr;	/* Pointer to this imported command. Needed
+				 * only when deleting it in order to remove
+				 * it from the real command's linked list of
+				 * imported commands that refer to it. */
+} ImportedCmdData;
+
+/*
+ * A Command structure exists for each command in a namespace. The
+ * Tcl_Command opaque type actually refers to these structures.
+ */
+
+typedef struct Command {
+    Tcl_HashEntry *hPtr;	/* Pointer to the hash table entry that
+				 * refers to this command. The hash table is
+				 * either a namespace's command table or an
+				 * interpreter's hidden command table. This
+				 * pointer is used to get a command's name
+				 * from its Tcl_Command handle. NULL means
+				 * that the hash table entry has been
+				 * removed already (this can happen if
+				 * deleteProc causes the command to be
+				 * deleted or recreated). */
+    Namespace *nsPtr;		/* Points to the namespace containing this
+				 * command. */
+    int refCount;		/* 1 if in command hashtable plus 1 for each
+				 * reference from a CmdName Tcl object
+				 * representing a command's name in a
+				 * ByteCode instruction sequence. This
+				 * structure can be freed when refCount
+				 * becomes zero. */
+    int cmdEpoch;		/* Incremented to invalidate any references
+				 * that point to this command when it is
+				 * renamed, deleted, hidden, or exposed. */
+    CompileProc *compileProc;	/* Procedure called to compile command. NULL
+				 * if no compile proc exists for command. */
+    Tcl_ObjCmdProc *objProc;	/* Object-based command procedure. */
+    ClientData objClientData;	/* Arbitrary value passed to object proc. */
+    Tcl_CmdProc *proc;		/* String-based command procedure. */
+    ClientData clientData;	/* Arbitrary value passed to string proc. */
+    Tcl_CmdDeleteProc *deleteProc;
+				/* Procedure invoked when deleting command
+				 * to, e.g., free all client data. */
+    ClientData deleteData;	/* Arbitrary value passed to deleteProc. */
+    int deleted;		/* Means that the command is in the process
+				 * of being deleted (its deleteProc is
+				 * currently executing). Other attempts to
+				 * delete the command should be ignored. */
+    ImportRef *importRefPtr;	/* List of each imported Command created in
+				 * another namespace when this command is
+				 * imported. These imported commands
+				 * redirect invocations back to this
+				 * command. The list is used to remove all
+				 * those imported commands when deleting
+				 * this "real" command. */
+} Command;
+
+/*
+ *----------------------------------------------------------------
+ * Data structures related to name resolution procedures.
+ *----------------------------------------------------------------
+ */
+
+/*
+ * The interpreter keeps a linked list of name resolution schemes.
+ * The scheme for a namespace is consulted first, followed by the
+ * list of schemes in an interpreter, followed by the default
+ * name resolution in Tcl.  Schemes are added/removed from the
+ * interpreter's list by calling Tcl_AddInterpResolver and
+ * Tcl_RemoveInterpResolver.
+ */
+
+typedef struct ResolverScheme {
+    char *name;			/* Name identifying this scheme. */
+    Tcl_ResolveCmdProc *cmdResProc;
+				/* Procedure handling command name
+				 * resolution. */
+    Tcl_ResolveVarProc *varResProc;
+				/* Procedure handling variable name
+				 * resolution for variables that
+				 * can only be handled at runtime. */
+    Tcl_ResolveCompiledVarProc *compiledVarResProc;
+				/* Procedure handling variable name
+				 * resolution at compile time. */
+
+    struct ResolverScheme *nextPtr;
+				/* Pointer to next record in linked list. */
+} ResolverScheme;
+
+/*
+ *----------------------------------------------------------------
+ * This structure defines an interpreter, which is a collection of
+ * commands plus other state information related to interpreting
+ * commands, such as variable storage. Primary responsibility for
+ * this data structure is in tclBasic.c, but almost every Tcl
+ * source file uses something in here.
+ *----------------------------------------------------------------
+ */
+
+typedef struct Interp {
+
+    /*
+     * Note:  the first three fields must match exactly the fields in
+     * a Tcl_Interp struct (see tcl.h).	 If you change one, be sure to
+     * change the other.
+     *
+     * The interpreter's result is held in both the string and the
+     * objResultPtr fields. These fields hold, respectively, the result's
+     * string or object value. The interpreter's result is always in the
+     * result field if that is non-empty, otherwise it is in objResultPtr.
+     * The two fields are kept consistent unless some C code sets
+     * interp->result directly. Programs should not access result and
+     * objResultPtr directly; instead, they should always get and set the
+     * result using procedures such as Tcl_SetObjResult, Tcl_GetObjResult,
+     * and Tcl_GetStringResult. See the SetResult man page for details.
+     */
+
+    char *result;		/* If the last command returned a string
+				 * result, this points to it. Should not be
+				 * accessed directly; see comment above. */
+    Tcl_FreeProc *freeProc;	/* Zero means a string result is statically
+				 * allocated. TCL_DYNAMIC means string
+				 * result was allocated with ckalloc and
+				 * should be freed with ckfree. Other values
+				 * give address of procedure to invoke to
+				 * free the string result. Tcl_Eval must
+				 * free it before executing next command. */
+    int errorLine;		/* When TCL_ERROR is returned, this gives
+				 * the line number in the command where the
+				 * error occurred (1 means first line). */
+    Tcl_Obj *objResultPtr;	/* If the last command returned an object
+				 * result, this points to it. Should not be
+				 * accessed directly; see comment above. */
+    Namespace *globalNsPtr;	/* The interpreter's global namespace. */
+    Tcl_HashTable mathFuncTable;/* Contains all the math functions currently
+				 * defined for the interpreter.	 Indexed by
+				 * strings (function names); values have
+				 * type (MathFunc *). */
+
+    /*
+     * Information related to procedures and variables. See tclProc.c
+     * and tclvar.c for usage.
+     */
+
+    int numLevels;		/* Keeps track of how many nested calls to
+				 * Tcl_Eval are in progress for this
+				 * interpreter.	 It's used to delay deletion
+				 * of the table until all Tcl_Eval
+				 * invocations are completed. */
+    int maxNestingDepth;	/* If numLevels exceeds this value then Tcl
+				 * assumes that infinite recursion has
+				 * occurred and it generates an error. */
+    CallFrame *framePtr;	/* Points to top-most in stack of all nested
+				 * procedure invocations.  NULL means there
+				 * are no active procedures. */
+    CallFrame *varFramePtr;	/* Points to the call frame whose variables
+				 * are currently in use (same as framePtr
+				 * unless an "uplevel" command is
+				 * executing). NULL means no procedure is
+				 * active or "uplevel 0" is executing. */
+    ActiveVarTrace *activeTracePtr;
+				/* First in list of active traces for
+				 * interp, or NULL if no active traces. */
+    int returnCode;		/* Completion code to return if current
+				 * procedure exits with TCL_RETURN code. */
+    char *errorInfo;		/* Value to store in errorInfo if returnCode
+				 * is TCL_ERROR.  Malloc'ed, may be NULL */
+    char *errorCode;		/* Value to store in errorCode if returnCode
+				 * is TCL_ERROR.  Malloc'ed, may be NULL */
+
+    /*
+     * Information used by Tcl_AppendResult to keep track of partial
+     * results.	 See Tcl_AppendResult code for details.
+     */
+
+    char *appendResult;		/* Storage space for results generated
+				 * by Tcl_AppendResult.	 Malloc-ed.  NULL
+				 * means not yet allocated. */
+    int appendAvl;		/* Total amount of space available at
+				 * partialResult. */
+    int appendUsed;		/* Number of non-null bytes currently
+				 * stored at partialResult. */
+
+    /*
+     * Miscellaneous information:
+     */
+
+    int cmdCount;		/* Total number of times a command procedure
+				 * has been called for this interpreter. */
+    int evalFlags;		/* Flags to control next call to Tcl_Eval.
+				 * Normally zero, but may be set before
+				 * calling Tcl_Eval.  See below for valid
+				 * values. */
+    int termOffset;		/* Offset of character just after last one
+				 * compiled or executed by Tcl_EvalObj. */
+    int compileEpoch;		/* Holds the current "compilation epoch"
+				 * for this interpreter. This is
+				 * incremented to invalidate existing
+				 * ByteCodes when, e.g., a command with a
+				 * compile procedure is redefined. */
+    Proc *compiledProcPtr;	/* If a procedure is being compiled, a
+				 * pointer to its Proc structure; otherwise,
+				 * this is NULL. Set by ObjInterpProc in
+				 * tclProc.c and used by tclCompile.c to
+				 * process local variables appropriately. */
+    ResolverScheme *resolverPtr;
+				/* Linked list of name resolution schemes
+				 * added to this interpreter.  Schemes
+				 * are added/removed by calling
+				 * Tcl_AddInterpResolver and
+				 * Tcl_RemoveInterpResolver. */
+    char *scriptFile;		/* NULL means there is no nested source
+				 * command active;  otherwise this points to
+				 * the name of the file being sourced (it's
+				 * not malloc-ed:  it points to an argument
+				 * to Tcl_EvalFile. */
+    int flags;			/* Various flag bits.  See below. */
+    long randSeed;		/* Seed used for rand() function. */
+    Trace *tracePtr;		/* List of traces for this interpreter. */
+    Tcl_HashTable *assocData;	/* Hash table for associating data with
+				 * this interpreter. Cleaned up when
+				 * this interpreter is deleted. */
+    struct ExecEnv *execEnvPtr;	/* Execution environment for Tcl bytecode
+				 * execution. Contains a pointer to the
+				 * Tcl evaluation stack. */
+    Tcl_Obj *emptyObjPtr;	/* Points to an object holding an empty
+				 * string. Returned by Tcl_ObjSetVar2 when
+				 * variable traces change a variable in a
+				 * gross way. */
+    char resultSpace[TCL_RESULT_SIZE+1];
+				/* Static space holding small results. */
+} Interp;
+
+/*
+ * EvalFlag bits for Interp structures:
+ *
+ * TCL_BRACKET_TERM	1 means that the current script is terminated by
+ *			a close bracket rather than the end of the string.
+ * TCL_ALLOW_EXCEPTIONS	1 means it's OK for the script to terminate with
+ *			a code other than TCL_OK or TCL_ERROR;	0 means
+ *			codes other than these should be turned into errors.
+ */
+
+#define TCL_BRACKET_TERM	  1
+#define TCL_ALLOW_EXCEPTIONS	  4
+
+/*
+ * Flag bits for Interp structures:
+ *
+ * DELETED:		Non-zero means the interpreter has been deleted:
+ *			don't process any more commands for it, and destroy
+ *			the structure as soon as all nested invocations of
+ *			Tcl_Eval are done.
+ * ERR_IN_PROGRESS:	Non-zero means an error unwind is already in
+ *			progress. Zero means a command proc has been
+ *			invoked since last error occured.
+ * ERR_ALREADY_LOGGED:	Non-zero means information has already been logged
+ *			in $errorInfo for the current Tcl_Eval instance,
+ *			so Tcl_Eval needn't log it (used to implement the
+ *			"error message log" command).
+ * ERROR_CODE_SET:	Non-zero means that Tcl_SetErrorCode has been
+ *			called to record information for the current
+ *			error.	Zero means Tcl_Eval must clear the
+ *			errorCode variable if an error is returned.
+ * EXPR_INITIALIZED:	Non-zero means initialization specific to
+ *			expressions has	been carried out.
+ * DONT_COMPILE_CMDS_INLINE: Non-zero means that the bytecode compiler
+ *			should not compile any commands into an inline
+ *			sequence of instructions. This is set 1, for
+ *			example, when command traces are requested.
+ * RAND_SEED_INITIALIZED: Non-zero means that the randSeed value of the
+ *			interp has not be initialized.	This is set 1
+ *			when we first use the rand() or srand() functions.
+ * SAFE_INTERP:		Non zero means that the current interp is a
+ *			safe interp (ie it has only the safe commands
+ *			installed, less priviledge than a regular interp).
+ */
+
+#define DELETED			 1
+#define ERR_IN_PROGRESS		 2
+#define ERR_ALREADY_LOGGED	 4
+#define ERROR_CODE_SET		 8
+#define EXPR_INITIALIZED	 0x10
+#define DONT_COMPILE_CMDS_INLINE 0x20
+#define RAND_SEED_INITIALIZED	 0x40
+#define SAFE_INTERP		 0x80
+
+/*
+ *----------------------------------------------------------------
+ * Data structures related to command parsing. These are used in
+ * tclParse.c and its clients.
+ *----------------------------------------------------------------
+ */
+
+/*
+ * The following data structure is used by various parsing procedures
+ * to hold information about where to store the results of parsing
+ * (e.g. the substituted contents of a quoted argument, or the result
+ * of a nested command).  At any given time, the space available
+ * for output is fixed, but a procedure may be called to expand the
+ * space available if the current space runs out.
+ */
+
+typedef struct ParseValue {
+    char *buffer;		/* Address of first character in
+				 * output buffer. */
+    char *next;			/* Place to store next character in
+				 * output buffer. */
+    char *end;			/* Address of the last usable character
+				 * in the buffer. */
+    void (*expandProc) _ANSI_ARGS_((struct ParseValue *pvPtr, int needed));
+				/* Procedure to call when space runs out;
+				 * it will make more space. */
+    ClientData clientData;	/* Arbitrary information for use of
+				 * expandProc. */
+} ParseValue;
+
+/*
+ * A table used to classify input characters to assist in parsing
+ * Tcl commands.  The table should be indexed with a signed character
+ * using the CHAR_TYPE macro.  The character may have a negative
+ * value.  The CHAR_TYPE macro takes a pointer to a signed character
+ * and a pointer to the last character in the source string.  If the
+ * src pointer is pointing at the terminating null of the string,
+ * CHAR_TYPE returns TCL_COMMAND_END.
+ */
+
+extern unsigned char tclTypeTable[];
+#define CHAR_TYPE(src,last) \
+	(((src)==(last))?TCL_COMMAND_END:(tclTypeTable)[(int)(*(src) + 128)])
+
+/*
+ * Possible values returned by CHAR_TYPE. Note that except for TCL_DOLLAR,
+ * these are all one byte values with a single bit set 1. This means these
+ * values may be bit-or'ed together (except for TCL_DOLLAR) to quickly test
+ * whether a character is one of several different kinds of characters.
+ *
+ * TCL_NORMAL -		All characters that don't have special significance
+ *			to the Tcl language.
+ * TCL_SPACE -		Character is space, tab, or return.
+ * TCL_COMMAND_END -	Character is newline or semicolon or close-bracket
+ *			or terminating null.
+ * TCL_QUOTE -		Character is a double-quote.
+ * TCL_OPEN_BRACKET -	Character is a "[".
+ * TCL_OPEN_BRACE -	Character is a "{".
+ * TCL_CLOSE_BRACE -	Character is a "}".
+ * TCL_BACKSLASH -	Character is a "\".
+ * TCL_DOLLAR -		Character is a "$".
+ */
+
+#define TCL_NORMAL		0x01
+#define TCL_SPACE		0x02
+#define TCL_COMMAND_END		0x04
+#define TCL_QUOTE		0x08
+#define TCL_OPEN_BRACKET	0x10
+#define TCL_OPEN_BRACE		0x20
+#define TCL_CLOSE_BRACE		0x40
+#define TCL_BACKSLASH		0x80
+#define TCL_DOLLAR		0x00
+
+/*
+ * Maximum number of levels of nesting permitted in Tcl commands (used
+ * to catch infinite recursion).
+ */
+
+#define MAX_NESTING_DEPTH	1000
+
+/*
+ * The macro below is used to modify a "char" value (e.g. by casting
+ * it to an unsigned character) so that it can be used safely with
+ * macros such as isspace.
+ */
+
+#define UCHAR(c) ((unsigned char) (c))
+
+/*
+ * This macro is used to determine the offset needed to safely allocate any
+ * data structure in memory. Given a starting offset or size, it "rounds up"
+ * or "aligns" the offset to the next 8-byte boundary so that any data
+ * structure can be placed at the resulting offset without fear of an
+ * alignment error.
+ *
+ * WARNING!! DO NOT USE THIS MACRO TO ALIGN POINTERS: it will produce
+ * the wrong result on platforms that allocate addresses that are divisible
+ * by 4 or 2. Only use it for offsets or sizes.
+ */
+
+#define TCL_ALIGN(x) (((int)(x) + 7) & ~7)
+
+/*
+ * The following macros are used to specify the runtime platform
+ * setting of the tclPlatform variable.
+ */
+
+typedef enum {
+    TCL_PLATFORM_UNIX,		/* Any Unix-like OS. */
+    TCL_PLATFORM_MAC,		/* MacOS. */
+    TCL_PLATFORM_WINDOWS	/* Any Microsoft Windows OS. */
+} TclPlatformType;
+
+/*
+ * Flags for TclInvoke:
+ *
+ * TCL_INVOKE_HIDDEN		Invoke a hidden command; if not set,
+ *				invokes an exposed command.
+ * TCL_INVOKE_NO_UNKNOWN	If set, "unknown" is not invoked if
+ *				the command to be invoked is not found.
+ *				Only has an effect if invoking an exposed
+ *				command, i.e. if TCL_INVOKE_HIDDEN is not
+ *				also set.
+ */
+
+#define	TCL_INVOKE_HIDDEN	(1<<0)
+#define TCL_INVOKE_NO_UNKNOWN	(1<<1)
+
+/*
+ * The structure used as the internal representation of Tcl list
+ * objects. This is an array of pointers to the element objects. This array
+ * is grown (reallocated and copied) as necessary to hold all the list's
+ * element pointers. The array might contain more slots than currently used
+ * to hold all element pointers. This is done to make append operations
+ * faster.
+ */
+
+typedef struct List {
+    int maxElemCount;		/* Total number of element array slots. */
+    int elemCount;		/* Current number of list elements. */
+    Tcl_Obj **elements;		/* Array of pointers to element objects. */
+} List;
+    
+/*
+ *----------------------------------------------------------------
+ * Data structures related to hooking 'TclStat(...)' and
+ * 'TclAccess(...)'.
+ *----------------------------------------------------------------
+ */
+
+typedef int (*TclCmdProcType) _ANSI_ARGS_((ClientData clientData,
+	Tcl_Interp *interp, int argc, char *argv[]));
+typedef int (*TclObjCmdProcType) _ANSI_ARGS_((ClientData clientData,
+	Tcl_Interp *interp, int objc, struct Tcl_Obj * CONST objv[]));
+
+/*
+ *----------------------------------------------------------------
+ * Variables shared among Tcl modules but not used by the outside world.
+ *----------------------------------------------------------------
+ */
+
+extern char *			tclExecutableName;
+extern TclPlatformType		tclPlatform;
+
+/*
+ * Variables denoting the Tcl object types defined in the core.
+ */
+
+extern Tcl_ObjType	tclBooleanType;
+extern Tcl_ObjType	tclByteCodeType;
+extern Tcl_ObjType	tclDoubleType;
+extern Tcl_ObjType	tclIntType;
+extern Tcl_ObjType	tclListType;
+extern Tcl_ObjType	tclProcBodyType;
+extern Tcl_ObjType	tclStringType;
+
+/*
+ * The head of the list of free Tcl objects, and the total number of Tcl
+ * objects ever allocated and freed.
+ */
+
+extern Tcl_Obj *	tclFreeObjList;
+
+#ifdef TCL_COMPILE_STATS
+extern long		tclObjsAlloced;
+extern long		tclObjsFreed;
+#endif /* TCL_COMPILE_STATS */
+
+/*
+ * Pointer to a heap-allocated string of length zero that the Tcl core uses
+ * as the value of an empty string representation for an object. This value
+ * is shared by all new objects allocated by Tcl_NewObj.
+ */
+
+extern char *		tclEmptyStringRep;
+
+/*
+ *----------------------------------------------------------------
+ * Procedures shared among Tcl modules but not used by the outside
+ * world:
+ *----------------------------------------------------------------
+ */
+
+EXTERN void		panic _ANSI_ARGS_(TCL_VARARGS(char *,format));
+EXTERN void		TclAllocateFreeObjects _ANSI_ARGS_((void));
+EXTERN void		TclCleanupCommand _ANSI_ARGS_((Command *cmdPtr));
+EXTERN int		TclCopyAndCollapse _ANSI_ARGS_((int count,
+			    char *src, char *dst));
+EXTERN int		TclCreateProc _ANSI_ARGS_((Tcl_Interp *interp,
+			    Namespace *nsPtr, char *procName,
+			    Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr,
+			    Proc **procPtrPtr));
+EXTERN void		TclDeleteCompiledLocalVars _ANSI_ARGS_((
+			    Interp *iPtr, CallFrame *framePtr));
+EXTERN void		TclDeleteVars _ANSI_ARGS_((Interp *iPtr,
+			    Tcl_HashTable *tablePtr));
+EXTERN void		TclDumpMemoryInfo _ANSI_ARGS_((FILE *outFile));
+EXTERN void		TclExpandParseValue _ANSI_ARGS_((ParseValue *pvPtr,
+			    int needed));
+EXTERN void		TclExprFloatError _ANSI_ARGS_((Tcl_Interp *interp,
+			    double value));
+EXTERN void		TclFinalizeCompExecEnv _ANSI_ARGS_((void));
+EXTERN void		TclFinalizeEnvironment _ANSI_ARGS_((void));
+EXTERN void		TclFinalizeExecEnv _ANSI_ARGS_((void));
+EXTERN int		TclFindElement _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *list, int listLength, char **elementPtr,
+			    char **nextPtr, int *sizePtr, int *bracePtr));
+EXTERN Proc *		TclFindProc _ANSI_ARGS_((Interp *iPtr,
+			    char *procName));
+EXTERN int		TclFormatInt _ANSI_ARGS_((char *buffer, long n));
+EXTERN int		TclGetDate _ANSI_ARGS_((char *p,
+			    unsigned long now, long zone,
+			    unsigned long *timePtr));
+EXTERN Tcl_Obj *	TclGetElementOfIndexedArray _ANSI_ARGS_((
+			    Tcl_Interp *interp, int localIndex,
+			    Tcl_Obj *elemPtr, int leaveErrorMsg));
+EXTERN char *		TclGetEnv _ANSI_ARGS_((CONST char *name));
+EXTERN int		TclGetFrame _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, CallFrame **framePtrPtr));
+EXTERN TclCmdProcType	TclGetInterpProc _ANSI_ARGS_((void));
+EXTERN int		TclGetIntForIndex _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr, int endValue, int *indexPtr));
+EXTERN Tcl_Obj *	TclGetIndexedScalar _ANSI_ARGS_((Tcl_Interp *interp,
+			    int localIndex, int leaveErrorMsg));
+EXTERN int		TclGetLong _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, long *longPtr));
+EXTERN int		TclGetNamespaceForQualName _ANSI_ARGS_((
+			    Tcl_Interp *interp, char *qualName,
+			    Namespace *cxtNsPtr, int flags,
+			    Namespace **nsPtrPtr, Namespace **altNsPtrPtr,
+			    Namespace **actualCxtPtrPtr,
+			    char **simpleNamePtr));
+EXTERN TclObjCmdProcType TclGetObjInterpProc _ANSI_ARGS_((void));
+EXTERN int		TclGetOpenMode _ANSI_ARGS_((Tcl_Interp *interp,
+        		    char *string, int *seekFlagPtr));
+EXTERN Tcl_Command	TclGetOriginalCommand _ANSI_ARGS_((
+			    Tcl_Command command));
+EXTERN char *		TclGetUserHome _ANSI_ARGS_((char *name,
+			    Tcl_DString *bufferPtr));
+EXTERN int		TclGlobalInvoke _ANSI_ARGS_((Tcl_Interp *interp,
+		            int argc, char **argv, int flags));
+EXTERN int		TclInExit _ANSI_ARGS_((void));
+EXTERN Tcl_Obj *	TclIncrElementOfIndexedArray _ANSI_ARGS_((
+                            Tcl_Interp *interp, int localIndex,
+			    Tcl_Obj *elemPtr, long incrAmount));
+EXTERN Tcl_Obj *	TclIncrIndexedScalar _ANSI_ARGS_((
+                            Tcl_Interp *interp, int localIndex,
+			    long incrAmount));
+EXTERN Tcl_Obj *	TclIncrVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
+			    long incrAmount, int part1NotParsed));
+EXTERN void		TclInitCompiledLocals _ANSI_ARGS_((
+			    Tcl_Interp *interp, CallFrame *framePtr,
+			    Namespace *nsPtr));
+EXTERN void		TclInitNamespaces _ANSI_ARGS_((void));
+EXTERN int		TclInterpInit _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int		TclInvoke _ANSI_ARGS_((Tcl_Interp *interp,
+		            int argc, char **argv, int flags));
+EXTERN int		TclInvokeObjectCommand _ANSI_ARGS_((
+                            ClientData clientData, Tcl_Interp *interp,
+                            int argc, char **argv));
+EXTERN int		TclInvokeStringCommand _ANSI_ARGS_((
+                            ClientData clientData, Tcl_Interp *interp,
+                            int objc, Tcl_Obj *CONST objv[]));
+EXTERN Proc *		TclIsProc _ANSI_ARGS_((Command *cmdPtr));
+EXTERN int		TclLooksLikeInt _ANSI_ARGS_((char *p));
+EXTERN Var *		TclLookupVar _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *part1, char *part2, int flags, char *msg,
+			    int createPart1, int createPart2,
+			    Var **arrayPtrPtr));
+EXTERN int		TclNeedSpace _ANSI_ARGS_((char *start, char *end));
+EXTERN Tcl_Obj *	TclNewProcBodyObj _ANSI_ARGS_((Proc *procPtr));
+EXTERN int		TclObjCommandComplete _ANSI_ARGS_((Tcl_Obj *cmdPtr));
+EXTERN int		TclObjInterpProc _ANSI_ARGS_((ClientData clientData,
+		    	    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+EXTERN int		TclObjInvoke _ANSI_ARGS_((Tcl_Interp *interp,
+		            int objc, Tcl_Obj *CONST objv[], int flags));
+EXTERN int		TclObjInvokeGlobal _ANSI_ARGS_((Tcl_Interp *interp,
+		            int objc, Tcl_Obj *CONST objv[], int flags));
+EXTERN char *		TclpAlloc _ANSI_ARGS_((unsigned int size));
+
+EXTERN char *		TclpRealloc _ANSI_ARGS_((char *ptr,
+			    unsigned int size));
+#ifndef TclpSysAlloc
+EXTERN VOID * 		TclpSysAlloc _ANSI_ARGS_((long size, int isBin));
+#endif
+#ifndef TclpSysFree
+EXTERN void 		TclpSysFree _ANSI_ARGS_((VOID *ptr));
+#endif
+#ifndef TclpSysRealloc
+EXTERN VOID * 		TclpSysRealloc _ANSI_ARGS_((VOID *cp,
+			    unsigned int size));
+#endif
+EXTERN int		TclParseBraces _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, char **termPtr, ParseValue *pvPtr));
+EXTERN int		TclParseNestedCmd _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, int flags, char **termPtr,
+			    ParseValue *pvPtr));
+EXTERN int		TclParseQuotes _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, int termChar, int flags,
+			    char **termPtr, ParseValue *pvPtr));
+EXTERN void		TclPlatformExit _ANSI_ARGS_((int status));
+EXTERN char *		TclPrecTraceProc _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, char *name1, char *name2,
+			    int flags));
+EXTERN int		TclPreventAliasLoop _ANSI_ARGS_((Tcl_Interp *interp,
+		            Tcl_Interp *cmdInterp, Tcl_Command cmd));
+EXTERN void		TclPrintByteCodeObj _ANSI_ARGS_((Tcl_Interp *interp,
+		            Tcl_Obj *objPtr));
+EXTERN void		TclProcCleanupProc _ANSI_ARGS_((Proc *procPtr));
+EXTERN int		TclProcCompileProc _ANSI_ARGS_((Tcl_Interp *interp,
+ 			    Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr,
+ 			    CONST char *description, CONST char *procName));
+EXTERN void		TclProcDeleteProc _ANSI_ARGS_((ClientData clientData));
+EXTERN int		TclProcInterpProc _ANSI_ARGS_((ClientData clientData,
+		    	    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int		TclRenameCommand _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *oldName, char *newName)) ;
+EXTERN void		TclResetShadowedCmdRefs _ANSI_ARGS_((
+			    Tcl_Interp *interp, Command *newCmdPtr));
+EXTERN int		TclServiceIdle _ANSI_ARGS_((void));
+EXTERN Tcl_Obj *	TclSetElementOfIndexedArray _ANSI_ARGS_((
+                            Tcl_Interp *interp, int localIndex,
+			    Tcl_Obj *elemPtr, Tcl_Obj *objPtr,
+			    int leaveErrorMsg));
+EXTERN Tcl_Obj *	TclSetIndexedScalar _ANSI_ARGS_((Tcl_Interp *interp,
+			    int localIndex, Tcl_Obj *objPtr,
+			    int leaveErrorMsg));
+EXTERN char *		TclSetPreInitScript _ANSI_ARGS_((char *string));
+EXTERN int		TclSockGetPort _ANSI_ARGS_((Tcl_Interp *interp,
+		            char *string, char *proto, int *portPtr));
+EXTERN int		TclSockMinimumBuffers _ANSI_ARGS_((int sock,
+        		    int size));
+EXTERN void		TclTeardownNamespace _ANSI_ARGS_((Namespace *nsPtr));
+EXTERN int		TclUpdateReturnInfo _ANSI_ARGS_((Interp *iPtr));
+EXTERN char *		TclWordEnd _ANSI_ARGS_((char *start, char *lastChar,
+			    int nested, int *semiPtr));
+
+/*
+ *----------------------------------------------------------------
+ * Command procedures in the generic core:
+ *----------------------------------------------------------------
+ */
+
+EXTERN int	Tcl_AfterObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_AppendObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_ArrayObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_BreakCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_CaseObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_CatchObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_CdObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_ConcatObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_ContinueCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_ErrorObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_EvalObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_ExitObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_ExprObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_ForCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_ForeachObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_FormatObjCmd _ANSI_ARGS_((ClientData dummy,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_GlobalObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_IfCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_IncrCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_InfoObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_InterpObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_JoinObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_LappendObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_LindexObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_LinsertObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_LlengthObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_ListObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_LrangeObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_LreplaceObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_LsortObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_NamespaceObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_ProcObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_PutsObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_PwdCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_RegexpCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_RegsubCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_RenameObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_ReturnObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_ScanCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_SetCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_SplitObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_SourceObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_StringObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_SubstCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_SwitchObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_TimeObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_TraceCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_UnsetObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_UplevelObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_UpvarObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_VariableObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_WhileCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+
+/*
+ *----------------------------------------------------------------
+ * Command procedures found only in the Mac version of the core:
+ *----------------------------------------------------------------
+ */
+
+#ifdef MAC_TCL
+EXTERN int 	Tcl_EchoCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int 	Tcl_LsCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int 	Tcl_BeepObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int 	Tcl_MacSourceObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_ResourceObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+#endif
+
+/*
+ *----------------------------------------------------------------
+ * Compilation procedures for commands in the generic core:
+ *----------------------------------------------------------------
+ */
+
+EXTERN int	TclCompileBreakCmd _ANSI_ARGS_((Tcl_Interp *interp,
+		    char *string, char *lastChar, int compileFlags,
+		    struct CompileEnv *compileEnvPtr));
+EXTERN int	TclCompileCatchCmd _ANSI_ARGS_((Tcl_Interp *interp,
+		    char *string, char *lastChar, int compileFlags,
+		    struct CompileEnv *compileEnvPtr));
+EXTERN int	TclCompileContinueCmd _ANSI_ARGS_((Tcl_Interp *interp,
+		    char *string, char *lastChar, int compileFlags,
+		    struct CompileEnv *compileEnvPtr));
+EXTERN int	TclCompileExprCmd _ANSI_ARGS_((Tcl_Interp *interp,
+		    char *string, char *lastChar, int compileFlags,
+		    struct CompileEnv *compileEnvPtr));
+EXTERN int	TclCompileForCmd _ANSI_ARGS_((Tcl_Interp *interp,
+		    char *string, char *lastChar, int compileFlags,
+		    struct CompileEnv *compileEnvPtr));
+EXTERN int	TclCompileForeachCmd _ANSI_ARGS_((Tcl_Interp *interp,
+		    char *string, char *lastChar, int compileFlags,
+		    struct CompileEnv *compileEnvPtr));
+EXTERN int	TclCompileIfCmd _ANSI_ARGS_((Tcl_Interp *interp,
+		    char *string, char *lastChar, int compileFlags,
+		    struct CompileEnv *compileEnvPtr));
+EXTERN int	TclCompileIncrCmd _ANSI_ARGS_((Tcl_Interp *interp,
+		    char *string, char *lastChar, int compileFlags,
+		    struct CompileEnv *compileEnvPtr));
+EXTERN int	TclCompileSetCmd _ANSI_ARGS_((Tcl_Interp *interp,
+		    char *string, char *lastChar, int compileFlags,
+		    struct CompileEnv *compileEnvPtr));
+EXTERN int	TclCompileWhileCmd _ANSI_ARGS_((Tcl_Interp *interp,
+		    char *string, char *lastChar, int compileFlags,
+		    struct CompileEnv *compileEnvPtr));
+
+/*
+ *----------------------------------------------------------------
+ * Macros used by the Tcl core to create and release Tcl objects.
+ * TclNewObj(objPtr) creates a new object denoting an empty string.
+ * TclDecrRefCount(objPtr) decrements the object's reference count,
+ * and frees the object if its reference count is zero.
+ * These macros are inline versions of Tcl_NewObj() and
+ * Tcl_DecrRefCount(). Notice that the names differ in not having
+ * a "_" after the "Tcl". Notice also that these macros reference
+ * their argument more than once, so you should avoid calling them
+ * with an expression that is expensive to compute or has
+ * side effects. The ANSI C "prototypes" for these macros are:
+ *
+ * EXTERN void	TclNewObj _ANSI_ARGS_((Tcl_Obj *objPtr));
+ * EXTERN void	TclDecrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr));
+ *----------------------------------------------------------------
+ */
+
+#ifdef TCL_COMPILE_STATS
+#  define TclIncrObjsAllocated() \
+    tclObjsAlloced++
+#  define TclIncrObjsFreed() \
+    tclObjsFreed++
+#else
+#  define TclIncrObjsAllocated()
+#  define TclIncrObjsFreed()
+#endif /* TCL_COMPILE_STATS */
+
+#ifdef TCL_MEM_DEBUG
+#  define TclNewObj(objPtr) \
+    (objPtr) = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), __FILE__, __LINE__); \
+    (objPtr)->refCount = 0; \
+    (objPtr)->bytes    = tclEmptyStringRep; \
+    (objPtr)->length   = 0; \
+    (objPtr)->typePtr  = NULL; \
+    TclIncrObjsAllocated()
+#  define TclDbNewObj(objPtr, file, line) \
+    (objPtr) = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line)); \
+    (objPtr)->refCount = 0; \
+    (objPtr)->bytes    = tclEmptyStringRep; \
+    (objPtr)->length   = 0; \
+    (objPtr)->typePtr  = NULL; \
+    TclIncrObjsAllocated()
+#  define TclDecrRefCount(objPtr) \
+    if (--(objPtr)->refCount <= 0) { \
+ 	if ((objPtr)->refCount < -1) \
+            panic("Reference count for %lx was negative: %s line %d", \
+		  (objPtr), __FILE__, __LINE__); \
+        if (((objPtr)->bytes != NULL) \
+	        && ((objPtr)->bytes != tclEmptyStringRep)) { \
+	    ckfree((char *) (objPtr)->bytes); \
+        } \
+        if (((objPtr)->typePtr != NULL) \
+	        && ((objPtr)->typePtr->freeIntRepProc != NULL)) { \
+	    (objPtr)->typePtr->freeIntRepProc(objPtr); \
+        } \
+        ckfree((char *) (objPtr)); \
+        TclIncrObjsFreed(); \
+    }
+#else /* not TCL_MEM_DEBUG */
+#  define TclNewObj(objPtr) \
+    if (tclFreeObjList == NULL) { \
+	TclAllocateFreeObjects(); \
+    } \
+    (objPtr) = tclFreeObjList; \
+    tclFreeObjList = (Tcl_Obj *) \
+	tclFreeObjList->internalRep.otherValuePtr; \
+    (objPtr)->refCount = 0; \
+    (objPtr)->bytes    = tclEmptyStringRep; \
+    (objPtr)->length   = 0; \
+    (objPtr)->typePtr  = NULL; \
+    TclIncrObjsAllocated()
+#  define TclDecrRefCount(objPtr) \
+    if (--(objPtr)->refCount <= 0) { \
+        if (((objPtr)->bytes != NULL) \
+	        && ((objPtr)->bytes != tclEmptyStringRep)) { \
+	    ckfree((char *) (objPtr)->bytes); \
+        } \
+        if (((objPtr)->typePtr != NULL) \
+	        && ((objPtr)->typePtr->freeIntRepProc != NULL)) { \
+	    (objPtr)->typePtr->freeIntRepProc(objPtr); \
+        } \
+        (objPtr)->internalRep.otherValuePtr = (VOID *) tclFreeObjList; \
+        tclFreeObjList = (objPtr); \
+        TclIncrObjsFreed(); \
+    }
+#endif /* TCL_MEM_DEBUG */
+
+/*
+ *----------------------------------------------------------------
+ * Macro used by the Tcl core to set a Tcl_Obj's string representation
+ * to a copy of the "len" bytes starting at "bytePtr". This code
+ * works even if the byte array contains NULLs as long as the length
+ * is correct. Because "len" is referenced multiple times, it should
+ * be as simple an expression as possible. The ANSI C "prototype" for
+ * this macro is:
+ *
+ * EXTERN void	TclInitStringRep _ANSI_ARGS_((Tcl_Obj *objPtr,
+ *		    char *bytePtr, int len));
+ *----------------------------------------------------------------
+ */
+
+#define TclInitStringRep(objPtr, bytePtr, len) \
+    if ((len) == 0) { \
+        (objPtr)->bytes  = tclEmptyStringRep; \
+	(objPtr)->length = 0; \
+    } else { \
+	(objPtr)->bytes = (char *) ckalloc((unsigned) ((len) + 1)); \
+	memcpy((VOID *) (objPtr)->bytes, (VOID *) (bytePtr), \
+	        (unsigned) (len)); \
+	(objPtr)->bytes[len] = '\0'; \
+	(objPtr)->length = (len); \
+    }
+
+/*
+ *----------------------------------------------------------------
+ * Macro used by the Tcl core to get the string representation's
+ * byte array pointer and length from a Tcl_Obj. This is an inline
+ * version of Tcl_GetStringFromObj(). "lengthPtr" must be the
+ * address of an integer variable or NULL; If non-NULL, that variable
+ * will be set to the string rep's length. The macro's expression
+ * result is the string rep's byte pointer which might be NULL.
+ * Note that the bytes referenced by this pointer must not be modified
+ * by the caller. The ANSI C "prototype" for this macro is:
+ *
+ * EXTERN char *  TclGetStringFromObj _ANSI_ARGS_((Tcl_Obj *objPtr,
+ *		       int *lengthPtr));
+ *----------------------------------------------------------------
+ */
+
+#define TclGetStringFromObj(objPtr, lengthPtr) \
+    ((objPtr)->bytes? \
+        ((lengthPtr)? \
+	    ((*(lengthPtr) = (objPtr)->length), (objPtr)->bytes) : \
+	    (objPtr)->bytes) : \
+        Tcl_GetStringFromObj((objPtr), (lengthPtr)))
+
+/*
+ *----------------------------------------------------------------
+ * Macro used by the Tcl core to reset an interpreter's Tcl object
+ * result to an unshared empty string object with ref count one.
+ * This does not clear any error information for the interpreter.
+ * The ANSI C "prototype" for this macro is:
+ *
+ * EXTERN void	TclResetObjResult _ANSI_ARGS_((Tcl_Interp *interp));
+ *---------------------------------------------------------------
+ */
+
+#define TclResetObjResult(interp) \
+    { \
+        register Tcl_Obj *objResultPtr = ((Interp *) interp)->objResultPtr; \
+        if (Tcl_IsShared(objResultPtr)) { \
+	    TclDecrRefCount(objResultPtr); \
+	    TclNewObj(objResultPtr); \
+	    Tcl_IncrRefCount(objResultPtr); \
+	    ((Interp *) interp)->objResultPtr = objResultPtr; \
+        } else { \
+	    if ((objResultPtr->bytes != NULL) \
+		    && (objResultPtr->bytes != tclEmptyStringRep)) { \
+	        ckfree((char *) objResultPtr->bytes); \
+	    } \
+	    objResultPtr->bytes  = tclEmptyStringRep; \
+	    objResultPtr->length = 0; \
+	    if ((objResultPtr->typePtr != NULL) \
+	            && (objResultPtr->typePtr->freeIntRepProc != NULL)) { \
+	        objResultPtr->typePtr->freeIntRepProc(objResultPtr); \
+	    } \
+	    objResultPtr->typePtr = (Tcl_ObjType *) NULL; \
+        } \
+    }
+
+/*
+ *----------------------------------------------------------------
+ * Procedures used in conjunction with Tcl namespaces. They are
+ * defined here instead of in tcl.h since they are not stable yet.
+ *----------------------------------------------------------------
+ */
+
+EXTERN void		Tcl_AddInterpResolvers _ANSI_ARGS_((Tcl_Interp *interp,
+ 			    char *name, Tcl_ResolveCmdProc *cmdProc,
+ 			    Tcl_ResolveVarProc *varProc,
+ 			    Tcl_ResolveCompiledVarProc *compiledVarProc));
+EXTERN int		Tcl_AppendExportList _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+			    Tcl_Obj *objPtr));
+EXTERN Tcl_Namespace *	Tcl_CreateNamespace _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *name, ClientData clientData,
+			    Tcl_NamespaceDeleteProc *deleteProc));
+EXTERN void		Tcl_DeleteNamespace _ANSI_ARGS_((
+			    Tcl_Namespace *nsPtr));
+EXTERN int		Tcl_Export _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Namespace *nsPtr, char *pattern,
+			    int resetListFirst));
+EXTERN Tcl_Command	Tcl_FindCommand _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *name, Tcl_Namespace *contextNsPtr,
+			    int flags));
+EXTERN Tcl_Namespace *	Tcl_FindNamespace _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *name, Tcl_Namespace *contextNsPtr,
+			    int flags));
+EXTERN int              Tcl_GetInterpResolvers _ANSI_ARGS_((Tcl_Interp *interp,
+                            char *name, Tcl_ResolverInfo *resInfo));
+EXTERN int              Tcl_GetNamespaceResolvers _ANSI_ARGS_((
+			    Tcl_Namespace *namespacePtr,
+			    Tcl_ResolverInfo *resInfo));
+EXTERN void		Tcl_GetVariableFullName _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_Var variable,
+  			    Tcl_Obj *objPtr));
+EXTERN Tcl_Var		Tcl_FindNamespaceVar _ANSI_ARGS_((
+			    Tcl_Interp *interp, char *name,
+			    Tcl_Namespace *contextNsPtr, int flags));
+EXTERN int		Tcl_ForgetImport _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Namespace *nsPtr, char *pattern));
+EXTERN Tcl_Command	Tcl_GetCommandFromObj _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_Obj *objPtr));
+EXTERN void		Tcl_GetCommandFullName _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_Command command,
+			    Tcl_Obj *objPtr));
+EXTERN Tcl_Namespace *	Tcl_GetCurrentNamespace _ANSI_ARGS_((
+			    Tcl_Interp *interp));
+EXTERN Tcl_Namespace *	Tcl_GetGlobalNamespace _ANSI_ARGS_((
+			    Tcl_Interp *interp));
+EXTERN void		Tcl_GetVariableFullName _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_Var variable,
+			    Tcl_Obj *objPtr));
+EXTERN int		Tcl_Import _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Namespace *nsPtr, char *pattern,
+			    int allowOverwrite));
+EXTERN void		Tcl_PopCallFrame _ANSI_ARGS_((Tcl_Interp* interp));
+EXTERN int		Tcl_PushCallFrame _ANSI_ARGS_((Tcl_Interp* interp,
+			    Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr,
+			    int isProcCallFrame)); 
+EXTERN int		Tcl_RemoveInterpResolvers _ANSI_ARGS_((
+			    Tcl_Interp *interp, char *name));
+EXTERN void		Tcl_SetNamespaceResolvers _ANSI_ARGS_((
+			    Tcl_Namespace *namespacePtr,
+			    Tcl_ResolveCmdProc *cmdProc,
+			    Tcl_ResolveVarProc *varProc,
+			    Tcl_ResolveCompiledVarProc *compiledVarProc));
+
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TCLINT */
+
Index: /trunk/tcl/tclLink.c
===================================================================
--- /trunk/tcl/tclLink.c	(revision 2)
+++ /trunk/tcl/tclLink.c	(revision 2)
@@ -0,0 +1,428 @@
+/* 
+ * tclLink.c --
+ *
+ *	This file implements linked variables (a C variable that is
+ *	tied to a Tcl variable).  The idea of linked variables was
+ *	first suggested by Andreas Stolcke and this implementation is
+ *	based heavily on a prototype implementation provided by
+ *	him.
+ *
+ * Copyright (c) 1993 The Regents of the University of California.
+ * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclLink.c,v 1.1 2008-06-04 13:58:07 demin Exp $
+ */
+
+#include "tclInt.h"
+
+/*
+ * For each linked variable there is a data structure of the following
+ * type, which describes the link and is the clientData for the trace
+ * set on the Tcl variable.
+ */
+
+typedef struct Link {
+    Tcl_Interp *interp;		/* Interpreter containing Tcl variable. */
+    char *varName;		/* Name of variable (must be global).  This
+				 * is needed during trace callbacks, since
+				 * the actual variable may be aliased at
+				 * that time via upvar. */
+    char *addr;			/* Location of C variable. */
+    int type;			/* Type of link (TCL_LINK_INT, etc.). */
+    union {
+	int i;
+	double d;
+    } lastValue;		/* Last known value of C variable;  used to
+				 * avoid string conversions. */
+    int flags;			/* Miscellaneous one-bit values;  see below
+				 * for definitions. */
+} Link;
+
+/*
+ * Definitions for flag bits:
+ * LINK_READ_ONLY -		1 means errors should be generated if Tcl
+ *				script attempts to write variable.
+ * LINK_BEING_UPDATED -		1 means that a call to Tcl_UpdateLinkedVar
+ *				is in progress for this variable, so
+ *				trace callbacks on the variable should
+ *				be ignored.
+ */
+
+#define LINK_READ_ONLY		1
+#define LINK_BEING_UPDATED	2
+
+/*
+ * Forward references to procedures defined later in this file:
+ */
+
+static char *		LinkTraceProc _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, char *name1, char *name2,
+			    int flags));
+static char *		StringValue _ANSI_ARGS_((Link *linkPtr,
+			    char *buffer));
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LinkVar --
+ *
+ *	Link a C variable to a Tcl variable so that changes to either
+ *	one causes the other to change.
+ *
+ * Results:
+ *	The return value is TCL_OK if everything went well or TCL_ERROR
+ *	if an error occurred (interp->result is also set after errors).
+ *
+ * Side effects:
+ *	The value at *addr is linked to the Tcl variable "varName",
+ *	using "type" to convert between string values for Tcl and
+ *	binary values for *addr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_LinkVar(interp, varName, addr, type)
+    Tcl_Interp *interp;		/* Interpreter in which varName exists. */
+    char *varName;		/* Name of a global variable in interp. */
+    char *addr;			/* Address of a C variable to be linked
+				 * to varName. */
+    int type;			/* Type of C variable: TCL_LINK_INT, etc. 
+				 * Also may have TCL_LINK_READ_ONLY
+				 * OR'ed in. */
+{
+    Link *linkPtr;
+    char buffer[TCL_DOUBLE_SPACE];
+    int code;
+
+    linkPtr = (Link *) ckalloc(sizeof(Link));
+    linkPtr->interp = interp;
+    linkPtr->varName = (char *) ckalloc((unsigned) (strlen(varName) + 1));
+    strcpy(linkPtr->varName, varName);
+    linkPtr->addr = addr;
+    linkPtr->type = type & ~TCL_LINK_READ_ONLY;
+    if (type & TCL_LINK_READ_ONLY) {
+	linkPtr->flags = LINK_READ_ONLY;
+    } else {
+	linkPtr->flags = 0;
+    }
+    if (Tcl_SetVar(interp, varName, StringValue(linkPtr, buffer),
+	    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
+	ckfree(linkPtr->varName);
+	ckfree((char *) linkPtr);
+	return TCL_ERROR;
+    }
+    code = Tcl_TraceVar(interp, varName, TCL_GLOBAL_ONLY|TCL_TRACE_READS
+	    |TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc,
+	    (ClientData) linkPtr);
+    if (code != TCL_OK) {
+	ckfree(linkPtr->varName);
+	ckfree((char *) linkPtr);
+    }
+    return code;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UnlinkVar --
+ *
+ *	Destroy the link between a Tcl variable and a C variable.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	If "varName" was previously linked to a C variable, the link
+ *	is broken to make the variable independent.  If there was no
+ *	previous link for "varName" then nothing happens.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_UnlinkVar(interp, varName)
+    Tcl_Interp *interp;		/* Interpreter containing variable to unlink. */
+    char *varName;		/* Global variable in interp to unlink. */
+{
+    Link *linkPtr;
+
+    linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
+	    LinkTraceProc, (ClientData) NULL);
+    if (linkPtr == NULL) {
+	return;
+    }
+    Tcl_UntraceVar(interp, varName,
+	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+	    LinkTraceProc, (ClientData) linkPtr);
+    ckfree(linkPtr->varName);
+    ckfree((char *) linkPtr);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UpdateLinkedVar --
+ *
+ *	This procedure is invoked after a linked variable has been
+ *	changed by C code.  It updates the Tcl variable so that
+ *	traces on the variable will trigger.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The Tcl variable "varName" is updated from its C value,
+ *	causing traces on the variable to trigger.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_UpdateLinkedVar(interp, varName)
+    Tcl_Interp *interp;		/* Interpreter containing variable. */
+    char *varName;		/* Name of global variable that is linked. */
+{
+    Link *linkPtr;
+    char buffer[TCL_DOUBLE_SPACE];
+    int savedFlag;
+
+    linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
+	    LinkTraceProc, (ClientData) NULL);
+    if (linkPtr == NULL) {
+	return;
+    }
+    savedFlag = linkPtr->flags & LINK_BEING_UPDATED;
+    linkPtr->flags |= LINK_BEING_UPDATED;
+    Tcl_SetVar(interp, linkPtr->varName, StringValue(linkPtr, buffer),
+	    TCL_GLOBAL_ONLY);
+    linkPtr->flags = (linkPtr->flags & ~LINK_BEING_UPDATED) | savedFlag;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * LinkTraceProc --
+ *
+ *	This procedure is invoked when a linked Tcl variable is read,
+ *	written, or unset from Tcl.  It's responsible for keeping the
+ *	C variable in sync with the Tcl variable.
+ *
+ * Results:
+ *	If all goes well, NULL is returned; otherwise an error message
+ *	is returned.
+ *
+ * Side effects:
+ *	The C variable may be updated to make it consistent with the
+ *	Tcl variable, or the Tcl variable may be overwritten to reject
+ *	a modification.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+LinkTraceProc(clientData, interp, name1, name2, flags)
+    ClientData clientData;	/* Contains information about the link. */
+    Tcl_Interp *interp;		/* Interpreter containing Tcl variable. */
+    char *name1;		/* First part of variable name. */
+    char *name2;		/* Second part of variable name. */
+    int flags;			/* Miscellaneous additional information. */
+{
+    Link *linkPtr = (Link *) clientData;
+    int changed;
+    char buffer[TCL_DOUBLE_SPACE];
+    char *value, **pp;
+    Tcl_DString savedResult;
+
+    /*
+     * If the variable is being unset, then just re-create it (with a
+     * trace) unless the whole interpreter is going away.
+     */
+
+    if (flags & TCL_TRACE_UNSETS) {
+	if (flags & TCL_INTERP_DESTROYED) {
+	    ckfree(linkPtr->varName);
+	    ckfree((char *) linkPtr);
+	} else if (flags & TCL_TRACE_DESTROYED) {
+	    Tcl_SetVar(interp, linkPtr->varName, StringValue(linkPtr, buffer),
+		    TCL_GLOBAL_ONLY);
+	    Tcl_TraceVar(interp, linkPtr->varName, TCL_GLOBAL_ONLY
+		    |TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+		    LinkTraceProc, (ClientData) linkPtr);
+	}
+	return NULL;
+    }
+
+    /*
+     * If we were invoked because of a call to Tcl_UpdateLinkedVar, then
+     * don't do anything at all.  In particular, we don't want to get
+     * upset that the variable is being modified, even if it is
+     * supposed to be read-only.
+     */
+
+    if (linkPtr->flags & LINK_BEING_UPDATED) {
+	return NULL;
+    }
+
+    /*
+     * For read accesses, update the Tcl variable if the C variable
+     * has changed since the last time we updated the Tcl variable.
+     */
+
+    if (flags & TCL_TRACE_READS) {
+	switch (linkPtr->type) {
+	    case TCL_LINK_INT:
+	    case TCL_LINK_BOOLEAN:
+		changed = *(int *)(linkPtr->addr) != linkPtr->lastValue.i;
+		break;
+	    case TCL_LINK_DOUBLE:
+		changed = *(double *)(linkPtr->addr) != linkPtr->lastValue.d;
+		break;
+	    case TCL_LINK_STRING:
+		changed = 1;
+		break;
+	    default:
+		return "internal error: bad linked variable type";
+	}
+	if (changed) {
+	    Tcl_SetVar(interp, linkPtr->varName, StringValue(linkPtr, buffer),
+		    TCL_GLOBAL_ONLY);
+	}
+	return NULL;
+    }
+
+    /*
+     * For writes, first make sure that the variable is writable.  Then
+     * convert the Tcl value to C if possible.  If the variable isn't
+     * writable or can't be converted, then restore the varaible's old
+     * value and return an error.  Another tricky thing: we have to save
+     * and restore the interpreter's result, since the variable access
+     * could occur when the result has been partially set.
+     */
+
+    if (linkPtr->flags & LINK_READ_ONLY) {
+	Tcl_SetVar(interp, linkPtr->varName, StringValue(linkPtr, buffer),
+		TCL_GLOBAL_ONLY);
+	return "linked variable is read-only";
+    }
+    value = Tcl_GetVar(interp, linkPtr->varName, TCL_GLOBAL_ONLY);
+    if (value == NULL) {
+	/*
+	 * This shouldn't ever happen.
+	 */
+	return "internal error: linked variable couldn't be read";
+    }
+    Tcl_DStringInit(&savedResult);
+    Tcl_DStringAppend(&savedResult, interp->result, -1);
+    Tcl_ResetResult(interp);
+    switch (linkPtr->type) {
+	case TCL_LINK_INT:
+	    if (Tcl_GetInt(interp, value, &linkPtr->lastValue.i) != TCL_OK) {
+		Tcl_DStringResult(interp, &savedResult);
+		Tcl_SetVar(interp, linkPtr->varName,
+			StringValue(linkPtr, buffer), TCL_GLOBAL_ONLY);
+		return "variable must have integer value";
+	    }
+	    *(int *)(linkPtr->addr) = linkPtr->lastValue.i;
+	    break;
+	case TCL_LINK_DOUBLE:
+	    if (Tcl_GetDouble(interp, value, &linkPtr->lastValue.d)
+		    != TCL_OK) {
+		Tcl_DStringResult(interp, &savedResult);
+		Tcl_SetVar(interp, linkPtr->varName,
+			StringValue(linkPtr, buffer), TCL_GLOBAL_ONLY);
+		return "variable must have real value";
+	    }
+	    *(double *)(linkPtr->addr) = linkPtr->lastValue.d;
+	    break;
+	case TCL_LINK_BOOLEAN:
+	    if (Tcl_GetBoolean(interp, value, &linkPtr->lastValue.i)
+		    != TCL_OK) {
+		Tcl_DStringResult(interp, &savedResult);
+		Tcl_SetVar(interp, linkPtr->varName,
+			StringValue(linkPtr, buffer), TCL_GLOBAL_ONLY);
+		return "variable must have boolean value";
+	    }
+	    *(int *)(linkPtr->addr) = linkPtr->lastValue.i;
+	    break;
+	case TCL_LINK_STRING:
+	    pp = (char **)(linkPtr->addr);
+	    if (*pp != NULL) {
+		ckfree(*pp);
+	    }
+	    *pp = (char *) ckalloc((unsigned) (strlen(value) + 1));
+	    strcpy(*pp, value);
+	    break;
+	default:
+	    return "internal error: bad linked variable type";
+    }
+    Tcl_DStringResult(interp, &savedResult);
+    return NULL;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringValue --
+ *
+ *	Converts the value of a C variable to a string for use in a
+ *	Tcl variable to which it is linked.
+ *
+ * Results:
+ *	The return value is a pointer
+ to a string that represents
+ *	the value of the C variable given by linkPtr.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+StringValue(linkPtr, buffer)
+    Link *linkPtr;		/* Structure describing linked variable. */
+    char *buffer;		/* Small buffer to use for converting
+				 * values.  Must have TCL_DOUBLE_SPACE
+				 * bytes or more. */
+{
+    char *p;
+
+    switch (linkPtr->type) {
+	case TCL_LINK_INT:
+	    linkPtr->lastValue.i = *(int *)(linkPtr->addr);
+	    TclFormatInt(buffer, linkPtr->lastValue.i);
+	    return buffer;
+	case TCL_LINK_DOUBLE:
+	    linkPtr->lastValue.d = *(double *)(linkPtr->addr);
+	    Tcl_PrintDouble((Tcl_Interp *) NULL, linkPtr->lastValue.d, buffer);
+	    return buffer;
+	case TCL_LINK_BOOLEAN:
+	    linkPtr->lastValue.i = *(int *)(linkPtr->addr);
+	    if (linkPtr->lastValue.i != 0) {
+		return "1";
+	    }
+	    return "0";
+	case TCL_LINK_STRING:
+	    p = *(char **)(linkPtr->addr);
+	    if (p == NULL) {
+		return "NULL";
+	    }
+	    return p;
+    }
+
+    /*
+     * This code only gets executed if the link type is unknown
+     * (shouldn't ever happen).
+     */
+
+    return "??";
+}
Index: /trunk/tcl/tclListObj.c
===================================================================
--- /trunk/tcl/tclListObj.c	(revision 2)
+++ /trunk/tcl/tclListObj.c	(revision 2)
@@ -0,0 +1,1069 @@
+/* 
+ * tclListObj.c --
+ *
+ *	This file contains procedures that implement the Tcl list object
+ *	type.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclListObj.c,v 1.1 2008-06-04 13:58:07 demin Exp $
+ */
+
+#include "tclInt.h"
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static void		DupListInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
+			    Tcl_Obj *copyPtr));
+static void		FreeListInternalRep _ANSI_ARGS_((Tcl_Obj *listPtr));
+static int		SetListFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr));
+static void		UpdateStringOfList _ANSI_ARGS_((Tcl_Obj *listPtr));
+
+/*
+ * The structure below defines the list Tcl object type by means of
+ * procedures that can be invoked by generic object code.
+ */
+
+Tcl_ObjType tclListType = {
+    "list",				/* name */
+    FreeListInternalRep,		/* freeIntRepProc */
+    DupListInternalRep,		        /* dupIntRepProc */
+    UpdateStringOfList,			/* updateStringProc */
+    SetListFromAny			/* setFromAnyProc */
+};
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NewListObj --
+ *
+ *	This procedure is normally called when not debugging: i.e., when
+ *	TCL_MEM_DEBUG is not defined. It creates a new list object from an
+ *	(objc,objv) array: that is, each of the objc elements of the array
+ *	referenced by objv is inserted as an element into a new Tcl object.
+ *
+ *	When TCL_MEM_DEBUG is defined, this procedure just returns the
+ *	result of calling the debugging version Tcl_DbNewListObj.
+ *
+ * Results:
+ *	A new list object is returned that is initialized from the object
+ *	pointers in objv. If objc is less than or equal to zero, an empty
+ *	object is returned. The new object's string representation
+ *	is left NULL. The resulting new list object has ref count 0.
+ *
+ * Side effects:
+ *	The ref counts of the elements in objv are incremented since the
+ *	resulting list now refers to them.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+#undef Tcl_NewListObj
+
+Tcl_Obj *
+Tcl_NewListObj(objc, objv)
+    int objc;			/* Count of objects referenced by objv. */
+    Tcl_Obj *CONST objv[];	/* An array of pointers to Tcl objects. */
+{
+    return Tcl_DbNewListObj(objc, objv, "unknown", 0);
+}
+
+#else /* if not TCL_MEM_DEBUG */
+
+Tcl_Obj *
+Tcl_NewListObj(objc, objv)
+    int objc;			/* Count of objects referenced by objv. */
+    Tcl_Obj *CONST objv[];	/* An array of pointers to Tcl objects. */
+{
+    register Tcl_Obj *listPtr;
+    register Tcl_Obj **elemPtrs;
+    register List *listRepPtr;
+    int i;
+    
+    TclNewObj(listPtr);
+    
+    if (objc > 0) {
+	Tcl_InvalidateStringRep(listPtr);
+	
+	elemPtrs = (Tcl_Obj **)
+	    ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
+	for (i = 0;  i < objc;  i++) {
+	    elemPtrs[i] = objv[i];
+	    Tcl_IncrRefCount(elemPtrs[i]);
+	}
+	
+	listRepPtr = (List *) ckalloc(sizeof(List));
+	listRepPtr->maxElemCount = objc;
+	listRepPtr->elemCount    = objc;
+	listRepPtr->elements     = elemPtrs;
+	
+	listPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
+	listPtr->typePtr = &tclListType;
+    }
+    return listPtr;
+}
+#endif /* if TCL_MEM_DEBUG */
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DbNewListObj --
+ *
+ *	This procedure is normally called when debugging: i.e., when
+ *	TCL_MEM_DEBUG is defined. It creates new list objects. It is the
+ *	same as the Tcl_NewListObj procedure above except that it calls
+ *	Tcl_DbCkalloc directly with the file name and line number from its
+ *	caller. This simplifies debugging since then the checkmem command
+ *	will report the correct file name and line number when reporting
+ *	objects that haven't been freed.
+ *
+ *	When TCL_MEM_DEBUG is not defined, this procedure just returns the
+ *	result of calling Tcl_NewListObj.
+ *
+ * Results:
+ *	A new list object is returned that is initialized from the object
+ *	pointers in objv. If objc is less than or equal to zero, an empty
+ *	object is returned. The new object's string representation
+ *	is left NULL. The new list object has ref count 0.
+ *
+ * Side effects:
+ *	The ref counts of the elements in objv are incremented since the
+ *	resulting list now refers to them.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+
+Tcl_Obj *
+Tcl_DbNewListObj(objc, objv, file, line)
+    int objc;			/* Count of objects referenced by objv. */
+    Tcl_Obj *CONST objv[];	/* An array of pointers to Tcl objects. */
+    char *file;			/* The name of the source file calling this
+				 * procedure; used for debugging. */
+    int line;			/* Line number in the source file; used
+				 * for debugging. */
+{
+    register Tcl_Obj *listPtr;
+    register Tcl_Obj **elemPtrs;
+    register List *listRepPtr;
+    int i;
+    
+    TclDbNewObj(listPtr, file, line);
+    
+    if (objc > 0) {
+	Tcl_InvalidateStringRep(listPtr);
+	
+	elemPtrs = (Tcl_Obj **)
+	    ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
+	for (i = 0;  i < objc;  i++) {
+	    elemPtrs[i] = objv[i];
+	    Tcl_IncrRefCount(elemPtrs[i]);
+	}
+	
+	listRepPtr = (List *) ckalloc(sizeof(List));
+	listRepPtr->maxElemCount = objc;
+	listRepPtr->elemCount    = objc;
+	listRepPtr->elements     = elemPtrs;
+	
+	listPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
+	listPtr->typePtr = &tclListType;
+    }
+    return listPtr;
+}
+
+#else /* if not TCL_MEM_DEBUG */
+
+Tcl_Obj *
+Tcl_DbNewListObj(objc, objv, file, line)
+    int objc;			/* Count of objects referenced by objv. */
+    Tcl_Obj *CONST objv[];	/* An array of pointers to Tcl objects. */
+    char *file;			/* The name of the source file calling this
+				 * procedure; used for debugging. */
+    int line;			/* Line number in the source file; used
+				 * for debugging. */
+{
+    return Tcl_NewListObj(objc, objv);
+}
+#endif /* TCL_MEM_DEBUG */
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetListObj --
+ *
+ *	Modify an object to be a list containing each of the objc elements
+ *	of the object array referenced by objv.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object is made a list object and is initialized from the object
+ *	pointers in objv. If objc is less than or equal to zero, an empty
+ *	object is returned. The new object's string representation
+ *	is left NULL. The ref counts of the elements in objv are incremented
+ *	since the list now refers to them. The object's old string and
+ *	internal representations are freed and its type is set NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetListObj(objPtr, objc, objv)
+    Tcl_Obj *objPtr;		/* Object whose internal rep to init. */
+    int objc;			/* Count of objects referenced by objv. */
+    Tcl_Obj *CONST objv[];	/* An array of pointers to Tcl objects. */
+{
+    register Tcl_Obj **elemPtrs;
+    register List *listRepPtr;
+    Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+    int i;
+
+    if (Tcl_IsShared(objPtr)) {
+	panic("Tcl_SetListObj called with shared object");
+    }
+    
+    /*
+     * Free any old string rep and any internal rep for the old type.
+     */
+
+    Tcl_InvalidateStringRep(objPtr);
+    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+	objPtr->typePtr = NULL;
+    }
+        
+    /*
+     * Set the object's type to "list" and initialize the internal rep.
+     */
+
+    if (objc > 0) {
+	elemPtrs = (Tcl_Obj **)
+	    ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
+	for (i = 0;  i < objc;  i++) {
+	    elemPtrs[i] = objv[i];
+	    Tcl_IncrRefCount(elemPtrs[i]);
+	}
+	
+	listRepPtr = (List *) ckalloc(sizeof(List));
+	listRepPtr->maxElemCount = objc;
+	listRepPtr->elemCount    = objc;
+	listRepPtr->elements     = elemPtrs;
+	
+	objPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
+	objPtr->typePtr = &tclListType;
+    } else {
+	objPtr->bytes = tclEmptyStringRep;
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ListObjGetElements --
+ *
+ *	This procedure returns an (objc,objv) array of the elements in a
+ *	list object.
+ *
+ * Results:
+ *	The return value is normally TCL_OK; in this case *objcPtr is set to
+ *	the count of list elements and *objvPtr is set to a pointer to an
+ *	array of (*objcPtr) pointers to each list element. If listPtr does
+ *	not refer to a list object and the object can not be converted to
+ *	one, TCL_ERROR is returned and an error message will be left in
+ *	the interpreter's result if interp is not NULL.
+ *
+ *	The objects referenced by the returned array should be treated as
+ *	readonly and their ref counts are _not_ incremented; the caller must
+ *	do that if it holds on to a reference. Furthermore, the pointer
+ *	and length returned by this procedure may change as soon as any
+ *	procedure is called on the list object; be careful about retaining
+ *	the pointer in a local data structure.
+ *
+ * Side effects:
+ *	The possible conversion of the object referenced by listPtr
+ *	to a list object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr)
+    Tcl_Interp *interp;		/* Used to report errors if not NULL. */
+    register Tcl_Obj *listPtr;	/* List object for which an element array
+				 * is to be returned. */
+    int *objcPtr;		/* Where to store the count of objects
+				 * referenced by objv. */
+    Tcl_Obj ***objvPtr;		/* Where to store the pointer to an array
+				 * of pointers to the list's objects. */
+{
+    register List *listRepPtr;
+
+    if (listPtr->typePtr != &tclListType) {
+	int result = SetListFromAny(interp, listPtr);
+	if (result != TCL_OK) {
+	    return result;
+	}
+    }
+    listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
+    *objcPtr = listRepPtr->elemCount;
+    *objvPtr = listRepPtr->elements;
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ListObjAppendList --
+ *
+ *	This procedure appends the objects in the list referenced by
+ *	elemListPtr to the list object referenced by listPtr. If listPtr is
+ *	not already a list object, an attempt will be made to convert it to
+ *	one.
+ *
+ * Results:
+ *	The return value is normally TCL_OK. If listPtr or elemListPtr do
+ *	not refer to list objects and they can not be converted to one,
+ *	TCL_ERROR is returned and an error message is left in
+ *	the interpreter's result if interp is not NULL.
+ *
+ * Side effects:
+ *	The reference counts of the elements in elemListPtr are incremented
+ *	since the list now refers to them. listPtr and elemListPtr are
+ *	converted, if necessary, to list objects. Also, appending the
+ *	new elements may cause listObj's array of element pointers to grow.
+ *	listPtr's old string representation, if any, is invalidated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ListObjAppendList(interp, listPtr, elemListPtr)
+    Tcl_Interp *interp;		/* Used to report errors if not NULL. */
+    register Tcl_Obj *listPtr;	/* List object to append elements to. */
+    Tcl_Obj *elemListPtr;	/* List obj with elements to append. */
+{
+    register List *listRepPtr;
+    int listLen, objc, result;
+    Tcl_Obj **objv;
+
+    if (Tcl_IsShared(listPtr)) {
+	panic("Tcl_ListObjAppendList called with shared object");
+    }
+    if (listPtr->typePtr != &tclListType) {
+	result = SetListFromAny(interp, listPtr);
+	if (result != TCL_OK) {
+	    return result;
+	}
+    }
+    listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
+    listLen = listRepPtr->elemCount;
+
+    result = Tcl_ListObjGetElements(interp, elemListPtr, &objc, &objv);
+    if (result != TCL_OK) {
+	return result;
+    }
+
+    /*
+     * Insert objc new elements starting after the lists's last element.
+     * Delete zero existing elements.
+     */
+    
+    return Tcl_ListObjReplace(interp, listPtr, listLen, 0, objc, objv);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ListObjAppendElement --
+ *
+ *	This procedure is a special purpose version of
+ *	Tcl_ListObjAppendList: it appends a single object referenced by
+ *	objPtr to the list object referenced by listPtr. If listPtr is not
+ *	already a list object, an attempt will be made to convert it to one.
+ *
+ * Results:
+ *	The return value is normally TCL_OK; in this case objPtr is added
+ *	to the end of listPtr's list. If listPtr does not refer to a list
+ *	object and the object can not be converted to one, TCL_ERROR is
+ *	returned and an error message will be left in the interpreter's
+ *	result if interp is not NULL.
+ *
+ * Side effects:
+ *	The ref count of objPtr is incremented since the list now refers 
+ *	to it. listPtr will be converted, if necessary, to a list object.
+ *	Also, appending the new element may cause listObj's array of element
+ *	pointers to grow. listPtr's old string representation, if any,
+ *	is invalidated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ListObjAppendElement(interp, listPtr, objPtr)
+    Tcl_Interp *interp;		/* Used to report errors if not NULL. */
+    Tcl_Obj *listPtr;		/* List object to append objPtr to. */
+    Tcl_Obj *objPtr;		/* Object to append to listPtr's list. */
+{
+    register List *listRepPtr;
+    register Tcl_Obj **elemPtrs;
+    int numElems, numRequired;
+    
+    if (Tcl_IsShared(listPtr)) {
+	panic("Tcl_ListObjAppendElement called with shared object");
+    }
+    if (listPtr->typePtr != &tclListType) {
+	int result = SetListFromAny(interp, listPtr);
+	if (result != TCL_OK) {
+	    return result;
+	}
+    }
+
+    listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
+    elemPtrs = listRepPtr->elements;
+    numElems = listRepPtr->elemCount;
+    numRequired = numElems + 1 ;
+    
+    /*
+     * If there is no room in the current array of element pointers,
+     * allocate a new, larger array and copy the pointers to it.
+     */
+
+    if (numRequired > listRepPtr->maxElemCount) {
+	int newMax = (2 * numRequired);
+	Tcl_Obj **newElemPtrs = (Tcl_Obj **)
+	    ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
+	
+	memcpy((VOID *) newElemPtrs, (VOID *) elemPtrs,
+	       (size_t) (numElems * sizeof(Tcl_Obj *)));
+
+	listRepPtr->maxElemCount = newMax;
+	listRepPtr->elements = newElemPtrs;
+	ckfree((char *) elemPtrs);
+	elemPtrs = newElemPtrs;
+    }
+
+    /*
+     * Add objPtr to the end of listPtr's array of element
+     * pointers. Increment the ref count for the (now shared) objPtr.
+     */
+
+    elemPtrs[numElems] = objPtr;
+    Tcl_IncrRefCount(objPtr);
+    listRepPtr->elemCount++;
+
+    /*
+     * Invalidate any old string representation since the list's internal
+     * representation has changed.
+     */
+
+    Tcl_InvalidateStringRep(listPtr);
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ListObjIndex --
+ *
+ *	This procedure returns a pointer to the index'th object from the
+ *	list referenced by listPtr. The first element has index 0. If index
+ *	is negative or greater than or equal to the number of elements in
+ *	the list, a NULL is returned. If listPtr is not a list object, an
+ *	attempt will be made to convert it to a list.
+ *
+ * Results:
+ *	The return value is normally TCL_OK; in this case objPtrPtr is set
+ *	to the Tcl_Obj pointer for the index'th list element or NULL if
+ *	index is out of range. This object should be treated as readonly and
+ *	its ref count is _not_ incremented; the caller must do that if it
+ *	holds on to the reference. If listPtr does not refer to a list and
+ *	can't be converted to one, TCL_ERROR is returned and an error
+ *	message is left in the interpreter's result if interp is not NULL.
+ *
+ * Side effects:
+ *	listPtr will be converted, if necessary, to a list object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ListObjIndex(interp, listPtr, index, objPtrPtr)
+    Tcl_Interp *interp;		/* Used to report errors if not NULL. */
+    register Tcl_Obj *listPtr;	/* List object to index into. */
+    register int index;		/* Index of element to return. */
+    Tcl_Obj **objPtrPtr;	/* The resulting Tcl_Obj* is stored here. */
+{
+    register List *listRepPtr;
+    
+    if (listPtr->typePtr != &tclListType) {
+	int result = SetListFromAny(interp, listPtr);
+	if (result != TCL_OK) {
+	    return result;
+	}
+    }
+
+    listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
+    if ((index < 0) || (index >= listRepPtr->elemCount)) {
+	*objPtrPtr = NULL;
+    } else {
+	*objPtrPtr = listRepPtr->elements[index];
+    }
+    
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ListObjLength --
+ *
+ *	This procedure returns the number of elements in a list object. If
+ *	the object is not already a list object, an attempt will be made to
+ *	convert it to one.
+ *
+ * Results:
+ *	The return value is normally TCL_OK; in this case *intPtr will be
+ *	set to the integer count of list elements. If listPtr does not refer
+ *	to a list object and the object can not be converted to one,
+ *	TCL_ERROR is returned and an error message will be left in
+ *	the interpreter's result if interp is not NULL.
+ *
+ * Side effects:
+ *	The possible conversion of the argument object to a list object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ListObjLength(interp, listPtr, intPtr)
+    Tcl_Interp *interp;		/* Used to report errors if not NULL. */
+    register Tcl_Obj *listPtr;	/* List object whose #elements to return. */
+    register int *intPtr;	/* The resulting int is stored here. */
+{
+    register List *listRepPtr;
+    
+    if (listPtr->typePtr != &tclListType) {
+	int result = SetListFromAny(interp, listPtr);
+	if (result != TCL_OK) {
+	    return result;
+	}
+    }
+
+    listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
+    *intPtr = listRepPtr->elemCount;
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ListObjReplace --
+ * 
+ *	This procedure replaces zero or more elements of the list referenced
+ *	by listPtr with the objects from an (objc,objv) array. 
+ *	The objc elements of the array referenced by objv replace the
+ *	count elements in listPtr starting at first.
+ *
+ *	If the argument first is zero or negative, it refers to the first
+ *	element. If first is greater than or equal to the number of elements
+ *	in the list, then no elements are deleted; the new elements are
+ *	appended to the list. Count gives the number of elements to
+ *	replace. If count is zero or negative then no elements are deleted;
+ *	the new elements are simply inserted before first.
+ *
+ *	The argument objv refers to an array of objc pointers to the new
+ *	elements to be added to listPtr in place of those that were
+ *	deleted. If objv is NULL, no new elements are added. If listPtr is
+ *	not a list object, an attempt will be made to convert it to one.
+ *
+ * Results:
+ *	The return value is normally TCL_OK. If listPtr does
+ *	not refer to a list object and can not be converted to one,
+ *	TCL_ERROR is returned and an error message will be left in
+ *	the interpreter's result if interp is not NULL.
+ *
+ * Side effects:
+ *	The ref counts of the objc elements in objv are incremented since
+ *	the resulting list now refers to them. Similarly, the ref counts for
+ *	replaced objects are decremented. listPtr is converted, if
+ *	necessary, to a list object. listPtr's old string representation, if
+ *	any, is freed. 
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv)
+    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
+    Tcl_Obj *listPtr;		/* List object whose elements to replace. */
+    int first;			/* Index of first element to replace. */
+    int count;			/* Number of elements to replace. */
+    int objc;			/* Number of objects to insert. */
+    Tcl_Obj *CONST objv[];	/* An array of objc pointers to Tcl objects
+				 * to insert. */
+{
+    List *listRepPtr;
+    register Tcl_Obj **elemPtrs, **newPtrs;
+    Tcl_Obj *victimPtr;
+    int numElems, numRequired, numAfterLast;
+    int start, shift, newMax, i, j, result;
+     
+    if (Tcl_IsShared(listPtr)) {
+	panic("Tcl_ListObjReplace called with shared object");
+    }
+    if (listPtr->typePtr != &tclListType) {
+	result = SetListFromAny(interp, listPtr);
+	if (result != TCL_OK) {
+	    return result;
+	}
+    }
+    listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
+    elemPtrs = listRepPtr->elements;
+    numElems = listRepPtr->elemCount;
+
+    if (first < 0)  {
+    	first = 0;
+    }
+    if (first >= numElems) {
+	first = numElems;	/* so we'll insert after last element */
+    }
+    if (count < 0) {
+	count = 0;
+    }
+    
+    numRequired = (numElems - count + objc);
+    if (numRequired <= listRepPtr->maxElemCount) {
+	/*
+	 * Enough room in the current array. First "delete" count
+	 * elements starting at first.
+	 */
+
+	for (i = 0, j = first;  i < count;  i++, j++) {
+	    victimPtr = elemPtrs[j];
+	    TclDecrRefCount(victimPtr);
+	}
+
+	/*
+	 * Shift the elements after the last one removed to their
+	 * new locations.
+	 */
+
+	start = (first + count);
+	numAfterLast = (numElems - start);
+	shift = (objc - count);	/* numNewElems - numDeleted */
+	if ((numAfterLast > 0) && (shift != 0)) {
+	    Tcl_Obj **src, **dst;
+
+	    if (shift < 0) {
+		for (src = elemPtrs + start, dst = src + shift;
+			numAfterLast > 0; numAfterLast--, src++, dst++) {
+		    *dst = *src;
+		}
+	    } else {
+		for (src = elemPtrs + numElems - 1, dst = src + shift;
+			numAfterLast > 0; numAfterLast--, src--, dst--) {
+		    *dst = *src;
+		}
+	    }
+	}
+
+	/*
+	 * Insert the new elements into elemPtrs before "first".
+	 */
+
+	for (i = 0, j = first;  i < objc;  i++, j++) {
+            elemPtrs[j] = objv[i];
+            Tcl_IncrRefCount(objv[i]);
+        }
+
+	/*
+	 * Update the count of elements.
+	 */
+
+	listRepPtr->elemCount = numRequired;
+    } else {
+	/*
+	 * Not enough room in the current array. Allocate a larger array and
+	 * insert elements into it. 
+	 */
+
+	newMax = (2 * numRequired);
+	newPtrs = (Tcl_Obj **)
+	    ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
+
+	/*
+	 * Copy over the elements before "first".
+	 */
+
+	if (first > 0) {
+	    memcpy((VOID *) newPtrs, (VOID *) elemPtrs,
+		    (size_t) (first * sizeof(Tcl_Obj *)));
+	}
+
+	/*
+	 * "Delete" count elements starting at first.
+	 */
+
+	for (i = 0, j = first;  i < count;  i++, j++) {
+	    victimPtr = elemPtrs[j];
+	    TclDecrRefCount(victimPtr);
+	}
+
+	/*
+	 * Copy the elements after the last one removed, shifted to
+	 * their new locations.
+	 */
+
+	start = (first + count);
+	numAfterLast = (numElems - start);
+	if (numAfterLast > 0) {
+	    memcpy((VOID *) &(newPtrs[first + objc]),
+		    (VOID *) &(elemPtrs[start]),
+		    (size_t) (numAfterLast * sizeof(Tcl_Obj *)));
+	}
+	
+	/*
+	 * Insert the new elements before "first" and update the
+	 * count of elements.
+	 */
+
+	for (i = 0, j = first;  i < objc;  i++, j++) {
+	    newPtrs[j] = objv[i];
+	    Tcl_IncrRefCount(objv[i]);
+	}
+
+	listRepPtr->elemCount = numRequired;
+	listRepPtr->maxElemCount = newMax;
+	listRepPtr->elements = newPtrs;
+	ckfree((char *) elemPtrs);
+    }
+    
+    /*
+     * Invalidate and free any old string representation since it no longer
+     * reflects the list's internal representation.
+     */
+
+    Tcl_InvalidateStringRep(listPtr);
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeListInternalRep --
+ *
+ *	Deallocate the storage associated with a list object's internal
+ *	representation.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Frees listPtr's List* internal representation and sets listPtr's
+ *	internalRep.otherValuePtr to NULL. Decrements the ref counts
+ *	of all element objects, which may free them.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeListInternalRep(listPtr)
+    Tcl_Obj *listPtr;		/* List object with internal rep to free. */
+{
+    register List *listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
+    register Tcl_Obj **elemPtrs = listRepPtr->elements;
+    register Tcl_Obj *objPtr;
+    int numElems = listRepPtr->elemCount;
+    int i;
+    
+    for (i = 0;  i < numElems;  i++) {
+	objPtr = elemPtrs[i];
+	Tcl_DecrRefCount(objPtr);
+    }
+    ckfree((char *) elemPtrs);
+    ckfree((char *) listRepPtr);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupListInternalRep --
+ *
+ *	Initialize the internal representation of a list Tcl_Obj to a
+ *	copy of the internal representation of an existing list object. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	"srcPtr"s list internal rep pointer should not be NULL and we assume
+ *	it is not NULL. We set "copyPtr"s internal rep to a pointer to a
+ *	newly allocated List structure that, in turn, points to "srcPtr"s
+ *	element objects. Those element objects are not actually copied but
+ *	are shared between "srcPtr" and "copyPtr". The ref count of each
+ *	element object is incremented.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupListInternalRep(srcPtr, copyPtr)
+    Tcl_Obj *srcPtr;		/* Object with internal rep to copy. */
+    Tcl_Obj *copyPtr;		/* Object with internal rep to set. */
+{
+    List *srcListRepPtr = (List *) srcPtr->internalRep.otherValuePtr;
+    int numElems = srcListRepPtr->elemCount;
+    int maxElems = srcListRepPtr->maxElemCount;
+    register Tcl_Obj **srcElemPtrs = srcListRepPtr->elements;
+    register Tcl_Obj **copyElemPtrs;
+    register List *copyListRepPtr;
+    int i;
+
+    /*
+     * Allocate a new List structure that points to "srcPtr"s element
+     * objects. Increment the ref counts for those (now shared) element
+     * objects.
+     */
+    
+    copyElemPtrs = (Tcl_Obj **)
+	ckalloc((unsigned) maxElems * sizeof(Tcl_Obj *));
+    for (i = 0;  i < numElems;  i++) {
+	copyElemPtrs[i] = srcElemPtrs[i];
+	Tcl_IncrRefCount(copyElemPtrs[i]);
+    }
+    
+    copyListRepPtr = (List *) ckalloc(sizeof(List));
+    copyListRepPtr->maxElemCount = maxElems;
+    copyListRepPtr->elemCount    = numElems;
+    copyListRepPtr->elements     = copyElemPtrs;
+    
+    copyPtr->internalRep.otherValuePtr = (VOID *) copyListRepPtr;
+    copyPtr->typePtr = &tclListType;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetListFromAny --
+ *
+ *	Attempt to generate a list internal form for the Tcl object
+ *	"objPtr".
+ *
+ * Results:
+ *	The return value is TCL_OK or TCL_ERROR. If an error occurs during
+ *	conversion, an error message is left in the interpreter's result
+ *	unless "interp" is NULL.
+ *
+ * Side effects:
+ *	If no error occurs, a list is stored as "objPtr"s internal
+ *	representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetListFromAny(interp, objPtr)
+    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
+    Tcl_Obj *objPtr;		/* The object to convert. */
+{
+    Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+    char *string, *elemStart, *nextElem, *s;
+    int lenRemain, length, estCount, elemSize, hasBrace, i, j, result;
+    char *limit;		/* Points just after string's last byte. */
+    register char *p;
+    register Tcl_Obj **elemPtrs;
+    register Tcl_Obj *elemPtr;
+    List *listRepPtr;
+
+    /*
+     * Get the string representation. Make it up-to-date if necessary.
+     */
+
+    string = TclGetStringFromObj(objPtr, &length);
+
+    /*
+     * Parse the string into separate string objects, and create a List
+     * structure that points to the element string objects. We use a
+     * modified version of Tcl_SplitList's implementation to avoid one
+     * malloc and a string copy for each list element. First, estimate the
+     * number of elements by counting the number of space characters in the
+     * list.
+     */
+
+    limit = (string + length);
+    estCount = 1;
+    for (p = string;  p < limit;  p++) {
+	if (isspace(UCHAR(*p))) {
+	    estCount++;
+	}
+    }
+
+    /*
+     * Allocate a new List structure with enough room for "estCount"
+     * elements. Each element is a pointer to a Tcl_Obj with the appropriate
+     * string rep. The initial "estCount" elements are set using the
+     * corresponding "argv" strings.
+     */
+
+    elemPtrs = (Tcl_Obj **)
+	    ckalloc((unsigned) (estCount * sizeof(Tcl_Obj *)));
+    for (p = string, lenRemain = length, i = 0;
+	    lenRemain > 0;
+	    p = nextElem, lenRemain = (limit - nextElem), i++) {
+	result = TclFindElement(interp, p, lenRemain, &elemStart, &nextElem,
+				&elemSize, &hasBrace);
+	if (result != TCL_OK) {
+	    for (j = 0;  j < i;  j++) {
+		elemPtr = elemPtrs[j];
+		Tcl_DecrRefCount(elemPtr);
+	    }
+	    ckfree((char *) elemPtrs);
+	    return result;
+	}
+	if (elemStart >= limit) {
+	    break;
+	}
+	if (i > estCount) {
+	    panic("SetListFromAny: bad size estimate for list");
+	}
+
+	/*
+	 * Allocate a Tcl object for the element and initialize it from the
+	 * "elemSize" bytes starting at "elemStart".
+	 */
+
+	s = ckalloc((unsigned) elemSize + 1);
+	if (hasBrace) {
+	    memcpy((VOID *) s, (VOID *) elemStart,  (size_t) elemSize);
+	    s[elemSize] = 0;
+	} else {
+	    elemSize = TclCopyAndCollapse(elemSize, elemStart, s);
+	}
+	
+	TclNewObj(elemPtr);
+        elemPtr->bytes  = s;
+        elemPtr->length = elemSize;
+        elemPtrs[i] = elemPtr;
+	Tcl_IncrRefCount(elemPtr); /* since list now holds ref to it */
+    }
+
+    listRepPtr = (List *) ckalloc(sizeof(List));
+    listRepPtr->maxElemCount = estCount;
+    listRepPtr->elemCount    = i;
+    listRepPtr->elements     = elemPtrs;
+
+    /*
+     * Free the old internalRep before setting the new one. We do this as
+     * late as possible to allow the conversion code, in particular
+     * Tcl_GetStringFromObj, to use that old internalRep.
+     */
+
+    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+    }
+
+    objPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
+    objPtr->typePtr = &tclListType;
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfList --
+ *
+ *	Update the string representation for a list object.
+ *	Note: This procedure does not invalidate an existing old string rep
+ *	so storage will be lost if this has not already been done. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's string is set to a valid string that results from
+ *	the list-to-string conversion. This string will be empty if the
+ *	list has no elements. The list internal representation
+ *	should not be NULL and we assume it is not NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfList(listPtr)
+    Tcl_Obj *listPtr;		/* List object with string rep to update. */
+{
+#   define LOCAL_SIZE 20
+    int localFlags[LOCAL_SIZE], *flagPtr;
+    List *listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
+    int numElems = listRepPtr->elemCount;
+    register int i;
+    char *elem, *dst;
+    int length;
+
+    /*
+     * Convert each element of the list to string form and then convert it
+     * to proper list element form, adding it to the result buffer.
+     */
+
+    /*
+     * Pass 1: estimate space, gather flags.
+     */
+
+    if (numElems <= LOCAL_SIZE) {
+	flagPtr = localFlags;
+    } else {
+	flagPtr = (int *) ckalloc((unsigned) numElems*sizeof(int));
+    }
+    listPtr->length = 1;
+    for (i = 0; i < numElems; i++) {
+	elem = Tcl_GetStringFromObj(listRepPtr->elements[i], &length);
+	listPtr->length += Tcl_ScanCountedElement(elem, length,
+		&flagPtr[i]) + 1;
+    }
+
+    /*
+     * Pass 2: copy into string rep buffer.
+     */
+
+    listPtr->bytes = ckalloc((unsigned) listPtr->length);
+    dst = listPtr->bytes;
+    for (i = 0; i < numElems; i++) {
+	elem = Tcl_GetStringFromObj(listRepPtr->elements[i], &length);
+	dst += Tcl_ConvertCountedElement(elem, length, dst, flagPtr[i]);
+	*dst = ' ';
+	dst++;
+    }
+    if (flagPtr != localFlags) {
+	ckfree((char *) flagPtr);
+    }
+    if (dst == listPtr->bytes) {
+	*dst = 0;
+    } else {
+	dst--;
+	*dst = 0;
+    }
+    listPtr->length = dst - listPtr->bytes;
+}
Index: /trunk/tcl/tclMath.h
===================================================================
--- /trunk/tcl/tclMath.h	(revision 2)
+++ /trunk/tcl/tclMath.h	(revision 2)
@@ -0,0 +1,27 @@
+/*
+ * tclMath.h --
+ *
+ *	This file is necessary because of Metrowerks CodeWarrior Pro 1
+ *	on the Macintosh. With 8-byte doubles turned on, the definitions of
+ *	sin, cos, acos, etc., are screwed up.  They are fine as long as
+ *	they are used as function calls, but if the function pointers
+ *	are passed around and used, they will crash hard on the 68K.
+ *
+ * Copyright (c) 1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclMath.h,v 1.1 2008-06-04 13:58:08 demin Exp $
+ */
+
+#ifndef _TCLMATH
+#define _TCLMATH
+
+#if defined(MAC_TCL)
+#   include "tclMacMath.h"
+#else
+#   include <math.h>
+#endif
+
+#endif /* _TCLMATH */
Index: /trunk/tcl/tclNamesp.c
===================================================================
--- /trunk/tcl/tclNamesp.c	(revision 2)
+++ /trunk/tcl/tclNamesp.c	(revision 2)
@@ -0,0 +1,3890 @@
+/*
+ * tclNamesp.c --
+ *
+ *      Contains support for namespaces, which provide a separate context of
+ *      commands and global variables. The global :: namespace is the
+ *      traditional Tcl "global" scope. Other namespaces are created as
+ *      children of the global namespace. These other namespaces contain
+ *      special-purpose commands and variables for packages.
+ *
+ * Copyright (c) 1993-1997 Lucent Technologies.
+ * Copyright (c) 1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * Originally implemented by
+ *   Michael J. McLennan
+ *   Bell Labs Innovations for Lucent Technologies
+ *   mmclennan@lucent.com
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclNamesp.c,v 1.1 2008-06-04 13:58:08 demin Exp $
+ */
+
+#include "tclInt.h"
+
+/*
+ * Flag passed to TclGetNamespaceForQualName to indicate that it should
+ * search for a namespace rather than a command or variable inside a
+ * namespace. Note that this flag's value must not conflict with the values
+ * of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, or CREATE_NS_IF_UNKNOWN.
+ */
+
+#define FIND_ONLY_NS	0x1000
+
+/*
+ * Initial sise of stack allocated space for tail list - used when resetting
+ * shadowed command references in the functin: TclResetShadowedCmdRefs.
+ */
+
+#define NUM_TRAIL_ELEMS 5
+
+/*
+ * Count of the number of namespaces created. This value is used as a
+ * unique id for each namespace.
+ */
+
+static long numNsCreated = 0; 
+
+/*
+ * This structure contains a cached pointer to a namespace that is the
+ * result of resolving the namespace's name in some other namespace. It is
+ * the internal representation for a nsName object. It contains the
+ * pointer along with some information that is used to check the cached
+ * pointer's validity.
+ */
+
+typedef struct ResolvedNsName {
+    Namespace *nsPtr;		/* A cached namespace pointer. */
+    long nsId;			/* nsPtr's unique namespace id. Used to
+				 * verify that nsPtr is still valid
+				 * (e.g., it's possible that the namespace
+				 * was deleted and a new one created at
+				 * the same address). */
+    Namespace *refNsPtr;	/* Points to the namespace containing the
+				 * reference (not the namespace that
+				 * contains the referenced namespace). */
+    int refCount;		/* Reference count: 1 for each nsName
+				 * object that has a pointer to this
+				 * ResolvedNsName structure as its internal
+				 * rep. This structure can be freed when
+				 * refCount becomes zero. */
+} ResolvedNsName;
+
+/*
+ * Declarations for procedures local to this file:
+ */
+
+static void		DeleteImportedCmd _ANSI_ARGS_((
+			    ClientData clientData));
+static void		DupNsNameInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
+			    Tcl_Obj *copyPtr));
+static void		FreeNsNameInternalRep _ANSI_ARGS_((
+			    Tcl_Obj *objPtr));
+static int		GetNamespaceFromObj _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_Obj *objPtr,
+			    Tcl_Namespace **nsPtrPtr));
+static int		InvokeImportedCmd _ANSI_ARGS_((
+			    ClientData clientData, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+static int		NamespaceChildrenCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+static int		NamespaceCodeCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+static int		NamespaceCurrentCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+static int		NamespaceDeleteCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+static int		NamespaceEvalCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+static int		NamespaceExportCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+static int		NamespaceForgetCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+static void		NamespaceFree _ANSI_ARGS_((Namespace *nsPtr));
+static int		NamespaceImportCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+static int		NamespaceInscopeCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+static int		NamespaceOriginCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+static int		NamespaceParentCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+static int		NamespaceQualifiersCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+static int		NamespaceTailCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+static int		NamespaceWhichCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+static int		SetNsNameFromAny _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_Obj *objPtr));
+static void		UpdateStringOfNsName _ANSI_ARGS_((Tcl_Obj *objPtr));
+
+/*
+ * This structure defines a Tcl object type that contains a
+ * namespace reference.  It is used in commands that take the
+ * name of a namespace as an argument.  The namespace reference
+ * is resolved, and the result in cached in the object.
+ */
+
+Tcl_ObjType tclNsNameType = {
+    "nsName",			/* the type's name */
+    FreeNsNameInternalRep,	/* freeIntRepProc */
+    DupNsNameInternalRep,	/* dupIntRepProc */
+    UpdateStringOfNsName,	/* updateStringProc */
+    SetNsNameFromAny		/* setFromAnyProc */
+};
+
+/*
+ * Boolean flag indicating whether or not the namespName object
+ * type has been registered with the Tcl compiler.
+ */
+
+static int nsInitialized = 0;
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInitNamespaces --
+ *
+ *	Called when any interpreter is created to make sure that
+ *	things are properly set up for namespaces.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	On the first call, the namespName object type is registered
+ *	with the Tcl compiler.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclInitNamespaces()
+{
+    if (!nsInitialized) {
+        Tcl_RegisterObjType(&tclNsNameType);
+        nsInitialized = 1;
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetCurrentNamespace --
+ *
+ *	Returns a pointer to an interpreter's currently active namespace.
+ *
+ * Results:
+ *	Returns a pointer to the interpreter's current namespace.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Namespace *
+Tcl_GetCurrentNamespace(interp)
+    register Tcl_Interp *interp; /* Interpreter whose current namespace is
+				  * being queried. */
+{
+    register Interp *iPtr = (Interp *) interp;
+    register Namespace *nsPtr;
+
+    if (iPtr->varFramePtr != NULL) {
+        nsPtr = iPtr->varFramePtr->nsPtr;
+    } else {
+        nsPtr = iPtr->globalNsPtr;
+    }
+    return (Tcl_Namespace *) nsPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetGlobalNamespace --
+ *
+ *	Returns a pointer to an interpreter's global :: namespace.
+ *
+ * Results:
+ *	Returns a pointer to the specified interpreter's global namespace.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Namespace *
+Tcl_GetGlobalNamespace(interp)
+    register Tcl_Interp *interp; /* Interpreter whose global namespace 
+				  * should be returned. */
+{
+    register Interp *iPtr = (Interp *) interp;
+    
+    return (Tcl_Namespace *) iPtr->globalNsPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_PushCallFrame --
+ *
+ *	Pushes a new call frame onto the interpreter's Tcl call stack.
+ *	Called when executing a Tcl procedure or a "namespace eval" or
+ *	"namespace inscope" command. 
+ *
+ * Results:
+ *	Returns TCL_OK if successful, or TCL_ERROR (along with an error
+ *	message in the interpreter's result object) if something goes wrong.
+ *
+ * Side effects:
+ *	Modifies the interpreter's Tcl call stack.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_PushCallFrame(interp, callFramePtr, namespacePtr, isProcCallFrame)
+    Tcl_Interp *interp;		 /* Interpreter in which the new call frame
+				  * is to be pushed. */
+    Tcl_CallFrame *callFramePtr; /* Points to a call frame structure to
+				  * push. Storage for this have already been
+				  * allocated by the caller; typically this
+				  * is the address of a CallFrame structure
+				  * allocated on the caller's C stack.  The
+				  * call frame will be initialized by this
+				  * procedure. The caller can pop the frame
+				  * later with Tcl_PopCallFrame, and it is
+				  * responsible for freeing the frame's
+				  * storage. */
+    Tcl_Namespace *namespacePtr; /* Points to the namespace in which the
+				  * frame will execute. If NULL, the
+				  * interpreter's current namespace will
+				  * be used. */
+    int isProcCallFrame;	 /* If nonzero, the frame represents a
+				  * called Tcl procedure and may have local
+				  * vars. Vars will ordinarily be looked up
+				  * in the frame. If new variables are
+				  * created, they will be created in the
+				  * frame. If 0, the frame is for a
+				  * "namespace eval" or "namespace inscope"
+				  * command and var references are treated
+				  * as references to namespace variables. */
+{
+    Interp *iPtr = (Interp *) interp;
+    register CallFrame *framePtr = (CallFrame *) callFramePtr;
+    register Namespace *nsPtr;
+
+    if (namespacePtr == NULL) {
+	nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    } else {
+        nsPtr = (Namespace *) namespacePtr;
+        if (nsPtr->flags & NS_DEAD) {
+           panic("Trying to push call frame for dead namespace");
+            /*NOTREACHED*/
+        }
+    }
+
+    nsPtr->activationCount++;
+    framePtr->nsPtr = nsPtr;
+    framePtr->isProcCallFrame = isProcCallFrame;
+    framePtr->objc = 0;
+    framePtr->objv = NULL;
+    framePtr->callerPtr = iPtr->framePtr;
+    framePtr->callerVarPtr = iPtr->varFramePtr;
+    if (iPtr->varFramePtr != NULL) {
+        framePtr->level = (iPtr->varFramePtr->level + 1);
+    } else {
+        framePtr->level = 1;
+    }
+    framePtr->procPtr = NULL; 	   /* no called procedure */
+    framePtr->varTablePtr = NULL;  /* and no local variables */
+    framePtr->numCompiledLocals = 0;
+    framePtr->compiledLocals = NULL;
+
+    /*
+     * Push the new call frame onto the interpreter's stack of procedure
+     * call frames making it the current frame.
+     */
+
+    iPtr->framePtr = framePtr;
+    iPtr->varFramePtr = framePtr;
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_PopCallFrame --
+ *
+ *	Removes a call frame from the Tcl call stack for the interpreter.
+ *	Called to remove a frame previously pushed by Tcl_PushCallFrame.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Modifies the call stack of the interpreter. Resets various fields of
+ *	the popped call frame. If a namespace has been deleted and
+ *	has no more activations on the call stack, the namespace is
+ *	destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_PopCallFrame(interp)
+    Tcl_Interp* interp;		/* Interpreter with call frame to pop. */
+{
+    register Interp *iPtr = (Interp *) interp;
+    register CallFrame *framePtr = iPtr->framePtr;
+    int saveErrFlag;
+    Namespace *nsPtr;
+
+    /*
+     * It's important to remove the call frame from the interpreter's stack
+     * of call frames before deleting local variables, so that traces
+     * invoked by the variable deletion don't see the partially-deleted
+     * frame.
+     */
+
+    iPtr->framePtr = framePtr->callerPtr;
+    iPtr->varFramePtr = framePtr->callerVarPtr;
+
+    /*
+     * Delete the local variables. As a hack, we save then restore the
+     * ERR_IN_PROGRESS flag in the interpreter. The problem is that there
+     * could be unset traces on the variables, which cause scripts to be
+     * evaluated. This will clear the ERR_IN_PROGRESS flag, losing stack
+     * trace information if the procedure was exiting with an error. The
+     * code below preserves the flag. Unfortunately, that isn't really
+     * enough: we really should preserve the errorInfo variable too
+     * (otherwise a nested error in the trace script will trash errorInfo).
+     * What's really needed is a general-purpose mechanism for saving and
+     * restoring interpreter state.
+     */
+
+    saveErrFlag = (iPtr->flags & ERR_IN_PROGRESS);
+
+    if (framePtr->varTablePtr != NULL) {
+        TclDeleteVars(iPtr, framePtr->varTablePtr);
+        ckfree((char *) framePtr->varTablePtr);
+        framePtr->varTablePtr = NULL;
+    }
+    if (framePtr->numCompiledLocals > 0) {
+        TclDeleteCompiledLocalVars(iPtr, framePtr);
+    }
+
+    iPtr->flags |= saveErrFlag;
+
+    /*
+     * Decrement the namespace's count of active call frames. If the
+     * namespace is "dying" and there are no more active call frames,
+     * call Tcl_DeleteNamespace to destroy it.
+     */
+
+    nsPtr = framePtr->nsPtr;
+    nsPtr->activationCount--;
+    if ((nsPtr->flags & NS_DYING)
+	    && (nsPtr->activationCount == 0)) {
+        Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
+    }
+    framePtr->nsPtr = NULL;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateNamespace --
+ *
+ *	Creates a new namespace with the given name. If there is no
+ *	active namespace (i.e., the interpreter is being initialized),
+ *	the global :: namespace is created and returned.
+ *
+ * Results:
+ *	Returns a pointer to the new namespace if successful. If the
+ *	namespace already exists or if another error occurs, this routine
+ *	returns NULL, along with an error message in the interpreter's
+ *	result object.
+ *
+ * Side effects:
+ *	If the name contains "::" qualifiers and a parent namespace does
+ *	not already exist, it is automatically created. 
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Namespace *
+Tcl_CreateNamespace(interp, name, clientData, deleteProc)
+    Tcl_Interp *interp;             /* Interpreter in which a new namespace
+				     * is being created. Also used for
+				     * error reporting. */
+    char *name;                     /* Name for the new namespace. May be a
+				     * qualified name with names of ancestor
+				     * namespaces separated by "::"s. */
+    ClientData clientData;	    /* One-word value to store with
+				     * namespace. */
+    Tcl_NamespaceDeleteProc *deleteProc;
+    				    /* Procedure called to delete client
+				     * data when the namespace is deleted.
+				     * NULL if no procedure should be
+				     * called. */
+{
+    Interp *iPtr = (Interp *) interp;
+    register Namespace *nsPtr, *ancestorPtr;
+    Namespace *parentPtr, *dummy1Ptr, *dummy2Ptr;
+    Namespace *globalNsPtr = iPtr->globalNsPtr;
+    char *simpleName;
+    Tcl_HashEntry *entryPtr;
+    Tcl_DString buffer1, buffer2;
+    int newEntry;
+
+    /*
+     * If there is no active namespace, the interpreter is being
+     * initialized. 
+     */
+
+    if ((globalNsPtr == NULL) && (iPtr->varFramePtr == NULL)) {
+	/*
+	 * Treat this namespace as the global namespace, and avoid
+	 * looking for a parent.
+	 */
+	
+        parentPtr = NULL;
+        simpleName = "";
+    } else if (*name == '\0') {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"can't create namespace \"\": only global namespace can have empty name", (char *) NULL);
+	return NULL;
+    } else {
+	/*
+	 * Find the parent for the new namespace.
+	 */
+
+       TclGetNamespaceForQualName(interp, name, (Namespace *) NULL,
+           /*flags*/ CREATE_NS_IF_UNKNOWN, &parentPtr, &dummy1Ptr,
+           &dummy2Ptr, &simpleName);
+
+	/*
+	 * If the unqualified name at the end is empty, there were trailing
+	 * "::"s after the namespace's name which we ignore. The new
+	 * namespace was already (recursively) created and is pointed to
+	 * by parentPtr.
+	 */
+
+	if (*simpleName == '\0') {
+	    return (Tcl_Namespace *) parentPtr;
+	}
+
+        /*
+         * Check for a bad namespace name and make sure that the name
+	 * does not already exist in the parent namespace.
+	 */
+
+        if (Tcl_FindHashEntry(&parentPtr->childTable, simpleName) != NULL) {
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		    "can't create namespace \"", name,
+    	    	    "\": already exists", (char *) NULL);
+            return NULL;
+        }
+    }
+
+    /*
+     * Create the new namespace and root it in its parent. Increment the
+     * count of namespaces created.
+     */
+
+    numNsCreated++;
+
+    nsPtr = (Namespace *) ckalloc(sizeof(Namespace));
+    nsPtr->name            = (char *) ckalloc((unsigned) (strlen(simpleName)+1));
+    strcpy(nsPtr->name, simpleName);
+    nsPtr->fullName        = NULL;   /* set below */
+    nsPtr->clientData      = clientData;
+    nsPtr->deleteProc      = deleteProc;
+    nsPtr->parentPtr       = parentPtr;
+    Tcl_InitHashTable(&nsPtr->childTable, TCL_STRING_KEYS);
+    nsPtr->nsId            = numNsCreated;
+    nsPtr->interp          = interp;
+    nsPtr->flags           = 0;
+    nsPtr->activationCount = 0;
+    nsPtr->refCount        = 0;
+    Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);
+    Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS);
+    nsPtr->exportArrayPtr  = NULL;
+    nsPtr->numExportPatterns = 0;
+    nsPtr->maxExportPatterns = 0;
+    nsPtr->cmdRefEpoch       = 0;
+    nsPtr->resolverEpoch     = 0;
+    nsPtr->cmdResProc        = NULL;
+    nsPtr->varResProc        = NULL;
+    nsPtr->compiledVarResProc = NULL;
+
+    if (parentPtr != NULL) {
+        entryPtr = Tcl_CreateHashEntry(&parentPtr->childTable, simpleName,
+	        &newEntry);
+        Tcl_SetHashValue(entryPtr, (ClientData) nsPtr);
+    }
+
+    /*
+     * Build the fully qualified name for this namespace.
+     */
+
+    Tcl_DStringInit(&buffer1);
+    Tcl_DStringInit(&buffer2);
+    for (ancestorPtr = nsPtr;  ancestorPtr != NULL;
+	    ancestorPtr = ancestorPtr->parentPtr) {
+        if (ancestorPtr != globalNsPtr) {
+            Tcl_DStringAppend(&buffer1, "::", 2);
+            Tcl_DStringAppend(&buffer1, ancestorPtr->name, -1);
+        }
+        Tcl_DStringAppend(&buffer1, Tcl_DStringValue(&buffer2), -1);
+
+        Tcl_DStringSetLength(&buffer2, 0);
+        Tcl_DStringAppend(&buffer2, Tcl_DStringValue(&buffer1), -1);
+        Tcl_DStringSetLength(&buffer1, 0);
+    }
+    
+    name = Tcl_DStringValue(&buffer2);
+    nsPtr->fullName = (char *) ckalloc((unsigned) (strlen(name)+1));
+    strcpy(nsPtr->fullName, name);
+
+    Tcl_DStringFree(&buffer1);
+    Tcl_DStringFree(&buffer2);
+
+    /*
+     * Return a pointer to the new namespace.
+     */
+
+    return (Tcl_Namespace *) nsPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteNamespace --
+ *
+ *	Deletes a namespace and all of the commands, variables, and other
+ *	namespaces within it.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	When a namespace is deleted, it is automatically removed as a
+ *	child of its parent namespace. Also, all its commands, variables
+ *	and child namespaces are deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DeleteNamespace(namespacePtr)
+    Tcl_Namespace *namespacePtr;   /* Points to the namespace to delete. */
+{
+    register Namespace *nsPtr = (Namespace *) namespacePtr;
+    Interp *iPtr = (Interp *) nsPtr->interp;
+    Namespace *globalNsPtr =
+	    (Namespace *) Tcl_GetGlobalNamespace((Tcl_Interp *) iPtr);
+    Tcl_HashEntry *entryPtr;
+
+    /*
+     * If the namespace is on the call frame stack, it is marked as "dying"
+     * (NS_DYING is OR'd into its flags): the namespace can't be looked up
+     * by name but its commands and variables are still usable by those
+     * active call frames. When all active call frames referring to the
+     * namespace have been popped from the Tcl stack, Tcl_PopCallFrame will
+     * call this procedure again to delete everything in the namespace.
+     * If no nsName objects refer to the namespace (i.e., if its refCount 
+     * is zero), its commands and variables are deleted and the storage for
+     * its namespace structure is freed. Otherwise, if its refCount is
+     * nonzero, the namespace's commands and variables are deleted but the
+     * structure isn't freed. Instead, NS_DEAD is OR'd into the structure's
+     * flags to allow the namespace resolution code to recognize that the
+     * namespace is "deleted". The structure's storage is freed by
+     * FreeNsNameInternalRep when its refCount reaches 0.
+     */
+
+    if (nsPtr->activationCount > 0) {
+        nsPtr->flags |= NS_DYING;
+        if (nsPtr->parentPtr != NULL) {
+            entryPtr = Tcl_FindHashEntry(&nsPtr->parentPtr->childTable,
+		    nsPtr->name);
+            if (entryPtr != NULL) {
+                Tcl_DeleteHashEntry(entryPtr);
+            }
+        }
+        nsPtr->parentPtr = NULL;
+    } else {
+	/*
+	 * Delete the namespace and everything in it. If this is the global
+	 * namespace, then clear it but don't free its storage unless the
+	 * interpreter is being torn down.
+	 */
+
+        TclTeardownNamespace(nsPtr);
+
+        if ((nsPtr != globalNsPtr) || (iPtr->flags & DELETED)) {
+            /*
+	     * If this is the global namespace, then it may have residual
+             * "errorInfo" and "errorCode" variables for errors that
+             * occurred while it was being torn down.  Try to clear the
+             * variable list one last time.
+	     */
+
+            TclDeleteVars((Interp *) nsPtr->interp, &nsPtr->varTable);
+	    
+            Tcl_DeleteHashTable(&nsPtr->childTable);
+            Tcl_DeleteHashTable(&nsPtr->cmdTable);
+
+            /*
+             * If the reference count is 0, then discard the namespace.
+             * Otherwise, mark it as "dead" so that it can't be used.
+             */
+
+            if (nsPtr->refCount == 0) {
+                NamespaceFree(nsPtr);
+            } else {
+                nsPtr->flags |= NS_DEAD;
+            }
+        }
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclTeardownNamespace --
+ *
+ *	Used internally to dismantle and unlink a namespace when it is
+ *	deleted. Divorces the namespace from its parent, and deletes all
+ *	commands, variables, and child namespaces.
+ *
+ *	This is kept separate from Tcl_DeleteNamespace so that the global
+ *	namespace can be handled specially. Global variables like
+ *	"errorInfo" and "errorCode" need to remain intact while other
+ *	namespaces and commands are torn down, in case any errors occur.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Removes this namespace from its parent's child namespace hashtable.
+ *	Deletes all commands, variables and namespaces in this namespace.
+ *	If this is the global namespace, the "errorInfo" and "errorCode"
+ *	variables are left alone and deleted later.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclTeardownNamespace(nsPtr)
+    register Namespace *nsPtr;	/* Points to the namespace to be dismantled
+				 * and unlinked from its parent. */
+{
+    Interp *iPtr = (Interp *) nsPtr->interp;
+    register Tcl_HashEntry *entryPtr;
+    Tcl_HashSearch search;
+    Tcl_Namespace *childNsPtr;
+    Tcl_Command cmd;
+    Namespace *globalNsPtr =
+	    (Namespace *) Tcl_GetGlobalNamespace((Tcl_Interp *) iPtr);
+    int i;
+
+    /*
+     * Start by destroying the namespace's variable table,
+     * since variables might trigger traces.
+     */
+
+    if (nsPtr == globalNsPtr) {
+	/*
+	 * This is the global namespace, so be careful to preserve the
+	 * "errorInfo" and "errorCode" variables. These might be needed
+	 * later on if errors occur while deleting commands. We are careful
+	 * to destroy and recreate the "errorInfo" and "errorCode"
+	 * variables, in case they had any traces on them.
+	 */
+    
+        char *str, *errorInfoStr, *errorCodeStr;
+
+        str = Tcl_GetVar((Tcl_Interp *) iPtr, "errorInfo", TCL_GLOBAL_ONLY);
+        if (str != NULL) {
+            errorInfoStr = ckalloc((unsigned) (strlen(str)+1));
+            strcpy(errorInfoStr, str);
+        } else {
+            errorInfoStr = NULL;
+        }
+
+        str = Tcl_GetVar((Tcl_Interp *) iPtr, "errorCode", TCL_GLOBAL_ONLY);
+        if (str != NULL) {
+            errorCodeStr = ckalloc((unsigned) (strlen(str)+1));
+            strcpy(errorCodeStr, str);
+        } else {
+            errorCodeStr = NULL;
+        }
+
+        TclDeleteVars(iPtr, &nsPtr->varTable);
+        Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS);
+
+        if (errorInfoStr != NULL) {
+            Tcl_SetVar((Tcl_Interp *) iPtr, "errorInfo", errorInfoStr,
+                TCL_GLOBAL_ONLY);
+            ckfree(errorInfoStr);
+        }
+        if (errorCodeStr != NULL) {
+            Tcl_SetVar((Tcl_Interp *) iPtr, "errorCode", errorCodeStr,
+                TCL_GLOBAL_ONLY);
+            ckfree(errorCodeStr);
+        }
+    } else {
+	/*
+	 * Variable table should be cleared but not freed! TclDeleteVars
+	 * frees it, so we reinitialize it afterwards.
+	 */
+    
+        TclDeleteVars(iPtr, &nsPtr->varTable);
+        Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS);
+    }
+
+    /*
+     * Remove the namespace from its parent's child hashtable.
+     */
+
+    if (nsPtr->parentPtr != NULL) {
+        entryPtr = Tcl_FindHashEntry(&nsPtr->parentPtr->childTable,
+	        nsPtr->name);
+        if (entryPtr != NULL) {
+            Tcl_DeleteHashEntry(entryPtr);
+        }
+    }
+    nsPtr->parentPtr = NULL;
+
+    /*
+     * Delete all the child namespaces.
+     *
+     * BE CAREFUL: When each child is deleted, it will divorce
+     *    itself from its parent. You can't traverse a hash table
+     *    properly if its elements are being deleted. We use only
+     *    the Tcl_FirstHashEntry function to be safe.
+     */
+
+    for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
+            entryPtr != NULL;
+            entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search)) {
+        childNsPtr = (Tcl_Namespace *) Tcl_GetHashValue(entryPtr);
+        Tcl_DeleteNamespace(childNsPtr);
+    }
+
+    /*
+     * Delete all commands in this namespace. Be careful when traversing the
+     * hash table: when each command is deleted, it removes itself from the
+     * command table.
+     */
+
+    for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
+            entryPtr != NULL;
+            entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search)) {
+        cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr);
+        Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, cmd);
+    }
+    Tcl_DeleteHashTable(&nsPtr->cmdTable);
+    Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);
+
+    /*
+     * Free the namespace's export pattern array.
+     */
+
+    if (nsPtr->exportArrayPtr != NULL) {
+	for (i = 0;  i < nsPtr->numExportPatterns;  i++) {
+	    ckfree(nsPtr->exportArrayPtr[i]);
+	}
+        ckfree((char *) nsPtr->exportArrayPtr);
+	nsPtr->exportArrayPtr = NULL;
+	nsPtr->numExportPatterns = 0;
+	nsPtr->maxExportPatterns = 0;
+    }
+
+    /*
+     * Free any client data associated with the namespace.
+     */
+
+    if (nsPtr->deleteProc != NULL) {
+        (*nsPtr->deleteProc)(nsPtr->clientData);
+    }
+    nsPtr->deleteProc = NULL;
+    nsPtr->clientData = NULL;
+
+    /*
+     * Reset the namespace's id field to ensure that this namespace won't
+     * be interpreted as valid by, e.g., the cache validation code for
+     * cached command references in Tcl_GetCommandFromObj.
+     */
+
+    nsPtr->nsId = 0;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NamespaceFree --
+ *
+ *	Called after a namespace has been deleted, when its
+ *	reference count reaches 0.  Frees the data structure
+ *	representing the namespace.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+NamespaceFree(nsPtr)
+    register Namespace *nsPtr;	/* Points to the namespace to free. */
+{
+    /*
+     * Most of the namespace's contents are freed when the namespace is
+     * deleted by Tcl_DeleteNamespace. All that remains is to free its names
+     * (for error messages), and the structure itself.
+     */
+
+    ckfree(nsPtr->name);
+    ckfree(nsPtr->fullName);
+
+    ckfree((char *) nsPtr);
+}
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Export --
+ *
+ *	Makes all the commands matching a pattern available to later be
+ *	imported from the namespace specified by contextNsPtr (or the
+ *	current namespace if contextNsPtr is NULL). The specified pattern is
+ *	appended onto the namespace's export pattern list, which is
+ *	optionally cleared beforehand.
+ *
+ * Results:
+ *	Returns TCL_OK if successful, or TCL_ERROR (along with an error
+ *	message in the interpreter's result) if something goes wrong.
+ *
+ * Side effects:
+ *	Appends the export pattern onto the namespace's export list.
+ *	Optionally reset the namespace's export pattern list.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_Export(interp, namespacePtr, pattern, resetListFirst)
+    Tcl_Interp *interp;		 /* Current interpreter. */
+    Tcl_Namespace *namespacePtr; /* Points to the namespace from which 
+				  * commands are to be exported. NULL for
+                                  * the current namespace. */
+    char *pattern;               /* String pattern indicating which commands
+                                  * to export. This pattern may not include
+				  * any namespace qualifiers; only commands
+				  * in the specified namespace may be
+				  * exported. */
+    int resetListFirst;		 /* If nonzero, resets the namespace's
+				  * export list before appending 
+				  * be overwritten by imported commands.
+				  * If 0, return an error if an imported
+				  * cmd conflicts with an existing one. */
+{
+#define INIT_EXPORT_PATTERNS 5    
+    Namespace *nsPtr, *exportNsPtr, *dummyPtr;
+    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    char *simplePattern, *patternCpy;
+    int neededElems, len, i;
+
+    /*
+     * If the specified namespace is NULL, use the current namespace.
+     */
+
+    if (namespacePtr == NULL) {
+        nsPtr = (Namespace *) currNsPtr;
+    } else {
+        nsPtr = (Namespace *) namespacePtr;
+    }
+
+    /*
+     * If resetListFirst is true (nonzero), clear the namespace's export
+     * pattern list.
+     */
+
+    if (resetListFirst) {
+	if (nsPtr->exportArrayPtr != NULL) {
+	    for (i = 0;  i < nsPtr->numExportPatterns;  i++) {
+		ckfree(nsPtr->exportArrayPtr[i]);
+	    }
+	    ckfree((char *) nsPtr->exportArrayPtr);
+	    nsPtr->exportArrayPtr = NULL;
+	    nsPtr->numExportPatterns = 0;
+	    nsPtr->maxExportPatterns = 0;
+	}
+    }
+
+    /*
+     * Check that the pattern doesn't have namespace qualifiers.
+     */
+
+    TclGetNamespaceForQualName(interp, pattern, nsPtr,
+       /*flags*/ 0, &exportNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
+
+    if ((exportNsPtr != nsPtr) || (strcmp(pattern, simplePattern) != 0)) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+	        "invalid export pattern \"", pattern,
+		"\": pattern can't specify a namespace",
+		(char *) NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Make sure there is room in the namespace's pattern array for the
+     * new pattern.
+     */
+
+    neededElems = nsPtr->numExportPatterns + 1;
+    if (nsPtr->exportArrayPtr == NULL) {
+	nsPtr->exportArrayPtr = (char **)
+	        ckalloc((unsigned) (INIT_EXPORT_PATTERNS * sizeof(char *)));
+	nsPtr->numExportPatterns = 0;
+	nsPtr->maxExportPatterns = INIT_EXPORT_PATTERNS;
+    } else if (neededElems > nsPtr->maxExportPatterns) {
+	int numNewElems = 2 * nsPtr->maxExportPatterns;
+	size_t currBytes = nsPtr->numExportPatterns * sizeof(char *);
+	size_t newBytes  = numNewElems * sizeof(char *);
+	char **newPtr = (char **) ckalloc((unsigned) newBytes);
+
+	memcpy((VOID *) newPtr, (VOID *) nsPtr->exportArrayPtr,
+	        currBytes);
+	ckfree((char *) nsPtr->exportArrayPtr);
+	nsPtr->exportArrayPtr = (char **) newPtr;
+	nsPtr->maxExportPatterns = numNewElems;
+    }
+
+    /*
+     * Add the pattern to the namespace's array of export patterns.
+     */
+
+    len = strlen(pattern);
+    patternCpy = (char *) ckalloc((unsigned) (len + 1));
+    strcpy(patternCpy, pattern);
+    
+    nsPtr->exportArrayPtr[nsPtr->numExportPatterns] = patternCpy;
+    nsPtr->numExportPatterns++;
+    return TCL_OK;
+#undef INIT_EXPORT_PATTERNS
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AppendExportList --
+ *
+ *	Appends onto the argument object the list of export patterns for the
+ *	specified namespace.
+ *
+ * Results:
+ *	The return value is normally TCL_OK; in this case the object
+ *	referenced by objPtr has each export pattern appended to it. If an
+ *	error occurs, TCL_ERROR is returned and the interpreter's result
+ *	holds an error message.
+ *
+ * Side effects:
+ *	If necessary, the object referenced by objPtr is converted into
+ *	a list object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_AppendExportList(interp, namespacePtr, objPtr)
+    Tcl_Interp *interp;		 /* Interpreter used for error reporting. */
+    Tcl_Namespace *namespacePtr; /* Points to the namespace whose export
+				  * pattern list is appended onto objPtr.
+				  * NULL for the current namespace. */
+    Tcl_Obj *objPtr;		 /* Points to the Tcl object onto which the
+				  * export pattern list is appended. */
+{
+    Namespace *nsPtr;
+    int i, result;
+
+    /*
+     * If the specified namespace is NULL, use the current namespace.
+     */
+
+    if (namespacePtr == NULL) {
+        nsPtr = (Namespace *) (Namespace *) Tcl_GetCurrentNamespace(interp);
+    } else {
+        nsPtr = (Namespace *) namespacePtr;
+    }
+
+    /*
+     * Append the export pattern list onto objPtr.
+     */
+
+    for (i = 0;  i < nsPtr->numExportPatterns;  i++) {
+	result = Tcl_ListObjAppendElement(interp, objPtr,
+		Tcl_NewStringObj(nsPtr->exportArrayPtr[i], -1));
+	if (result != TCL_OK) {
+	    return result;
+	}
+    }
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Import --
+ *
+ *	Imports all of the commands matching a pattern into the namespace
+ *	specified by contextNsPtr (or the current namespace if contextNsPtr
+ *	is NULL). This is done by creating a new command (the "imported
+ *	command") that points to the real command in its original namespace.
+ *
+ *      If matching commands are on the autoload path but haven't been
+ *	loaded yet, this command forces them to be loaded, then creates
+ *	the links to them.
+ *
+ * Results:
+ *	Returns TCL_OK if successful, or TCL_ERROR (along with an error
+ *	message in the interpreter's result) if something goes wrong.
+ *
+ * Side effects:
+ *	Creates new commands in the importing namespace. These indirect
+ *	calls back to the real command and are deleted if the real commands
+ *	are deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
+    Tcl_Interp *interp;		 /* Current interpreter. */
+    Tcl_Namespace *namespacePtr; /* Points to the namespace into which the
+				  * commands are to be imported. NULL for
+                                  * the current namespace. */
+    char *pattern;               /* String pattern indicating which commands
+                                  * to import. This pattern should be
+				  * qualified by the name of the namespace
+				  * from which to import the command(s). */
+    int allowOverwrite;		 /* If nonzero, allow existing commands to
+				  * be overwritten by imported commands.
+				  * If 0, return an error if an imported
+				  * cmd conflicts with an existing one. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Namespace *nsPtr, *importNsPtr, *dummyPtr;
+    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    char *simplePattern, *cmdName;
+    register Tcl_HashEntry *hPtr;
+    Tcl_HashSearch search;
+    Command *cmdPtr;
+    ImportRef *refPtr;
+    Tcl_Command autoCmd, importedCmd;
+    ImportedCmdData *dataPtr;
+    int wasExported, i, result;
+
+    /*
+     * If the specified namespace is NULL, use the current namespace.
+     */
+
+    if (namespacePtr == NULL) {
+        nsPtr = (Namespace *) currNsPtr;
+    } else {
+        nsPtr = (Namespace *) namespacePtr;
+    }
+ 
+    /*
+     * First, invoke the "auto_import" command with the pattern
+     * being imported.  This command is part of the Tcl library.
+     * It looks for imported commands in autoloaded libraries and
+     * loads them in.  That way, they will be found when we try
+     * to create links below.
+     */
+    
+    autoCmd = Tcl_FindCommand(interp, "auto_import",
+ 	    (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY);
+ 
+    if (autoCmd != NULL) {
+	Tcl_Obj *objv[2];
+ 
+	objv[0] = Tcl_NewStringObj("auto_import", -1);
+	Tcl_IncrRefCount(objv[0]);
+	objv[1] = Tcl_NewStringObj(pattern, -1);
+	Tcl_IncrRefCount(objv[1]);
+ 
+	cmdPtr = (Command *) autoCmd;
+	result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp,
+		2, objv);
+ 
+	Tcl_DecrRefCount(objv[0]);
+	Tcl_DecrRefCount(objv[1]);
+ 
+	if (result != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	Tcl_ResetResult(interp);
+    }
+
+    /*
+     * From the pattern, find the namespace from which we are importing
+     * and get the simple pattern (no namespace qualifiers or ::'s) at
+     * the end.
+     */
+
+    if (strlen(pattern) == 0) {
+	Tcl_SetStringObj(Tcl_GetObjResult(interp),
+	        "empty import pattern", -1);
+        return TCL_ERROR;
+    }
+    TclGetNamespaceForQualName(interp, pattern, nsPtr,
+       /*flags*/ 0, &importNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
+
+    if (importNsPtr == NULL) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"unknown namespace in import pattern \"",
+		pattern, "\"", (char *) NULL);
+        return TCL_ERROR;
+    }
+    if (importNsPtr == nsPtr) {
+	if (pattern == simplePattern) {
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		    "no namespace specified in import pattern \"", pattern,
+		    "\"", (char *) NULL);
+	} else {
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		    "import pattern \"", pattern,
+		    "\" tries to import from namespace \"",
+		    importNsPtr->name, "\" into itself", (char *) NULL);
+	}
+        return TCL_ERROR;
+    }
+
+    /*
+     * Scan through the command table in the source namespace and look for
+     * exported commands that match the string pattern. Create an "imported
+     * command" in the current namespace for each imported command; these
+     * commands redirect their invocations to the "real" command.
+     */
+
+    for (hPtr = Tcl_FirstHashEntry(&importNsPtr->cmdTable, &search);
+	    (hPtr != NULL);
+	    hPtr = Tcl_NextHashEntry(&search)) {
+        cmdName = Tcl_GetHashKey(&importNsPtr->cmdTable, hPtr);
+        if (Tcl_StringMatch(cmdName, simplePattern)) {
+	    /*
+	     * The command cmdName in the source namespace matches the
+	     * pattern. Check whether it was exported. If it wasn't,
+	     * we ignore it.
+	     */
+
+	    wasExported = 0;
+	    for (i = 0;  i < importNsPtr->numExportPatterns;  i++) {
+		if (Tcl_StringMatch(cmdName,
+			importNsPtr->exportArrayPtr[i])) {
+		    wasExported = 1;
+		    break;
+		}
+	    }
+	    if (!wasExported) {
+		continue;
+            }
+
+	    /*
+	     * Unless there is a name clash, create an imported command
+	     * in the current namespace that refers to cmdPtr.
+	     */
+	    
+            if ((Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName) == NULL)
+		    || allowOverwrite) {
+		/*
+		 * Create the imported command and its client data.
+		 * To create the new command in the current namespace, 
+		 * generate a fully qualified name for it.
+		 */
+
+		Tcl_DString ds;
+
+		Tcl_DStringInit(&ds);
+		Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
+		if (nsPtr != iPtr->globalNsPtr) {
+		    Tcl_DStringAppend(&ds, "::", 2);
+		}
+		Tcl_DStringAppend(&ds, cmdName, -1);
+		
+		cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+		dataPtr = (ImportedCmdData *)
+		        ckalloc(sizeof(ImportedCmdData));
+                importedCmd = Tcl_CreateObjCommand(interp, 
+                        Tcl_DStringValue(&ds), InvokeImportedCmd,
+                        (ClientData) dataPtr, DeleteImportedCmd);
+		dataPtr->realCmdPtr = cmdPtr;
+		dataPtr->selfPtr = (Command *) importedCmd;
+
+		/*
+		 * Create an ImportRef structure describing this new import
+		 * command and add it to the import ref list in the "real"
+		 * command.
+		 */
+
+                refPtr = (ImportRef *) ckalloc(sizeof(ImportRef));
+                refPtr->importedCmdPtr = (Command *) importedCmd;
+                refPtr->nextPtr = cmdPtr->importRefPtr;
+                cmdPtr->importRefPtr = refPtr;
+            } else {
+		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		        "can't import command \"", cmdName,
+			"\": already exists", (char *) NULL);
+                return TCL_ERROR;
+            }
+        }
+    }
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ForgetImport --
+ *
+ *	Deletes previously imported commands. Given a pattern that may
+ *	include the name of an exporting namespace, this procedure first
+ *	finds all matching exported commands. It then looks in the namespace
+ *	specified by namespacePtr for any corresponding previously imported
+ *	commands, which it deletes. If namespacePtr is NULL, commands are
+ *	deleted from the current namespace.
+ *
+ * Results:
+ *	Returns TCL_OK if successful. If there is an error, returns
+ *	TCL_ERROR and puts an error message in the interpreter's result
+ *	object.
+ *
+ * Side effects:
+ *	May delete commands. 
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ForgetImport(interp, namespacePtr, pattern)
+    Tcl_Interp *interp;		 /* Current interpreter. */
+    Tcl_Namespace *namespacePtr; /* Points to the namespace from which
+				  * previously imported commands should be
+				  * removed. NULL for current namespace. */
+    char *pattern;		 /* String pattern indicating which imported
+				  * commands to remove. This pattern should
+				  * be qualified by the name of the
+				  * namespace from which the command(s) were
+				  * imported. */
+{
+    Namespace *nsPtr, *importNsPtr, *dummyPtr, *actualCtxPtr;
+    char *simplePattern, *cmdName;
+    register Tcl_HashEntry *hPtr;
+    Tcl_HashSearch search;
+    Command *cmdPtr;
+
+    /*
+     * If the specified namespace is NULL, use the current namespace.
+     */
+
+    if (namespacePtr == NULL) {
+        nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    } else {
+        nsPtr = (Namespace *) namespacePtr;
+    }
+
+    /*
+     * From the pattern, find the namespace from which we are importing
+     * and get the simple pattern (no namespace qualifiers or ::'s) at
+     * the end.
+     */
+
+    TclGetNamespaceForQualName(interp, pattern, nsPtr,
+       /*flags*/ 0, &importNsPtr, &dummyPtr, &actualCtxPtr, &simplePattern);
+
+    if (importNsPtr == NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"unknown namespace in namespace forget pattern \"",
+		pattern, "\"", (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    /*
+     * Scan through the command table in the source namespace and look for
+     * exported commands that match the string pattern. If the current
+     * namespace has an imported command that refers to one of those real
+     * commands, delete it.
+     */
+
+    for (hPtr = Tcl_FirstHashEntry(&importNsPtr->cmdTable, &search);
+            (hPtr != NULL);
+            hPtr = Tcl_NextHashEntry(&search)) {
+        cmdName = Tcl_GetHashKey(&importNsPtr->cmdTable, hPtr);
+        if (Tcl_StringMatch(cmdName, simplePattern)) {
+            hPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName);
+            if (hPtr != NULL) {	/* cmd of same name in current namespace */
+                cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+                if (cmdPtr->deleteProc == DeleteImportedCmd) { 
+                    Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
+                }
+            }
+        }
+    }
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetOriginalCommand --
+ *
+ *	An imported command is created in an namespace when it imports a
+ *	"real" command from another namespace. If the specified command is a
+ *	imported command, this procedure returns the original command it
+ *	refers to.  
+ *
+ * Results:
+ *	If the command was imported into a sequence of namespaces a, b,...,n
+ *	where each successive namespace just imports the command from the
+ *	previous namespace, this procedure returns the Tcl_Command token in
+ *	the first namespace, a. Otherwise, if the specified command is not
+ *	an imported command, the procedure returns NULL.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Command
+TclGetOriginalCommand(command)
+    Tcl_Command command;	/* The command for which the original
+				 * command should be returned. */
+{
+    register Command *cmdPtr = (Command *) command;
+    ImportedCmdData *dataPtr;
+
+    if (cmdPtr->deleteProc != DeleteImportedCmd) {
+	return (Tcl_Command) NULL;
+    }
+    
+    while (cmdPtr->deleteProc == DeleteImportedCmd) {
+	dataPtr = (ImportedCmdData *) cmdPtr->objClientData;
+	cmdPtr = dataPtr->realCmdPtr;
+    }
+    return (Tcl_Command) cmdPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InvokeImportedCmd --
+ *
+ *	Invoked by Tcl whenever the user calls an imported command that
+ *	was created by Tcl_Import. Finds the "real" command (in another
+ *	namespace), and passes control to it.
+ *
+ * Results:
+ *	Returns TCL_OK if successful, and  TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	Returns a result in the interpreter's result object. If anything
+ *	goes wrong, the result object is set to an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InvokeImportedCmd(clientData, interp, objc, objv)
+    ClientData clientData;	/* Points to the imported command's
+				 * ImportedCmdData structure. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* The argument objects. */
+{
+    register ImportedCmdData *dataPtr = (ImportedCmdData *) clientData;
+    register Command *realCmdPtr = dataPtr->realCmdPtr;
+
+    return (*realCmdPtr->objProc)(realCmdPtr->objClientData, interp,
+            objc, objv);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteImportedCmd --
+ *
+ *	Invoked by Tcl whenever an imported command is deleted. The "real"
+ *	command keeps a list of all the imported commands that refer to it,
+ *	so those imported commands can be deleted when the real command is
+ *	deleted. This procedure removes the imported command reference from
+ *	the real command's list, and frees up the memory associated with
+ *	the imported command.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Removes the imported command from the real command's import list.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteImportedCmd(clientData)
+    ClientData clientData;	/* Points to the imported command's
+				 * ImportedCmdData structure. */
+{
+    ImportedCmdData *dataPtr = (ImportedCmdData *) clientData;
+    Command *realCmdPtr = dataPtr->realCmdPtr;
+    Command *selfPtr = dataPtr->selfPtr;
+    register ImportRef *refPtr, *prevPtr;
+
+    prevPtr = NULL;
+    for (refPtr = realCmdPtr->importRefPtr;  refPtr != NULL;
+            refPtr = refPtr->nextPtr) {
+	if (refPtr->importedCmdPtr == selfPtr) {
+	    /*
+	     * Remove *refPtr from real command's list of imported commands
+	     * that refer to it.
+	     */
+	    
+	    if (prevPtr == NULL) { /* refPtr is first in list */
+		realCmdPtr->importRefPtr = refPtr->nextPtr;
+	    } else {
+		prevPtr->nextPtr = refPtr->nextPtr;
+	    }
+	    ckfree((char *) refPtr);
+	    ckfree((char *) dataPtr);
+	    return;
+	}
+	prevPtr = refPtr;
+    }
+	
+    panic("DeleteImportedCmd: did not find cmd in real cmd's list of import references");
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetNamespaceForQualName --
+ *
+ *	Given a qualified name specifying a command, variable, or namespace,
+ *	and a namespace in which to resolve the name, this procedure returns
+ *	a pointer to the namespace that contains the item. A qualified name
+ *	consists of the "simple" name of an item qualified by the names of
+ *	an arbitrary number of containing namespace separated by "::"s. If
+ *	the qualified name starts with "::", it is interpreted absolutely
+ *	from the global namespace. Otherwise, it is interpreted relative to
+ *	the namespace specified by cxtNsPtr if it is non-NULL. If cxtNsPtr
+ *	is NULL, the name is interpreted relative to the current namespace.
+ *
+ *	A relative name like "foo::bar::x" can be found starting in either
+ *	the current namespace or in the global namespace. So each search
+ *	usually follows two tracks, and two possible namespaces are
+ *	returned. If the procedure sets either *nsPtrPtr or *altNsPtrPtr to
+ *	NULL, then that path failed.
+ *
+ *	If "flags" contains TCL_GLOBAL_ONLY, the relative qualified name is
+ *	sought only in the global :: namespace. The alternate search
+ *	(also) starting from the global namespace is ignored and
+ *	*altNsPtrPtr is set NULL. 
+ *
+ *	If "flags" contains TCL_NAMESPACE_ONLY, the relative qualified
+ *	name is sought only in the namespace specified by cxtNsPtr. The
+ *	alternate search starting from the global namespace is ignored and
+ *	*altNsPtrPtr is set NULL. If both TCL_GLOBAL_ONLY and
+ *	TCL_NAMESPACE_ONLY are specified, TCL_GLOBAL_ONLY is ignored and
+ *	the search starts from the namespace specified by cxtNsPtr.
+ *
+ *	If "flags" contains CREATE_NS_IF_UNKNOWN, all namespace
+ *	components of the qualified name that cannot be found are
+ *	automatically created within their specified parent. This makes sure
+ *	that functions like Tcl_CreateCommand always succeed. There is no
+ *	alternate search path, so *altNsPtrPtr is set NULL.
+ *
+ *	If "flags" contains FIND_ONLY_NS, the qualified name is treated as a
+ *	reference to a namespace, and the entire qualified name is
+ *	followed. If the name is relative, the namespace is looked up only
+ *	in the current namespace. A pointer to the namespace is stored in
+ *	*nsPtrPtr and NULL is stored in *simpleNamePtr. Otherwise, if
+ *	FIND_ONLY_NS is not specified, only the leading components are
+ *	treated as namespace names, and a pointer to the simple name of the
+ *	final component is stored in *simpleNamePtr.
+ *
+ * Results:
+ *     It sets *nsPtrPtr and *altNsPtrPtr to point to the two possible
+ *     namespaces which represent the last (containing) namespace in the
+ *     qualified name. If the procedure sets either *nsPtrPtr or *altNsPtrPtr
+ *     to NULL, then the search along that path failed.  The procedure also
+ *     stores a pointer to the simple name of the final component in
+ *     *simpleNamePtr. If the qualified name is "::" or was treated as a
+ *     namespace reference (FIND_ONLY_NS), the procedure stores a pointer
+ *     to the namespace in *nsPtrPtr, NULL in *altNsPtrPtr, and sets
+ *	*simpleNamePtr to point to an empty string.
+ *
+ *	*actualCxtPtrPtr is set to the actual context namespace. It is
+ *	set to the input context namespace pointer in cxtNsPtr. If cxtNsPtr
+ *	is NULL, it is set to the current namespace context.
+ *
+ *	For backwards compatibility with the TclPro byte code loader,
+ *	this function always returns TCL_OK.
+ *
+ * Side effects:
+ *     If "flags" contains CREATE_NS_IF_UNKNOWN, new namespaces may be
+ *     created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
+	nsPtrPtr, altNsPtrPtr, actualCxtPtrPtr, simpleNamePtr)
+    Tcl_Interp *interp;		 /* Interpreter in which to find the
+				  * namespace containing qualName. */
+    register char *qualName;	 /* A namespace-qualified name of an
+				  * command, variable, or namespace. */
+    Namespace *cxtNsPtr;	 /* The namespace in which to start the
+				  * search for qualName's namespace. If NULL
+				  * start from the current namespace.
+				  * Ignored if TCL_GLOBAL_ONLY or
+				  * TCL_NAMESPACE_ONLY are set. */
+    int flags;			 /* Flags controlling the search: an OR'd
+				  * combination of TCL_GLOBAL_ONLY,
+				  * TCL_NAMESPACE_ONLY,
+				  * CREATE_NS_IF_UNKNOWN, and
+				  * FIND_ONLY_NS. */
+    Namespace **nsPtrPtr;	 /* Address where procedure stores a pointer
+				  * to containing namespace if qualName is
+				  * found starting from *cxtNsPtr or, if
+				  * TCL_GLOBAL_ONLY is set, if qualName is
+				  * found in the global :: namespace. NULL
+				  * is stored otherwise. */
+    Namespace **altNsPtrPtr;	 /* Address where procedure stores a pointer
+				  * to containing namespace if qualName is
+				  * found starting from the global ::
+				  * namespace. NULL is stored if qualName
+				  * isn't found starting from :: or if the
+				  * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
+				  * CREATE_NS_IF_UNKNOWN, FIND_ONLY_NS flag
+				  * is set. */
+    Namespace **actualCxtPtrPtr; /* Address where procedure stores a pointer
+				  * to the actual namespace from which the
+				  * search started. This is either cxtNsPtr,
+				  * the :: namespace if TCL_GLOBAL_ONLY was
+				  * specified, or the current namespace if
+				  * cxtNsPtr was NULL. */
+    char **simpleNamePtr;	 /* Address where procedure stores the
+				  * simple name at end of the qualName, or
+				  * NULL if qualName is "::" or the flag
+				  * FIND_ONLY_NS was specified. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Namespace *nsPtr = cxtNsPtr;
+    Namespace *altNsPtr;
+    Namespace *globalNsPtr = iPtr->globalNsPtr;
+    register char *start, *end;
+    char *nsName;
+    Tcl_HashEntry *entryPtr;
+    Tcl_DString buffer;
+    int len;
+
+    /*
+     * Determine the context namespace nsPtr in which to start the primary
+     * search. If TCL_NAMESPACE_ONLY or FIND_ONLY_NS was specified, search
+     * from the current namespace. If the qualName name starts with a "::"
+     * or TCL_GLOBAL_ONLY was specified, search from the global
+     * namespace. Otherwise, use the given namespace given in cxtNsPtr, or
+     * if that is NULL, use the current namespace context. Note that we
+     * always treat two or more adjacent ":"s as a namespace separator.
+     */
+
+    if (flags & (TCL_NAMESPACE_ONLY | FIND_ONLY_NS)) {
+	nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    } else if (flags & TCL_GLOBAL_ONLY) {
+	nsPtr = globalNsPtr;
+    } else if (nsPtr == NULL) {
+	if (iPtr->varFramePtr != NULL) {
+	    nsPtr = iPtr->varFramePtr->nsPtr;
+	} else {
+	    nsPtr = iPtr->globalNsPtr;
+	}
+    }
+
+    start = qualName;		/* pts to start of qualifying namespace */
+    if ((*qualName == ':') && (*(qualName+1) == ':')) {
+	start = qualName+2;	/* skip over the initial :: */
+	while (*start == ':') {
+            start++;		/* skip over a subsequent : */
+	}
+        nsPtr = globalNsPtr;
+        if (*start == '\0') {	/* qualName is just two or more ":"s */
+            *nsPtrPtr        = globalNsPtr;
+            *altNsPtrPtr     = NULL;
+	    *actualCxtPtrPtr = globalNsPtr;
+            *simpleNamePtr   = start; /* points to empty string */
+            return TCL_OK;
+        }
+    }
+    *actualCxtPtrPtr = nsPtr;
+
+    /*
+     * Start an alternate search path starting with the global namespace.
+     * However, if the starting context is the global namespace, or if the
+     * flag is set to search only the namespace *cxtNsPtr, ignore the
+     * alternate search path.
+     */
+
+    altNsPtr = globalNsPtr;
+    if ((nsPtr == globalNsPtr)
+	    || (flags & (TCL_NAMESPACE_ONLY | FIND_ONLY_NS))) {
+        altNsPtr = NULL;
+    }
+
+    /*
+     * Loop to resolve each namespace qualifier in qualName.
+     */
+
+    Tcl_DStringInit(&buffer);
+    end = start;
+    while (*start != '\0') {
+        /*
+         * Find the next namespace qualifier (i.e., a name ending in "::")
+	 * or the end of the qualified name  (i.e., a name ending in "\0").
+	 * Set len to the number of characters, starting from start,
+	 * in the name; set end to point after the "::"s or at the "\0".
+         */
+
+	len = 0;
+        for (end = start;  *end != '\0';  end++) {
+	    if ((*end == ':') && (*(end+1) == ':')) {
+		end += 2;	/* skip over the initial :: */
+		while (*end == ':') {
+		    end++;	/* skip over the subsequent : */
+		}
+		break;		/* exit for loop; end is after ::'s */
+	    }
+            len++;
+	}
+
+	if ((*end == '\0')
+	        && !((end-start >= 2) && (*(end-1) == ':') && (*(end-2) == ':'))) {
+	    /*
+	     * qualName ended with a simple name at start. If FIND_ONLY_NS
+	     * was specified, look this up as a namespace. Otherwise,
+	     * start is the name of a cmd or var and we are done.
+	     */
+	    
+	    if (flags & FIND_ONLY_NS) {
+		nsName = start;
+	    } else {
+		*nsPtrPtr      = nsPtr;
+		*altNsPtrPtr   = altNsPtr;
+		*simpleNamePtr = start;
+		Tcl_DStringFree(&buffer);
+               return TCL_OK;
+	    }
+	} else {
+	    /*
+	     * start points to the beginning of a namespace qualifier ending
+	     * in "::". end points to the start of a name in that namespace
+	     * that might be empty. Copy the namespace qualifier to a
+	     * buffer so it can be null terminated. We can't modify the
+	     * incoming qualName since it may be a string constant.
+	     */
+
+	    Tcl_DStringSetLength(&buffer, 0);
+            Tcl_DStringAppend(&buffer, start, len);
+            nsName = Tcl_DStringValue(&buffer);
+        }
+
+        /*
+	 * Look up the namespace qualifier nsName in the current namespace
+         * context. If it isn't found but CREATE_NS_IF_UNKNOWN is set,
+         * create that qualifying namespace. This is needed for procedures
+         * like Tcl_CreateCommand that cannot fail.
+	 */
+
+        if (nsPtr != NULL) {
+            entryPtr = Tcl_FindHashEntry(&nsPtr->childTable, nsName);
+            if (entryPtr != NULL) {
+                nsPtr = (Namespace *) Tcl_GetHashValue(entryPtr);
+            } else if (flags & CREATE_NS_IF_UNKNOWN) {
+		Tcl_CallFrame frame;
+		
+               (void) Tcl_PushCallFrame(interp, &frame,
+		        (Tcl_Namespace *) nsPtr, /*isProcCallFrame*/ 0);
+
+                nsPtr = (Namespace *) Tcl_CreateNamespace(interp, nsName,
+		        (ClientData) NULL, (Tcl_NamespaceDeleteProc *) NULL);
+                Tcl_PopCallFrame(interp);
+
+                if (nsPtr == NULL) {
+                   panic("Could not create namespace '%s'", nsName);
+                }
+            } else {		/* namespace not found and wasn't created */
+                nsPtr = NULL;
+            }
+        }
+
+        /*
+         * Look up the namespace qualifier in the alternate search path too.
+         */
+
+        if (altNsPtr != NULL) {
+            entryPtr = Tcl_FindHashEntry(&altNsPtr->childTable, nsName);
+            if (entryPtr != NULL) {
+                altNsPtr = (Namespace *) Tcl_GetHashValue(entryPtr);
+            } else {
+                altNsPtr = NULL;
+            }
+        }
+
+        /*
+         * If both search paths have failed, return NULL results.
+         */
+
+        if ((nsPtr == NULL) && (altNsPtr == NULL)) {
+            *nsPtrPtr      = NULL;
+            *altNsPtrPtr   = NULL;
+            *simpleNamePtr = NULL;
+            Tcl_DStringFree(&buffer);
+            return TCL_OK;
+        }
+
+	start = end;
+    }
+
+    /*
+     * We ignore trailing "::"s in a namespace name, but in a command or
+     * variable name, trailing "::"s refer to the cmd or var named {}.
+     */
+
+    if ((flags & FIND_ONLY_NS)
+	    || ((end > start ) && (*(end-1) != ':'))) {
+	*simpleNamePtr = NULL; /* found namespace name */
+    } else {
+	*simpleNamePtr = end;  /* found cmd/var: points to empty string */
+    }
+
+    /*
+     * As a special case, if we are looking for a namespace and qualName
+     * is "" and the current active namespace (nsPtr) is not the global
+     * namespace, return NULL (no namespace was found). This is because
+     * namespaces can not have empty names except for the global namespace.
+     */
+
+    if ((flags & FIND_ONLY_NS) && (*qualName == '\0')
+	    && (nsPtr != globalNsPtr)) {
+	nsPtr = NULL;
+    }
+
+    *nsPtrPtr    = nsPtr;
+    *altNsPtrPtr = altNsPtr;
+    Tcl_DStringFree(&buffer);
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FindNamespace --
+ *
+ *	Searches for a namespace.
+ *
+ * Results:
+ *	Returns a pointer to the namespace if it is found. Otherwise,
+ *	returns NULL and leaves an error message in the interpreter's
+ *	result object if "flags" contains TCL_LEAVE_ERR_MSG.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Namespace *
+Tcl_FindNamespace(interp, name, contextNsPtr, flags)
+    Tcl_Interp *interp;		 /* The interpreter in which to find the
+				  * namespace. */
+    char *name;			 /* Namespace name. If it starts with "::",
+				  * will be looked up in global namespace.
+				  * Else, looked up first in contextNsPtr
+				  * (current namespace if contextNsPtr is
+				  * NULL), then in global namespace. */
+    Tcl_Namespace *contextNsPtr; /* Ignored if TCL_GLOBAL_ONLY flag is set
+				  * or if the name starts with "::".
+				  * Otherwise, points to namespace in which
+				  * to resolve name; if NULL, look up name
+				  * in the current namespace. */
+    register int flags;		 /* Flags controlling namespace lookup: an
+				  * OR'd combination of TCL_GLOBAL_ONLY and
+				  * TCL_LEAVE_ERR_MSG flags. */
+{
+    Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr;
+    char *dummy;
+
+    /*
+     * Find the namespace(s) that contain the specified namespace name.
+     * Add the FIND_ONLY_NS flag to resolve the name all the way down
+     * to its last component, a namespace.
+     */
+
+    TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
+       (flags | FIND_ONLY_NS), &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
+
+    if (nsPtr != NULL) {
+       return (Tcl_Namespace *) nsPtr;
+    } else if (flags & TCL_LEAVE_ERR_MSG) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "unknown namespace \"", name, "\"", (char *) NULL);
+    }
+    return NULL;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FindCommand --
+ *
+ *	Searches for a command.
+ *
+ * Results:
+ *	Returns a token for the command if it is found. Otherwise, if it
+ *	can't be found or there is an error, returns NULL and leaves an
+ *	error message in the interpreter's result object if "flags"
+ *	contains TCL_LEAVE_ERR_MSG.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Command
+Tcl_FindCommand(interp, name, contextNsPtr, flags)
+    Tcl_Interp *interp;         /* The interpreter in which to find the
+				  * command and to report errors. */
+    char *name;		         /* Command's name. If it starts with "::",
+				  * will be looked up in global namespace.
+				  * Else, looked up first in contextNsPtr
+				  * (current namespace if contextNsPtr is
+				  * NULL), then in global namespace. */
+    Tcl_Namespace *contextNsPtr; /* Ignored if TCL_GLOBAL_ONLY flag set.
+				  * Otherwise, points to namespace in which
+				  * to resolve name. If NULL, look up name
+				  * in the current namespace. */
+    int flags;                   /* An OR'd combination of flags:
+				  * TCL_GLOBAL_ONLY (look up name only in
+				  * global namespace), TCL_NAMESPACE_ONLY
+				  * (look up only in contextNsPtr, or the
+				  * current namespace if contextNsPtr is
+				  * NULL), and TCL_LEAVE_ERR_MSG. If both
+				  * TCL_GLOBAL_ONLY and TCL_NAMESPACE_ONLY
+				  * are given, TCL_GLOBAL_ONLY is
+				  * ignored. */
+{
+    Interp *iPtr = (Interp*)interp;
+
+    ResolverScheme *resPtr;
+    Namespace *nsPtr[2], *cxtNsPtr;
+    char *simpleName;
+    register Tcl_HashEntry *entryPtr;
+    register Command *cmdPtr;
+    register int search;
+    int result;
+    Tcl_Command cmd;
+
+    /*
+     * If this namespace has a command resolver, then give it first
+     * crack at the command resolution.  If the interpreter has any
+     * command resolvers, consult them next.  The command resolver
+     * procedures may return a Tcl_Command value, they may signal
+     * to continue onward, or they may signal an error.
+     */
+    if ((flags & TCL_GLOBAL_ONLY) != 0) {
+        cxtNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
+    }
+    else if (contextNsPtr != NULL) {
+        cxtNsPtr = (Namespace *) contextNsPtr;
+    }
+    else {
+        cxtNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    }
+
+    if (cxtNsPtr->cmdResProc != NULL || iPtr->resolverPtr != NULL) {
+        resPtr = iPtr->resolverPtr;
+
+        if (cxtNsPtr->cmdResProc) {
+            result = (*cxtNsPtr->cmdResProc)(interp, name,
+                (Tcl_Namespace *) cxtNsPtr, flags, &cmd);
+        } else {
+            result = TCL_CONTINUE;
+        }
+
+        while (result == TCL_CONTINUE && resPtr) {
+            if (resPtr->cmdResProc) {
+                result = (*resPtr->cmdResProc)(interp, name,
+                    (Tcl_Namespace *) cxtNsPtr, flags, &cmd);
+            }
+            resPtr = resPtr->nextPtr;
+        }
+
+        if (result == TCL_OK) {
+            return cmd;
+        }
+        else if (result != TCL_CONTINUE) {
+            return (Tcl_Command) NULL;
+        }
+    }
+
+    /*
+     * Find the namespace(s) that contain the command.
+     */
+
+    TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
+       flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);
+
+    /*
+     * Look for the command in the command table of its namespace.
+     * Be sure to check both possible search paths: from the specified
+     * namespace context and from the global namespace.
+     */
+
+    cmdPtr = NULL;
+    for (search = 0;  (search < 2) && (cmdPtr == NULL);  search++) {
+        if ((nsPtr[search] != NULL) && (simpleName != NULL)) {
+	    entryPtr = Tcl_FindHashEntry(&nsPtr[search]->cmdTable,
+		    simpleName);
+            if (entryPtr != NULL) {
+                cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
+            }
+        }
+    }
+    if (cmdPtr != NULL) {
+        return (Tcl_Command) cmdPtr;
+    } else if (flags & TCL_LEAVE_ERR_MSG) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "unknown command \"", name, "\"", (char *) NULL);
+    }
+
+    return (Tcl_Command) NULL;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FindNamespaceVar --
+ *
+ *	Searches for a namespace variable, a variable not local to a
+ *	procedure. The variable can be either a scalar or an array, but
+ *	may not be an element of an array.
+ *
+ * Results:
+ *	Returns a token for the variable if it is found. Otherwise, if it
+ *	can't be found or there is an error, returns NULL and leaves an
+ *	error message in the interpreter's result object if "flags"
+ *	contains TCL_LEAVE_ERR_MSG.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Var
+Tcl_FindNamespaceVar(interp, name, contextNsPtr, flags)
+    Tcl_Interp *interp;		 /* The interpreter in which to find the
+				  * variable. */
+    char *name;			 /* Variable's name. If it starts with "::",
+				  * will be looked up in global namespace.
+				  * Else, looked up first in contextNsPtr
+				  * (current namespace if contextNsPtr is
+				  * NULL), then in global namespace. */
+    Tcl_Namespace *contextNsPtr; /* Ignored if TCL_GLOBAL_ONLY flag set.
+				  * Otherwise, points to namespace in which
+				  * to resolve name. If NULL, look up name
+				  * in the current namespace. */
+    int flags;			 /* An OR'd combination of flags:
+				  * TCL_GLOBAL_ONLY (look up name only in
+				  * global namespace), TCL_NAMESPACE_ONLY
+				  * (look up only in contextNsPtr, or the
+				  * current namespace if contextNsPtr is
+				  * NULL), and TCL_LEAVE_ERR_MSG. If both
+				  * TCL_GLOBAL_ONLY and TCL_NAMESPACE_ONLY
+				  * are given, TCL_GLOBAL_ONLY is
+				  * ignored. */
+{
+    Interp *iPtr = (Interp*)interp;
+    ResolverScheme *resPtr;
+    Namespace *nsPtr[2], *cxtNsPtr;
+    char *simpleName;
+    Tcl_HashEntry *entryPtr;
+    Var *varPtr;
+    register int search;
+    int result;
+    Tcl_Var var;
+
+    /*
+     * If this namespace has a variable resolver, then give it first
+     * crack at the variable resolution.  It may return a Tcl_Var
+     * value, it may signal to continue onward, or it may signal
+     * an error.
+     */
+    if ((flags & TCL_GLOBAL_ONLY) != 0) {
+        cxtNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
+    }
+    else if (contextNsPtr != NULL) {
+        cxtNsPtr = (Namespace *) contextNsPtr;
+    }
+    else {
+        cxtNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    }
+
+    if (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) {
+        resPtr = iPtr->resolverPtr;
+
+        if (cxtNsPtr->varResProc) {
+            result = (*cxtNsPtr->varResProc)(interp, name,
+                (Tcl_Namespace *) cxtNsPtr, flags, &var);
+        } else {
+            result = TCL_CONTINUE;
+        }
+
+        while (result == TCL_CONTINUE && resPtr) {
+            if (resPtr->varResProc) {
+                result = (*resPtr->varResProc)(interp, name,
+                    (Tcl_Namespace *) cxtNsPtr, flags, &var);
+            }
+            resPtr = resPtr->nextPtr;
+        }
+
+        if (result == TCL_OK) {
+            return var;
+        }
+        else if (result != TCL_CONTINUE) {
+            return (Tcl_Var) NULL;
+        }
+    }
+
+    /*
+     * Find the namespace(s) that contain the variable.
+     */
+
+    TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
+       flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);
+
+    /*
+     * Look for the variable in the variable table of its namespace.
+     * Be sure to check both possible search paths: from the specified
+     * namespace context and from the global namespace.
+     */
+
+    varPtr = NULL;
+    for (search = 0;  (search < 2) && (varPtr == NULL);  search++) {
+        if ((nsPtr[search] != NULL) && (simpleName != NULL)) {
+            entryPtr = Tcl_FindHashEntry(&nsPtr[search]->varTable,
+		    simpleName);
+            if (entryPtr != NULL) {
+                varPtr = (Var *) Tcl_GetHashValue(entryPtr);
+            }
+        }
+    }
+    if (varPtr != NULL) {
+	return (Tcl_Var) varPtr;
+    } else if (flags & TCL_LEAVE_ERR_MSG) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "unknown variable \"", name, "\"", (char *) NULL);
+    }
+    return (Tcl_Var) NULL;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclResetShadowedCmdRefs --
+ *
+ *	Called when a command is added to a namespace to check for existing
+ *	command references that the new command may invalidate. Consider the
+ *	following cases that could happen when you add a command "foo" to a
+ *	namespace "b":
+ *	   1. It could shadow a command named "foo" at the global scope.
+ *	      If it does, all command references in the namespace "b" are
+ *	      suspect.
+ *	   2. Suppose the namespace "b" resides in a namespace "a".
+ *	      Then to "a" the new command "b::foo" could shadow another
+ *	      command "b::foo" in the global namespace. If so, then all
+ *	      command references in "a" are suspect.
+ *	The same checks are applied to all parent namespaces, until we
+ *	reach the global :: namespace.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	If the new command shadows an existing command, the cmdRefEpoch
+ *	counter is incremented in each namespace that sees the shadow.
+ *	This invalidates all command references that were previously cached
+ *	in that namespace. The next time the commands are used, they are
+ *	resolved from scratch.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclResetShadowedCmdRefs(interp, newCmdPtr)
+    Tcl_Interp *interp;	       /* Interpreter containing the new command. */
+    Command *newCmdPtr;	       /* Points to the new command. */
+{
+    char *cmdName;
+    Tcl_HashEntry *hPtr;
+    register Namespace *nsPtr;
+    Namespace *trailNsPtr, *shadowNsPtr;
+    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
+    int found, i;
+
+    /*
+     * This procedure generates an array used to hold the trail list. This
+     * starts out with stack-allocated space but uses dynamically-allocated
+     * storage if needed.
+     */
+
+    Namespace *(trailStorage[NUM_TRAIL_ELEMS]);
+    Namespace **trailPtr = trailStorage;
+    int trailFront = -1;
+    int trailSize = NUM_TRAIL_ELEMS;
+
+    /*
+     * Start at the namespace containing the new command, and work up
+     * through the list of parents. Stop just before the global namespace,
+     * since the global namespace can't "shadow" its own entries.
+     *
+     * The namespace "trail" list we build consists of the names of each
+     * namespace that encloses the new command, in order from outermost to
+     * innermost: for example, "a" then "b". Each iteration of this loop
+     * eventually extends the trail upwards by one namespace, nsPtr. We use
+     * this trail list to see if nsPtr (e.g. "a" in 2. above) could have
+     * now-invalid cached command references. This will happen if nsPtr
+     * (e.g. "a") contains a sequence of child namespaces (e.g. "b")
+     * such that there is a identically-named sequence of child namespaces
+     * starting from :: (e.g. "::b") whose tail namespace contains a command
+     * also named cmdName.
+     */
+
+    cmdName = Tcl_GetHashKey(newCmdPtr->hPtr->tablePtr, newCmdPtr->hPtr);
+    for (nsPtr = newCmdPtr->nsPtr;
+	    (nsPtr != NULL) && (nsPtr != globalNsPtr);
+            nsPtr = nsPtr->parentPtr) {
+        /*
+	 * Find the maximal sequence of child namespaces contained in nsPtr
+	 * such that there is a identically-named sequence of child
+	 * namespaces starting from ::. shadowNsPtr will be the tail of this
+	 * sequence, or the deepest namespace under :: that might contain a
+	 * command now shadowed by cmdName. We check below if shadowNsPtr
+	 * actually contains a command cmdName.
+	 */
+
+        found = 1;
+        shadowNsPtr = globalNsPtr;
+
+        for (i = trailFront;  i >= 0;  i--) {
+            trailNsPtr = trailPtr[i];
+            hPtr = Tcl_FindHashEntry(&shadowNsPtr->childTable,
+		    trailNsPtr->name);
+            if (hPtr != NULL) {
+                shadowNsPtr = (Namespace *) Tcl_GetHashValue(hPtr);
+            } else {
+                found = 0;
+                break;
+            }
+        }
+
+        /*
+	 * If shadowNsPtr contains a command named cmdName, we invalidate
+         * all of the command refs cached in nsPtr. As a boundary case,
+	 * shadowNsPtr is initially :: and we check for case 1. above.
+	 */
+
+        if (found) {
+            hPtr = Tcl_FindHashEntry(&shadowNsPtr->cmdTable, cmdName);
+            if (hPtr != NULL) {
+                nsPtr->cmdRefEpoch++;
+            }
+        }
+
+        /*
+	 * Insert nsPtr at the front of the trail list: i.e., at the end
+	 * of the trailPtr array.
+	 */
+
+	trailFront++;
+	if (trailFront == trailSize) {
+	    size_t currBytes = trailSize * sizeof(Namespace *);
+	    int newSize = 2*trailSize;
+	    size_t newBytes = newSize * sizeof(Namespace *);
+	    Namespace **newPtr =
+		    (Namespace **) ckalloc((unsigned) newBytes);
+	    
+	    memcpy((VOID *) newPtr, (VOID *) trailPtr, currBytes);
+	    if (trailPtr != trailStorage) {
+		ckfree((char *) trailPtr);
+	    }
+	    trailPtr = newPtr;
+	    trailSize = newSize;
+	}
+	trailPtr[trailFront] = nsPtr;
+    }
+
+    /*
+     * Free any allocated storage.
+     */
+    
+    if (trailPtr != trailStorage) {
+	ckfree((char *) trailPtr);
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetNamespaceFromObj --
+ *
+ *	Returns the namespace specified by the name in a Tcl_Obj.
+ *
+ * Results:
+ *	Returns TCL_OK if the namespace was resolved successfully, and
+ *	stores a pointer to the namespace in the location specified by
+ *	nsPtrPtr. If the namespace can't be found, the procedure stores
+ *	NULL in *nsPtrPtr and returns TCL_OK. If anything else goes wrong,
+ *	this procedure returns TCL_ERROR.
+ *
+ * Side effects:
+ *	May update the internal representation for the object, caching the
+ *	namespace reference. The next time this procedure is called, the
+ *	namespace value can be found quickly.
+ *
+ *	If anything goes wrong, an error message is left in the
+ *	interpreter's result object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetNamespaceFromObj(interp, objPtr, nsPtrPtr)
+    Tcl_Interp *interp;		/* The current interpreter. */
+    Tcl_Obj *objPtr;		/* The object to be resolved as the name
+				 * of a namespace. */
+    Tcl_Namespace **nsPtrPtr;	/* Result namespace pointer goes here. */
+{
+    register ResolvedNsName *resNamePtr;
+    register Namespace *nsPtr;
+    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    int result;
+
+    /*
+     * Get the internal representation, converting to a namespace type if
+     * needed. The internal representation is a ResolvedNsName that points
+     * to the actual namespace.
+     */
+
+    if (objPtr->typePtr != &tclNsNameType) {
+        result = tclNsNameType.setFromAnyProc(interp, objPtr);
+        if (result != TCL_OK) {
+            return TCL_ERROR;
+        }
+    }
+    resNamePtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
+
+    /*
+     * Check the context namespace of the resolved symbol to make sure that
+     * it is fresh. If not, then force another conversion to the namespace
+     * type, to discard the old rep and create a new one. Note that we
+     * verify that the namespace id of the cached namespace is the same as
+     * the id when we cached it; this insures that the namespace wasn't
+     * deleted and a new one created at the same address.
+     */
+
+    nsPtr = NULL;
+    if ((resNamePtr != NULL)
+	    && (resNamePtr->refNsPtr == currNsPtr)
+	    && (resNamePtr->nsId == resNamePtr->nsPtr->nsId)) {
+        nsPtr = resNamePtr->nsPtr;
+	if (nsPtr->flags & NS_DEAD) {
+	    nsPtr = NULL;
+	}
+    }
+    if (nsPtr == NULL) {	/* try again */
+        result = tclNsNameType.setFromAnyProc(interp, objPtr);
+        if (result != TCL_OK) {
+            return TCL_ERROR;
+        }
+        resNamePtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
+        if (resNamePtr != NULL) {
+            nsPtr = resNamePtr->nsPtr;
+            if (nsPtr->flags & NS_DEAD) {
+                nsPtr = NULL;
+            }
+        }
+    }
+    *nsPtrPtr = (Tcl_Namespace *) nsPtr;
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NamespaceObjCmd --
+ *
+ *	Invoked to implement the "namespace" command that creates, deletes,
+ *	or manipulates Tcl namespaces. Handles the following syntax:
+ *
+ *	    namespace children ?name? ?pattern?
+ *	    namespace code arg
+ *	    namespace current
+ *	    namespace delete ?name name...?
+ *	    namespace eval name arg ?arg...?
+ *	    namespace export ?-clear? ?pattern pattern...?
+ *	    namespace forget ?pattern pattern...?
+ *	    namespace import ?-force? ?pattern pattern...?
+ *	    namespace inscope name arg ?arg...?
+ *	    namespace origin name
+ *	    namespace parent ?name?
+ *	    namespace qualifiers string
+ *	    namespace tail string
+ *	    namespace which ?-command? ?-variable? name
+ *
+ * Results:
+ *	Returns TCL_OK if the command is successful. Returns TCL_ERROR if
+ *	anything goes wrong.
+ *
+ * Side effects:
+ *	Based on the subcommand name (e.g., "import"), this procedure
+ *	dispatches to a corresponding procedure NamespaceXXXCmd defined
+ *	statically in this file. This procedure's side effects depend on
+ *	whatever that subcommand procedure does. If there is an error, this
+ *	procedure returns an error message in the interpreter's result
+ *	object. Otherwise it may return a result in the interpreter's result
+ *	object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_NamespaceObjCmd(clientData, interp, objc, objv)
+    ClientData clientData;		/* Arbitrary value passed to cmd. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    register int objc;			/* Number of arguments. */
+    register Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    static char *subCmds[] = {
+            "children", "code", "current", "delete",
+	    "eval", "export", "forget", "import",
+	    "inscope", "origin", "parent", "qualifiers",
+	    "tail", "which", (char *) NULL};
+    enum NSSubCmdIdx {
+	    NSChildrenIdx, NSCodeIdx, NSCurrentIdx, NSDeleteIdx,
+	    NSEvalIdx, NSExportIdx, NSForgetIdx, NSImportIdx,
+	    NSInscopeIdx, NSOriginIdx, NSParentIdx, NSQualifiersIdx,
+	    NSTailIdx, NSWhichIdx
+    } index;
+    int result;
+
+    if (objc < 2) {
+        Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
+        return TCL_ERROR;
+    }
+
+    /*
+     * Return an index reflecting the particular subcommand.
+     */
+
+    result = Tcl_GetIndexFromObj((Tcl_Interp *) interp, objv[1], subCmds,
+	    "option", /*flags*/ 0, (int *) &index);
+    if (result != TCL_OK) {
+	return result;
+    }
+    
+    switch (index) {
+        case NSChildrenIdx:
+	    result = NamespaceChildrenCmd(clientData, interp, objc, objv);
+            break;
+        case NSCodeIdx:
+	    result = NamespaceCodeCmd(clientData, interp, objc, objv);
+            break;
+        case NSCurrentIdx:
+	    result = NamespaceCurrentCmd(clientData, interp, objc, objv);
+            break;
+        case NSDeleteIdx:
+	    result = NamespaceDeleteCmd(clientData, interp, objc, objv);
+            break;
+        case NSEvalIdx:
+	    result = NamespaceEvalCmd(clientData, interp, objc, objv);
+            break;
+        case NSExportIdx:
+	    result = NamespaceExportCmd(clientData, interp, objc, objv);
+            break;
+        case NSForgetIdx:
+	    result = NamespaceForgetCmd(clientData, interp, objc, objv);
+            break;
+        case NSImportIdx:
+	    result = NamespaceImportCmd(clientData, interp, objc, objv);
+            break;
+        case NSInscopeIdx:
+	    result = NamespaceInscopeCmd(clientData, interp, objc, objv);
+            break;
+        case NSOriginIdx:
+	    result = NamespaceOriginCmd(clientData, interp, objc, objv);
+            break;
+        case NSParentIdx:
+	    result = NamespaceParentCmd(clientData, interp, objc, objv);
+            break;
+        case NSQualifiersIdx:
+	    result = NamespaceQualifiersCmd(clientData, interp, objc, objv);
+            break;
+        case NSTailIdx:
+	    result = NamespaceTailCmd(clientData, interp, objc, objv);
+            break;
+        case NSWhichIdx:
+	    result = NamespaceWhichCmd(clientData, interp, objc, objv);
+            break;
+    }
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NamespaceChildrenCmd --
+ *
+ *	Invoked to implement the "namespace children" command that returns a
+ *	list containing the fully-qualified names of the child namespaces of
+ *	a given namespace. Handles the following syntax:
+ *
+ *	    namespace children ?name? ?pattern?
+ *
+ * Results:
+ *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	Returns a result in the interpreter's result object. If anything
+ *	goes wrong, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceChildrenCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Tcl_Namespace *namespacePtr;
+    Namespace *nsPtr, *childNsPtr;
+    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
+    char *pattern = NULL;
+    Tcl_DString buffer;
+    register Tcl_HashEntry *entryPtr;
+    Tcl_HashSearch search;
+    Tcl_Obj *listPtr, *elemPtr;
+
+    /*
+     * Get a pointer to the specified namespace, or the current namespace.
+     */
+
+    if (objc == 2) {
+	nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    } else if ((objc == 3) || (objc == 4)) {
+        if (GetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK) {
+            return TCL_ERROR;
+        }
+        if (namespacePtr == NULL) {
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                    "unknown namespace \"",
+		    Tcl_GetStringFromObj(objv[2], (int *) NULL),
+		    "\" in namespace children command", (char *) NULL);
+            return TCL_ERROR;
+        }
+        nsPtr = (Namespace *) namespacePtr;
+    } else {
+	Tcl_WrongNumArgs(interp, 2, objv, "?name? ?pattern?");
+        return TCL_ERROR;
+    }
+
+    /*
+     * Get the glob-style pattern, if any, used to narrow the search.
+     */
+
+    Tcl_DStringInit(&buffer);
+    if (objc == 4) {
+        char *name = Tcl_GetStringFromObj(objv[3], (int *) NULL);
+	
+        if ((*name == ':') && (*(name+1) == ':')) {
+            pattern = name;
+        } else {
+            Tcl_DStringAppend(&buffer, nsPtr->fullName, -1);
+            if (nsPtr != globalNsPtr) {
+                Tcl_DStringAppend(&buffer, "::", 2);
+            }
+            Tcl_DStringAppend(&buffer, name, -1);
+            pattern = Tcl_DStringValue(&buffer);
+        }
+    }
+
+    /*
+     * Create a list containing the full names of all child namespaces
+     * whose names match the specified pattern, if any.
+     */
+
+    listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+    entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
+    while (entryPtr != NULL) {
+        childNsPtr = (Namespace *) Tcl_GetHashValue(entryPtr);
+        if ((pattern == NULL)
+	        || Tcl_StringMatch(childNsPtr->fullName, pattern)) {
+            elemPtr = Tcl_NewStringObj(childNsPtr->fullName, -1);
+            Tcl_ListObjAppendElement(interp, listPtr, elemPtr);
+        }
+        entryPtr = Tcl_NextHashEntry(&search);
+    }
+
+    Tcl_SetObjResult(interp, listPtr);
+    Tcl_DStringFree(&buffer);
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NamespaceCodeCmd --
+ *
+ *	Invoked to implement the "namespace code" command to capture the
+ *	namespace context of a command. Handles the following syntax:
+ *
+ *	    namespace code arg
+ *
+ *	Here "arg" can be a list. "namespace code arg" produces a result
+ *	equivalent to that produced by the command
+ *
+ *	    list namespace inscope [namespace current] $arg
+ *
+ *	However, if "arg" is itself a scoped value starting with
+ *	"namespace inscope", then the result is just "arg".
+ *
+ * Results:
+ *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	If anything goes wrong, this procedure returns an error
+ *	message as the result in the interpreter's result object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceCodeCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Namespace *currNsPtr;
+    Tcl_Obj *listPtr, *objPtr;
+    register char *arg, *p;
+    int length;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 2, objv, "arg");
+        return TCL_ERROR;
+    }
+
+    /*
+     * If "arg" is already a scoped value, then return it directly.
+     */
+
+    arg = Tcl_GetStringFromObj(objv[2], &length);
+    if ((*arg == 'n') && (length > 17)
+	    && (strncmp(arg, "namespace", 9) == 0)) {
+	for (p = (arg + 9);  (*p == ' ');  p++) {
+	    /* empty body: skip over spaces */
+	}
+	if ((*p == 'i') && ((p + 7) <= (arg + length))
+	        && (strncmp(p, "inscope", 7) == 0)) {
+	    Tcl_SetObjResult(interp, objv[2]);
+	    return TCL_OK;
+	}
+    }
+
+    /*
+     * Otherwise, construct a scoped command by building a list with
+     * "namespace inscope", the full name of the current namespace, and 
+     * the argument "arg". By constructing a list, we ensure that scoped
+     * commands are interpreted properly when they are executed later,
+     * by the "namespace inscope" command.
+     */
+
+    listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+    Tcl_ListObjAppendElement(interp, listPtr,
+            Tcl_NewStringObj("namespace", -1));
+    Tcl_ListObjAppendElement(interp, listPtr,
+	    Tcl_NewStringObj("inscope", -1));
+
+    currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    if (currNsPtr == (Namespace *) Tcl_GetGlobalNamespace(interp)) {
+	objPtr = Tcl_NewStringObj("::", -1);
+    } else {
+	objPtr = Tcl_NewStringObj(currNsPtr->fullName, -1);
+    }
+    Tcl_ListObjAppendElement(interp, listPtr, objPtr);
+    
+    Tcl_ListObjAppendElement(interp, listPtr, objv[2]);
+
+    Tcl_SetObjResult(interp, listPtr);
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NamespaceCurrentCmd --
+ *
+ *	Invoked to implement the "namespace current" command which returns
+ *	the fully-qualified name of the current namespace. Handles the
+ *	following syntax:
+ *
+ *	    namespace current
+ *
+ * Results:
+ *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	Returns a result in the interpreter's result object. If anything
+ *	goes wrong, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceCurrentCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    register Namespace *currNsPtr;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 2, objv, NULL);
+        return TCL_ERROR;
+    }
+
+    /*
+     * The "real" name of the global namespace ("::") is the null string,
+     * but we return "::" for it as a convenience to programmers. Note that
+     * "" and "::" are treated as synonyms by the namespace code so that it
+     * is still easy to do things like:
+     *
+     *    namespace [namespace current]::bar { ... }
+     */
+
+    currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    if (currNsPtr == (Namespace *) Tcl_GetGlobalNamespace(interp)) {
+        Tcl_AppendToObj(Tcl_GetObjResult(interp), "::", -1);
+    } else {
+	Tcl_AppendToObj(Tcl_GetObjResult(interp), currNsPtr->fullName, -1);
+    }
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NamespaceDeleteCmd --
+ *
+ *	Invoked to implement the "namespace delete" command to delete
+ *	namespace(s). Handles the following syntax:
+ *
+ *	    namespace delete ?name name...?
+ *
+ *	Each name identifies a namespace. It may include a sequence of
+ *	namespace qualifiers separated by "::"s. If a namespace is found, it
+ *	is deleted: all variables and procedures contained in that namespace
+ *	are deleted. If that namespace is being used on the call stack, it
+ *	is kept alive (but logically deleted) until it is removed from the
+ *	call stack: that is, it can no longer be referenced by name but any
+ *	currently executing procedure that refers to it is allowed to do so
+ *	until the procedure returns. If the namespace can't be found, this
+ *	procedure returns an error. If no namespaces are specified, this
+ *	command does nothing.
+ *
+ * Results:
+ *	Returns TCL_OK if successful, and  TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	Deletes the specified namespaces. If anything goes wrong, this
+ *	procedure returns an error message in the interpreter's
+ *	result object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceDeleteCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Tcl_Namespace *namespacePtr;
+    char *name;
+    register int i;
+
+    if (objc < 2) {
+        Tcl_WrongNumArgs(interp, 2, objv, "?name name...?");
+        return TCL_ERROR;
+    }
+
+    /*
+     * Destroying one namespace may cause another to be destroyed. Break
+     * this into two passes: first check to make sure that all namespaces on
+     * the command line are valid, and report any errors.
+     */
+
+    for (i = 2;  i < objc;  i++) {
+        name = Tcl_GetStringFromObj(objv[i], (int *) NULL);
+	namespacePtr = Tcl_FindNamespace(interp, name,
+		(Tcl_Namespace *) NULL, /*flags*/ 0);
+        if (namespacePtr == NULL) {
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                    "unknown namespace \"",
+		    Tcl_GetStringFromObj(objv[i], (int *) NULL),
+		    "\" in namespace delete command", (char *) NULL);
+            return TCL_ERROR;
+        }
+    }
+
+    /*
+     * Okay, now delete each namespace.
+     */
+
+    for (i = 2;  i < objc;  i++) {
+        name = Tcl_GetStringFromObj(objv[i], (int *) NULL);
+	namespacePtr = Tcl_FindNamespace(interp, name,
+	    (Tcl_Namespace *) NULL, /* flags */ 0);
+	if (namespacePtr) {
+            Tcl_DeleteNamespace(namespacePtr);
+        }
+    }
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NamespaceEvalCmd --
+ *
+ *	Invoked to implement the "namespace eval" command. Executes
+ *	commands in a namespace. If the namespace does not already exist,
+ *	it is created. Handles the following syntax:
+ *
+ *	    namespace eval name arg ?arg...?
+ *
+ *	If more than one arg argument is specified, the command that is
+ *	executed is the result of concatenating the arguments together with
+ *	a space between each argument.
+ *
+ * Results:
+ *	Returns TCL_OK if the namespace is found and the commands are
+ *	executed successfully. Returns TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	Returns the result of the command in the interpreter's result
+ *	object. If anything goes wrong, this procedure returns an error
+ *	message as the result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceEvalCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Tcl_Namespace *namespacePtr;
+    Tcl_CallFrame frame;
+    Tcl_Obj *objPtr;
+    char *name;
+    int length, result;
+
+    if (objc < 4) {
+        Tcl_WrongNumArgs(interp, 2, objv, "name arg ?arg...?");
+        return TCL_ERROR;
+    }
+
+    /*
+     * Try to resolve the namespace reference, caching the result in the
+     * namespace object along the way.
+     */
+
+    result = GetNamespaceFromObj(interp, objv[2], &namespacePtr);
+    if (result != TCL_OK) {
+        return result;
+    }
+
+    /*
+     * If the namespace wasn't found, try to create it.
+     */
+    
+    if (namespacePtr == NULL) {
+	name = Tcl_GetStringFromObj(objv[2], &length);
+	namespacePtr = Tcl_CreateNamespace(interp, name, (ClientData) NULL, 
+                (Tcl_NamespaceDeleteProc *) NULL);
+	if (namespacePtr == NULL) {
+	    return TCL_ERROR;
+	}
+    }
+
+    /*
+     * Make the specified namespace the current namespace and evaluate
+     * the command(s).
+     */
+
+    result = Tcl_PushCallFrame(interp, &frame, namespacePtr,
+	    /*isProcCallFrame*/ 0);
+    if (result != TCL_OK) {
+        return TCL_ERROR;
+    }
+
+    if (objc == 4) {
+        result = Tcl_EvalObj(interp, objv[3]);
+    } else {
+        objPtr = Tcl_ConcatObj(objc-3, objv+3);
+        result = Tcl_EvalObj(interp, objPtr);
+        Tcl_DecrRefCount(objPtr);  /* we're done with the object */
+    }
+    if (result == TCL_ERROR) {
+        char msg[256];
+	
+        sprintf(msg, "\n    (in namespace eval \"%.200s\" script line %d)",
+            namespacePtr->fullName, interp->errorLine);
+        Tcl_AddObjErrorInfo(interp, msg, -1);
+    }
+
+    /*
+     * Restore the previous "current" namespace.
+     */
+    
+    Tcl_PopCallFrame(interp);
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NamespaceExportCmd --
+ *
+ *	Invoked to implement the "namespace export" command that specifies
+ *	which commands are exported from a namespace. The exported commands
+ *	are those that can be imported into another namespace using
+ *	"namespace import". Both commands defined in a namespace and
+ *	commands the namespace has imported can be exported by a
+ *	namespace. This command has the following syntax:
+ *
+ *	    namespace export ?-clear? ?pattern pattern...?
+ *
+ *	Each pattern may contain "string match"-style pattern matching
+ *	special characters, but the pattern may not include any namespace
+ *	qualifiers: that is, the pattern must specify commands in the
+ *	current (exporting) namespace. The specified patterns are appended
+ *	onto the namespace's list of export patterns.
+ *
+ *	To reset the namespace's export pattern list, specify the "-clear"
+ *	flag.
+ *
+ *	If there are no export patterns and the "-clear" flag isn't given,
+ *	this command returns the namespace's current export list.
+ *
+ * Results:
+ *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	Returns a result in the interpreter's result object. If anything
+ *	goes wrong, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceExportCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Namespace *currNsPtr = (Namespace*) Tcl_GetCurrentNamespace(interp);
+    char *pattern, *string;
+    int resetListFirst = 0;
+    int firstArg, patternCt, i, result;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 2, objv,
+	        "?-clear? ?pattern pattern...?");
+        return TCL_ERROR;
+    }
+
+    /*
+     * Process the optional "-clear" argument.
+     */
+
+    firstArg = 2;
+    if (firstArg < objc) {
+	string = Tcl_GetStringFromObj(objv[firstArg], (int *) NULL);
+	if (strcmp(string, "-clear") == 0) {
+	    resetListFirst = 1;
+	    firstArg++;
+	}
+    }
+
+    /*
+     * If no pattern arguments are given, and "-clear" isn't specified,
+     * return the namespace's current export pattern list.
+     */
+
+    patternCt = (objc - firstArg);
+    if (patternCt == 0) {
+	if (firstArg > 2) {
+	    return TCL_OK;
+	} else {		/* create list with export patterns */
+	    Tcl_Obj *listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+	    result = Tcl_AppendExportList(interp,
+		    (Tcl_Namespace *) currNsPtr, listPtr);
+	    if (result != TCL_OK) {
+		return result;
+	    }
+	    Tcl_SetObjResult(interp, listPtr);
+	    return TCL_OK;
+	}
+    }
+
+    /*
+     * Add each pattern to the namespace's export pattern list.
+     */
+    
+    for (i = firstArg;  i < objc;  i++) {
+	pattern = Tcl_GetStringFromObj(objv[i], (int *) NULL);
+	result = Tcl_Export(interp, (Tcl_Namespace *) currNsPtr, pattern,
+		((i == firstArg)? resetListFirst : 0));
+        if (result != TCL_OK) {
+            return result;
+        }
+    }
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NamespaceForgetCmd --
+ *
+ *	Invoked to implement the "namespace forget" command to remove
+ *	imported commands from a namespace. Handles the following syntax:
+ *
+ *	    namespace forget ?pattern pattern...?
+ *
+ *	Each pattern is a name like "foo::*" or "a::b::x*". That is, the
+ *	pattern may include the special pattern matching characters
+ *	recognized by the "string match" command, but only in the command
+ *	name at the end of the qualified name; the special pattern
+ *	characters may not appear in a namespace name. All of the commands
+ *	that match that pattern are checked to see if they have an imported
+ *	command in the current namespace that refers to the matched
+ *	command. If there is an alias, it is removed.
+ *	
+ * Results:
+ *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	Imported commands are removed from the current namespace. If
+ *	anything goes wrong, this procedure returns an error message in the
+ *	interpreter's result object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceForgetCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    char *pattern;
+    register int i, result;
+
+    if (objc < 2) {
+        Tcl_WrongNumArgs(interp, 2, objv, "?pattern pattern...?");
+        return TCL_ERROR;
+    }
+
+    for (i = 2;  i < objc;  i++) {
+        pattern = Tcl_GetStringFromObj(objv[i], (int *) NULL);
+	result = Tcl_ForgetImport(interp, (Tcl_Namespace *) NULL, pattern);
+        if (result != TCL_OK) {
+            return result;
+        }
+    }
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NamespaceImportCmd --
+ *
+ *	Invoked to implement the "namespace import" command that imports
+ *	commands into a namespace. Handles the following syntax:
+ *
+ *	    namespace import ?-force? ?pattern pattern...?
+ *
+ *	Each pattern is a namespace-qualified name like "foo::*",
+ *	"a::b::x*", or "bar::p". That is, the pattern may include the
+ *	special pattern matching characters recognized by the "string match"
+ *	command, but only in the command name at the end of the qualified
+ *	name; the special pattern characters may not appear in a namespace
+ *	name. All of the commands that match the pattern and which are
+ *	exported from their namespace are made accessible from the current
+ *	namespace context. This is done by creating a new "imported command"
+ *	in the current namespace that points to the real command in its
+ *	original namespace; when the imported command is called, it invokes
+ *	the real command.
+ *
+ *	If an imported command conflicts with an existing command, it is
+ *	treated as an error. But if the "-force" option is included, then
+ *	existing commands are overwritten by the imported commands.
+ *	
+ * Results:
+ *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	Adds imported commands to the current namespace. If anything goes
+ *	wrong, this procedure returns an error message in the interpreter's
+ *	result object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceImportCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    int allowOverwrite = 0;
+    char *string, *pattern;
+    register int i, result;
+    int firstArg;
+
+    if (objc < 2) {
+        Tcl_WrongNumArgs(interp, 2, objv,
+	        "?-force? ?pattern pattern...?");
+        return TCL_ERROR;
+    }
+
+    /*
+     * Skip over the optional "-force" as the first argument.
+     */
+
+    firstArg = 2;
+    if (firstArg < objc) {
+	string = Tcl_GetStringFromObj(objv[firstArg], (int *) NULL);
+	if ((*string == '-') && (strcmp(string, "-force") == 0)) {
+	    allowOverwrite = 1;
+	    firstArg++;
+	}
+    }
+
+    /*
+     * Handle the imports for each of the patterns.
+     */
+
+    for (i = firstArg;  i < objc;  i++) {
+        pattern = Tcl_GetStringFromObj(objv[i], (int *) NULL);
+	result = Tcl_Import(interp, (Tcl_Namespace *) NULL, pattern,
+	        allowOverwrite);
+        if (result != TCL_OK) {
+            return result;
+        }
+    }
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NamespaceInscopeCmd --
+ *
+ *	Invoked to implement the "namespace inscope" command that executes a
+ *	script in the context of a particular namespace. This command is not
+ *	expected to be used directly by programmers; calls to it are
+ *	generated implicitly when programs use "namespace code" commands
+ *	to register callback scripts. Handles the following syntax:
+ *
+ *	    namespace inscope name arg ?arg...?
+ *
+ *	The "namespace inscope" command is much like the "namespace eval"
+ *	command except that it has lappend semantics and the namespace must
+ *	already exist. It treats the first argument as a list, and appends
+ *	any arguments after the first onto the end as proper list elements.
+ *	For example,
+ *
+ *	    namespace inscope ::foo a b c d
+ *
+ *	is equivalent to
+ *
+ *	    namespace eval ::foo [concat a [list b c d]]
+ *
+ *	This lappend semantics is important because many callback scripts
+ *	are actually prefixes.
+ *
+ * Results:
+ *	Returns TCL_OK to indicate success, or TCL_ERROR to indicate
+ *	failure.
+ *
+ * Side effects:
+ *	Returns a result in the Tcl interpreter's result object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceInscopeCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Tcl_Namespace *namespacePtr;
+    Tcl_CallFrame frame;
+    int i, result;
+
+    if (objc < 4) {
+	Tcl_WrongNumArgs(interp, 2, objv, "name arg ?arg...?");
+        return TCL_ERROR;
+    }
+
+    /*
+     * Resolve the namespace reference.
+     */
+
+    result = GetNamespaceFromObj(interp, objv[2], &namespacePtr);
+    if (result != TCL_OK) {
+        return result;
+    }
+    if (namespacePtr == NULL) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+	        "unknown namespace \"",
+		Tcl_GetStringFromObj(objv[2], (int *) NULL),
+		"\" in inscope namespace command", (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    /*
+     * Make the specified namespace the current namespace.
+     */
+
+    result = Tcl_PushCallFrame(interp, &frame, namespacePtr,
+	    /*isProcCallFrame*/ 0);
+    if (result != TCL_OK) {
+        return result;
+    }
+
+    /*
+     * Execute the command. If there is just one argument, just treat it as
+     * a script and evaluate it. Otherwise, create a list from the arguments
+     * after the first one, then concatenate the first argument and the list
+     * of extra arguments to form the command to evaluate.
+     */
+
+    if (objc == 4) {
+        result = Tcl_EvalObj(interp, objv[3]);
+    } else {
+	Tcl_Obj *concatObjv[2];
+	register Tcl_Obj *listPtr, *cmdObjPtr;
+	
+        listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+        for (i = 4;  i < objc;  i++) {
+	    result = Tcl_ListObjAppendElement(interp, listPtr, objv[i]);
+            if (result != TCL_OK) {
+                Tcl_DecrRefCount(listPtr); /* free unneeded obj */
+                return result;
+            }
+        }
+
+	concatObjv[0] = objv[3];
+	concatObjv[1] = listPtr;
+	cmdObjPtr = Tcl_ConcatObj(2, concatObjv);
+        result = Tcl_EvalObj(interp, cmdObjPtr);
+	
+	Tcl_DecrRefCount(cmdObjPtr);  /* we're done with the cmd object */
+	Tcl_DecrRefCount(listPtr);    /* we're done with the list object */
+    }
+    if (result == TCL_ERROR) {
+        char msg[256];
+	
+        sprintf(msg,
+	    "\n    (in namespace inscope \"%.200s\" script line %d)",
+            namespacePtr->fullName, interp->errorLine);
+        Tcl_AddObjErrorInfo(interp, msg, -1);
+    }
+
+    /*
+     * Restore the previous "current" namespace.
+     */
+
+    Tcl_PopCallFrame(interp);
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NamespaceOriginCmd --
+ *
+ *	Invoked to implement the "namespace origin" command to return the
+ *	fully-qualified name of the "real" command to which the specified
+ *	"imported command" refers. Handles the following syntax:
+ *
+ *	    namespace origin name
+ *
+ * Results:
+ *	An imported command is created in an namespace when that namespace
+ *	imports a command from another namespace. If a command is imported
+ *	into a sequence of namespaces a, b,...,n where each successive
+ *	namespace just imports the command from the previous namespace, this
+ *	command returns the fully-qualified name of the original command in
+ *	the first namespace, a. If "name" does not refer to an alias, its
+ *	fully-qualified name is returned. The returned name is stored in the
+ *	interpreter's result object. This procedure returns TCL_OK if
+ *	successful, and TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	If anything goes wrong, this procedure returns an error message in
+ *	the interpreter's result object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceOriginCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Tcl_Command command, origCommand;
+
+    if (objc != 3) {
+        Tcl_WrongNumArgs(interp, 2, objv, "name");
+        return TCL_ERROR;
+    }
+
+    command = Tcl_GetCommandFromObj(interp, objv[2]);
+    if (command == (Tcl_Command) NULL) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"invalid command name \"",
+		Tcl_GetStringFromObj(objv[2], (int *) NULL),
+		"\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+    origCommand = TclGetOriginalCommand(command);
+    if (origCommand == (Tcl_Command) NULL) {
+	/*
+	 * The specified command isn't an imported command. Return the
+	 * command's name qualified by the full name of the namespace it
+	 * was defined in.
+	 */
+	
+	Tcl_GetCommandFullName(interp, command, Tcl_GetObjResult(interp));
+    } else {
+	Tcl_GetCommandFullName(interp, origCommand, Tcl_GetObjResult(interp));
+    }
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NamespaceParentCmd --
+ *
+ *	Invoked to implement the "namespace parent" command that returns the
+ *	fully-qualified name of the parent namespace for a specified
+ *	namespace. Handles the following syntax:
+ *
+ *	    namespace parent ?name?
+ *
+ * Results:
+ *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	Returns a result in the interpreter's result object. If anything
+ *	goes wrong, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceParentCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Tcl_Namespace *nsPtr;
+    int result;
+
+    if (objc == 2) {
+        nsPtr = Tcl_GetCurrentNamespace(interp);
+    } else if (objc == 3) {
+	result = GetNamespaceFromObj(interp, objv[2], &nsPtr);
+        if (result != TCL_OK) {
+            return result;
+        }
+        if (nsPtr == NULL) {
+            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                    "unknown namespace \"",
+		    Tcl_GetStringFromObj(objv[2], (int *) NULL),
+		    "\" in namespace parent command", (char *) NULL);
+            return TCL_ERROR;
+        }
+    } else {
+        Tcl_WrongNumArgs(interp, 2, objv, "?name?");
+        return TCL_ERROR;
+    }
+
+    /*
+     * Report the parent of the specified namespace.
+     */
+
+    if (nsPtr->parentPtr != NULL) {
+        Tcl_SetStringObj(Tcl_GetObjResult(interp),
+	        nsPtr->parentPtr->fullName, -1);
+    }
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NamespaceQualifiersCmd --
+ *
+ *	Invoked to implement the "namespace qualifiers" command that returns
+ *	any leading namespace qualifiers in a string. These qualifiers are
+ *	namespace names separated by "::"s. For example, for "::foo::p" this
+ *	command returns "::foo", and for "::" it returns "". This command
+ *	is the complement of the "namespace tail" command. Note that this
+ *	command does not check whether the "namespace" names are, in fact,
+ *	the names of currently defined namespaces. Handles the following
+ *	syntax:
+ *
+ *	    namespace qualifiers string
+ *
+ * Results:
+ *	Returns TCL_OK if successful, and  TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	Returns a result in the interpreter's result object. If anything
+ *	goes wrong, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceQualifiersCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    register char *name, *p;
+    int length;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 2, objv, "string");
+        return TCL_ERROR;
+    }
+
+    /*
+     * Find the end of the string, then work backward and find
+     * the start of the last "::" qualifier.
+     */
+
+    name = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+    for (p = name;  *p != '\0';  p++) {
+	/* empty body */
+    }
+    while (--p >= name) {
+        if ((*p == ':') && (p > name) && (*(p-1) == ':')) {
+	    p -= 2;		/* back up over the :: */
+	    while ((p >= name) && (*p == ':')) {
+		p--;		/* back up over the preceeding : */
+	    }
+	    break;
+        }
+    }
+
+    if (p >= name) {
+        length = p-name+1;
+        Tcl_AppendToObj(Tcl_GetObjResult(interp), name, length);
+    }
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NamespaceTailCmd --
+ *
+ *	Invoked to implement the "namespace tail" command that returns the
+ *	trailing name at the end of a string with "::" namespace
+ *	qualifiers. These qualifiers are namespace names separated by
+ *	"::"s. For example, for "::foo::p" this command returns "p", and for
+ *	"::" it returns "". This command is the complement of the "namespace
+ *	qualifiers" command. Note that this command does not check whether
+ *	the "namespace" names are, in fact, the names of currently defined
+ *	namespaces. Handles the following syntax:
+ *
+ *	    namespace tail string
+ *
+ * Results:
+ *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	Returns a result in the interpreter's result object. If anything
+ *	goes wrong, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceTailCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    register char *name, *p;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 2, objv, "string");
+        return TCL_ERROR;
+    }
+
+    /*
+     * Find the end of the string, then work backward and find the
+     * last "::" qualifier.
+     */
+
+    name = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+    for (p = name;  *p != '\0';  p++) {
+	/* empty body */
+    }
+    while (--p > name) {
+        if ((*p == ':') && (*(p-1) == ':')) {
+            p++;		/* just after the last "::" */
+            break;
+        }
+    }
+    
+    if (p >= name) {
+        Tcl_AppendToObj(Tcl_GetObjResult(interp), p, -1);
+    }
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NamespaceWhichCmd --
+ *
+ *	Invoked to implement the "namespace which" command that returns the
+ *	fully-qualified name of a command or variable. If the specified
+ *	command or variable does not exist, it returns "". Handles the
+ *	following syntax:
+ *
+ *	    namespace which ?-command? ?-variable? name
+ *
+ * Results:
+ *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	Returns a result in the interpreter's result object. If anything
+ *	goes wrong, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceWhichCmd(dummy, interp, objc, objv)
+    ClientData dummy;                   /* Not used. */
+    Tcl_Interp *interp;                 /* Current interpreter. */
+    int objc;                           /* Number of arguments. */
+    Tcl_Obj *CONST objv[];              /* Argument objects. */
+{
+    register char *arg;
+    Tcl_Command cmd;
+    Tcl_Var variable;
+    int argIndex, lookup;
+
+    if (objc < 3) {
+        badArgs:
+        Tcl_WrongNumArgs(interp, 2, objv,
+	        "?-command? ?-variable? name");
+        return TCL_ERROR;
+    }
+
+    /*
+     * Look for a flag controlling the lookup.
+     */
+
+    argIndex = 2;
+    lookup = 0;			/* assume command lookup by default */
+    arg = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+    if (*arg == '-') {
+	if (strncmp(arg, "-command", 8) == 0) {
+	    lookup = 0;
+	} else if (strncmp(arg, "-variable", 9) == 0) {
+	    lookup = 1;
+	} else {
+	    goto badArgs;
+	}
+	argIndex = 3;
+    }
+    if (objc != (argIndex + 1)) {
+	goto badArgs;
+    }
+
+    switch (lookup) {
+    case 0:			/* -command */
+	cmd = Tcl_GetCommandFromObj(interp, objv[argIndex]);
+        if (cmd == (Tcl_Command) NULL) {	
+            return TCL_OK;	/* cmd not found, just return (no error) */
+        }
+	Tcl_GetCommandFullName(interp, cmd, Tcl_GetObjResult(interp));
+        break;
+
+    case 1:			/* -variable */
+        arg = Tcl_GetStringFromObj(objv[argIndex], (int *) NULL);
+	variable = Tcl_FindNamespaceVar(interp, arg, (Tcl_Namespace *) NULL,
+		/*flags*/ 0);
+        if (variable != (Tcl_Var) NULL) {
+            Tcl_GetVariableFullName(interp, variable, Tcl_GetObjResult(interp));
+        }
+        break;
+    }
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeNsNameInternalRep --
+ *
+ *	Frees the resources associated with a nsName object's internal
+ *	representation.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Decrements the ref count of any Namespace structure pointed
+ *	to by the nsName's internal representation. If there are no more
+ *	references to the namespace, it's structure will be freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeNsNameInternalRep(objPtr)
+    register Tcl_Obj *objPtr;   /* nsName object with internal
+                                 * representation to free */
+{
+    register ResolvedNsName *resNamePtr =
+        (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
+    Namespace *nsPtr;
+
+    /*
+     * Decrement the reference count of the namespace. If there are no
+     * more references, free it up.
+     */
+
+    if (resNamePtr != NULL) {
+        resNamePtr->refCount--;
+        if (resNamePtr->refCount == 0) {
+
+            /*
+	     * Decrement the reference count for the cached namespace.  If
+	     * the namespace is dead, and there are no more references to
+	     * it, free it.
+	     */
+
+            nsPtr = resNamePtr->nsPtr;
+            nsPtr->refCount--;
+            if ((nsPtr->refCount == 0) && (nsPtr->flags & NS_DEAD)) {
+                NamespaceFree(nsPtr);
+            }
+            ckfree((char *) resNamePtr);
+        }
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupNsNameInternalRep --
+ *
+ *	Initializes the internal representation of a nsName object to a copy
+ *	of the internal representation of another nsName object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	copyPtr's internal rep is set to refer to the same namespace
+ *	referenced by srcPtr's internal rep. Increments the ref count of
+ *	the ResolvedNsName structure used to hold the namespace reference.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupNsNameInternalRep(srcPtr, copyPtr)
+    Tcl_Obj *srcPtr;                /* Object with internal rep to copy. */
+    register Tcl_Obj *copyPtr;      /* Object with internal rep to set. */
+{
+    register ResolvedNsName *resNamePtr =
+        (ResolvedNsName *) srcPtr->internalRep.otherValuePtr;
+
+    copyPtr->internalRep.otherValuePtr = (VOID *) resNamePtr;
+    if (resNamePtr != NULL) {
+        resNamePtr->refCount++;
+    }
+    copyPtr->typePtr = &tclNsNameType;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetNsNameFromAny --
+ *
+ *	Attempt to generate a nsName internal representation for a
+ *	Tcl object.
+ *
+ * Results:
+ *	Returns TCL_OK if the value could be converted to a proper
+ *	namespace reference. Otherwise, it returns TCL_ERROR, along
+ *	with an error message in the interpreter's result object.
+ *
+ * Side effects:
+ *	If successful, the object is made a nsName object. Its internal rep
+ *	is set to point to a ResolvedNsName, which contains a cached pointer
+ *	to the Namespace. Reference counts are kept on both the
+ *	ResolvedNsName and the Namespace, so we can keep track of their
+ *	usage and free them when appropriate.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetNsNameFromAny(interp, objPtr)
+    Tcl_Interp *interp;		/* Points to the namespace in which to
+				 * resolve name. Also used for error
+				 * reporting if not NULL. */
+    register Tcl_Obj *objPtr;	/* The object to convert. */
+{
+    register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+    char *name, *dummy;
+    Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr;
+    register ResolvedNsName *resNamePtr;
+
+    /*
+     * Get the string representation. Make it up-to-date if necessary.
+     */
+
+    name = objPtr->bytes;
+    if (name == NULL) {
+	name = Tcl_GetStringFromObj(objPtr, (int *) NULL);
+    }
+
+    /*
+     * Look for the namespace "name" in the current namespace. If there is
+     * an error parsing the (possibly qualified) name, return an error.
+     * If the namespace isn't found, we convert the object to an nsName
+     * object with a NULL ResolvedNsName* internal rep.
+     */
+
+    TclGetNamespaceForQualName(interp, name, (Namespace *) NULL,
+       /*flags*/ FIND_ONLY_NS, &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
+
+    /*
+     * If we found a namespace, then create a new ResolvedNsName structure
+     * that holds a reference to it.
+     */
+
+    if (nsPtr != NULL) {
+	Namespace *currNsPtr =
+	        (Namespace *) Tcl_GetCurrentNamespace(interp);
+	
+        nsPtr->refCount++;
+        resNamePtr = (ResolvedNsName *) ckalloc(sizeof(ResolvedNsName));
+        resNamePtr->nsPtr = nsPtr;
+        resNamePtr->nsId = nsPtr->nsId;
+        resNamePtr->refNsPtr = currNsPtr;
+        resNamePtr->refCount = 1;
+    } else {
+        resNamePtr = NULL;
+    }
+
+    /*
+     * Free the old internalRep before setting the new one.
+     * We do this as late as possible to allow the conversion code
+     * (in particular, Tcl_GetStringFromObj) to use that old internalRep.
+     */
+
+    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+        oldTypePtr->freeIntRepProc(objPtr);
+    }
+
+    objPtr->internalRep.otherValuePtr = (VOID *) resNamePtr;
+    objPtr->typePtr = &tclNsNameType;
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfNsName --
+ *
+ *	Updates the string representation for a nsName object.
+ *	Note: This procedure does not free an existing old string rep
+ *	so storage will be lost if this has not already been done.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's string is set to a copy of the fully qualified
+ *	namespace name.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfNsName(objPtr)
+    register Tcl_Obj *objPtr; /* nsName object with string rep to update. */
+{
+    ResolvedNsName *resNamePtr =
+        (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
+    register Namespace *nsPtr;
+    char *name = "";
+    int length;
+
+    if ((resNamePtr != NULL)
+	    && (resNamePtr->nsId == resNamePtr->nsPtr->nsId)) {
+        nsPtr = resNamePtr->nsPtr;
+        if (nsPtr->flags & NS_DEAD) {
+            nsPtr = NULL;
+        }
+        if (nsPtr != NULL) {
+            name = nsPtr->fullName;
+        }
+    }
+
+    /*
+     * The following sets the string rep to an empty string on the heap
+     * if the internal rep is NULL.
+     */
+
+    length = strlen(name);
+    if (length == 0) {
+	objPtr->bytes = tclEmptyStringRep;
+    } else {
+	objPtr->bytes = (char *) ckalloc((unsigned) (length + 1));
+	memcpy((VOID *) objPtr->bytes, (VOID *) name, (unsigned) length);
+	objPtr->bytes[length] = '\0';
+    }
+    objPtr->length = length;
+}
Index: /trunk/tcl/tclObj.c
===================================================================
--- /trunk/tcl/tclObj.c	(revision 2)
+++ /trunk/tcl/tclObj.c	(revision 2)
@@ -0,0 +1,2184 @@
+/* 
+ * tclObj.c --
+ *
+ *	This file contains Tcl object-related procedures that are used by
+ * 	many Tcl commands.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclObj.c,v 1.1 2008-06-04 13:58:08 demin Exp $
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ * Table of all object types.
+ */
+
+static Tcl_HashTable typeTable;
+static int typeTableInitialized = 0;    /* 0 means not yet initialized. */
+
+/*
+ * Head of the list of free Tcl_Objs we maintain.
+ */
+
+Tcl_Obj *tclFreeObjList = NULL;
+
+/*
+ * Pointer to a heap-allocated string of length zero that the Tcl core uses
+ * as the value of an empty string representation for an object. This value
+ * is shared by all new objects allocated by Tcl_NewObj.
+ */
+
+char *tclEmptyStringRep = NULL;
+
+/*
+ * Count of the number of Tcl objects every allocated (by Tcl_NewObj) and
+ * freed (by TclFreeObj).
+ */
+
+#ifdef TCL_COMPILE_STATS
+long tclObjsAlloced = 0;
+long tclObjsFreed = 0;
+#endif /* TCL_COMPILE_STATS */
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static void		DupBooleanInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
+			    Tcl_Obj *copyPtr));
+static void		DupDoubleInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
+			    Tcl_Obj *copyPtr));
+static void		DupIntInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
+			    Tcl_Obj *copyPtr));
+static void		FinalizeTypeTable _ANSI_ARGS_((void));
+static void		FinalizeFreeObjList _ANSI_ARGS_((void));
+static void		InitTypeTable _ANSI_ARGS_((void));
+static int		SetBooleanFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr));
+static int		SetDoubleFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr));
+static int		SetIntFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr));
+static void		UpdateStringOfBoolean _ANSI_ARGS_((Tcl_Obj *objPtr));
+static void		UpdateStringOfDouble _ANSI_ARGS_((Tcl_Obj *objPtr));
+static void		UpdateStringOfInt _ANSI_ARGS_((Tcl_Obj *objPtr));
+
+/*
+ * The structures below defines the Tcl object types defined in this file by
+ * means of procedures that can be invoked by generic object code. See also
+ * tclStringObj.c, tclListObj.c, tclByteCode.c for other type manager
+ * implementations.
+ */
+
+Tcl_ObjType tclBooleanType = {
+    "boolean",				/* name */
+    (Tcl_FreeInternalRepProc *) NULL,   /* freeIntRepProc */
+    DupBooleanInternalRep,		/* dupIntRepProc */
+    UpdateStringOfBoolean,		/* updateStringProc */
+    SetBooleanFromAny			/* setFromAnyProc */
+};
+
+Tcl_ObjType tclDoubleType = {
+    "double",				/* name */
+    (Tcl_FreeInternalRepProc *) NULL,   /* freeIntRepProc */
+    DupDoubleInternalRep,		/* dupIntRepProc */
+    UpdateStringOfDouble,		/* updateStringProc */
+    SetDoubleFromAny			/* setFromAnyProc */
+};
+
+Tcl_ObjType tclIntType = {
+    "int",				/* name */
+    (Tcl_FreeInternalRepProc *) NULL,   /* freeIntRepProc */
+    DupIntInternalRep,		        /* dupIntRepProc */
+    UpdateStringOfInt,			/* updateStringProc */
+    SetIntFromAny			/* setFromAnyProc */
+};
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * InitTypeTable --
+ *
+ *	This procedure is invoked to perform once-only initialization of
+ *	the type table. It also registers the object types defined in 
+ *	this file.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Initializes the table of defined object types "typeTable" with
+ *	builtin object types defined in this file. It also initializes the
+ *	value of tclEmptyStringRep, which points to the heap-allocated
+ *	string of length zero used as the string representation for
+ *	newly-created objects.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+InitTypeTable()
+{
+    typeTableInitialized = 1;
+
+    Tcl_InitHashTable(&typeTable, TCL_STRING_KEYS);
+    Tcl_RegisterObjType(&tclBooleanType);
+    Tcl_RegisterObjType(&tclDoubleType);
+    Tcl_RegisterObjType(&tclIntType);
+    Tcl_RegisterObjType(&tclStringType);
+    Tcl_RegisterObjType(&tclListType);
+    Tcl_RegisterObjType(&tclByteCodeType);
+    Tcl_RegisterObjType(&tclProcBodyType);
+
+    tclEmptyStringRep = (char *) ckalloc((unsigned) 1);
+    tclEmptyStringRep[0] = '\0';
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FinalizeTypeTable --
+ *
+ *	This procedure is called by Tcl_Finalize after all exit handlers
+ *	have been run to free up storage associated with the table of Tcl
+ *	object types.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Deletes all entries in the hash table of object types, "typeTable".
+ *	Then sets "typeTableInitialized" to 0 so that the Tcl type system
+ *	will be properly reinitialized if Tcl is restarted. Also deallocates
+ *	the storage for tclEmptyStringRep.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FinalizeTypeTable()
+{
+    if (typeTableInitialized) {
+        Tcl_DeleteHashTable(&typeTable);
+	ckfree(tclEmptyStringRep);
+        typeTableInitialized = 0;
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FinalizeFreeObjList --
+ *
+ *	Resets the free object list so it can later be reinitialized.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Resets the value of tclFreeObjList.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FinalizeFreeObjList()
+{
+    tclFreeObjList = NULL;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFinalizeCompExecEnv --
+ *
+ *	Clean up the compiler execution environment so it can later be
+ *	properly reinitialized.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Cleans up the execution environment
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFinalizeCompExecEnv()
+{
+    FinalizeTypeTable();
+    FinalizeFreeObjList();
+    TclFinalizeExecEnv();
+}
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tcl_RegisterObjType --
+ *
+ *	This procedure is called to register a new Tcl object type
+ *	in the table of all object types supported by Tcl.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The type is registered in the Tcl type table. If there was already
+ *	a type with the same name as in typePtr, it is replaced with the
+ *	new type.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tcl_RegisterObjType(typePtr)
+    Tcl_ObjType *typePtr;	/* Information about object type;
+				 * storage must be statically
+				 * allocated (must live forever). */
+{
+    register Tcl_HashEntry *hPtr;
+    int new;
+
+    if (!typeTableInitialized) {
+	InitTypeTable();
+    }
+
+    /*
+     * If there's already an object type with the given name, remove it.
+     */
+
+    hPtr = Tcl_FindHashEntry(&typeTable, typePtr->name);
+    if (hPtr != (Tcl_HashEntry *) NULL) {
+        Tcl_DeleteHashEntry(hPtr);
+    }
+
+    /*
+     * Now insert the new object type.
+     */
+
+    hPtr = Tcl_CreateHashEntry(&typeTable, typePtr->name, &new);
+    if (new) {
+	Tcl_SetHashValue(hPtr, typePtr);
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AppendAllObjTypes --
+ *
+ *	This procedure appends onto the argument object the name of each
+ *	object type as a list element. This includes the builtin object
+ *	types (e.g. int, list) as well as those added using
+ *	Tcl_CreateObjType. These names can be used, for example, with
+ *	Tcl_GetObjType to get pointers to the corresponding Tcl_ObjType
+ *	structures.
+ *
+ * Results:
+ *	The return value is normally TCL_OK; in this case the object
+ *	referenced by objPtr has each type name appended to it. If an
+ *	error occurs, TCL_ERROR is returned and the interpreter's result
+ *	holds an error message.
+ *
+ * Side effects:
+ *	If necessary, the object referenced by objPtr is converted into
+ *	a list object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_AppendAllObjTypes(interp, objPtr)
+    Tcl_Interp *interp;		/* Interpreter used for error reporting. */
+    Tcl_Obj *objPtr;		/* Points to the Tcl object onto which the
+				 * name of each registered type is appended
+				 * as a list element. */
+{
+    register Tcl_HashEntry *hPtr;
+    Tcl_HashSearch search;
+    Tcl_ObjType *typePtr;
+    int result;
+ 
+    if (!typeTableInitialized) {
+	InitTypeTable();
+    }
+
+    /*
+     * This code assumes that types names do not contain embedded NULLs.
+     */
+
+    for (hPtr = Tcl_FirstHashEntry(&typeTable, &search);
+	    hPtr != NULL;  hPtr = Tcl_NextHashEntry(&search)) {
+        typePtr = (Tcl_ObjType *) Tcl_GetHashValue(hPtr);
+	result = Tcl_ListObjAppendElement(interp, objPtr,
+	        Tcl_NewStringObj(typePtr->name, -1));
+	if (result == TCL_ERROR) {
+	    return result;
+	}
+    }
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetObjType --
+ *
+ *	This procedure looks up an object type by name.
+ *
+ * Results:
+ *	If an object type with name matching "typeName" is found, a pointer
+ *	to its Tcl_ObjType structure is returned; otherwise, NULL is
+ *	returned.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_ObjType *
+Tcl_GetObjType(typeName)
+    char *typeName;		/* Name of Tcl object type to look up. */
+{
+    register Tcl_HashEntry *hPtr;
+    Tcl_ObjType *typePtr;
+
+    if (!typeTableInitialized) {
+	InitTypeTable();
+    }
+
+    hPtr = Tcl_FindHashEntry(&typeTable, typeName);
+    if (hPtr != (Tcl_HashEntry *) NULL) {
+        typePtr = (Tcl_ObjType *) Tcl_GetHashValue(hPtr);
+	return typePtr;
+    }
+    return NULL;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ConvertToType --
+ *
+ *	Convert the Tcl object "objPtr" to have type "typePtr" if possible.
+ *
+ * Results:
+ *	The return value is TCL_OK on success and TCL_ERROR on failure. If
+ *	TCL_ERROR is returned, then the interpreter's result contains an
+ *	error message unless "interp" is NULL. Passing a NULL "interp"
+ *	allows this procedure to be used as a test whether the conversion
+ *	could be done (and in fact was done).
+ *
+ * Side effects:
+ *	Any internal representation for the old type is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ConvertToType(interp, objPtr, typePtr)
+    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
+    Tcl_Obj *objPtr;		/* The object to convert. */
+    Tcl_ObjType *typePtr;	/* The target type. */
+{
+    if (objPtr->typePtr == typePtr) {
+	return TCL_OK;
+    }
+
+    /*
+     * Use the target type's Tcl_SetFromAnyProc to set "objPtr"s internal
+     * form as appropriate for the target type. This frees the old internal
+     * representation.
+     */
+
+    return typePtr->setFromAnyProc(interp, objPtr);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NewObj --
+ *
+ *	This procedure is normally called when not debugging: i.e., when
+ *	TCL_MEM_DEBUG is not defined. It creates new Tcl objects that denote
+ *	the empty string. These objects have a NULL object type and NULL
+ *	string representation byte pointer. Type managers call this routine
+ *	to allocate new objects that they further initialize.
+ *
+ *	When TCL_MEM_DEBUG is defined, this procedure just returns the
+ *	result of calling the debugging version Tcl_DbNewObj.
+ *
+ * Results:
+ *	The result is a newly allocated object that represents the empty
+ *	string. The new object's typePtr is set NULL and its ref count
+ *	is set to 0.
+ *
+ * Side effects:
+ *	If compiling with TCL_COMPILE_STATS, this procedure increments
+ *	the global count of allocated objects (tclObjsAlloced).
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+#undef Tcl_NewObj
+
+Tcl_Obj *
+Tcl_NewObj()
+{
+    return Tcl_DbNewObj("unknown", 0);
+}
+
+#else /* if not TCL_MEM_DEBUG */
+
+Tcl_Obj *
+Tcl_NewObj()
+{
+    register Tcl_Obj *objPtr;
+
+    /*
+     * Allocate the object using the list of free Tcl_Objs we maintain.
+     */
+
+    if (tclFreeObjList == NULL) {
+	TclAllocateFreeObjects();
+    }
+    objPtr = tclFreeObjList;
+    tclFreeObjList = (Tcl_Obj *) tclFreeObjList->internalRep.otherValuePtr;
+    
+    objPtr->refCount = 0;
+    objPtr->bytes    = tclEmptyStringRep;
+    objPtr->length   = 0;
+    objPtr->typePtr  = NULL;
+#ifdef TCL_COMPILE_STATS
+    tclObjsAlloced++;
+#endif /* TCL_COMPILE_STATS */
+    return objPtr;
+}
+#endif /* TCL_MEM_DEBUG */
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DbNewObj --
+ *
+ *	This procedure is normally called when debugging: i.e., when
+ *	TCL_MEM_DEBUG is defined. It creates new Tcl objects that denote the
+ *	empty string. It is the same as the Tcl_NewObj procedure above
+ *	except that it calls Tcl_DbCkalloc directly with the file name and
+ *	line number from its caller. This simplifies debugging since then
+ *	the checkmem command will report the correct file name and line
+ *	number when reporting objects that haven't been freed.
+ *
+ *	When TCL_MEM_DEBUG is not defined, this procedure just returns the
+ *	result of calling Tcl_NewObj.
+ *
+ * Results:
+ *	The result is a newly allocated that represents the empty string.
+ *	The new object's typePtr is set NULL and its ref count is set to 0.
+ *
+ * Side effects:
+ *	If compiling with TCL_COMPILE_STATS, this procedure increments
+ *	the global count of allocated objects (tclObjsAlloced).
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+
+Tcl_Obj *
+Tcl_DbNewObj(file, line)
+    register char *file;	/* The name of the source file calling this
+				 * procedure; used for debugging. */
+    register int line;		/* Line number in the source file; used
+				 * for debugging. */
+{
+    register Tcl_Obj *objPtr;
+
+    /*
+     * If debugging Tcl's memory usage, allocate the object using ckalloc.
+     * Otherwise, allocate it using the list of free Tcl_Objs we maintain.
+     */
+
+    objPtr = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), file, line);
+    objPtr->refCount = 0;
+    objPtr->bytes    = tclEmptyStringRep;
+    objPtr->length   = 0;
+    objPtr->typePtr  = NULL;
+#ifdef TCL_COMPILE_STATS
+    tclObjsAlloced++;
+#endif /* TCL_COMPILE_STATS */
+    return objPtr;
+}
+
+#else /* if not TCL_MEM_DEBUG */
+
+Tcl_Obj *
+Tcl_DbNewObj(file, line)
+    char *file;			/* The name of the source file calling this
+				 * procedure; used for debugging. */
+    int line;			/* Line number in the source file; used
+				 * for debugging. */
+{
+    return Tcl_NewObj();
+}
+#endif /* TCL_MEM_DEBUG */
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclAllocateFreeObjects --
+ *
+ *	Procedure to allocate a number of free Tcl_Objs. This is done using
+ *	a single ckalloc to reduce the overhead for Tcl_Obj allocation.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	tclFreeObjList, the head of the list of free Tcl_Objs, is set to the
+ *	first of a number of free Tcl_Obj's linked together by their
+ *	internalRep.otherValuePtrs.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#define OBJS_TO_ALLOC_EACH_TIME 100
+
+void
+TclAllocateFreeObjects()
+{
+    Tcl_Obj tmp[2];
+    size_t objSizePlusPadding =	/* NB: this assumes byte addressing. */
+	((int)(&(tmp[1])) - (int)(&(tmp[0])));
+    size_t bytesToAlloc = (OBJS_TO_ALLOC_EACH_TIME * objSizePlusPadding);
+    char *basePtr;
+    register Tcl_Obj *prevPtr, *objPtr;
+    register int i;
+
+    basePtr = (char *) ckalloc(bytesToAlloc);
+    memset(basePtr, 0, bytesToAlloc);
+
+    prevPtr = NULL;
+    objPtr = (Tcl_Obj *) basePtr;
+    for (i = 0;  i < OBJS_TO_ALLOC_EACH_TIME;  i++) {
+	objPtr->internalRep.otherValuePtr = (VOID *) prevPtr;
+	prevPtr = objPtr;
+	objPtr = (Tcl_Obj *) (((char *)objPtr) + objSizePlusPadding);
+    }
+    tclFreeObjList = prevPtr;
+}
+#undef OBJS_TO_ALLOC_EACH_TIME
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFreeObj --
+ *
+ *	This procedure frees the memory associated with the argument
+ *	object. It is called by the tcl.h macro Tcl_DecrRefCount when an
+ *	object's ref count is zero. It is only "public" since it must
+ *	be callable by that macro wherever the macro is used. It should not
+ *	be directly called by clients.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Deallocates the storage for the object's Tcl_Obj structure
+ *	after deallocating the string representation and calling the
+ *	type-specific Tcl_FreeInternalRepProc to deallocate the object's
+ *	internal representation. If compiling with TCL_COMPILE_STATS,
+ *	this procedure increments the global count of freed objects
+ *	(tclObjsFreed).
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFreeObj(objPtr)
+    register Tcl_Obj *objPtr;	/* The object to be freed. */
+{
+    register Tcl_ObjType *typePtr = objPtr->typePtr;
+    
+#ifdef TCL_MEM_DEBUG
+    if ((objPtr)->refCount < -1) {
+	panic("Reference count for %lx was negative", objPtr);
+    }
+#endif /* TCL_MEM_DEBUG */
+
+    Tcl_InvalidateStringRep(objPtr);
+    if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+	typePtr->freeIntRepProc(objPtr);
+    }
+
+    /*
+     * If debugging Tcl's memory usage, deallocate the object using ckfree.
+     * Otherwise, deallocate it by adding it onto the list of free
+     * Tcl_Objs we maintain.
+     */
+    
+#ifdef TCL_MEM_DEBUG
+    ckfree((char *) objPtr);
+#else
+    objPtr->internalRep.otherValuePtr = (VOID *) tclFreeObjList;
+    tclFreeObjList = objPtr;
+#endif /* TCL_MEM_DEBUG */
+
+#ifdef TCL_COMPILE_STATS    
+    tclObjsFreed++;
+#endif /* TCL_COMPILE_STATS */    
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DuplicateObj --
+ *
+ *	Create and return a new object that is a duplicate of the argument
+ *	object.
+ *
+ * Results:
+ *	The return value is a pointer to a newly created Tcl_Obj. This
+ *	object has reference count 0 and the same type, if any, as the
+ *	source object objPtr. Also:
+ *	  1) If the source object has a valid string rep, we copy it;
+ *	     otherwise, the duplicate's string rep is set NULL to mark
+ *	     it invalid.
+ *	  2) If the source object has an internal representation (i.e. its
+ *	     typePtr is non-NULL), the new object's internal rep is set to
+ *	     a copy; otherwise the new internal rep is marked invalid.
+ *
+ * Side effects:
+ *      What constitutes "copying" the internal representation depends on
+ *	the type. For example, if the argument object is a list,
+ *	the element objects it points to will not actually be copied but
+ *	will be shared with the duplicate list. That is, the ref counts of
+ *	the element objects will be incremented.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_DuplicateObj(objPtr)
+    register Tcl_Obj *objPtr;		/* The object to duplicate. */
+{
+    register Tcl_ObjType *typePtr = objPtr->typePtr;
+    register Tcl_Obj *dupPtr;
+
+    TclNewObj(dupPtr);
+
+    if (objPtr->bytes == NULL) {
+	dupPtr->bytes = NULL;
+    } else if (objPtr->bytes != tclEmptyStringRep) {
+	int len = objPtr->length;
+	
+	dupPtr->bytes = (char *) ckalloc((unsigned) len+1);
+	if (len > 0) {
+	    memcpy((VOID *) dupPtr->bytes, (VOID *) objPtr->bytes,
+		   (unsigned) len);
+	}
+	dupPtr->bytes[len] = '\0';
+	dupPtr->length = len;
+    }
+    
+    if (typePtr != NULL) {
+	typePtr->dupIntRepProc(objPtr, dupPtr);
+    }
+    return dupPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetStringFromObj --
+ *
+ *	Returns the string representation's byte array pointer and length
+ *	for an object.
+ *
+ * Results:
+ *	Returns a pointer to the string representation of objPtr. If
+ *	lengthPtr isn't NULL, the length of the string representation is
+ *	stored at *lengthPtr. The byte array referenced by the returned
+ *	pointer must not be modified by the caller. Furthermore, the
+ *	caller must copy the bytes if they need to retain them since the
+ *	object's string rep can change as a result of other operations.
+ *
+ * Side effects:
+ *	May call the object's updateStringProc to update the string
+ *	representation from the internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_GetStringFromObj(objPtr, lengthPtr)
+    register Tcl_Obj *objPtr;	/* Object whose string rep byte pointer
+				 * should be returned. */
+    register int *lengthPtr;	/* If non-NULL, the location where the
+				 * string rep's byte array length should be
+				 * stored. If NULL, no length is stored. */
+{
+    if (objPtr->bytes != NULL) {
+	if (lengthPtr != NULL) {
+	    *lengthPtr = objPtr->length;
+	}
+	return objPtr->bytes;
+    }
+
+    objPtr->typePtr->updateStringProc(objPtr);
+    if (lengthPtr != NULL) {
+	*lengthPtr = objPtr->length;
+    }
+    return objPtr->bytes;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_InvalidateStringRep --
+ *
+ *	This procedure is called to invalidate an object's string
+ *	representation. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Deallocates the storage for any old string representation, then
+ *	sets the string representation NULL to mark it invalid.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_InvalidateStringRep(objPtr)
+     register Tcl_Obj *objPtr;	/* Object whose string rep byte pointer
+				 * should be freed. */
+{
+    if (objPtr->bytes != NULL) {
+	if (objPtr->bytes != tclEmptyStringRep) {
+	    ckfree((char *) objPtr->bytes);
+	}
+	objPtr->bytes = NULL;
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NewBooleanObj --
+ *
+ *	This procedure is normally called when not debugging: i.e., when
+ *	TCL_MEM_DEBUG is not defined. It creates a new boolean object and
+ *	initializes it from the argument boolean value. A nonzero
+ *	"boolValue" is coerced to 1.
+ *
+ *	When TCL_MEM_DEBUG is defined, this procedure just returns the
+ *	result of calling the debugging version Tcl_DbNewBooleanObj.
+ *
+ * Results:
+ *	The newly created object is returned. This object will have an
+ *	invalid string representation. The returned object has ref count 0.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+#undef Tcl_NewBooleanObj
+
+Tcl_Obj *
+Tcl_NewBooleanObj(boolValue)
+    register int boolValue;	/* Boolean used to initialize new object. */
+{
+    return Tcl_DbNewBooleanObj(boolValue, "unknown", 0);
+}
+
+#else /* if not TCL_MEM_DEBUG */
+
+Tcl_Obj *
+Tcl_NewBooleanObj(boolValue)
+    register int boolValue;	/* Boolean used to initialize new object. */
+{
+    register Tcl_Obj *objPtr;
+
+    TclNewObj(objPtr);
+    objPtr->bytes = NULL;
+    
+    objPtr->internalRep.longValue = (boolValue? 1 : 0);
+    objPtr->typePtr = &tclBooleanType;
+    return objPtr;
+}
+#endif /* TCL_MEM_DEBUG */
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DbNewBooleanObj --
+ *
+ *	This procedure is normally called when debugging: i.e., when
+ *	TCL_MEM_DEBUG is defined. It creates new boolean objects. It is the
+ *	same as the Tcl_NewBooleanObj procedure above except that it calls
+ *	Tcl_DbCkalloc directly with the file name and line number from its
+ *	caller. This simplifies debugging since then the checkmem command
+ *	will report the correct file name and line number when reporting
+ *	objects that haven't been freed.
+ *
+ *	When TCL_MEM_DEBUG is not defined, this procedure just returns the
+ *	result of calling Tcl_NewBooleanObj.
+ *
+ * Results:
+ *	The newly created object is returned. This object will have an
+ *	invalid string representation. The returned object has ref count 0.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+
+Tcl_Obj *
+Tcl_DbNewBooleanObj(boolValue, file, line)
+    register int boolValue;	/* Boolean used to initialize new object. */
+    char *file;			/* The name of the source file calling this
+				 * procedure; used for debugging. */
+    int line;			/* Line number in the source file; used
+				 * for debugging. */
+{
+    register Tcl_Obj *objPtr;
+
+    TclDbNewObj(objPtr, file, line);
+    objPtr->bytes = NULL;
+    
+    objPtr->internalRep.longValue = (boolValue? 1 : 0);
+    objPtr->typePtr = &tclBooleanType;
+    return objPtr;
+}
+
+#else /* if not TCL_MEM_DEBUG */
+
+Tcl_Obj *
+Tcl_DbNewBooleanObj(boolValue, file, line)
+    register int boolValue;	/* Boolean used to initialize new object. */
+    char *file;			/* The name of the source file calling this
+				 * procedure; used for debugging. */
+    int line;			/* Line number in the source file; used
+				 * for debugging. */
+{
+    return Tcl_NewBooleanObj(boolValue);
+}
+#endif /* TCL_MEM_DEBUG */
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetBooleanObj --
+ *
+ *	Modify an object to be a boolean object and to have the specified
+ *	boolean value. A nonzero "boolValue" is coerced to 1.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's old string rep, if any, is freed. Also, any old
+ *	internal rep is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetBooleanObj(objPtr, boolValue)
+    register Tcl_Obj *objPtr;	/* Object whose internal rep to init. */
+    register int boolValue;	/* Boolean used to set object's value. */
+{
+    register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+
+    if (Tcl_IsShared(objPtr)) {
+	panic("Tcl_SetBooleanObj called with shared object");
+    }
+    
+    Tcl_InvalidateStringRep(objPtr);
+    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+    }
+    
+    objPtr->internalRep.longValue = (boolValue? 1 : 0);
+    objPtr->typePtr = &tclBooleanType;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetBooleanFromObj --
+ *
+ *	Attempt to return a boolean from the Tcl object "objPtr". If the
+ *	object is not already a boolean, an attempt will be made to convert
+ *	it to one.
+ *
+ * Results:
+ *	The return value is a standard Tcl object result. If an error occurs
+ *	during conversion, an error message is left in the interpreter's
+ *	result unless "interp" is NULL.
+ *
+ * Side effects:
+ *	If the object is not already a boolean, the conversion will free
+ *	any old internal representation. 
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetBooleanFromObj(interp, objPtr, boolPtr)
+    Tcl_Interp *interp; 	/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr;	/* The object from which to get boolean. */
+    register int *boolPtr;	/* Place to store resulting boolean. */
+{
+    register int result;
+
+    result = SetBooleanFromAny(interp, objPtr);
+    if (result == TCL_OK) {
+	*boolPtr = (int) objPtr->internalRep.longValue;
+    }
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupBooleanInternalRep --
+ *
+ *	Initialize the internal representation of a boolean Tcl_Obj to a
+ *	copy of the internal representation of an existing boolean object. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	"copyPtr"s internal rep is set to the boolean (an integer)
+ *	corresponding to "srcPtr"s internal rep.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupBooleanInternalRep(srcPtr, copyPtr)
+    register Tcl_Obj *srcPtr;	/* Object with internal rep to copy. */
+    register Tcl_Obj *copyPtr;	/* Object with internal rep to set. */
+{
+    copyPtr->internalRep.longValue = srcPtr->internalRep.longValue;
+    copyPtr->typePtr = &tclBooleanType;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetBooleanFromAny --
+ *
+ *	Attempt to generate a boolean internal form for the Tcl object
+ *	"objPtr".
+ *
+ * Results:
+ *	The return value is a standard Tcl result. If an error occurs during
+ *	conversion, an error message is left in the interpreter's result
+ *	unless "interp" is NULL.
+ *
+ * Side effects:
+ *	If no error occurs, an integer 1 or 0 is stored as "objPtr"s
+ *	internal representation and the type of "objPtr" is set to boolean.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetBooleanFromAny(interp, objPtr)
+    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr;	/* The object to convert. */
+{
+    Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+    char *string, *end;
+    register char c;
+    char lowerCase[10];
+    int newBool, length;
+    register int i;
+    double dbl;
+
+    /*
+     * Get the string representation. Make it up-to-date if necessary.
+     */
+
+    string = TclGetStringFromObj(objPtr, &length);
+
+    /*
+     * Copy the string converting its characters to lower case.
+     */
+
+    for (i = 0;  (i < 9) && (i < length);  i++) {
+	c = string[i];
+	if (isupper(UCHAR(c))) {
+	    c = (char) tolower(UCHAR(c));
+	}
+	lowerCase[i] = c;
+    }
+    lowerCase[i] = 0;
+
+    /*
+     * Parse the string as a boolean. We use an implementation here that
+     * doesn't report errors in interp if interp is NULL.
+     */
+
+    c = lowerCase[0];
+    if ((c == '0') && (lowerCase[1] == '\0')) {
+	newBool = 0;
+    } else if ((c == '1') && (lowerCase[1] == '\0')) {
+	newBool = 1;
+    } else if ((c == 'y') && (strncmp(lowerCase, "yes", (size_t) length) == 0)) {
+	newBool = 1;
+    } else if ((c == 'n') && (strncmp(lowerCase, "no", (size_t) length) == 0)) {
+	newBool = 0;
+    } else if ((c == 't') && (strncmp(lowerCase, "true", (size_t) length) == 0)) {
+	newBool = 1;
+    } else if ((c == 'f') && (strncmp(lowerCase, "false", (size_t) length) == 0)) {
+	newBool = 0;
+    } else if ((c == 'o') && (length >= 2)) {
+	if (strncmp(lowerCase, "on", (size_t) length) == 0) {
+	    newBool = 1;
+	} else if (strncmp(lowerCase, "off", (size_t) length) == 0) {
+	    newBool = 0;
+	} else {
+	    goto badBoolean;
+	}
+    } else {
+        /*
+         * Still might be a string containing the characters representing an
+         * int or double that wasn't handled above. This would be a string
+         * like "27" or "1.0" that is non-zero and not "1". Such a string
+         * whould result in the boolean value true. We try converting to
+         * double. If that succeeds and the resulting double is non-zero, we
+         * have a "true". Note that numbers can't have embedded NULLs.
+	 */
+
+	dbl = strtod(string, &end);
+	if (end == string) {
+	    goto badBoolean;
+	}
+
+	/*
+	 * Make sure the string has no garbage after the end of the double.
+	 */
+	
+	while ((end < (string+length)) && isspace(UCHAR(*end))) {
+	    end++;
+	}
+	if (end != (string+length)) {
+	    goto badBoolean;
+	}
+	newBool = (dbl != 0.0);
+    }
+
+    /*
+     * Free the old internalRep before setting the new one. We do this as
+     * late as possible to allow the conversion code, in particular
+     * Tcl_GetStringFromObj, to use that old internalRep.
+     */
+
+    if ((oldTypePtr != NULL) &&	(oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+    }
+
+    objPtr->internalRep.longValue = newBool;
+    objPtr->typePtr = &tclBooleanType;
+    return TCL_OK;
+
+    badBoolean:
+    if (interp != NULL) {
+	/*
+	 * Must copy string before resetting the result in case a caller
+	 * is trying to convert the interpreter's result to a boolean.
+	 */
+	
+	char buf[100];
+	sprintf(buf, "expected boolean value but got \"%.50s\"", string);
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
+    }
+    return TCL_ERROR;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfBoolean --
+ *
+ *	Update the string representation for a boolean object.
+ *	Note: This procedure does not free an existing old string rep
+ *	so storage will be lost if this has not already been done. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's string is set to a valid string that results from
+ *	the boolean-to-string conversion.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfBoolean(objPtr)
+    register Tcl_Obj *objPtr;	/* Int object whose string rep to update. */
+{
+    char *s = ckalloc((unsigned) 2);
+    
+    s[0] = (char) (objPtr->internalRep.longValue? '1' : '0');
+    s[1] = '\0';
+    objPtr->bytes = s;
+    objPtr->length = 1;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NewDoubleObj --
+ *
+ *	This procedure is normally called when not debugging: i.e., when
+ *	TCL_MEM_DEBUG is not defined. It creates a new double object and
+ *	initializes it from the argument double value.
+ *
+ *	When TCL_MEM_DEBUG is defined, this procedure just returns the
+ *	result of calling the debugging version Tcl_DbNewDoubleObj.
+ *
+ * Results:
+ *	The newly created object is returned. This object will have an
+ *	invalid string representation. The returned object has ref count 0.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+#undef Tcl_NewDoubleObj
+
+Tcl_Obj *
+Tcl_NewDoubleObj(dblValue)
+    register double dblValue;	/* Double used to initialize the object. */
+{
+    return Tcl_DbNewDoubleObj(dblValue, "unknown", 0);
+}
+
+#else /* if not TCL_MEM_DEBUG */
+
+Tcl_Obj *
+Tcl_NewDoubleObj(dblValue)
+    register double dblValue;	/* Double used to initialize the object. */
+{
+    register Tcl_Obj *objPtr;
+
+    TclNewObj(objPtr);
+    objPtr->bytes = NULL;
+    
+    objPtr->internalRep.doubleValue = dblValue;
+    objPtr->typePtr = &tclDoubleType;
+    return objPtr;
+}
+#endif /* if TCL_MEM_DEBUG */
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DbNewDoubleObj --
+ *
+ *	This procedure is normally called when debugging: i.e., when
+ *	TCL_MEM_DEBUG is defined. It creates new double objects. It is the
+ *	same as the Tcl_NewDoubleObj procedure above except that it calls
+ *	Tcl_DbCkalloc directly with the file name and line number from its
+ *	caller. This simplifies debugging since then the checkmem command
+ *	will report the correct file name and line number when reporting
+ *	objects that haven't been freed.
+ *
+ *	When TCL_MEM_DEBUG is not defined, this procedure just returns the
+ *	result of calling Tcl_NewDoubleObj.
+ *
+ * Results:
+ *	The newly created object is returned. This object will have an
+ *	invalid string representation. The returned object has ref count 0.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+
+Tcl_Obj *
+Tcl_DbNewDoubleObj(dblValue, file, line)
+    register double dblValue;	/* Double used to initialize the object. */
+    char *file;			/* The name of the source file calling this
+				 * procedure; used for debugging. */
+    int line;			/* Line number in the source file; used
+				 * for debugging. */
+{
+    register Tcl_Obj *objPtr;
+
+    TclDbNewObj(objPtr, file, line);
+    objPtr->bytes = NULL;
+    
+    objPtr->internalRep.doubleValue = dblValue;
+    objPtr->typePtr = &tclDoubleType;
+    return objPtr;
+}
+
+#else /* if not TCL_MEM_DEBUG */
+
+Tcl_Obj *
+Tcl_DbNewDoubleObj(dblValue, file, line)
+    register double dblValue;	/* Double used to initialize the object. */
+    char *file;			/* The name of the source file calling this
+				 * procedure; used for debugging. */
+    int line;			/* Line number in the source file; used
+				 * for debugging. */
+{
+    return Tcl_NewDoubleObj(dblValue);
+}
+#endif /* TCL_MEM_DEBUG */
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetDoubleObj --
+ *
+ *	Modify an object to be a double object and to have the specified
+ *	double value.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's old string rep, if any, is freed. Also, any old
+ *	internal rep is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetDoubleObj(objPtr, dblValue)
+    register Tcl_Obj *objPtr;	/* Object whose internal rep to init. */
+    register double dblValue;	/* Double used to set the object's value. */
+{
+    register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+
+    if (Tcl_IsShared(objPtr)) {
+	panic("Tcl_SetDoubleObj called with shared object");
+    }
+
+    Tcl_InvalidateStringRep(objPtr);
+    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+    }
+    
+    objPtr->internalRep.doubleValue = dblValue;
+    objPtr->typePtr = &tclDoubleType;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetDoubleFromObj --
+ *
+ *	Attempt to return a double from the Tcl object "objPtr". If the
+ *	object is not already a double, an attempt will be made to convert
+ *	it to one.
+ *
+ * Results:
+ *	The return value is a standard Tcl object result. If an error occurs
+ *	during conversion, an error message is left in the interpreter's
+ *	result unless "interp" is NULL.
+ *
+ * Side effects:
+ *	If the object is not already a double, the conversion will free
+ *	any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetDoubleFromObj(interp, objPtr, dblPtr)
+    Tcl_Interp *interp; 	/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr;	/* The object from which to get a double. */
+    register double *dblPtr;	/* Place to store resulting double. */
+{
+    register int result;
+    
+    if (objPtr->typePtr == &tclDoubleType) {
+	*dblPtr = objPtr->internalRep.doubleValue;
+	return TCL_OK;
+    }
+
+    result = SetDoubleFromAny(interp, objPtr);
+    if (result == TCL_OK) {
+	*dblPtr = objPtr->internalRep.doubleValue;
+    }
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupDoubleInternalRep --
+ *
+ *	Initialize the internal representation of a double Tcl_Obj to a
+ *	copy of the internal representation of an existing double object. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	"copyPtr"s internal rep is set to the double precision floating 
+ *	point number corresponding to "srcPtr"s internal rep.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupDoubleInternalRep(srcPtr, copyPtr)
+    register Tcl_Obj *srcPtr;	/* Object with internal rep to copy. */
+    register Tcl_Obj *copyPtr;	/* Object with internal rep to set. */
+{
+    copyPtr->internalRep.doubleValue = srcPtr->internalRep.doubleValue;
+    copyPtr->typePtr = &tclDoubleType;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetDoubleFromAny --
+ *
+ *	Attempt to generate an double-precision floating point internal form
+ *	for the Tcl object "objPtr".
+ *
+ * Results:
+ *	The return value is a standard Tcl object result. If an error occurs
+ *	during conversion, an error message is left in the interpreter's
+ *	result unless "interp" is NULL.
+ *
+ * Side effects:
+ *	If no error occurs, a double is stored as "objPtr"s internal
+ *	representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetDoubleFromAny(interp, objPtr)
+    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr;	/* The object to convert. */
+{
+    Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+    char *string, *end;
+    double newDouble;
+    int length;
+
+    /*
+     * Get the string representation. Make it up-to-date if necessary.
+     */
+
+    string = TclGetStringFromObj(objPtr, &length);
+
+    /*
+     * Now parse "objPtr"s string as an double. Numbers can't have embedded
+     * NULLs. We use an implementation here that doesn't report errors in
+     * interp if interp is NULL.
+     */
+
+    errno = 0;
+    newDouble = strtod(string, &end);
+    if (end == string) {
+	badDouble:
+	if (interp != NULL) {
+	    /*
+	     * Must copy string before resetting the result in case a caller
+	     * is trying to convert the interpreter's result to an int.
+	     */
+	    
+	    char buf[100];
+	    sprintf(buf, "expected floating-point number but got \"%.50s\"",
+	            string);
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
+	}
+	return TCL_ERROR;
+    }
+    if (errno != 0) {
+	if (interp != NULL) {
+	    TclExprFloatError(interp, newDouble);
+	}
+	return TCL_ERROR;
+    }
+
+    /*
+     * Make sure that the string has no garbage after the end of the double.
+     */
+    
+    while ((end < (string+length)) && isspace(UCHAR(*end))) {
+	end++;
+    }
+    if (end != (string+length)) {
+	goto badDouble;
+    }
+    
+    /*
+     * The conversion to double succeeded. Free the old internalRep before
+     * setting the new one. We do this as late as possible to allow the
+     * conversion code, in particular Tcl_GetStringFromObj, to use that old
+     * internalRep.
+     */
+    
+    if ((oldTypePtr != NULL) &&	(oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+    }
+
+    objPtr->internalRep.doubleValue = newDouble;
+    objPtr->typePtr = &tclDoubleType;
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfDouble --
+ *
+ *	Update the string representation for a double-precision floating
+ *	point object. This must obey the current tcl_precision value for
+ *	double-to-string conversions. Note: This procedure does not free an
+ *	existing old string rep so storage will be lost if this has not
+ *	already been done.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's string is set to a valid string that results from
+ *	the double-to-string conversion.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfDouble(objPtr)
+    register Tcl_Obj *objPtr;	/* Double obj with string rep to update. */
+{
+    char buffer[TCL_DOUBLE_SPACE];
+    register int len;
+    
+    Tcl_PrintDouble((Tcl_Interp *) NULL, objPtr->internalRep.doubleValue,
+	    buffer);
+    len = strlen(buffer);
+    
+    objPtr->bytes = (char *) ckalloc((unsigned) len + 1);
+    strcpy(objPtr->bytes, buffer);
+    objPtr->length = len;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NewIntObj --
+ *
+ *	If a client is compiled with TCL_MEM_DEBUG defined, calls to
+ *	Tcl_NewIntObj to create a new integer object end up calling the
+ *	debugging procedure Tcl_DbNewLongObj instead.
+ *
+ *	Otherwise, if the client is compiled without TCL_MEM_DEBUG defined,
+ *	calls to Tcl_NewIntObj result in a call to one of the two
+ *	Tcl_NewIntObj implementations below. We provide two implementations
+ *	so that the Tcl core can be compiled to do memory debugging of the 
+ *	core even if a client does not request it for itself.
+ *
+ *	Integer and long integer objects share the same "integer" type
+ *	implementation. We store all integers as longs and Tcl_GetIntFromObj
+ *	checks whether the current value of the long can be represented by
+ *	an int.
+ *
+ * Results:
+ *	The newly created object is returned. This object will have an
+ *	invalid string representation. The returned object has ref count 0.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+#undef Tcl_NewIntObj
+
+Tcl_Obj *
+Tcl_NewIntObj(intValue)
+    register int intValue;	/* Int used to initialize the new object. */
+{
+    return Tcl_DbNewLongObj((long)intValue, "unknown", 0);
+}
+
+#else /* if not TCL_MEM_DEBUG */
+
+Tcl_Obj *
+Tcl_NewIntObj(intValue)
+    register int intValue;	/* Int used to initialize the new object. */
+{
+    register Tcl_Obj *objPtr;
+
+    TclNewObj(objPtr);
+    objPtr->bytes = NULL;
+    
+    objPtr->internalRep.longValue = (long)intValue;
+    objPtr->typePtr = &tclIntType;
+    return objPtr;
+}
+#endif /* if TCL_MEM_DEBUG */
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetIntObj --
+ *
+ *	Modify an object to be an integer and to have the specified integer
+ *	value.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's old string rep, if any, is freed. Also, any old
+ *	internal rep is freed. 
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetIntObj(objPtr, intValue)
+    register Tcl_Obj *objPtr;	/* Object whose internal rep to init. */
+    register int intValue;	/* Integer used to set object's value. */
+{
+    register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+
+    if (Tcl_IsShared(objPtr)) {
+	panic("Tcl_SetIntObj called with shared object");
+    }
+    
+    Tcl_InvalidateStringRep(objPtr);
+    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+    }
+    
+    objPtr->internalRep.longValue = (long) intValue;
+    objPtr->typePtr = &tclIntType;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetIntFromObj --
+ *
+ *	Attempt to return an int from the Tcl object "objPtr". If the object
+ *	is not already an int, an attempt will be made to convert it to one.
+ *
+ *	Integer and long integer objects share the same "integer" type
+ *	implementation. We store all integers as longs and Tcl_GetIntFromObj
+ *	checks whether the current value of the long can be represented by
+ *	an int.
+ *
+ * Results:
+ *	The return value is a standard Tcl object result. If an error occurs
+ *	during conversion or if the long integer held by the object
+ *	can not be represented by an int, an error message is left in
+ *	the interpreter's result unless "interp" is NULL.
+ *
+ * Side effects:
+ *	If the object is not already an int, the conversion will free
+ *	any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetIntFromObj(interp, objPtr, intPtr)
+    Tcl_Interp *interp; 	/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr;	/* The object from which to get a int. */
+    register int *intPtr;	/* Place to store resulting int. */
+{
+    register long l;
+    int result;
+    
+    if (objPtr->typePtr != &tclIntType) {
+	result = SetIntFromAny(interp, objPtr);
+	if (result != TCL_OK) {
+	    return result;
+	}
+    }
+    l = objPtr->internalRep.longValue;
+    if (((long)((int)l)) == l) {
+	*intPtr = (int)objPtr->internalRep.longValue;
+	return TCL_OK;
+    }
+    if (interp != NULL) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		"integer value too large to represent as non-long integer", -1);
+    }
+    return TCL_ERROR;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupIntInternalRep --
+ *
+ *	Initialize the internal representation of an int Tcl_Obj to a
+ *	copy of the internal representation of an existing int object. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	"copyPtr"s internal rep is set to the integer corresponding to
+ *	"srcPtr"s internal rep.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupIntInternalRep(srcPtr, copyPtr)
+    register Tcl_Obj *srcPtr;	/* Object with internal rep to copy. */
+    register Tcl_Obj *copyPtr;	/* Object with internal rep to set. */
+{
+    copyPtr->internalRep.longValue = srcPtr->internalRep.longValue;
+    copyPtr->typePtr = &tclIntType;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetIntFromAny --
+ *
+ *	Attempt to generate an integer internal form for the Tcl object
+ *	"objPtr".
+ *
+ * Results:
+ *	The return value is a standard object Tcl result. If an error occurs
+ *	during conversion, an error message is left in the interpreter's
+ *	result unless "interp" is NULL.
+ *
+ * Side effects:
+ *	If no error occurs, an int is stored as "objPtr"s internal
+ *	representation. 
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetIntFromAny(interp, objPtr)
+    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr;	/* The object to convert. */
+{
+    Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+    char *string, *end;
+    int length;
+    register char *p;
+    long newLong;
+
+    /*
+     * Get the string representation. Make it up-to-date if necessary.
+     */
+
+    string = TclGetStringFromObj(objPtr, &length);
+
+    /*
+     * Now parse "objPtr"s string as an int. We use an implementation here
+     * that doesn't report errors in interp if interp is NULL. Note: use
+     * strtoul instead of strtol for integer conversions to allow full-size
+     * unsigned numbers, but don't depend on strtoul to handle sign
+     * characters; it won't in some implementations.
+     */
+
+    errno = 0;
+    for (p = string;  isspace(UCHAR(*p));  p++) {
+	/* Empty loop body. */
+    }
+    if (*p == '-') {
+	p++;
+	newLong = -((long)strtoul(p, &end, 0));
+    } else if (*p == '+') {
+	p++;
+	newLong = strtoul(p, &end, 0);
+    } else {
+	newLong = strtoul(p, &end, 0);
+    }
+    if (end == p) {
+	badInteger:
+	if (interp != NULL) {
+	    /*
+	     * Must copy string before resetting the result in case a caller
+	     * is trying to convert the interpreter's result to an int.
+	     */
+	    
+	    char buf[100];
+	    sprintf(buf, "expected integer but got \"%.50s\"", string);
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
+	}
+	return TCL_ERROR;
+    }
+    if (errno == ERANGE) {
+	if (interp != NULL) {
+	    char *s = "integer value too large to represent";
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
+	    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *) NULL);
+	}
+	return TCL_ERROR;
+    }
+
+    /*
+     * Make sure that the string has no garbage after the end of the int.
+     */
+    
+    while ((end < (string+length)) && isspace(UCHAR(*end))) {
+	end++;
+    }
+    if (end != (string+length)) {
+	goto badInteger;
+    }
+
+    /*
+     * The conversion to int succeeded. Free the old internalRep before
+     * setting the new one. We do this as late as possible to allow the
+     * conversion code, in particular Tcl_GetStringFromObj, to use that old
+     * internalRep.
+     */
+
+    if ((oldTypePtr != NULL) &&	(oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+    }
+    
+    objPtr->internalRep.longValue = newLong;
+    objPtr->typePtr = &tclIntType;
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfInt --
+ *
+ *	Update the string representation for an integer object.
+ *	Note: This procedure does not free an existing old string rep
+ *	so storage will be lost if this has not already been done. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's string is set to a valid string that results from
+ *	the int-to-string conversion.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfInt(objPtr)
+    register Tcl_Obj *objPtr;	/* Int object whose string rep to update. */
+{
+    char buffer[TCL_DOUBLE_SPACE];
+    register int len;
+    
+    len = TclFormatInt(buffer, objPtr->internalRep.longValue);
+    
+    objPtr->bytes = ckalloc((unsigned) len + 1);
+    strcpy(objPtr->bytes, buffer);
+    objPtr->length = len;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NewLongObj --
+ *
+ *	If a client is compiled with TCL_MEM_DEBUG defined, calls to
+ *	Tcl_NewLongObj to create a new long integer object end up calling
+ *	the debugging procedure Tcl_DbNewLongObj instead.
+ *
+ *	Otherwise, if the client is compiled without TCL_MEM_DEBUG defined,
+ *	calls to Tcl_NewLongObj result in a call to one of the two
+ *	Tcl_NewLongObj implementations below. We provide two implementations
+ *	so that the Tcl core can be compiled to do memory debugging of the 
+ *	core even if a client does not request it for itself.
+ *
+ *	Integer and long integer objects share the same "integer" type
+ *	implementation. We store all integers as longs and Tcl_GetIntFromObj
+ *	checks whether the current value of the long can be represented by
+ *	an int.
+ *
+ * Results:
+ *	The newly created object is returned. This object will have an
+ *	invalid string representation. The returned object has ref count 0.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+#undef Tcl_NewLongObj
+
+Tcl_Obj *
+Tcl_NewLongObj(longValue)
+    register long longValue;	/* Long integer used to initialize the
+				 * new object. */
+{
+    return Tcl_DbNewLongObj(longValue, "unknown", 0);
+}
+
+#else /* if not TCL_MEM_DEBUG */
+
+Tcl_Obj *
+Tcl_NewLongObj(longValue)
+    register long longValue;	/* Long integer used to initialize the
+				 * new object. */
+{
+    register Tcl_Obj *objPtr;
+
+    TclNewObj(objPtr);
+    objPtr->bytes = NULL;
+    
+    objPtr->internalRep.longValue = longValue;
+    objPtr->typePtr = &tclIntType;
+    return objPtr;
+}
+#endif /* if TCL_MEM_DEBUG */
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DbNewLongObj --
+ *
+ *	If a client is compiled with TCL_MEM_DEBUG defined, calls to
+ *	Tcl_NewIntObj and Tcl_NewLongObj to create new integer or
+ *	long integer objects end up calling the debugging procedure
+ *	Tcl_DbNewLongObj instead. We provide two implementations of
+ *	Tcl_DbNewLongObj so that whether the Tcl core is compiled to do
+ *	memory debugging of the core is independent of whether a client
+ *	requests debugging for itself.
+ *
+ *	When the core is compiled with TCL_MEM_DEBUG defined,
+ *	Tcl_DbNewLongObj calls Tcl_DbCkalloc directly with the file name and
+ *	line number from its caller. This simplifies debugging since then
+ *	the checkmem command will report the caller's file name and line
+ *	number when reporting objects that haven't been freed.
+ *
+ *	Otherwise, when the core is compiled without TCL_MEM_DEBUG defined,
+ *	this procedure just returns the result of calling Tcl_NewLongObj.
+ *
+ * Results:
+ *	The newly created long integer object is returned. This object
+ *	will have an invalid string representation. The returned object has
+ *	ref count 0.
+ *
+ * Side effects:
+ *	Allocates memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+
+Tcl_Obj *
+Tcl_DbNewLongObj(longValue, file, line)
+    register long longValue;	/* Long integer used to initialize the
+				 * new object. */
+    char *file;			/* The name of the source file calling this
+				 * procedure; used for debugging. */
+    int line;			/* Line number in the source file; used
+				 * for debugging. */
+{
+    register Tcl_Obj *objPtr;
+
+    TclDbNewObj(objPtr, file, line);
+    objPtr->bytes = NULL;
+    
+    objPtr->internalRep.longValue = longValue;
+    objPtr->typePtr = &tclIntType;
+    return objPtr;
+}
+
+#else /* if not TCL_MEM_DEBUG */
+
+Tcl_Obj *
+Tcl_DbNewLongObj(longValue, file, line)
+    register long longValue;	/* Long integer used to initialize the
+				 * new object. */
+    char *file;			/* The name of the source file calling this
+				 * procedure; used for debugging. */
+    int line;			/* Line number in the source file; used
+				 * for debugging. */
+{
+    return Tcl_NewLongObj(longValue);
+}
+#endif /* TCL_MEM_DEBUG */
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetLongObj --
+ *
+ *	Modify an object to be an integer object and to have the specified
+ *	long integer value.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's old string rep, if any, is freed. Also, any old
+ *	internal rep is freed. 
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetLongObj(objPtr, longValue)
+    register Tcl_Obj *objPtr;	/* Object whose internal rep to init. */
+    register long longValue;	/* Long integer used to initialize the
+				 * object's value. */
+{
+    register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+
+    if (Tcl_IsShared(objPtr)) {
+	panic("Tcl_SetLongObj called with shared object");
+    }
+
+    Tcl_InvalidateStringRep(objPtr);
+    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+    }
+    
+    objPtr->internalRep.longValue = longValue;
+    objPtr->typePtr = &tclIntType;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetLongFromObj --
+ *
+ *	Attempt to return an long integer from the Tcl object "objPtr". If
+ *	the object is not already an int object, an attempt will be made to
+ *	convert it to one.
+ *
+ * Results:
+ *	The return value is a standard Tcl object result. If an error occurs
+ *	during conversion, an error message is left in the interpreter's
+ *	result unless "interp" is NULL.
+ *
+ * Side effects:
+ *	If the object is not already an int object, the conversion will free
+ *	any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetLongFromObj(interp, objPtr, longPtr)
+    Tcl_Interp *interp; 	/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr;	/* The object from which to get a long. */
+    register long *longPtr;	/* Place to store resulting long. */
+{
+    register int result;
+    
+    if (objPtr->typePtr == &tclIntType) {
+	*longPtr = objPtr->internalRep.longValue;
+	return TCL_OK;
+    }
+    result = SetIntFromAny(interp, objPtr);
+    if (result == TCL_OK) {
+	*longPtr = objPtr->internalRep.longValue;
+    }
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DbIncrRefCount --
+ *
+ *	This procedure is normally called when debugging: i.e., when
+ *	TCL_MEM_DEBUG is defined. This checks to see whether or not
+ *	the memory has been freed before incrementing the ref count.
+ *
+ *	When TCL_MEM_DEBUG is not defined, this procedure just increments
+ *	the reference count of the object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's ref count is incremented.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DbIncrRefCount(objPtr, file, line)
+    register Tcl_Obj *objPtr;	/* The object we are adding a reference to. */
+    char *file;			/* The name of the source file calling this
+				 * procedure; used for debugging. */
+    int line;			/* Line number in the source file; used
+				 * for debugging. */
+{
+#ifdef TCL_MEM_DEBUG
+    if (objPtr->refCount == 0x61616161) {
+	fprintf(stderr, "file = %s, line = %d\n", file, line);
+	fflush(stderr);
+	panic("Trying to increment refCount of previously disposed object.");
+    }
+#endif
+    ++(objPtr)->refCount;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DbDecrRefCount --
+ *
+ *	This procedure is normally called when debugging: i.e., when
+ *	TCL_MEM_DEBUG is defined. This checks to see whether or not
+ *	the memory has been freed before incrementing the ref count.
+ *
+ *	When TCL_MEM_DEBUG is not defined, this procedure just increments
+ *	the reference count of the object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's ref count is incremented.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DbDecrRefCount(objPtr, file, line)
+    register Tcl_Obj *objPtr;	/* The object we are adding a reference to. */
+    char *file;			/* The name of the source file calling this
+				 * procedure; used for debugging. */
+    int line;			/* Line number in the source file; used
+				 * for debugging. */
+{
+#ifdef TCL_MEM_DEBUG
+    if (objPtr->refCount == 0x61616161) {
+	fprintf(stderr, "file = %s, line = %d\n", file, line);
+	fflush(stderr);
+	panic("Trying to decrement refCount of previously disposed object.");
+    }
+#endif
+    if (--(objPtr)->refCount <= 0) {
+	TclFreeObj(objPtr);
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DbIsShared --
+ *
+ *	This procedure is normally called when debugging: i.e., when
+ *	TCL_MEM_DEBUG is defined. This checks to see whether or not
+ *	the memory has been freed before incrementing the ref count.
+ *
+ *	When TCL_MEM_DEBUG is not defined, this procedure just decrements
+ *	the reference count of the object and throws it away if the count
+ *	is 0 or less.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's ref count is incremented.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_DbIsShared(objPtr, file, line)
+    register Tcl_Obj *objPtr;	/* The object we are adding a reference to. */
+    char *file;			/* The name of the source file calling this
+				 * procedure; used for debugging. */
+    int line;			/* Line number in the source file; used
+				 * for debugging. */
+{
+#ifdef TCL_MEM_DEBUG
+    if (objPtr->refCount == 0x61616161) {
+	fprintf(stderr, "file = %s, line = %d\n", file, line);
+	fflush(stderr);
+	panic("Trying to check whether previously disposed object is shared.");
+    }
+#endif
+    return ((objPtr)->refCount > 1);
+}
Index: /trunk/tcl/tclParse.c
===================================================================
--- /trunk/tcl/tclParse.c	(revision 2)
+++ /trunk/tcl/tclParse.c	(revision 2)
@@ -0,0 +1,949 @@
+/* 
+ * tclParse.c --
+ *
+ *	This file contains a collection of procedures that are used
+ *	to parse Tcl commands or parts of commands (like quoted
+ *	strings or nested sub-commands).
+ *
+ * Copyright (c) 1987-1993 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclParse.c,v 1.1 2008-06-04 13:58:09 demin Exp $
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ * Function prototypes for procedures local to this file:
+ */
+
+static char *	QuoteEnd _ANSI_ARGS_((char *string, char *lastChar,
+		    int term));
+static char *	ScriptEnd _ANSI_ARGS_((char *p, char *lastChar,
+		    int nested));
+static char *	VarNameEnd _ANSI_ARGS_((char *string,  char *lastChar));
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TclParseQuotes --
+ *
+ *	This procedure parses a double-quoted string such as a
+ *	quoted Tcl command argument or a quoted value in a Tcl
+ *	expression.  This procedure is also used to parse array
+ *	element names within parentheses, or anything else that
+ *	needs all the substitutions that happen in quotes.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is
+ *	TCL_OK unless there was an error while parsing the
+ *	quoted string.  If an error occurs then interp->result
+ *	contains a standard error message.  *TermPtr is filled
+ *	in with the address of the character just after the
+ *	last one successfully processed;  this is usually the
+ *	character just after the matching close-quote.  The
+ *	fully-substituted contents of the quotes are stored in
+ *	standard fashion in *pvPtr, null-terminated with
+ *	pvPtr->next pointing to the terminating null character.
+ *
+ * Side effects:
+ *	The buffer space in pvPtr may be enlarged by calling its
+ *	expandProc.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TclParseQuotes(interp, string, termChar, flags, termPtr, pvPtr)
+    Tcl_Interp *interp;		/* Interpreter to use for nested command
+				 * evaluations and error messages. */
+    char *string;		/* Character just after opening double-
+				 * quote. */
+    int termChar;		/* Character that terminates "quoted" string
+				 * (usually double-quote, but sometimes
+				 * right-paren or something else). */
+    int flags;			/* Flags to pass to nested Tcl_Eval calls. */
+    char **termPtr;		/* Store address of terminating character
+				 * here. */
+    ParseValue *pvPtr;		/* Information about where to place
+				 * fully-substituted result of parse. */
+{
+    register char *src, *dst, c;
+    char *lastChar = string + strlen(string);
+
+    src = string;
+    dst = pvPtr->next;
+
+    while (1) {
+	if (dst == pvPtr->end) {
+	    /*
+	     * Target buffer space is about to run out.  Make more space.
+	     */
+
+	    pvPtr->next = dst;
+	    (*pvPtr->expandProc)(pvPtr, 1);
+	    dst = pvPtr->next;
+	}
+
+	c = *src;
+	src++;
+	if (c == termChar) {
+	    *dst = '\0';
+	    pvPtr->next = dst;
+	    *termPtr = src;
+	    return TCL_OK;
+	} else if (CHAR_TYPE(src-1, lastChar) == TCL_NORMAL) {
+	    copy:
+	    *dst = c;
+	    dst++;
+	    continue;
+	} else if (c == '$') {
+	    int length;
+	    char *value;
+
+	    value = Tcl_ParseVar(interp, src-1, termPtr);
+	    if (value == NULL) {
+		return TCL_ERROR;
+	    }
+	    src = *termPtr;
+	    length = strlen(value);
+	    if ((pvPtr->end - dst) <= length) {
+		pvPtr->next = dst;
+		(*pvPtr->expandProc)(pvPtr, length);
+		dst = pvPtr->next;
+	    }
+	    strcpy(dst, value);
+	    dst += length;
+	    continue;
+	} else if (c == '[') {
+	    int result;
+
+	    pvPtr->next = dst;
+	    result = TclParseNestedCmd(interp, src, flags, termPtr, pvPtr);
+	    if (result != TCL_OK) {
+		return result;
+	    }
+	    src = *termPtr;
+	    dst = pvPtr->next;
+	    continue;
+	} else if (c == '\\') {
+	    int numRead;
+
+	    src--;
+	    *dst = Tcl_Backslash(src, &numRead);
+	    dst++;
+	    src += numRead;
+	    continue;
+	} else if (c == '\0') {
+	    char buf[30];
+	    
+	    Tcl_ResetResult(interp);
+	    sprintf(buf, "missing %c", termChar);
+	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
+	    *termPtr = string-1;
+	    return TCL_ERROR;
+	} else {
+	    goto copy;
+	}
+    }
+}
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TclParseNestedCmd --
+ *
+ *	This procedure parses a nested Tcl command between
+ *	brackets, returning the result of the command.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is
+ *	TCL_OK unless there was an error while executing the
+ *	nested command.  If an error occurs then interp->result
+ *	contains a standard error message.  *TermPtr is filled
+ *	in with the address of the character just after the
+ *	last one processed;  this is usually the character just
+ *	after the matching close-bracket, or the null character
+ *	at the end of the string if the close-bracket was missing
+ *	(a missing close bracket is an error).  The result returned
+ *	by the command is stored in standard fashion in *pvPtr,
+ *	null-terminated, with pvPtr->next pointing to the null
+ *	character.
+ *
+ * Side effects:
+ *	The storage space at *pvPtr may be expanded.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TclParseNestedCmd(interp, string, flags, termPtr, pvPtr)
+    Tcl_Interp *interp;		/* Interpreter to use for nested command
+				 * evaluations and error messages. */
+    char *string;		/* Character just after opening bracket. */
+    int flags;			/* Flags to pass to nested Tcl_Eval. */
+    char **termPtr;		/* Store address of terminating character
+				 * here. */
+    register ParseValue *pvPtr;	/* Information about where to place
+				 * result of command. */
+{
+    int result, length, shortfall;
+    Interp *iPtr = (Interp *) interp;
+
+    iPtr->evalFlags = flags | TCL_BRACKET_TERM;
+    result = Tcl_Eval(interp, string);
+    *termPtr = (string + iPtr->termOffset);
+    if (result != TCL_OK) {
+	/*
+	 * The increment below results in slightly cleaner message in
+	 * the errorInfo variable (the close-bracket will appear).
+	 */
+
+	if (**termPtr == ']') {
+	    *termPtr += 1;
+	}
+	return result;
+    }
+    (*termPtr) += 1;
+    length = strlen(iPtr->result);
+    shortfall = length + 1 - (pvPtr->end - pvPtr->next);
+    if (shortfall > 0) {
+	(*pvPtr->expandProc)(pvPtr, shortfall);
+    }
+    strcpy(pvPtr->next, iPtr->result);
+    pvPtr->next += length;
+    
+    Tcl_FreeResult(interp);
+    iPtr->result = iPtr->resultSpace;
+    iPtr->resultSpace[0] = '\0';
+    return TCL_OK;
+}
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TclParseBraces --
+ *
+ *	This procedure scans the information between matching
+ *	curly braces.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is
+ *	TCL_OK unless there was an error while parsing string.
+ *	If an error occurs then interp->result contains a
+ *	standard error message.  *TermPtr is filled
+ *	in with the address of the character just after the
+ *	last one successfully processed;  this is usually the
+ *	character just after the matching close-brace.  The
+ *	information between curly braces is stored in standard
+ *	fashion in *pvPtr, null-terminated with pvPtr->next
+ *	pointing to the terminating null character.
+ *
+ * Side effects:
+ *	The storage space at *pvPtr may be expanded.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TclParseBraces(interp, string, termPtr, pvPtr)
+    Tcl_Interp *interp;		/* Interpreter to use for nested command
+				 * evaluations and error messages. */
+    char *string;		/* Character just after opening bracket. */
+    char **termPtr;		/* Store address of terminating character
+				 * here. */
+    register ParseValue *pvPtr;	/* Information about where to place
+				 * result of command. */
+{
+    int level;
+    register char *src, *dst, *end;
+    register char c;
+    char *lastChar = string + strlen(string);
+
+    src = string;
+    dst = pvPtr->next;
+    end = pvPtr->end;
+    level = 1;
+
+    /*
+     * Copy the characters one at a time to the result area, stopping
+     * when the matching close-brace is found.
+     */
+
+    while (1) {
+	c = *src;
+	src++;
+	if (dst == end) {
+	    pvPtr->next = dst;
+	    (*pvPtr->expandProc)(pvPtr, 20);
+	    dst = pvPtr->next;
+	    end = pvPtr->end;
+	}
+	*dst = c;
+	dst++;
+	if (CHAR_TYPE(src-1, lastChar) == TCL_NORMAL) {
+	    continue;
+	} else if (c == '{') {
+	    level++;
+	} else if (c == '}') {
+	    level--;
+	    if (level == 0) {
+		dst--;			/* Don't copy the last close brace. */
+		break;
+	    }
+	} else if (c == '\\') {
+	    int count;
+
+	    /*
+	     * Must always squish out backslash-newlines, even when in
+	     * braces.  This is needed so that this sequence can appear
+	     * anywhere in a command, such as the middle of an expression.
+	     */
+
+	    if (*src == '\n') {
+		dst[-1] = Tcl_Backslash(src-1, &count);
+		src += count - 1;
+	    } else {
+		(void) Tcl_Backslash(src-1, &count);
+		while (count > 1) {
+                    if (dst == end) {
+                        pvPtr->next = dst;
+                        (*pvPtr->expandProc)(pvPtr, 20);
+                        dst = pvPtr->next;
+                        end = pvPtr->end;
+                    }
+		    *dst = *src;
+		    dst++;
+		    src++;
+		    count--;
+		}
+	    }
+	} else if (c == '\0') {
+	    Tcl_SetResult(interp, "missing close-brace", TCL_STATIC);
+	    *termPtr = string-1;
+	    return TCL_ERROR;
+	}
+    }
+
+    *dst = '\0';
+    pvPtr->next = dst;
+    *termPtr = src;
+    return TCL_OK;
+}
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TclExpandParseValue --
+ *
+ *	This procedure is commonly used as the value of the
+ *	expandProc in a ParseValue.  It uses malloc to allocate
+ *	more space for the result of a parse.
+ *
+ * Results:
+ *	The buffer space in *pvPtr is reallocated to something
+ *	larger, and if pvPtr->clientData is non-zero the old
+ *	buffer is freed.  Information is copied from the old
+ *	buffer to the new one.
+ *
+ * Side effects:
+ *	None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TclExpandParseValue(pvPtr, needed)
+    register ParseValue *pvPtr;		/* Information about buffer that
+					 * must be expanded.  If the clientData
+					 * in the structure is non-zero, it
+					 * means that the current buffer is
+					 * dynamically allocated. */
+    int needed;				/* Minimum amount of additional space
+					 * to allocate. */
+{
+    int newSpace;
+    char *new;
+
+    /*
+     * Either double the size of the buffer or add enough new space
+     * to meet the demand, whichever produces a larger new buffer.
+     */
+
+    newSpace = (pvPtr->end - pvPtr->buffer) + 1;
+    if (newSpace < needed) {
+	newSpace += needed;
+    } else {
+	newSpace += newSpace;
+    }
+    new = (char *) ckalloc((unsigned) newSpace);
+
+    /*
+     * Copy from old buffer to new, free old buffer if needed, and
+     * mark new buffer as malloc-ed.
+     */
+
+    memcpy((VOID *) new, (VOID *) pvPtr->buffer,
+	    (size_t) (pvPtr->next - pvPtr->buffer));
+    pvPtr->next = new + (pvPtr->next - pvPtr->buffer);
+    if (pvPtr->clientData != 0) {
+	ckfree(pvPtr->buffer);
+    }
+    pvPtr->buffer = new;
+    pvPtr->end = new + newSpace - 1;
+    pvPtr->clientData = (ClientData) 1;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWordEnd --
+ *
+ *	Given a pointer into a Tcl command, find the end of the next
+ *	word of the command.
+ *
+ * Results:
+ *	The return value is a pointer to the last character that's part
+ *	of the word pointed to by "start".  If the word doesn't end
+ *	properly within the string then the return value is the address
+ *	of the null character at the end of the string.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclWordEnd(start, lastChar, nested, semiPtr)
+    char *start;		/* Beginning of a word of a Tcl command. */
+    char *lastChar;		/* Terminating character in string. */
+    int nested;			/* Zero means this is a top-level command.
+				 * One means this is a nested command (close
+				 * bracket is a word terminator). */
+    int *semiPtr;		/* Set to 1 if word ends with a command-
+				 * terminating semi-colon, zero otherwise.
+				 * If NULL then ignored. */
+{
+    register char *p;
+    int count;
+
+    if (semiPtr != NULL) {
+	*semiPtr = 0;
+    }
+
+    /*
+     * Skip leading white space (backslash-newline must be treated like
+     * white-space, except that it better not be the last thing in the
+     * command).
+     */
+
+    for (p = start; ; p++) {
+	if (isspace(UCHAR(*p))) {
+	    continue;
+	}
+	if ((p[0] == '\\') && (p[1] == '\n')) {
+	    if (p+2 == lastChar) {
+		return p+2;
+	    }
+	    continue;
+	}
+	break;
+    }
+
+    /*
+     * Handle words beginning with a double-quote or a brace.
+     */
+
+    if (*p == '"') {
+	p = QuoteEnd(p+1, lastChar, '"');
+	if (p == lastChar) {
+	    return p;
+	}
+	p++;
+    } else if (*p == '{') {
+	int braces = 1;
+	while (braces != 0) {
+	    p++;
+	    while (*p == '\\') {
+		(void) Tcl_Backslash(p, &count);
+		p += count;
+	    }
+	    if (*p == '}') {
+		braces--;
+	    } else if (*p == '{') {
+		braces++;
+	    } else if (p == lastChar) {
+		return p;
+	    }
+	}
+	p++;
+    }
+
+    /*
+     * Handle words that don't start with a brace or double-quote.
+     * This code is also invoked if the word starts with a brace or
+     * double-quote and there is garbage after the closing brace or
+     * quote.  This is an error as far as Tcl_Eval is concerned, but
+     * for here the garbage is treated as part of the word.
+     */
+
+    while (1) {
+	if (*p == '[') {
+	    p = ScriptEnd(p+1, lastChar, 1);
+	    if (p == lastChar) {
+		return p;
+	    }
+	    p++;
+	} else if (*p == '\\') {
+	    if (p[1] == '\n') {
+		/*
+		 * Backslash-newline:  it maps to a space character
+		 * that is a word separator, so the word ends just before
+		 * the backslash.
+		 */
+
+		return p-1;
+	    }
+	    (void) Tcl_Backslash(p, &count);
+	    p += count;
+	} else if (*p == '$') {
+	    p = VarNameEnd(p, lastChar);
+	    if (p == lastChar) {
+		return p;
+	    }
+	    p++;
+	} else if (*p == ';') {
+	    /*
+	     * Include the semi-colon in the word that is returned.
+	     */
+
+	    if (semiPtr != NULL) {
+		*semiPtr = 1;
+	    }
+	    return p;
+	} else if (isspace(UCHAR(*p))) {
+	    return p-1;
+	} else if ((*p == ']') && nested) {
+	    return p-1;
+	} else if (p == lastChar) {
+	    if (nested) {
+		/*
+		 * Nested commands can't end because of the end of the
+		 * string.
+		 */
+		return p;
+	    }
+	    return p-1;
+	} else {
+	    p++;
+	}
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * QuoteEnd --
+ *
+ *	Given a pointer to a string that obeys the parsing conventions
+ *	for quoted things in Tcl, find the end of that quoted thing.
+ *	The actual thing may be a quoted argument or a parenthesized
+ *	index name.
+ *
+ * Results:
+ *	The return value is a pointer to the last character that is
+ *	part of the quoted string (i.e the character that's equal to
+ *	term).  If the quoted string doesn't terminate properly then
+ *	the return value is a pointer to the null character at the
+ *	end of the string.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+QuoteEnd(string, lastChar, term)
+    char *string;		/* Pointer to character just after opening
+				 * "quote". */
+    char *lastChar;		/* Terminating character in string. */
+    int term;			/* This character will terminate the
+				 * quoted string (e.g. '"' or ')'). */
+{
+    register char *p = string;
+    int count;
+
+    while (*p != term) {
+	if (*p == '\\') {
+	    (void) Tcl_Backslash(p, &count);
+	    p += count;
+	} else if (*p == '[') {
+	    for (p++; *p != ']'; p++) {
+		p = TclWordEnd(p, lastChar, 1, (int *) NULL);
+		if (*p == 0) {
+		    return p;
+		}
+	    }
+	    p++;
+	} else if (*p == '$') {
+	    p = VarNameEnd(p, lastChar);
+	    if (*p == 0) {
+		return p;
+	    }
+	    p++;
+	} else if (p == lastChar) {
+	    return p;
+	} else {
+	    p++;
+	}
+    }
+    return p-1;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * VarNameEnd --
+ *
+ *	Given a pointer to a variable reference using $-notation, find
+ *	the end of the variable name spec.
+ *
+ * Results:
+ *	The return value is a pointer to the last character that
+ *	is part of the variable name.  If the variable name doesn't
+ *	terminate properly then the return value is a pointer to the
+ *	null character at the end of the string.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+VarNameEnd(string, lastChar)
+    char *string;		/* Pointer to dollar-sign character. */
+    char *lastChar;		/* Terminating character in string. */
+{
+    register char *p = string+1;
+
+    if (*p == '{') {
+	for (p++; (*p != '}') && (p != lastChar); p++) {
+	    /* Empty loop body. */
+	}
+	return p;
+    }
+    while (isalnum(UCHAR(*p)) || (*p == '_')) {
+	p++;
+    }
+    if ((*p == '(') && (p != string+1)) {
+	return QuoteEnd(p+1, lastChar, ')');
+    }
+    return p-1;
+}
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ScriptEnd --
+ *
+ *	Given a pointer to the beginning of a Tcl script, find the end of
+ *	the script.
+ *
+ * Results:
+ *	The return value is a pointer to the last character that's part
+ *	of the script pointed to by "p".  If the command doesn't end
+ *	properly within the string then the return value is the address
+ *	of the null character at the end of the string.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+ScriptEnd(p, lastChar, nested)
+    char *p;			/* Script to check. */
+    char *lastChar;		/* Terminating character in string. */
+    int nested;			/* Zero means this is a top-level command.
+				 * One means this is a nested command (the
+				 * last character of the script must be
+				 * an unquoted ]). */
+{
+    int commentOK = 1;
+    int length;
+
+    while (1) {
+	while (isspace(UCHAR(*p))) {
+	    if (*p == '\n') {
+		commentOK = 1;
+	    }
+	    p++;
+	}
+	if ((*p == '#') && commentOK) {
+	    do {
+		if (*p == '\\') {
+		    /*
+		     * If the script ends with backslash-newline, then
+		     * this command isn't complete.
+		     */
+
+		    if ((p[1] == '\n') && (p+2 == lastChar)) {
+			return p+2;
+		    }
+		    Tcl_Backslash(p, &length);
+		    p += length;
+		} else {
+		    p++;
+		}
+	    } while ((p != lastChar) && (*p != '\n'));
+	    continue;
+	}
+	p = TclWordEnd(p, lastChar, nested, &commentOK);
+	if (p == lastChar) {
+	    return p;
+	}
+	p++;
+	if (nested) {
+	    if (*p == ']') {
+		return p;
+	    }
+	} else {
+	    if (p == lastChar) {
+		return p-1;
+	    }
+	}
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ParseVar --
+ *
+ *	Given a string starting with a $ sign, parse off a variable
+ *	name and return its value.
+ *
+ * Results:
+ *	The return value is the contents of the variable given by
+ *	the leading characters of string.  If termPtr isn't NULL,
+ *	*termPtr gets filled in with the address of the character
+ *	just after the last one in the variable specifier.  If the
+ *	variable doesn't exist, then the return value is NULL and
+ *	an error message will be left in interp->result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_ParseVar(interp, string, termPtr)
+    Tcl_Interp *interp;			/* Context for looking up variable. */
+    register char *string;		/* String containing variable name.
+					 * First character must be "$". */
+    char **termPtr;			/* If non-NULL, points to word to fill
+					 * in with character just after last
+					 * one in the variable specifier. */
+
+{
+    char *name1, *name1End, c, *result;
+    register char *name2;
+#define NUM_CHARS 200
+    char copyStorage[NUM_CHARS];
+    ParseValue pv;
+
+    /*
+     * There are three cases:
+     * 1. The $ sign is followed by an open curly brace.  Then the variable
+     *    name is everything up to the next close curly brace, and the
+     *    variable is a scalar variable.
+     * 2. The $ sign is not followed by an open curly brace.  Then the
+     *    variable name is everything up to the next character that isn't
+     *    a letter, digit, or underscore, or a "::" namespace separator.
+     *    If the following character is an open parenthesis, then the
+     *    information between parentheses is the array element name, which
+     *    can include any of the substitutions permissible between quotes.
+     * 3. The $ sign is followed by something that isn't a letter, digit,
+     *    underscore, or a "::" namespace separator: in this case,
+     *    there is no variable name, and "$" is returned.
+     */
+
+    name2 = NULL;
+    string++;
+    if (*string == '{') {
+	string++;
+	name1 = string;
+	while (*string != '}') {
+	    if (*string == 0) {
+		Tcl_SetResult(interp, "missing close-brace for variable name",
+			TCL_STATIC);
+		if (termPtr != 0) {
+		    *termPtr = string;
+		}
+		return NULL;
+	    }
+	    string++;
+	}
+	name1End = string;
+	string++;
+    } else {
+	name1 = string;
+	while (isalnum(UCHAR(*string)) || (*string == '_')
+	        || (*string == ':')) {
+	    if (*string == ':') {
+		if (*(string+1) == ':') {
+                    string += 2;  /* skip over the initial :: */
+		    while (*string == ':') {
+			string++; /* skip over a subsequent : */
+		    }
+		} else {
+		    break;	  /* : by itself */
+                }
+	    } else {
+		string++;
+	    }
+	}
+	if (string == name1) {
+	    if (termPtr != 0) {
+		*termPtr = string;
+	    }
+	    return "$";
+	}
+	name1End = string;
+	if (*string == '(') {
+	    char *end;
+
+	    /*
+	     * Perform substitutions on the array element name, just as
+	     * is done for quotes.
+	     */
+
+	    pv.buffer = pv.next = copyStorage;
+	    pv.end = copyStorage + NUM_CHARS - 1;
+	    pv.expandProc = TclExpandParseValue;
+	    pv.clientData = (ClientData) NULL;
+	    if (TclParseQuotes(interp, string+1, ')', 0, &end, &pv)
+		    != TCL_OK) {
+		char msg[200];
+		int length;
+
+		length = string-name1;
+		if (length > 100) {
+		    length = 100;
+		}
+		sprintf(msg, "\n    (parsing index for array \"%.*s\")",
+			length, name1);
+		Tcl_AddErrorInfo(interp, msg);
+		result = NULL;
+		name2 = pv.buffer;
+		if (termPtr != 0) {
+		    *termPtr = end;
+		}
+		goto done;
+	    }
+	    Tcl_ResetResult(interp);
+	    string = end;
+	    name2 = pv.buffer;
+	}
+    }
+    if (termPtr != 0) {
+	*termPtr = string;
+    }
+
+    c = *name1End;
+    *name1End = 0;
+    result = Tcl_GetVar2(interp, name1, name2, TCL_LEAVE_ERR_MSG);
+    *name1End = c;
+
+    done:
+    if ((name2 != NULL) && (pv.buffer != copyStorage)) {
+	ckfree(pv.buffer);
+    }
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CommandComplete --
+ *
+ *	Given a partial or complete Tcl command, this procedure
+ *	determines whether the command is complete in the sense
+ *	of having matched braces and quotes and brackets.
+ *
+ * Results:
+ *	1 is returned if the command is complete, 0 otherwise.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_CommandComplete(cmd)
+    char *cmd;			/* Command to check. */
+{
+    char *p;
+
+    if (*cmd == 0) {
+	return 1;
+    }
+    p = ScriptEnd(cmd, cmd+strlen(cmd), 0);
+    return (*p != 0);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclObjCommandComplete --
+ *
+ *	Given a partial or complete Tcl command in a Tcl object, this
+ *	procedure determines whether the command is complete in the sense of
+ *	having matched braces and quotes and brackets.
+ *
+ * Results:
+ *	1 is returned if the command is complete, 0 otherwise.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclObjCommandComplete(cmdPtr)
+    Tcl_Obj *cmdPtr;			/* Points to object holding command
+					 * to check. */
+{
+    char *cmd, *p;
+    int length;
+
+    cmd = Tcl_GetStringFromObj(cmdPtr, &length);
+    if (length == 0) {
+	return 1;
+    }
+    p = ScriptEnd(cmd, cmd+length, /*nested*/ 0);
+    return (*p != 0);
+}
Index: /trunk/tcl/tclPort.h
===================================================================
--- /trunk/tcl/tclPort.h	(revision 2)
+++ /trunk/tcl/tclPort.h	(revision 2)
@@ -0,0 +1,21 @@
+/*
+ * tclPort.h --
+ *
+ *	This header file handles porting issues that occur because
+ *	of differences between systems.  It reads in platform specific
+ *	portability files.
+ *
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclPort.h,v 1.1 2008-06-04 13:58:09 demin Exp $
+ */
+
+#ifndef _TCLPORT
+#define _TCLPORT
+
+#include "tclUnixPort.h"
+
+#endif /* _TCLPORT */
Index: /trunk/tcl/tclPosixStr.c
===================================================================
--- /trunk/tcl/tclPosixStr.c	(revision 2)
+++ /trunk/tcl/tclPosixStr.c	(revision 2)
@@ -0,0 +1,1178 @@
+/* 
+ * tclPosixStr.c --
+ *
+ *	This file contains procedures that generate strings
+ *	corresponding to various POSIX-related codes, such
+ *	as errno and signals.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclPosixStr.c,v 1.1 2008-06-04 13:58:09 demin Exp $
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ErrnoId --
+ *
+ *	Return a textual identifier for the current errno value.
+ *
+ * Results:
+ *	This procedure returns a machine-readable textual identifier
+ *	that corresponds to the current errno value (e.g. "EPERM").
+ *	The identifier is the same as the #define name in errno.h.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_ErrnoId()
+{
+    switch (errno) {
+#ifdef E2BIG
+	case E2BIG: return "E2BIG";
+#endif
+#ifdef EACCES
+	case EACCES: return "EACCES";
+#endif
+#ifdef EADDRINUSE
+	case EADDRINUSE: return "EADDRINUSE";
+#endif
+#ifdef EADDRNOTAVAIL
+	case EADDRNOTAVAIL: return "EADDRNOTAVAIL";
+#endif
+#ifdef EADV
+	case EADV: return "EADV";
+#endif
+#ifdef EAFNOSUPPORT
+	case EAFNOSUPPORT: return "EAFNOSUPPORT";
+#endif
+#ifdef EAGAIN
+	case EAGAIN: return "EAGAIN";
+#endif
+#ifdef EALIGN
+	case EALIGN: return "EALIGN";
+#endif
+#if defined(EALREADY) && (!defined(EBUSY) || (EALREADY != EBUSY ))
+	case EALREADY: return "EALREADY";
+#endif
+#ifdef EBADE
+	case EBADE: return "EBADE";
+#endif
+#ifdef EBADF
+	case EBADF: return "EBADF";
+#endif
+#ifdef EBADFD
+	case EBADFD: return "EBADFD";
+#endif
+#ifdef EBADMSG
+	case EBADMSG: return "EBADMSG";
+#endif
+#ifdef EBADR
+	case EBADR: return "EBADR";
+#endif
+#ifdef EBADRPC
+	case EBADRPC: return "EBADRPC";
+#endif
+#ifdef EBADRQC
+	case EBADRQC: return "EBADRQC";
+#endif
+#ifdef EBADSLT
+	case EBADSLT: return "EBADSLT";
+#endif
+#ifdef EBFONT
+	case EBFONT: return "EBFONT";
+#endif
+#ifdef EBUSY
+	case EBUSY: return "EBUSY";
+#endif
+#ifdef ECHILD
+	case ECHILD: return "ECHILD";
+#endif
+#ifdef ECHRNG
+	case ECHRNG: return "ECHRNG";
+#endif
+#ifdef ECOMM
+	case ECOMM: return "ECOMM";
+#endif
+#ifdef ECONNABORTED
+	case ECONNABORTED: return "ECONNABORTED";
+#endif
+#ifdef ECONNREFUSED
+	case ECONNREFUSED: return "ECONNREFUSED";
+#endif
+#ifdef ECONNRESET
+	case ECONNRESET: return "ECONNRESET";
+#endif
+#if defined(EDEADLK) && (!defined(EWOULDBLOCK) || (EDEADLK != EWOULDBLOCK))
+	case EDEADLK: return "EDEADLK";
+#endif
+#if defined(EDEADLOCK) && (!defined(EDEADLK) || (EDEADLOCK != EDEADLK))
+	case EDEADLOCK: return "EDEADLOCK";
+#endif
+#ifdef EDESTADDRREQ
+	case EDESTADDRREQ: return "EDESTADDRREQ";
+#endif
+#ifdef EDIRTY
+	case EDIRTY: return "EDIRTY";
+#endif
+#ifdef EDOM
+	case EDOM: return "EDOM";
+#endif
+#ifdef EDOTDOT
+	case EDOTDOT: return "EDOTDOT";
+#endif
+#ifdef EDQUOT
+	case EDQUOT: return "EDQUOT";
+#endif
+#ifdef EDUPPKG
+	case EDUPPKG: return "EDUPPKG";
+#endif
+#ifdef EEXIST
+	case EEXIST: return "EEXIST";
+#endif
+#ifdef EFAULT
+	case EFAULT: return "EFAULT";
+#endif
+#ifdef EFBIG
+	case EFBIG: return "EFBIG";
+#endif
+#ifdef EHOSTDOWN
+	case EHOSTDOWN: return "EHOSTDOWN";
+#endif
+#ifdef EHOSTUNREACH
+	case EHOSTUNREACH: return "EHOSTUNREACH";
+#endif
+#if defined(EIDRM) && (!defined(EINPROGRESS) || (EIDRM != EINPROGRESS))
+	case EIDRM: return "EIDRM";
+#endif
+#ifdef EINIT
+	case EINIT: return "EINIT";
+#endif
+#ifdef EINPROGRESS
+	case EINPROGRESS: return "EINPROGRESS";
+#endif
+#ifdef EINTR
+	case EINTR: return "EINTR";
+#endif
+#ifdef EINVAL
+	case EINVAL: return "EINVAL";
+#endif
+#ifdef EIO
+	case EIO: return "EIO";
+#endif
+#ifdef EISCONN
+	case EISCONN: return "EISCONN";
+#endif
+#ifdef EISDIR
+	case EISDIR: return "EISDIR";
+#endif
+#ifdef EISNAME
+	case EISNAM: return "EISNAM";
+#endif
+#ifdef ELBIN
+	case ELBIN: return "ELBIN";
+#endif
+#ifdef EL2HLT
+	case EL2HLT: return "EL2HLT";
+#endif
+#ifdef EL2NSYNC
+	case EL2NSYNC: return "EL2NSYNC";
+#endif
+#ifdef EL3HLT
+	case EL3HLT: return "EL3HLT";
+#endif
+#ifdef EL3RST
+	case EL3RST: return "EL3RST";
+#endif
+#ifdef ELIBACC
+	case ELIBACC: return "ELIBACC";
+#endif
+#ifdef ELIBBAD
+	case ELIBBAD: return "ELIBBAD";
+#endif
+#ifdef ELIBEXEC
+	case ELIBEXEC: return "ELIBEXEC";
+#endif
+#ifdef ELIBMAX
+	case ELIBMAX: return "ELIBMAX";
+#endif
+#ifdef ELIBSCN
+	case ELIBSCN: return "ELIBSCN";
+#endif
+#ifdef ELNRNG
+	case ELNRNG: return "ELNRNG";
+#endif
+#if defined(ELOOP) && (!defined(ENOENT) || (ELOOP != ENOENT))
+	case ELOOP: return "ELOOP";
+#endif
+#ifdef EMFILE
+	case EMFILE: return "EMFILE";
+#endif
+#ifdef EMLINK
+	case EMLINK: return "EMLINK";
+#endif
+#ifdef EMSGSIZE
+	case EMSGSIZE: return "EMSGSIZE";
+#endif
+#ifdef EMULTIHOP
+	case EMULTIHOP: return "EMULTIHOP";
+#endif
+#ifdef ENAMETOOLONG
+	case ENAMETOOLONG: return "ENAMETOOLONG";
+#endif
+#ifdef ENAVAIL
+	case ENAVAIL: return "ENAVAIL";
+#endif
+#ifdef ENET
+	case ENET: return "ENET";
+#endif
+#ifdef ENETDOWN
+	case ENETDOWN: return "ENETDOWN";
+#endif
+#ifdef ENETRESET
+	case ENETRESET: return "ENETRESET";
+#endif
+#ifdef ENETUNREACH
+	case ENETUNREACH: return "ENETUNREACH";
+#endif
+#ifdef ENFILE
+	case ENFILE: return "ENFILE";
+#endif
+#ifdef ENOANO
+	case ENOANO: return "ENOANO";
+#endif
+#if defined(ENOBUFS) && (!defined(ENOSR) || (ENOBUFS != ENOSR))
+	case ENOBUFS: return "ENOBUFS";
+#endif
+#ifdef ENOCSI
+	case ENOCSI: return "ENOCSI";
+#endif
+#if defined(ENODATA) && (!defined(ECONNREFUSED) || (ENODATA != ECONNREFUSED))
+	case ENODATA: return "ENODATA";
+#endif
+#ifdef ENODEV
+	case ENODEV: return "ENODEV";
+#endif
+#ifdef ENOENT
+	case ENOENT: return "ENOENT";
+#endif
+#ifdef ENOEXEC
+	case ENOEXEC: return "ENOEXEC";
+#endif
+#ifdef ENOLCK
+	case ENOLCK: return "ENOLCK";
+#endif
+#ifdef ENOLINK
+	case ENOLINK: return "ENOLINK";
+#endif
+#ifdef ENOMEM
+	case ENOMEM: return "ENOMEM";
+#endif
+#ifdef ENOMSG
+	case ENOMSG: return "ENOMSG";
+#endif
+#ifdef ENONET
+	case ENONET: return "ENONET";
+#endif
+#ifdef ENOPKG
+	case ENOPKG: return "ENOPKG";
+#endif
+#ifdef ENOPROTOOPT
+	case ENOPROTOOPT: return "ENOPROTOOPT";
+#endif
+#ifdef ENOSPC
+	case ENOSPC: return "ENOSPC";
+#endif
+#if defined(ENOSR) && (!defined(ENAMETOOLONG) || (ENAMETOOLONG != ENOSR))
+	case ENOSR: return "ENOSR";
+#endif
+#if defined(ENOSTR) && (!defined(ENOTTY) || (ENOTTY != ENOSTR))
+	case ENOSTR: return "ENOSTR";
+#endif
+#ifdef ENOSYM
+	case ENOSYM: return "ENOSYM";
+#endif
+#ifdef ENOSYS
+	case ENOSYS: return "ENOSYS";
+#endif
+#ifdef ENOTBLK
+	case ENOTBLK: return "ENOTBLK";
+#endif
+#ifdef ENOTCONN
+	case ENOTCONN: return "ENOTCONN";
+#endif
+#ifdef ENOTDIR
+	case ENOTDIR: return "ENOTDIR";
+#endif
+#if defined(ENOTEMPTY) && (!defined(EEXIST) || (ENOTEMPTY != EEXIST))
+	case ENOTEMPTY: return "ENOTEMPTY";
+#endif
+#ifdef ENOTNAM
+	case ENOTNAM: return "ENOTNAM";
+#endif
+#ifdef ENOTSOCK
+	case ENOTSOCK: return "ENOTSOCK";
+#endif
+#ifdef ENOTSUP
+	case ENOTSUP: return "ENOTSUP";
+#endif
+#ifdef ENOTTY
+	case ENOTTY: return "ENOTTY";
+#endif
+#ifdef ENOTUNIQ
+	case ENOTUNIQ: return "ENOTUNIQ";
+#endif
+#ifdef ENXIO
+	case ENXIO: return "ENXIO";
+#endif
+#if defined(EOPNOTSUPP) && (!defined(ENOTSUP) || (ENOTSUP != EOPNOTSUPP))
+	case EOPNOTSUPP: return "EOPNOTSUPP";
+#endif
+#ifdef EPERM
+	case EPERM: return "EPERM";
+#endif
+#if defined(EPFNOSUPPORT) && (!defined(ENOLCK) || (ENOLCK != EPFNOSUPPORT))
+	case EPFNOSUPPORT: return "EPFNOSUPPORT";
+#endif
+#ifdef EPIPE
+	case EPIPE: return "EPIPE";
+#endif
+#ifdef EPROCLIM
+	case EPROCLIM: return "EPROCLIM";
+#endif
+#ifdef EPROCUNAVAIL
+	case EPROCUNAVAIL: return "EPROCUNAVAIL";
+#endif
+#ifdef EPROGMISMATCH
+	case EPROGMISMATCH: return "EPROGMISMATCH";
+#endif
+#ifdef EPROGUNAVAIL
+	case EPROGUNAVAIL: return "EPROGUNAVAIL";
+#endif
+#ifdef EPROTO
+	case EPROTO: return "EPROTO";
+#endif
+#ifdef EPROTONOSUPPORT
+	case EPROTONOSUPPORT: return "EPROTONOSUPPORT";
+#endif
+#ifdef EPROTOTYPE
+	case EPROTOTYPE: return "EPROTOTYPE";
+#endif
+#ifdef ERANGE
+	case ERANGE: return "ERANGE";
+#endif
+#if defined(EREFUSED) && (!defined(ECONNREFUSED) || (EREFUSED != ECONNREFUSED))
+	case EREFUSED: return "EREFUSED";
+#endif
+#ifdef EREMCHG
+	case EREMCHG: return "EREMCHG";
+#endif
+#ifdef EREMDEV
+	case EREMDEV: return "EREMDEV";
+#endif
+#ifdef EREMOTE
+	case EREMOTE: return "EREMOTE";
+#endif
+#ifdef EREMOTEIO
+	case EREMOTEIO: return "EREMOTEIO";
+#endif
+#ifdef EREMOTERELEASE
+	case EREMOTERELEASE: return "EREMOTERELEASE";
+#endif
+#ifdef EROFS
+	case EROFS: return "EROFS";
+#endif
+#ifdef ERPCMISMATCH
+	case ERPCMISMATCH: return "ERPCMISMATCH";
+#endif
+#ifdef ERREMOTE
+	case ERREMOTE: return "ERREMOTE";
+#endif
+#ifdef ESHUTDOWN
+	case ESHUTDOWN: return "ESHUTDOWN";
+#endif
+#ifdef ESOCKTNOSUPPORT
+	case ESOCKTNOSUPPORT: return "ESOCKTNOSUPPORT";
+#endif
+#ifdef ESPIPE
+	case ESPIPE: return "ESPIPE";
+#endif
+#ifdef ESRCH
+	case ESRCH: return "ESRCH";
+#endif
+#ifdef ESRMNT
+	case ESRMNT: return "ESRMNT";
+#endif
+#ifdef ESTALE
+	case ESTALE: return "ESTALE";
+#endif
+#ifdef ESUCCESS
+	case ESUCCESS: return "ESUCCESS";
+#endif
+#if defined(ETIME) && (!defined(ELOOP) || (ETIME != ELOOP))
+	case ETIME: return "ETIME";
+#endif
+#if defined(ETIMEDOUT) && (!defined(ENOSTR) || (ETIMEDOUT != ENOSTR))
+	case ETIMEDOUT: return "ETIMEDOUT";
+#endif
+#ifdef ETOOMANYREFS
+	case ETOOMANYREFS: return "ETOOMANYREFS";
+#endif
+#ifdef ETXTBSY
+	case ETXTBSY: return "ETXTBSY";
+#endif
+#ifdef EUCLEAN
+	case EUCLEAN: return "EUCLEAN";
+#endif
+#ifdef EUNATCH
+	case EUNATCH: return "EUNATCH";
+#endif
+#ifdef EUSERS
+	case EUSERS: return "EUSERS";
+#endif
+#ifdef EVERSION
+	case EVERSION: return "EVERSION";
+#endif
+#if defined(EWOULDBLOCK) && (!defined(EAGAIN) || (EWOULDBLOCK != EAGAIN))
+	case EWOULDBLOCK: return "EWOULDBLOCK";
+#endif
+#ifdef EXDEV
+	case EXDEV: return "EXDEV";
+#endif
+#ifdef EXFULL
+	case EXFULL: return "EXFULL";
+#endif
+    }
+    return "unknown error";
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ErrnoMsg --
+ *
+ *	Return a human-readable message corresponding to a given
+ *	errno value.
+ *
+ * Results:
+ *	The return value is the standard POSIX error message for
+ *	errno.  This procedure is used instead of strerror because
+ *	strerror returns slightly different values on different
+ *	machines (e.g. different capitalizations), which cause
+ *	problems for things such as regression tests.  This procedure
+ *	provides messages for most standard errors, then it calls
+ *	strerror for things it doesn't understand.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_ErrnoMsg(err)
+    int err;			/* Error number (such as in errno variable). */
+{
+    switch (err) {
+#ifdef E2BIG
+	case E2BIG: return "argument list too long";
+#endif
+#ifdef EACCES
+	case EACCES: return "permission denied";
+#endif
+#ifdef EADDRINUSE
+	case EADDRINUSE: return "address already in use";
+#endif
+#ifdef EADDRNOTAVAIL
+	case EADDRNOTAVAIL: return "can't assign requested address";
+#endif
+#ifdef EADV
+	case EADV: return "advertise error";
+#endif
+#ifdef EAFNOSUPPORT
+	case EAFNOSUPPORT: return "address family not supported by protocol family";
+#endif
+#ifdef EAGAIN
+	case EAGAIN: return "resource temporarily unavailable";
+#endif
+#ifdef EALIGN
+	case EALIGN: return "EALIGN";
+#endif
+#if defined(EALREADY) && (!defined(EBUSY) || (EALREADY != EBUSY ))
+	case EALREADY: return "operation already in progress";
+#endif
+#ifdef EBADE
+	case EBADE: return "bad exchange descriptor";
+#endif
+#ifdef EBADF
+	case EBADF: return "bad file number";
+#endif
+#ifdef EBADFD
+	case EBADFD: return "file descriptor in bad state";
+#endif
+#ifdef EBADMSG
+	case EBADMSG: return "not a data message";
+#endif
+#ifdef EBADR
+	case EBADR: return "bad request descriptor";
+#endif
+#ifdef EBADRPC
+	case EBADRPC: return "RPC structure is bad";
+#endif
+#ifdef EBADRQC
+	case EBADRQC: return "bad request code";
+#endif
+#ifdef EBADSLT
+	case EBADSLT: return "invalid slot";
+#endif
+#ifdef EBFONT
+	case EBFONT: return "bad font file format";
+#endif
+#ifdef EBUSY
+	case EBUSY: return "file busy";
+#endif
+#ifdef ECHILD
+	case ECHILD: return "no children";
+#endif
+#ifdef ECHRNG
+	case ECHRNG: return "channel number out of range";
+#endif
+#ifdef ECOMM
+	case ECOMM: return "communication error on send";
+#endif
+#ifdef ECONNABORTED
+	case ECONNABORTED: return "software caused connection abort";
+#endif
+#ifdef ECONNREFUSED
+	case ECONNREFUSED: return "connection refused";
+#endif
+#ifdef ECONNRESET
+	case ECONNRESET: return "connection reset by peer";
+#endif
+#if defined(EDEADLK) && (!defined(EWOULDBLOCK) || (EDEADLK != EWOULDBLOCK))
+	case EDEADLK: return "resource deadlock avoided";
+#endif
+#if defined(EDEADLOCK) && (!defined(EDEADLK) || (EDEADLOCK != EDEADLK))
+	case EDEADLOCK: return "resource deadlock avoided";
+#endif
+#ifdef EDESTADDRREQ
+	case EDESTADDRREQ: return "destination address required";
+#endif
+#ifdef EDIRTY
+	case EDIRTY: return "mounting a dirty fs w/o force";
+#endif
+#ifdef EDOM
+	case EDOM: return "math argument out of range";
+#endif
+#ifdef EDOTDOT
+	case EDOTDOT: return "cross mount point";
+#endif
+#ifdef EDQUOT
+	case EDQUOT: return "disk quota exceeded";
+#endif
+#ifdef EDUPPKG
+	case EDUPPKG: return "duplicate package name";
+#endif
+#ifdef EEXIST
+	case EEXIST: return "file already exists";
+#endif
+#ifdef EFAULT
+	case EFAULT: return "bad address in system call argument";
+#endif
+#ifdef EFBIG
+	case EFBIG: return "file too large";
+#endif
+#ifdef EHOSTDOWN
+	case EHOSTDOWN: return "host is down";
+#endif
+#ifdef EHOSTUNREACH
+	case EHOSTUNREACH: return "host is unreachable";
+#endif
+#if defined(EIDRM) && (!defined(EINPROGRESS) || (EIDRM != EINPROGRESS))
+	case EIDRM: return "identifier removed";
+#endif
+#ifdef EINIT
+	case EINIT: return "initialization error";
+#endif
+#ifdef EINPROGRESS
+	case EINPROGRESS: return "operation now in progress";
+#endif
+#ifdef EINTR
+	case EINTR: return "interrupted system call";
+#endif
+#ifdef EINVAL
+	case EINVAL: return "invalid argument";
+#endif
+#ifdef EIO
+	case EIO: return "I/O error";
+#endif
+#ifdef EISCONN
+	case EISCONN: return "socket is already connected";
+#endif
+#ifdef EISDIR
+	case EISDIR: return "illegal operation on a directory";
+#endif
+#ifdef EISNAME
+	case EISNAM: return "is a name file";
+#endif
+#ifdef ELBIN
+	case ELBIN: return "ELBIN";
+#endif
+#ifdef EL2HLT
+	case EL2HLT: return "level 2 halted";
+#endif
+#ifdef EL2NSYNC
+	case EL2NSYNC: return "level 2 not synchronized";
+#endif
+#ifdef EL3HLT
+	case EL3HLT: return "level 3 halted";
+#endif
+#ifdef EL3RST
+	case EL3RST: return "level 3 reset";
+#endif
+#ifdef ELIBACC
+	case ELIBACC: return "can not access a needed shared library";
+#endif
+#ifdef ELIBBAD
+	case ELIBBAD: return "accessing a corrupted shared library";
+#endif
+#ifdef ELIBEXEC
+	case ELIBEXEC: return "can not exec a shared library directly";
+#endif
+#ifdef ELIBMAX
+	case ELIBMAX: return
+		"attempting to link in more shared libraries than system limit";
+#endif
+#ifdef ELIBSCN
+	case ELIBSCN: return ".lib section in a.out corrupted";
+#endif
+#ifdef ELNRNG
+	case ELNRNG: return "link number out of range";
+#endif
+#if defined(ELOOP) && (!defined(ENOENT) || (ELOOP != ENOENT))
+	case ELOOP: return "too many levels of symbolic links";
+#endif
+#ifdef EMFILE
+	case EMFILE: return "too many open files";
+#endif
+#ifdef EMLINK
+	case EMLINK: return "too many links";
+#endif
+#ifdef EMSGSIZE
+	case EMSGSIZE: return "message too long";
+#endif
+#ifdef EMULTIHOP
+	case EMULTIHOP: return "multihop attempted";
+#endif
+#ifdef ENAMETOOLONG
+	case ENAMETOOLONG: return "file name too long";
+#endif
+#ifdef ENAVAIL
+	case ENAVAIL: return "not available";
+#endif
+#ifdef ENET
+	case ENET: return "ENET";
+#endif
+#ifdef ENETDOWN
+	case ENETDOWN: return "network is down";
+#endif
+#ifdef ENETRESET
+	case ENETRESET: return "network dropped connection on reset";
+#endif
+#ifdef ENETUNREACH
+	case ENETUNREACH: return "network is unreachable";
+#endif
+#ifdef ENFILE
+	case ENFILE: return "file table overflow";
+#endif
+#ifdef ENOANO
+	case ENOANO: return "anode table overflow";
+#endif
+#if defined(ENOBUFS) && (!defined(ENOSR) || (ENOBUFS != ENOSR))
+	case ENOBUFS: return "no buffer space available";
+#endif
+#ifdef ENOCSI
+	case ENOCSI: return "no CSI structure available";
+#endif
+#if defined(ENODATA) && (!defined(ECONNREFUSED) || (ENODATA != ECONNREFUSED))
+	case ENODATA: return "no data available";
+#endif
+#ifdef ENODEV
+	case ENODEV: return "no such device";
+#endif
+#ifdef ENOENT
+	case ENOENT: return "no such file or directory";
+#endif
+#ifdef ENOEXEC
+	case ENOEXEC: return "exec format error";
+#endif
+#ifdef ENOLCK
+	case ENOLCK: return "no locks available";
+#endif
+#ifdef ENOLINK
+	case ENOLINK: return "link has be severed";
+#endif
+#ifdef ENOMEM
+	case ENOMEM: return "not enough memory";
+#endif
+#ifdef ENOMSG
+	case ENOMSG: return "no message of desired type";
+#endif
+#ifdef ENONET
+	case ENONET: return "machine is not on the network";
+#endif
+#ifdef ENOPKG
+	case ENOPKG: return "package not installed";
+#endif
+#ifdef ENOPROTOOPT
+	case ENOPROTOOPT: return "bad proocol option";
+#endif
+#ifdef ENOSPC
+	case ENOSPC: return "no space left on device";
+#endif
+#if defined(ENOSR) && (!defined(ENAMETOOLONG) || (ENAMETOOLONG != ENOSR))
+	case ENOSR: return "out of stream resources";
+#endif
+#if defined(ENOSTR) && (!defined(ENOTTY) || (ENOTTY != ENOSTR))
+	case ENOSTR: return "not a stream device";
+#endif
+#ifdef ENOSYM
+	case ENOSYM: return "unresolved symbol name";
+#endif
+#ifdef ENOSYS
+	case ENOSYS: return "function not implemented";
+#endif
+#ifdef ENOTBLK
+	case ENOTBLK: return "block device required";
+#endif
+#ifdef ENOTCONN
+	case ENOTCONN: return "socket is not connected";
+#endif
+#ifdef ENOTDIR
+	case ENOTDIR: return "not a directory";
+#endif
+#if defined(ENOTEMPTY) && (!defined(EEXIST) || (ENOTEMPTY != EEXIST))
+	case ENOTEMPTY: return "directory not empty";
+#endif
+#ifdef ENOTNAM
+	case ENOTNAM: return "not a name file";
+#endif
+#ifdef ENOTSOCK
+	case ENOTSOCK: return "socket operation on non-socket";
+#endif
+#ifdef ENOTSUP
+	case ENOTSUP: return "operation not supported";
+#endif
+#ifdef ENOTTY
+	case ENOTTY: return "inappropriate device for ioctl";
+#endif
+#ifdef ENOTUNIQ
+	case ENOTUNIQ: return "name not unique on network";
+#endif
+#ifdef ENXIO
+	case ENXIO: return "no such device or address";
+#endif
+#if defined(EOPNOTSUPP) && (!defined(ENOTSUP) || (ENOTSUP != EOPNOTSUPP))
+	case EOPNOTSUPP: return "operation not supported on socket";
+#endif
+#ifdef EPERM
+	case EPERM: return "not owner";
+#endif
+#if defined(EPFNOSUPPORT) && (!defined(ENOLCK) || (ENOLCK != EPFNOSUPPORT))
+	case EPFNOSUPPORT: return "protocol family not supported";
+#endif
+#ifdef EPIPE
+	case EPIPE: return "broken pipe";
+#endif
+#ifdef EPROCLIM
+	case EPROCLIM: return "too many processes";
+#endif
+#ifdef EPROCUNAVAIL
+	case EPROCUNAVAIL: return "bad procedure for program";
+#endif
+#ifdef EPROGMISMATCH
+	case EPROGMISMATCH: return "program version wrong";
+#endif
+#ifdef EPROGUNAVAIL
+	case EPROGUNAVAIL: return "RPC program not available";
+#endif
+#ifdef EPROTO
+	case EPROTO: return "protocol error";
+#endif
+#ifdef EPROTONOSUPPORT
+	case EPROTONOSUPPORT: return "protocol not suppored";
+#endif
+#ifdef EPROTOTYPE
+	case EPROTOTYPE: return "protocol wrong type for socket";
+#endif
+#ifdef ERANGE
+	case ERANGE: return "math result unrepresentable";
+#endif
+#if defined(EREFUSED) && (!defined(ECONNREFUSED) || (EREFUSED != ECONNREFUSED))
+	case EREFUSED: return "EREFUSED";
+#endif
+#ifdef EREMCHG
+	case EREMCHG: return "remote address changed";
+#endif
+#ifdef EREMDEV
+	case EREMDEV: return "remote device";
+#endif
+#ifdef EREMOTE
+	case EREMOTE: return "pathname hit remote file system";
+#endif
+#ifdef EREMOTEIO
+	case EREMOTEIO: return "remote i/o error";
+#endif
+#ifdef EREMOTERELEASE
+	case EREMOTERELEASE: return "EREMOTERELEASE";
+#endif
+#ifdef EROFS
+	case EROFS: return "read-only file system";
+#endif
+#ifdef ERPCMISMATCH
+	case ERPCMISMATCH: return "RPC version is wrong";
+#endif
+#ifdef ERREMOTE
+	case ERREMOTE: return "object is remote";
+#endif
+#ifdef ESHUTDOWN
+	case ESHUTDOWN: return "can't send afer socket shutdown";
+#endif
+#ifdef ESOCKTNOSUPPORT
+	case ESOCKTNOSUPPORT: return "socket type not supported";
+#endif
+#ifdef ESPIPE
+	case ESPIPE: return "invalid seek";
+#endif
+#ifdef ESRCH
+	case ESRCH: return "no such process";
+#endif
+#ifdef ESRMNT
+	case ESRMNT: return "srmount error";
+#endif
+#ifdef ESTALE
+	case ESTALE: return "stale remote file handle";
+#endif
+#ifdef ESUCCESS
+	case ESUCCESS: return "Error 0";
+#endif
+#if defined(ETIME) && (!defined(ELOOP) || (ETIME != ELOOP))
+	case ETIME: return "timer expired";
+#endif
+#if defined(ETIMEDOUT) && (!defined(ENOSTR) || (ETIMEDOUT != ENOSTR))
+	case ETIMEDOUT: return "connection timed out";
+#endif
+#ifdef ETOOMANYREFS
+	case ETOOMANYREFS: return "too many references: can't splice";
+#endif
+#ifdef ETXTBSY
+	case ETXTBSY: return "text file or pseudo-device busy";
+#endif
+#ifdef EUCLEAN
+	case EUCLEAN: return "structure needs cleaning";
+#endif
+#ifdef EUNATCH
+	case EUNATCH: return "protocol driver not attached";
+#endif
+#ifdef EUSERS
+	case EUSERS: return "too many users";
+#endif
+#ifdef EVERSION
+	case EVERSION: return "version mismatch";
+#endif
+#if defined(EWOULDBLOCK) && (!defined(EAGAIN) || (EWOULDBLOCK != EAGAIN))
+	case EWOULDBLOCK: return "operation would block";
+#endif
+#ifdef EXDEV
+	case EXDEV: return "cross-domain link";
+#endif
+#ifdef EXFULL
+	case EXFULL: return "message tables full";
+#endif
+	default:
+#ifdef NO_STRERROR
+	    return "unknown POSIX error";
+#else
+	    return strerror(errno);
+#endif
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SignalId --
+ *
+ *	Return a textual identifier for a signal number.
+ *
+ * Results:
+ *	This procedure returns a machine-readable textual identifier
+ *	that corresponds to sig.  The identifier is the same as the
+ *	#define name in signal.h.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_SignalId(sig)
+    int sig;			/* Number of signal. */
+{
+    switch (sig) {
+#ifdef SIGABRT
+	case SIGABRT: return "SIGABRT";
+#endif
+#ifdef SIGALRM
+	case SIGALRM: return "SIGALRM";
+#endif
+#ifdef SIGBUS
+	case SIGBUS: return "SIGBUS";
+#endif
+#ifdef SIGCHLD
+	case SIGCHLD: return "SIGCHLD";
+#endif
+#if defined(SIGCLD) && (!defined(SIGCHLD) || (SIGCLD != SIGCHLD))
+	case SIGCLD: return "SIGCLD";
+#endif
+#ifdef SIGCONT
+	case SIGCONT: return "SIGCONT";
+#endif
+#if defined(SIGEMT) && (!defined(SIGXCPU) || (SIGEMT != SIGXCPU))
+	case SIGEMT: return "SIGEMT";
+#endif
+#ifdef SIGFPE
+	case SIGFPE: return "SIGFPE";
+#endif
+#ifdef SIGHUP
+	case SIGHUP: return "SIGHUP";
+#endif
+#ifdef SIGILL
+	case SIGILL: return "SIGILL";
+#endif
+#ifdef SIGINT
+	case SIGINT: return "SIGINT";
+#endif
+#ifdef SIGIO
+	case SIGIO: return "SIGIO";
+#endif
+#if defined(SIGIOT) && (!defined(SIGABRT) || (SIGIOT != SIGABRT))
+	case SIGIOT: return "SIGIOT";
+#endif
+#ifdef SIGKILL
+	case SIGKILL: return "SIGKILL";
+#endif
+#if defined(SIGLOST) && (!defined(SIGIOT) || (SIGLOST != SIGIOT)) && (!defined(SIGURG) || (SIGLOST != SIGURG)) && (!defined(SIGPROF) || (SIGLOST != SIGPROF)) && (!defined(SIGIO) || (SIGLOST != SIGIO))
+	case SIGLOST: return "SIGLOST";
+#endif
+#ifdef SIGPIPE
+	case SIGPIPE: return "SIGPIPE";
+#endif
+#if defined(SIGPOLL) && (!defined(SIGIO) || (SIGPOLL != SIGIO))
+	case SIGPOLL: return "SIGPOLL";
+#endif
+#ifdef SIGPROF
+	case SIGPROF: return "SIGPROF";
+#endif
+#if defined(SIGPWR) && (!defined(SIGXFSZ) || (SIGPWR != SIGXFSZ))
+	case SIGPWR: return "SIGPWR";
+#endif
+#ifdef SIGQUIT
+	case SIGQUIT: return "SIGQUIT";
+#endif
+#ifdef SIGSEGV
+	case SIGSEGV: return "SIGSEGV";
+#endif
+#ifdef SIGSTOP
+	case SIGSTOP: return "SIGSTOP";
+#endif
+#ifdef SIGSYS
+	case SIGSYS: return "SIGSYS";
+#endif
+#ifdef SIGTERM
+	case SIGTERM: return "SIGTERM";
+#endif
+#ifdef SIGTRAP
+	case SIGTRAP: return "SIGTRAP";
+#endif
+#ifdef SIGTSTP
+	case SIGTSTP: return "SIGTSTP";
+#endif
+#ifdef SIGTTIN
+	case SIGTTIN: return "SIGTTIN";
+#endif
+#ifdef SIGTTOU
+	case SIGTTOU: return "SIGTTOU";
+#endif
+#if defined(SIGURG) && (!defined(SIGIO) || (SIGURG != SIGIO))
+	case SIGURG: return "SIGURG";
+#endif
+#if defined(SIGUSR1) && (!defined(SIGIO) || (SIGUSR1 != SIGIO))
+	case SIGUSR1: return "SIGUSR1";
+#endif
+#if defined(SIGUSR2) && (!defined(SIGURG) || (SIGUSR2 != SIGURG))
+	case SIGUSR2: return "SIGUSR2";
+#endif
+#ifdef SIGVTALRM
+	case SIGVTALRM: return "SIGVTALRM";
+#endif
+#ifdef SIGWINCH
+	case SIGWINCH: return "SIGWINCH";
+#endif
+#ifdef SIGXCPU
+	case SIGXCPU: return "SIGXCPU";
+#endif
+#ifdef SIGXFSZ
+	case SIGXFSZ: return "SIGXFSZ";
+#endif
+    }
+    return "unknown signal";
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SignalMsg --
+ *
+ *	Return a human-readable message describing a signal.
+ *
+ * Results:
+ *	This procedure returns a string describing sig that should
+ *	make sense to a human.  It may not be easy for a machine
+ *	to parse.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_SignalMsg(sig)
+    int sig;			/* Number of signal. */
+{
+    switch (sig) {
+#ifdef SIGABRT
+	case SIGABRT: return "SIGABRT";
+#endif
+#ifdef SIGALRM
+	case SIGALRM: return "alarm clock";
+#endif
+#ifdef SIGBUS
+	case SIGBUS: return "bus error";
+#endif
+#ifdef SIGCHLD
+	case SIGCHLD: return "child status changed";
+#endif
+#if defined(SIGCLD) && (!defined(SIGCHLD) || (SIGCLD != SIGCHLD))
+	case SIGCLD: return "child status changed";
+#endif
+#ifdef SIGCONT
+	case SIGCONT: return "continue after stop";
+#endif
+#if defined(SIGEMT) && (!defined(SIGXCPU) || (SIGEMT != SIGXCPU))
+	case SIGEMT: return "EMT instruction";
+#endif
+#ifdef SIGFPE
+	case SIGFPE: return "floating-point exception";
+#endif
+#ifdef SIGHUP
+	case SIGHUP: return "hangup";
+#endif
+#ifdef SIGILL
+	case SIGILL: return "illegal instruction";
+#endif
+#ifdef SIGINT
+	case SIGINT: return "interrupt";
+#endif
+#ifdef SIGIO
+	case SIGIO: return "input/output possible on file";
+#endif
+#if defined(SIGIOT) && (!defined(SIGABRT) || (SIGABRT != SIGIOT))
+	case SIGIOT: return "IOT instruction";
+#endif
+#ifdef SIGKILL
+	case SIGKILL: return "kill signal";
+#endif
+#if defined(SIGLOST) && (!defined(SIGIOT) || (SIGLOST != SIGIOT)) && (!defined(SIGURG) || (SIGLOST != SIGURG)) && (!defined(SIGPROF) || (SIGLOST != SIGPROF)) && (!defined(SIGIO) || (SIGLOST != SIGIO))
+	case SIGLOST: return "resource lost";
+#endif
+#ifdef SIGPIPE
+	case SIGPIPE: return "write on pipe with no readers";
+#endif
+#if defined(SIGPOLL) && (!defined(SIGIO) || (SIGPOLL != SIGIO))
+	case SIGPOLL: return "input/output possible on file";
+#endif
+#ifdef SIGPROF
+	case SIGPROF: return "profiling alarm";
+#endif
+#if defined(SIGPWR) && (!defined(SIGXFSZ) || (SIGPWR != SIGXFSZ))
+	case SIGPWR: return "power-fail restart";
+#endif
+#ifdef SIGQUIT
+	case SIGQUIT: return "quit signal";
+#endif
+#ifdef SIGSEGV
+	case SIGSEGV: return "segmentation violation";
+#endif
+#ifdef SIGSTOP
+	case SIGSTOP: return "stop";
+#endif
+#ifdef SIGSYS
+	case SIGSYS: return "bad argument to system call";
+#endif
+#ifdef SIGTERM
+	case SIGTERM: return "software termination signal";
+#endif
+#ifdef SIGTRAP
+	case SIGTRAP: return "trace trap";
+#endif
+#ifdef SIGTSTP
+	case SIGTSTP: return "stop signal from tty";
+#endif
+#ifdef SIGTTIN
+	case SIGTTIN: return "background tty read";
+#endif
+#ifdef SIGTTOU
+	case SIGTTOU: return "background tty write";
+#endif
+#if defined(SIGURG) && (!defined(SIGIO) || (SIGURG != SIGIO))
+	case SIGURG: return "urgent I/O condition";
+#endif
+#if defined(SIGUSR1) && (!defined(SIGIO) || (SIGUSR1 != SIGIO))
+	case SIGUSR1: return "user-defined signal 1";
+#endif
+#if defined(SIGUSR2) && (!defined(SIGURG) || (SIGUSR2 != SIGURG))
+	case SIGUSR2: return "user-defined signal 2";
+#endif
+#ifdef SIGVTALRM
+	case SIGVTALRM: return "virtual time alarm";
+#endif
+#ifdef SIGWINCH
+	case SIGWINCH: return "window changed";
+#endif
+#ifdef SIGXCPU
+	case SIGXCPU: return "exceeded CPU time limit";
+#endif
+#ifdef SIGXFSZ
+	case SIGXFSZ: return "exceeded file size limit";
+#endif
+    }
+    return "unknown signal";
+}
Index: /trunk/tcl/tclPreserve.c
===================================================================
--- /trunk/tcl/tclPreserve.c	(revision 2)
+++ /trunk/tcl/tclPreserve.c	(revision 2)
@@ -0,0 +1,96 @@
+/* 
+ * tclPreserve.c --
+ *
+ *	This file contains a collection of procedures that are used
+ *	to make sure that widget records and other data structures
+ *	aren't reallocated when there are nested procedures that
+ *	depend on their existence.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclPreserve.c,v 1.1 2008-06-04 13:58:10 demin Exp $
+ */
+
+#include "tclInt.h"
+
+/*
+ * The following data structure is used to keep track of all the
+ * Tcl_Preserve calls that are still in effect.  It grows as needed
+ * to accommodate any number of calls in effect.
+ */
+
+typedef struct {
+    ClientData clientData;	/* Address of preserved block. */
+    int refCount;		/* Number of Tcl_Preserve calls in effect
+				 * for block. */
+    int mustFree;		/* Non-zero means Tcl_EventuallyFree was
+				 * called while a Tcl_Preserve call was in
+				 * effect, so the structure must be freed
+				 * when refCount becomes zero. */
+    Tcl_FreeProc *freeProc;	/* Procedure to call to free. */
+} Reference;
+
+static Reference *refArray;	/* First in array of references. */
+static int inUse = 0;		/* Count of structures currently in use
+				 * in refArray. */
+#define INITIAL_SIZE 2
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_EventuallyFree --
+ *
+ *	Free up a block of memory, unless a call to Tcl_Preserve is in
+ *	effect for that block.  In this case, defer the free until all
+ *	calls to Tcl_Preserve have been undone by matching calls to
+ *	Tcl_Release.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Ptr may be released by calling free().
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_EventuallyFree(clientData, freeProc)
+    ClientData clientData;	/* Pointer to malloc'ed block of memory. */
+    Tcl_FreeProc *freeProc;	/* Procedure to actually do free. */
+{
+    Reference *refPtr;
+    int i;
+
+    /*
+     * See if there is a reference for this pointer.  If so, set its
+     * "mustFree" flag (the flag had better not be set already!).
+     */
+
+    for (i = 0, refPtr = refArray; i < inUse; i++, refPtr++) {
+	if (refPtr->clientData != clientData) {
+	    continue;
+	}
+	if (refPtr->mustFree) {
+	    panic("Tcl_EventuallyFree called twice for 0x%x\n", clientData);
+        }
+        refPtr->mustFree = 1;
+	refPtr->freeProc = freeProc;
+        return;
+    }
+
+    /*
+     * No reference for this block.  Free it now.
+     */
+
+    if ((freeProc == TCL_DYNAMIC)
+	    || (freeProc == (Tcl_FreeProc *) free)) {
+	ckfree((char *) clientData);
+    } else {
+	(*freeProc)((char *)clientData);
+    }
+}
Index: /trunk/tcl/tclProc.c
===================================================================
--- /trunk/tcl/tclProc.c	(revision 2)
+++ /trunk/tcl/tclProc.c	(revision 2)
@@ -0,0 +1,1543 @@
+/* 
+ * tclProc.c --
+ *
+ *	This file contains routines that implement Tcl procedures,
+ *	including the "proc" and "uplevel" commands.
+ *
+ * Copyright (c) 1987-1993 The Regents of the University of California.
+ * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclProc.c,v 1.1 2008-06-04 13:58:10 demin Exp $
+ */
+
+#include "tclInt.h"
+#include "tclCompile.h"
+
+/*
+ * Prototypes for static functions in this file
+ */
+
+static void	ProcBodyDup _ANSI_ARGS_((Tcl_Obj *srcPtr, Tcl_Obj *dupPtr));
+static void	ProcBodyFree _ANSI_ARGS_((Tcl_Obj *objPtr));
+static int	ProcBodySetFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+		Tcl_Obj *objPtr));
+static void	ProcBodyUpdateString _ANSI_ARGS_((Tcl_Obj *objPtr));
+
+/*
+ * The ProcBodyObjType type
+ */
+
+Tcl_ObjType tclProcBodyType = {
+    "procbody",			/* name for this type */
+    ProcBodyFree,		/* FreeInternalRep procedure */
+    ProcBodyDup,		/* DupInternalRep procedure */
+    ProcBodyUpdateString,	/* UpdateString procedure */
+    ProcBodySetFromAny		/* SetFromAny procedure */
+};
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ProcObjCmd --
+ *
+ *	This object-based procedure is invoked to process the "proc" Tcl 
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl object result value.
+ *
+ * Side effects:
+ *	A new procedure gets created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_ProcObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    register Interp *iPtr = (Interp *) interp;
+    Proc *procPtr;
+    char *fullName, *procName;
+    Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
+    Tcl_Command cmd;
+    Tcl_DString ds;
+
+    if (objc != 4) {
+	Tcl_WrongNumArgs(interp, 1, objv, "name args body");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Determine the namespace where the procedure should reside. Unless
+     * the command name includes namespace qualifiers, this will be the
+     * current namespace.
+     */
+    
+    fullName = Tcl_GetStringFromObj(objv[1], (int *) NULL);
+    TclGetNamespaceForQualName(interp, fullName, (Namespace *) NULL,
+       /*flags*/ 0, &nsPtr, &altNsPtr, &cxtNsPtr, &procName);
+
+    if (nsPtr == NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"can't create procedure \"", fullName,
+		"\": unknown namespace", (char *) NULL);
+        return TCL_ERROR;
+    }
+    if (procName == NULL) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"can't create procedure \"", fullName,
+		"\": bad procedure name", (char *) NULL);
+        return TCL_ERROR;
+    }
+    if ((nsPtr != iPtr->globalNsPtr)
+	    && (procName != NULL) && (procName[0] == ':')) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"can't create procedure \"", procName,
+		"\" in non-global namespace with name starting with \":\"",
+	        (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    /*
+     *  Create the data structure to represent the procedure.
+     */
+    if (TclCreateProc(interp, nsPtr, procName, objv[2], objv[3],
+        &procPtr) != TCL_OK) {
+        return TCL_ERROR;
+    }
+
+    /*
+     * Now create a command for the procedure. This will initially be in
+     * the current namespace unless the procedure's name included namespace
+     * qualifiers. To create the new command in the right namespace, we
+     * generate a fully qualified name for it.
+     */
+
+    Tcl_DStringInit(&ds);
+    if (nsPtr != iPtr->globalNsPtr) {
+	Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
+	Tcl_DStringAppend(&ds, "::", 2);
+    }
+    Tcl_DStringAppend(&ds, procName, -1);
+    
+    Tcl_CreateCommand(interp, Tcl_DStringValue(&ds), TclProcInterpProc,
+	    (ClientData) procPtr, TclProcDeleteProc);
+    cmd = Tcl_CreateObjCommand(interp, Tcl_DStringValue(&ds),
+	    TclObjInterpProc, (ClientData) procPtr, TclProcDeleteProc);
+
+    /*
+     * Now initialize the new procedure's cmdPtr field. This will be used
+     * later when the procedure is called to determine what namespace the
+     * procedure will run in. This will be different than the current
+     * namespace if the proc was renamed into a different namespace.
+     */
+    
+    procPtr->cmdPtr = (Command *) cmd;
+
+    return TCL_OK;
+}
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCreateProc --
+ *
+ *	Creates the data associated with a Tcl procedure definition.
+ *	This procedure knows how to handle two types of body objects:
+ *	strings and procbody. Strings are the traditional (and common) value
+ *	for bodies, procbody are values created by extensions that have
+ *	loaded a previously compiled script.
+ *
+ * Results:
+ *	Returns TCL_OK on success, along with a pointer to a Tcl
+ *	procedure definition in procPtrPtr.  This definition should
+ *	be freed by calling TclCleanupProc() when it is no longer
+ *	needed.  Returns TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	If anything goes wrong, this procedure returns an error
+ *	message in the interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
+    Tcl_Interp *interp;         /* interpreter containing proc */
+    Namespace *nsPtr;           /* namespace containing this proc */
+    char *procName;             /* unqualified name of this proc */
+    Tcl_Obj *argsPtr;           /* description of arguments */
+    Tcl_Obj *bodyPtr;           /* command body */
+    Proc **procPtrPtr;          /* returns:  pointer to proc data */
+{
+    Interp *iPtr = (Interp*)interp;
+    char **argArray = NULL;
+
+    register Proc *procPtr;
+    int i, length, result, numArgs;
+    char *args, *bytes, *p;
+    register CompiledLocal *localPtr;
+    Tcl_Obj *defPtr;
+    int precompiled = 0;
+    
+    if (bodyPtr->typePtr == &tclProcBodyType) {
+        /*
+         * Because the body is a TclProProcBody, the actual body is already
+         * compiled, and it is not shared with anyone else, so it's OK not to
+         * unshare it (as a matter of fact, it is bad to unshare it, because
+         * there may be no source code).
+         *
+         * We don't create and initialize a Proc structure for the procedure;
+         * rather, we use what is in the body object. Note that
+         * we initialize its cmdPtr field below after we've created the command
+         * for the procedure. We increment the ref count of the Proc struct
+         * since the command (soon to be created) will be holding a reference
+         * to it.
+         */
+    
+        procPtr = (Proc *) bodyPtr->internalRep.otherValuePtr;
+        procPtr->iPtr = iPtr;
+        procPtr->refCount++;
+        precompiled = 1;
+    } else {
+        /*
+         * If the procedure's body object is shared because its string value is
+         * identical to, e.g., the body of another procedure, we must create a
+         * private copy for this procedure to use. Such sharing of procedure
+         * bodies is rare but can cause problems. A procedure body is compiled
+         * in a context that includes the number of compiler-allocated "slots"
+         * for local variables. Each formal parameter is given a local variable
+         * slot (the "procPtr->numCompiledLocals = numArgs" assignment
+         * below). This means that the same code can not be shared by two
+         * procedures that have a different number of arguments, even if their
+         * bodies are identical. Note that we don't use Tcl_DuplicateObj since
+         * we would not want any bytecode internal representation.
+         */
+
+        if (Tcl_IsShared(bodyPtr)) {
+            bytes = Tcl_GetStringFromObj(bodyPtr, &length);
+            bodyPtr = Tcl_NewStringObj(bytes, length);
+        }
+
+        /*
+         * Create and initialize a Proc structure for the procedure. Note that
+         * we initialize its cmdPtr field below after we've created the command
+         * for the procedure. We increment the ref count of the procedure's
+         * body object since there will be a reference to it in the Proc
+         * structure.
+         */
+    
+        Tcl_IncrRefCount(bodyPtr);
+
+        procPtr = (Proc *) ckalloc(sizeof(Proc));
+        procPtr->iPtr = iPtr;
+        procPtr->refCount = 1;
+        procPtr->bodyPtr = bodyPtr;
+        procPtr->numArgs  = 0;	/* actual argument count is set below. */
+        procPtr->numCompiledLocals = 0;
+        procPtr->firstLocalPtr = NULL;
+        procPtr->lastLocalPtr = NULL;
+    }
+    
+    /*
+     * Break up the argument list into argument specifiers, then process
+     * each argument specifier.
+     * If the body is precompiled, processing is limited to checking that
+     * the the parsed argument is consistent with the one stored in the
+     * Proc.
+     * THIS FAILS IF THE ARG LIST OBJECT'S STRING REP CONTAINS NULLS.
+     */
+
+    args = Tcl_GetStringFromObj(argsPtr, &length);
+    result = Tcl_SplitList(interp, args, &numArgs, &argArray);
+    if (result != TCL_OK) {
+        goto procError;
+    }
+
+    if (precompiled) {
+        if (numArgs > procPtr->numArgs) {
+            char buf[128];
+            sprintf(buf, "\": arg list contains %d entries, precompiled header expects %d",
+                    numArgs, procPtr->numArgs);
+            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                    "procedure \"", procName,
+                    buf, (char *) NULL);
+            goto procError;
+        }
+        localPtr = procPtr->firstLocalPtr;
+    } else {
+        procPtr->numArgs = numArgs;
+        procPtr->numCompiledLocals = numArgs;
+    }
+    for (i = 0;  i < numArgs;  i++) {
+        int fieldCount, nameLength, valueLength;
+        char **fieldValues;
+
+        /*
+         * Now divide the specifier up into name and default.
+         */
+
+        result = Tcl_SplitList(interp, argArray[i], &fieldCount,
+                &fieldValues);
+        if (result != TCL_OK) {
+            goto procError;
+        }
+        if (fieldCount > 2) {
+            ckfree((char *) fieldValues);
+            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                    "too many fields in argument specifier \"",
+                    argArray[i], "\"", (char *) NULL);
+            goto procError;
+        }
+        if ((fieldCount == 0) || (*fieldValues[0] == 0)) {
+            ckfree((char *) fieldValues);
+            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                    "procedure \"", procName,
+                    "\" has argument with no name", (char *) NULL);
+            goto procError;
+        }
+	
+        nameLength = strlen(fieldValues[0]);
+        if (fieldCount == 2) {
+            valueLength = strlen(fieldValues[1]);
+        } else {
+            valueLength = 0;
+        }
+
+        /*
+         * Check that the formal parameter name is a scalar.
+         */
+
+        p = fieldValues[0];
+        while (*p != '\0') {
+            if (*p == '(') {
+                char *q = p;
+                do {
+		    q++;
+		} while (*q != '\0');
+		q--;
+		if (*q == ')') { /* we have an array element */
+		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		            "procedure \"", procName,
+		            "\" has formal parameter \"", fieldValues[0],
+			    "\" that is an array element",
+			    (char *) NULL);
+		    ckfree((char *) fieldValues);
+		    goto procError;
+		}
+	    }
+	    p++;
+	}
+
+        if (precompiled) {
+            /*
+             * compare the parsed argument with the stored one
+             */
+
+            if ((localPtr->nameLength != nameLength)
+                    || (strcmp(localPtr->name, fieldValues[0]))
+                    || (localPtr->frameIndex != i)
+                    || (localPtr->flags != (VAR_SCALAR | VAR_ARGUMENT))
+                    || ((localPtr->defValuePtr == NULL)
+                            && (fieldCount == 2))
+                    || ((localPtr->defValuePtr != NULL)
+                            && (fieldCount != 2))) {
+                char buf[128];
+                sprintf(buf, "\": formal parameter %d is inconsistent with precompiled body",
+                        i);
+                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                        "procedure \"", procName,
+                        buf, (char *) NULL);
+                ckfree((char *) fieldValues);
+                goto procError;
+            }
+
+            /*
+             * compare the default value if any
+             */
+
+            if (localPtr->defValuePtr != NULL) {
+                int tmpLength;
+                char *tmpPtr = Tcl_GetStringFromObj(localPtr->defValuePtr,
+                        &tmpLength);
+                if ((valueLength != tmpLength)
+                        || (strncmp(fieldValues[1], tmpPtr,
+                                (size_t) tmpLength))) {
+                    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                            "procedure \"", procName,
+                            "\": formal parameter \"",
+                            fieldValues[0],
+                            "\" has default value inconsistent with precompiled body",
+                            (char *) NULL);
+                    ckfree((char *) fieldValues);
+                    goto procError;
+                }
+            }
+
+            localPtr = localPtr->nextPtr;
+        } else {
+            /*
+             * Allocate an entry in the runtime procedure frame's array of
+             * local variables for the argument. 
+             */
+
+            localPtr = (CompiledLocal *) ckalloc((unsigned) 
+                    (sizeof(CompiledLocal) - sizeof(localPtr->name)
+                            + nameLength+1));
+            if (procPtr->firstLocalPtr == NULL) {
+                procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
+            } else {
+                procPtr->lastLocalPtr->nextPtr = localPtr;
+                procPtr->lastLocalPtr = localPtr;
+            }
+            localPtr->nextPtr = NULL;
+            localPtr->nameLength = nameLength;
+            localPtr->frameIndex = i;
+            localPtr->flags = VAR_SCALAR | VAR_ARGUMENT;
+            localPtr->resolveInfo = NULL;
+	
+            if (fieldCount == 2) {
+                localPtr->defValuePtr =
+		    Tcl_NewStringObj(fieldValues[1], valueLength);
+                Tcl_IncrRefCount(localPtr->defValuePtr);
+            } else {
+                localPtr->defValuePtr = NULL;
+            }
+            strcpy(localPtr->name, fieldValues[0]);
+	}
+
+        ckfree((char *) fieldValues);
+    }
+
+    /*
+     * Now initialize the new procedure's cmdPtr field. This will be used
+     * later when the procedure is called to determine what namespace the
+     * procedure will run in. This will be different than the current
+     * namespace if the proc was renamed into a different namespace.
+     */
+    
+    *procPtrPtr = procPtr;
+    ckfree((char *) argArray);
+    return TCL_OK;
+
+procError:
+    if (precompiled) {
+        procPtr->refCount--;
+    } else {
+        Tcl_DecrRefCount(bodyPtr);
+        while (procPtr->firstLocalPtr != NULL) {
+            localPtr = procPtr->firstLocalPtr;
+            procPtr->firstLocalPtr = localPtr->nextPtr;
+	
+            defPtr = localPtr->defValuePtr;
+            if (defPtr != NULL) {
+                Tcl_DecrRefCount(defPtr);
+            }
+	
+            ckfree((char *) localPtr);
+        }
+        ckfree((char *) procPtr);
+    }
+    if (argArray != NULL) {
+	ckfree((char *) argArray);
+    }
+    return TCL_ERROR;
+}
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetFrame --
+ *
+ *	Given a description of a procedure frame, such as the first
+ *	argument to an "uplevel" or "upvar" command, locate the
+ *	call frame for the appropriate level of procedure.
+ *
+ * Results:
+ *	The return value is -1 if an error occurred in finding the
+ *	frame (in this case an error message is left in interp->result).
+ *	1 is returned if string was either a number or a number preceded
+ *	by "#" and it specified a valid frame.  0 is returned if string
+ *	isn't one of the two things above (in this case, the lookup
+ *	acts as if string were "1").  The variable pointed to by
+ *	framePtrPtr is filled in with the address of the desired frame
+ *	(unless an error occurs, in which case it isn't modified).
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclGetFrame(interp, string, framePtrPtr)
+    Tcl_Interp *interp;		/* Interpreter in which to find frame. */
+    char *string;		/* String describing frame. */
+    CallFrame **framePtrPtr;	/* Store pointer to frame here (or NULL
+				 * if global frame indicated). */
+{
+    register Interp *iPtr = (Interp *) interp;
+    int curLevel, level, result;
+    CallFrame *framePtr;
+
+    /*
+     * Parse string to figure out which level number to go to.
+     */
+
+    result = 1;
+    curLevel = (iPtr->varFramePtr == NULL) ? 0 : iPtr->varFramePtr->level;
+    if (*string == '#') {
+	if (Tcl_GetInt(interp, string+1, &level) != TCL_OK) {
+	    return -1;
+	}
+	if (level < 0) {
+	    levelError:
+	    Tcl_AppendResult(interp, "bad level \"", string, "\"",
+		    (char *) NULL);
+	    return -1;
+	}
+    } else if (isdigit(UCHAR(*string))) {
+	if (Tcl_GetInt(interp, string, &level) != TCL_OK) {
+	    return -1;
+	}
+	level = curLevel - level;
+    } else {
+	level = curLevel - 1;
+	result = 0;
+    }
+
+    /*
+     * Figure out which frame to use, and modify the interpreter so
+     * its variables come from that frame.
+     */
+
+    if (level == 0) {
+	framePtr = NULL;
+    } else {
+	for (framePtr = iPtr->varFramePtr; framePtr != NULL;
+		framePtr = framePtr->callerVarPtr) {
+	    if (framePtr->level == level) {
+		break;
+	    }
+	}
+	if (framePtr == NULL) {
+	    goto levelError;
+	}
+    }
+    *framePtrPtr = framePtr;
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UplevelObjCmd --
+ *
+ *	This object procedure is invoked to process the "uplevel" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl object result value.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_UplevelObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    register Interp *iPtr = (Interp *) interp;
+    char *optLevel;
+    int length, result;
+    CallFrame *savedVarFramePtr, *framePtr;
+
+    if (objc < 2) {
+	uplevelSyntax:
+	Tcl_WrongNumArgs(interp, 1, objv, "?level? command ?arg ...?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Find the level to use for executing the command.
+     * THIS FAILS IF THE OBJECT RESULT'S STRING REP CONTAINS A NULL.
+     */
+
+    optLevel = Tcl_GetStringFromObj(objv[1], &length);
+    result = TclGetFrame(interp, optLevel, &framePtr);
+    if (result == -1) {
+	return TCL_ERROR;
+    }
+    objc -= (result+1);
+    if (objc == 0) {
+	goto uplevelSyntax;
+    }
+    objv += (result+1);
+
+    /*
+     * Modify the interpreter state to execute in the given frame.
+     */
+
+    savedVarFramePtr = iPtr->varFramePtr;
+    iPtr->varFramePtr = framePtr;
+
+    /*
+     * Execute the residual arguments as a command.
+     */
+
+    if (objc == 1) {
+	result = Tcl_EvalObj(interp, objv[0]);
+    } else {
+	Tcl_Obj *cmdObjPtr = Tcl_ConcatObj(objc, objv);
+	result = Tcl_EvalObj(interp, cmdObjPtr);
+	Tcl_DecrRefCount(cmdObjPtr); /* done with object */
+    }
+    if (result == TCL_ERROR) {
+	char msg[60];
+	sprintf(msg, "\n    (\"uplevel\" body line %d)", interp->errorLine);
+	Tcl_AddObjErrorInfo(interp, msg, -1);
+    }
+
+    /*
+     * Restore the variable frame, and return.
+     */
+
+    iPtr->varFramePtr = savedVarFramePtr;
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFindProc --
+ *
+ *	Given the name of a procedure, return a pointer to the
+ *	record describing the procedure.
+ *
+ * Results:
+ *	NULL is returned if the name doesn't correspond to any
+ *	procedure.  Otherwise the return value is a pointer to
+ *	the procedure's record.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Proc *
+TclFindProc(iPtr, procName)
+    Interp *iPtr;		/* Interpreter in which to look. */
+    char *procName;		/* Name of desired procedure. */
+{
+    Tcl_Command cmd;
+    Tcl_Command origCmd;
+    Command *cmdPtr;
+    
+    cmd = Tcl_FindCommand((Tcl_Interp *) iPtr, procName,
+            (Tcl_Namespace *) NULL, /*flags*/ 0);
+    if (cmd == (Tcl_Command) NULL) {
+        return NULL;
+    }
+    cmdPtr = (Command *) cmd;
+
+    origCmd = TclGetOriginalCommand(cmd);
+    if (origCmd != NULL) {
+	cmdPtr = (Command *) origCmd;
+    }
+    if (cmdPtr->proc != TclProcInterpProc) {
+	return NULL;
+    }
+    return (Proc *) cmdPtr->clientData;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclIsProc --
+ *
+ *	Tells whether a command is a Tcl procedure or not.
+ *
+ * Results:
+ *	If the given command is actually a Tcl procedure, the
+ *	return value is the address of the record describing
+ *	the procedure.  Otherwise the return value is 0.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Proc *
+TclIsProc(cmdPtr)
+    Command *cmdPtr;		/* Command to test. */
+{
+    Tcl_Command origCmd;
+
+    origCmd = TclGetOriginalCommand((Tcl_Command) cmdPtr);
+    if (origCmd != NULL) {
+	cmdPtr = (Command *) origCmd;
+    }
+    if (cmdPtr->proc == TclProcInterpProc) {
+	return (Proc *) cmdPtr->clientData;
+    }
+    return (Proc *) 0;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclProcInterpProc --
+ *
+ *	When a Tcl procedure gets invoked with an argc/argv array of
+ *	strings, this routine gets invoked to interpret the procedure.
+ *
+ * Results:
+ *	A standard Tcl result value, usually TCL_OK.
+ *
+ * Side effects:
+ *	Depends on the commands in the procedure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclProcInterpProc(clientData, interp, argc, argv)
+    ClientData clientData;	/* Record describing procedure to be
+				 * interpreted. */
+    Tcl_Interp *interp;		/* Interpreter in which procedure was
+				 * invoked. */
+    int argc;			/* Count of number of arguments to this
+				 * procedure. */
+    register char **argv;	/* Argument values. */
+{
+    register Tcl_Obj *objPtr;
+    register int i;
+    int result;
+
+    /*
+     * This procedure generates an objv array for object arguments that hold
+     * the argv strings. It starts out with stack-allocated space but uses
+     * dynamically-allocated storage if needed.
+     */
+
+#define NUM_ARGS 20
+    Tcl_Obj *(objStorage[NUM_ARGS]);
+    register Tcl_Obj **objv = objStorage;
+
+    /*
+     * Create the object argument array "objv". Make sure objv is large
+     * enough to hold the objc arguments plus 1 extra for the zero
+     * end-of-objv word.
+     */
+
+    if ((argc + 1) > NUM_ARGS) {
+	objv = (Tcl_Obj **)
+	    ckalloc((unsigned)(argc + 1) * sizeof(Tcl_Obj *));
+    }
+
+    for (i = 0;  i < argc;  i++) {
+	objv[i] = Tcl_NewStringObj(argv[i], -1);
+	Tcl_IncrRefCount(objv[i]);
+    }
+    objv[argc] = 0;
+
+    /*
+     * Use TclObjInterpProc to actually interpret the procedure.
+     */
+
+    result = TclObjInterpProc(clientData, interp, argc, objv);
+
+    /*
+     * Move the interpreter's object result to the string result, 
+     * then reset the object result.
+     * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
+     */
+    
+    Tcl_SetResult(interp,
+	    TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
+	    TCL_VOLATILE);
+
+    /*
+     * Decrement the ref counts on the objv elements since we are done
+     * with them.
+     */
+
+    for (i = 0;  i < argc;  i++) {
+	objPtr = objv[i];
+	TclDecrRefCount(objPtr);
+    }
+    
+    /*
+     * Free the objv array if malloc'ed storage was used.
+     */
+
+    if (objv != objStorage) {
+	ckfree((char *) objv);
+    }
+    return result;
+#undef NUM_ARGS
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclObjInterpProc --
+ *
+ *	When a Tcl procedure gets invoked during bytecode evaluation, this 
+ *	object-based routine gets invoked to interpret the procedure.
+ *
+ * Results:
+ *	A standard Tcl object result value.
+ *
+ * Side effects:
+ *	Depends on the commands in the procedure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclObjInterpProc(clientData, interp, objc, objv)
+    ClientData clientData;	/* Record describing procedure to be
+				 * interpreted. */
+    Tcl_Interp *interp;		/* Interpreter in which procedure was
+				 * invoked. */
+    int objc;			/* Count of number of arguments to this
+				 * procedure. */
+    Tcl_Obj *CONST objv[];	/* Argument value objects. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Proc *procPtr = (Proc *) clientData;
+    Namespace *nsPtr = procPtr->cmdPtr->nsPtr;
+    CallFrame frame;
+    register CallFrame *framePtr = &frame;
+    register CompiledLocal *localPtr;
+    char *procName, *bytes;
+    int nameLen, localCt, numArgs, argCt, length, i, result;
+    Var *varPtr;
+
+    /*
+     * This procedure generates an array "compiledLocals" that holds the
+     * storage for local variables. It starts out with stack-allocated space
+     * but uses dynamically-allocated storage if needed.
+     */
+
+#define NUM_LOCALS 20
+    Var localStorage[NUM_LOCALS];
+    Var *compiledLocals = localStorage;
+
+    /*
+     * Get the procedure's name.
+     * THIS FAILS IF THE PROC NAME'S STRING REP HAS A NULL.
+     */
+    
+    procName = Tcl_GetStringFromObj(objv[0], &nameLen);
+
+    /*
+     * If necessary, compile the procedure's body. The compiler will
+     * allocate frame slots for the procedure's non-argument local
+     * variables.  Note that compiling the body might increase
+     * procPtr->numCompiledLocals if new local variables are found
+     * while compiling.
+     */
+    
+    result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr, nsPtr,
+	    "body of proc", procName);
+    
+    if (result != TCL_OK) {
+        return result;
+    }
+
+    /*
+     * Create the "compiledLocals" array. Make sure it is large enough to
+     * hold all the procedure's compiled local variables, including its
+     * formal parameters.
+     */
+
+    localCt = procPtr->numCompiledLocals;
+    if (localCt > NUM_LOCALS) {
+	compiledLocals = (Var *) ckalloc((unsigned) localCt * sizeof(Var));
+    }
+    
+    /*
+     * Set up and push a new call frame for the new procedure invocation.
+     * This call frame will execute in the proc's namespace, which might
+     * be different than the current namespace. The proc's namespace is
+     * that of its command, which can change if the command is renamed
+     * from one namespace to another.
+     */
+
+    result = Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr,
+            (Tcl_Namespace *) nsPtr, /*isProcCallFrame*/ 1);
+
+    if (result != TCL_OK) {
+        return result;
+    }
+
+    framePtr->objc = objc;
+    framePtr->objv = objv;  /* ref counts for args are incremented below */
+
+    /*
+     * Initialize and resolve compiled variable references.
+     */
+
+    framePtr->procPtr = procPtr;
+    framePtr->numCompiledLocals = localCt;
+    framePtr->compiledLocals = compiledLocals;
+
+    TclInitCompiledLocals(interp, framePtr, nsPtr);
+    
+    /*
+     * Match and assign the call's actual parameters to the procedure's
+     * formal arguments. The formal arguments are described by the first
+     * numArgs entries in both the Proc structure's local variable list and
+     * the call frame's local variable array.
+     */
+
+    numArgs = procPtr->numArgs;
+    varPtr = framePtr->compiledLocals;
+    localPtr = procPtr->firstLocalPtr;
+    argCt = objc;
+    for (i = 1, argCt -= 1;  i <= numArgs;  i++, argCt--) {
+	if (!TclIsVarArgument(localPtr)) {
+	    panic("TclObjInterpProc: local variable %s is not argument but should be",
+		  localPtr->name);
+	    return TCL_ERROR;
+	}
+	if (TclIsVarTemporary(localPtr)) {
+	    panic("TclObjInterpProc: local variable %d is temporary but should be an argument", i);
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Handle the special case of the last formal being "args".  When
+	 * it occurs, assign it a list consisting of all the remaining
+	 * actual arguments.
+	 */
+
+	if ((i == numArgs) && ((localPtr->name[0] == 'a')
+	        && (strcmp(localPtr->name, "args") == 0))) {
+	    Tcl_Obj *listPtr = Tcl_NewListObj(argCt, &(objv[i]));
+	    varPtr->value.objPtr = listPtr;
+	    Tcl_IncrRefCount(listPtr); /* local var is a reference */
+	    varPtr->flags &= ~VAR_UNDEFINED;
+	    argCt = 0;
+	    break;		/* done processing args */
+	} else if (argCt > 0) {
+	    Tcl_Obj *objPtr = objv[i];
+	    varPtr->value.objPtr = objPtr;
+	    varPtr->flags &= ~VAR_UNDEFINED;
+	    Tcl_IncrRefCount(objPtr);  /* since the local variable now has
+					* another reference to object. */
+	} else if (localPtr->defValuePtr != NULL) {
+	    Tcl_Obj *objPtr = localPtr->defValuePtr;
+	    varPtr->value.objPtr = objPtr;
+	    varPtr->flags &= ~VAR_UNDEFINED;
+	    Tcl_IncrRefCount(objPtr);  /* since the local variable now has
+					* another reference to object. */
+	} else {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		    "no value given for parameter \"", localPtr->name,
+		    "\" to \"", Tcl_GetStringFromObj(objv[0], (int *) NULL),
+		    "\"", (char *) NULL);
+	    result = TCL_ERROR;
+	    goto procDone;
+	}
+	varPtr++;
+	localPtr = localPtr->nextPtr;
+    }
+    if (argCt > 0) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"called \"", Tcl_GetStringFromObj(objv[0], (int *) NULL),
+		"\" with too many arguments", (char *) NULL);
+	result = TCL_ERROR;
+	goto procDone;
+    }
+
+    /*
+     * Invoke the commands in the procedure's body.
+     */
+
+    if (tclTraceExec >= 1) {
+	fprintf(stdout, "Calling proc ");
+	for (i = 0;  i < objc;  i++) {
+	    bytes = Tcl_GetStringFromObj(objv[i], &length);
+	    TclPrintSource(stdout, bytes, TclMin(length, 15));
+	    fprintf(stdout, " ");
+	}
+	fprintf(stdout, "\n");
+	fflush(stdout);
+    }
+
+    iPtr->returnCode = TCL_OK;
+    procPtr->refCount++;
+    result = Tcl_EvalObj(interp, procPtr->bodyPtr);
+    procPtr->refCount--;
+    if (procPtr->refCount <= 0) {
+	TclProcCleanupProc(procPtr);
+    }
+
+    if (result != TCL_OK) {
+	if (result == TCL_RETURN) {
+	    result = TclUpdateReturnInfo(iPtr);
+	} else if (result == TCL_ERROR) {
+	    char msg[100];
+	    sprintf(msg, "\n    (procedure \"%.50s\" line %d)",
+		    procName, iPtr->errorLine);
+	    Tcl_AddObjErrorInfo(interp, msg, -1);
+	} else if (result == TCL_BREAK) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	            "invoked \"break\" outside of a loop", -1);
+	    result = TCL_ERROR;
+	} else if (result == TCL_CONTINUE) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		    "invoked \"continue\" outside of a loop", -1);
+	    result = TCL_ERROR;
+	}
+    }
+    
+    procDone:
+
+    /*
+     * Pop and free the call frame for this procedure invocation.
+     */
+    
+    Tcl_PopCallFrame(interp);
+    
+    /*
+     * Free the compiledLocals array if malloc'ed storage was used.
+     */
+
+    if (compiledLocals != localStorage) {
+	ckfree((char *) compiledLocals);
+    }
+    return result;
+#undef NUM_LOCALS
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclProcCompileProc --
+ *
+ *	Called just before a procedure is executed to compile the
+ *	body to byte codes.  If the type of the body is not
+ *	"byte code" or if the compile conditions have changed
+ *	(namespace context, epoch counters, etc.) then the body
+ *	is recompiled.  Otherwise, this procedure does nothing.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May change the internal representation of the body object
+ *	to compiled code.
+ *
+ *----------------------------------------------------------------------
+ */
+ 
+int
+TclProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName)
+    Tcl_Interp *interp;		/* Interpreter containing procedure. */
+    Proc *procPtr;		/* Data associated with procedure. */
+    Tcl_Obj *bodyPtr;		/* Body of proc. (Usually procPtr->bodyPtr,
+ 				 * but could be any code fragment compiled
+ 				 * in the context of this procedure.) */
+    Namespace *nsPtr;		/* Namespace containing procedure. */
+    CONST char *description;	/* string describing this body of code. */
+    CONST char *procName;	/* Name of this procedure. */
+{
+    Interp *iPtr = (Interp*)interp;
+    int result;
+    Tcl_CallFrame frame;
+    Proc *saveProcPtr;
+    ByteCode *codePtr = (ByteCode *) bodyPtr->internalRep.otherValuePtr;
+ 
+    /*
+     * If necessary, compile the procedure's body. The compiler will
+     * allocate frame slots for the procedure's non-argument local
+     * variables. If the ByteCode already exists, make sure it hasn't been
+     * invalidated by someone redefining a core command (this might make the
+     * compiled code wrong). Also, if the code was compiled in/for a
+     * different interpreter, we recompile it. Note that compiling the body
+     * might increase procPtr->numCompiledLocals if new local variables are
+     * found while compiling.
+     *
+     * Precompiled procedure bodies, however, are immutable and therefore
+     * they are not recompiled, even if things have changed.
+     */
+ 
+    if (bodyPtr->typePtr == &tclByteCodeType) {
+ 	if ((codePtr->iPtr != iPtr)
+ 	        || (codePtr->compileEpoch != iPtr->compileEpoch)
+ 	        || (codePtr->nsPtr != nsPtr)) {
+            if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
+                if (codePtr->iPtr != iPtr) {
+                    Tcl_AppendResult(interp,
+                            "a precompiled script jumped interps", NULL);
+                    return TCL_ERROR;
+                }
+	        codePtr->compileEpoch = iPtr->compileEpoch;
+                codePtr->nsPtr = nsPtr;
+            } else {
+                tclByteCodeType.freeIntRepProc(bodyPtr);
+                bodyPtr->typePtr = (Tcl_ObjType *) NULL;
+            }
+ 	}
+    }
+    if (bodyPtr->typePtr != &tclByteCodeType) {
+ 	char buf[100];
+ 	int numChars;
+ 	char *ellipsis;
+ 	
+ 	if (tclTraceCompile >= 1) {
+ 	    /*
+ 	     * Display a line summarizing the top level command we
+ 	     * are about to compile.
+ 	     */
+ 
+ 	    numChars = strlen(procName);
+ 	    ellipsis = "";
+ 	    if (numChars > 50) {
+ 		numChars = 50;
+ 		ellipsis = "...";
+ 	    }
+ 	    fprintf(stdout, "Compiling %s \"%.*s%s\"\n",
+ 		    description, numChars, procName, ellipsis);
+ 	}
+ 	
+ 	/*
+ 	 * Plug the current procPtr into the interpreter and coerce
+ 	 * the code body to byte codes.  The interpreter needs to
+ 	 * know which proc it's compiling so that it can access its
+ 	 * list of compiled locals.
+ 	 *
+ 	 * TRICKY NOTE:  Be careful to push a call frame with the
+ 	 *   proper namespace context, so that the byte codes are
+ 	 *   compiled in the appropriate class context.
+ 	 */
+ 
+ 	saveProcPtr = iPtr->compiledProcPtr;
+ 	iPtr->compiledProcPtr = procPtr;
+ 
+ 	result = Tcl_PushCallFrame(interp, &frame,
+		(Tcl_Namespace*)nsPtr, /* isProcCallFrame */ 0);
+ 
+ 	if (result == TCL_OK) {
+	    result = tclByteCodeType.setFromAnyProc(interp, bodyPtr);
+	    Tcl_PopCallFrame(interp);
+	}
+ 
+ 	iPtr->compiledProcPtr = saveProcPtr;
+ 	
+ 	if (result != TCL_OK) {
+ 	    if (result == TCL_ERROR) {
+ 		numChars = strlen(procName);
+ 		ellipsis = "";
+ 		if (numChars > 50) {
+ 		    numChars = 50;
+ 		    ellipsis = "...";
+ 		}
+ 		sprintf(buf, "\n    (compiling %s \"%.*s%s\", line %d)",
+ 			description, numChars, procName, ellipsis,
+ 			interp->errorLine);
+ 		Tcl_AddObjErrorInfo(interp, buf, -1);
+ 	    }
+ 	    return result;
+ 	}
+    } else if (codePtr->nsEpoch != nsPtr->resolverEpoch) {
+	register CompiledLocal *localPtr;
+ 	
+	/*
+	 * The resolver epoch has changed, but we only need to invalidate
+	 * the resolver cache.
+	 */
+
+	for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;
+	    localPtr = localPtr->nextPtr) {
+	    localPtr->flags &= ~(VAR_RESOLVED);
+	    if (localPtr->resolveInfo) {
+		if (localPtr->resolveInfo->deleteProc) {
+		    localPtr->resolveInfo->deleteProc(localPtr->resolveInfo);
+		} else {
+		    ckfree((char*)localPtr->resolveInfo);
+		}
+		localPtr->resolveInfo = NULL;
+	    }
+	}
+    }
+    return TCL_OK;
+}
+ 
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclProcDeleteProc --
+ *
+ *	This procedure is invoked just before a command procedure is
+ *	removed from an interpreter.  Its job is to release all the
+ *	resources allocated to the procedure.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Memory gets freed, unless the procedure is actively being
+ *	executed.  In this case the cleanup is delayed until the
+ *	last call to the current procedure completes.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclProcDeleteProc(clientData)
+    ClientData clientData;		/* Procedure to be deleted. */
+{
+    Proc *procPtr = (Proc *) clientData;
+
+    procPtr->refCount--;
+    if (procPtr->refCount <= 0) {
+	TclProcCleanupProc(procPtr);
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclProcCleanupProc --
+ *
+ *	This procedure does all the real work of freeing up a Proc
+ *	structure.  It's called only when the structure's reference
+ *	count becomes zero.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Memory gets freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclProcCleanupProc(procPtr)
+    register Proc *procPtr;		/* Procedure to be deleted. */
+{
+    register CompiledLocal *localPtr;
+    Tcl_Obj *bodyPtr = procPtr->bodyPtr;
+    Tcl_Obj *defPtr;
+    Tcl_ResolvedVarInfo *resVarInfo;
+
+    if (bodyPtr != NULL) {
+	Tcl_DecrRefCount(bodyPtr);
+    }
+    for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;  ) {
+	CompiledLocal *nextPtr = localPtr->nextPtr;
+
+        resVarInfo = localPtr->resolveInfo;
+	if (resVarInfo) {
+	    if (resVarInfo->deleteProc) {
+		(*resVarInfo->deleteProc)(resVarInfo);
+	    } else {
+		ckfree((char *) resVarInfo);
+	    }
+        }
+
+	if (localPtr->defValuePtr != NULL) {
+	    defPtr = localPtr->defValuePtr;
+	    Tcl_DecrRefCount(defPtr);
+	}
+	ckfree((char *) localPtr);
+	localPtr = nextPtr;
+    }
+    ckfree((char *) procPtr);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclUpdateReturnInfo --
+ *
+ *	This procedure is called when procedures return, and at other
+ *	points where the TCL_RETURN code is used.  It examines fields
+ *	such as iPtr->returnCode and iPtr->errorCode and modifies
+ *	the real return status accordingly.
+ *
+ * Results:
+ *	The return value is the true completion code to use for
+ *	the procedure, instead of TCL_RETURN.
+ *
+ * Side effects:
+ *	The errorInfo and errorCode variables may get modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclUpdateReturnInfo(iPtr)
+    Interp *iPtr;		/* Interpreter for which TCL_RETURN
+				 * exception is being processed. */
+{
+    int code;
+
+    code = iPtr->returnCode;
+    iPtr->returnCode = TCL_OK;
+    if (code == TCL_ERROR) {
+	Tcl_SetVar2((Tcl_Interp *) iPtr, "errorCode", (char *) NULL,
+		(iPtr->errorCode != NULL) ? iPtr->errorCode : "NONE",
+		TCL_GLOBAL_ONLY);
+	iPtr->flags |= ERROR_CODE_SET;
+	if (iPtr->errorInfo != NULL) {
+	    Tcl_SetVar2((Tcl_Interp *) iPtr, "errorInfo", (char *) NULL,
+		    iPtr->errorInfo, TCL_GLOBAL_ONLY);
+	    iPtr->flags |= ERR_IN_PROGRESS;
+	}
+    }
+    return code;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetInterpProc --
+ *
+ *  Returns a pointer to the TclProcInterpProc procedure; this is different
+ *  from the value obtained from the TclProcInterpProc reference on systems
+ *  like Windows where import and export versions of a procedure exported
+ *  by a DLL exist.
+ *
+ * Results:
+ *  Returns the internal address of the TclProcInterpProc procedure.
+ *
+ * Side effects:
+ *  None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TclCmdProcType
+TclGetInterpProc()
+{
+    return TclProcInterpProc;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetObjInterpProc --
+ *
+ *  Returns a pointer to the TclObjInterpProc procedure; this is different
+ *  from the value obtained from the TclObjInterpProc reference on systems
+ *  like Windows where import and export versions of a procedure exported
+ *  by a DLL exist.
+ *
+ * Results:
+ *  Returns the internal address of the TclObjInterpProc procedure.
+ *
+ * Side effects:
+ *  None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TclObjCmdProcType
+TclGetObjInterpProc()
+{
+    return TclObjInterpProc;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNewProcBodyObj --
+ *
+ *  Creates a new object, of type "procbody", whose internal
+ *  representation is the given Proc struct.
+ *  The newly created object's reference count is 0.
+ *
+ * Results:
+ *  Returns a pointer to a newly allocated Tcl_Obj, 0 on error.
+ *
+ * Side effects:
+ *  The reference count in the ByteCode attached to the Proc is bumped up
+ *  by one, since the internal rep stores a pointer to it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclNewProcBodyObj(procPtr)
+    Proc *procPtr;	/* the Proc struct to store as the internal
+                         * representation. */
+{
+    Tcl_Obj *objPtr;
+
+    if (!procPtr) {
+        return (Tcl_Obj *) NULL;
+    }
+    
+    objPtr = Tcl_NewStringObj("", 0);
+
+    if (objPtr) {
+        objPtr->typePtr = &tclProcBodyType;
+        objPtr->internalRep.otherValuePtr = (VOID *) procPtr;
+
+        procPtr->refCount++;
+    }
+
+    return objPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ProcBodyDup --
+ *
+ *  Tcl_ObjType's Dup function for the proc body object.
+ *  Bumps the reference count on the Proc stored in the internal
+ *  representation.
+ *
+ * Results:
+ *  None.
+ *
+ * Side effects:
+ *  Sets up the object in dupPtr to be a duplicate of the one in srcPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void ProcBodyDup(srcPtr, dupPtr)
+    Tcl_Obj *srcPtr;		/* object to copy */
+    Tcl_Obj *dupPtr;		/* target object for the duplication */
+{
+    Proc *procPtr = (Proc *) srcPtr->internalRep.otherValuePtr;
+    
+    dupPtr->typePtr = &tclProcBodyType;
+    dupPtr->internalRep.otherValuePtr = (VOID *) procPtr;
+    procPtr->refCount++;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ProcBodyFree --
+ *
+ *  Tcl_ObjType's Free function for the proc body object.
+ *  The reference count on its Proc struct is decreased by 1; if the count
+ *  reaches 0, the proc is freed.
+ *
+ * Results:
+ *  None.
+ *
+ * Side effects:
+ *  If the reference count on the Proc struct reaches 0, the struct is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ProcBodyFree(objPtr)
+    Tcl_Obj *objPtr;		/* the object to clean up */
+{
+    Proc *procPtr = (Proc *) objPtr->internalRep.otherValuePtr;
+    procPtr->refCount--;
+    if (procPtr->refCount <= 0) {
+        TclProcCleanupProc(procPtr);
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ProcBodySetFromAny --
+ *
+ *  Tcl_ObjType's SetFromAny function for the proc body object.
+ *  Calls panic.
+ *
+ * Results:
+ *  Theoretically returns a TCL result code.
+ *
+ * Side effects:
+ *  Calls panic, since we can't set the value of the object from a string
+ *  representation (or any other internal ones).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ProcBodySetFromAny(interp, objPtr)
+    Tcl_Interp *interp;			/* current interpreter */
+    Tcl_Obj *objPtr;			/* object pointer */
+{
+    panic("called ProcBodySetFromAny");
+
+    /*
+     * this to keep compilers happy.
+     */
+    
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ProcBodyUpdateString --
+ *
+ *  Tcl_ObjType's UpdateString function for the proc body object.
+ *  Calls panic.
+ *
+ * Results:
+ *  None.
+ *
+ * Side effects:
+ *  Calls panic, since we this type has no string representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ProcBodyUpdateString(objPtr)
+    Tcl_Obj *objPtr;		/* the object to update */
+{
+    panic("called ProcBodyUpdateString");
+}
Index: /trunk/tcl/tclResolve.c
===================================================================
--- /trunk/tcl/tclResolve.c	(revision 2)
+++ /trunk/tcl/tclResolve.c	(revision 2)
@@ -0,0 +1,424 @@
+/*
+ * tclResolve.c --
+ *
+ *      Contains hooks for customized command/variable name resolution
+ *      schemes.  These hooks allow extensions like [incr Tcl] to add
+ *      their own name resolution rules to the Tcl language.  Rules can
+ *      be applied to a particular namespace, to the interpreter as a
+ *      whole, or both.
+ *
+ * Copyright (c) 1998 Lucent Technologies, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclResolve.c,v 1.1 2008-06-04 13:58:10 demin Exp $
+ */
+
+#include "tclInt.h"
+
+/*
+ * Declarations for procedures local to this file:
+ */
+
+static void		BumpCmdRefEpochs _ANSI_ARGS_((Namespace *nsPtr));
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AddInterpResolvers --
+ *
+ *	Adds a set of command/variable resolution procedures to an
+ *	interpreter.  These procedures are consulted when commands
+ *	are resolved in Tcl_FindCommand, and when variables are
+ *	resolved in TclLookupVar and LookupCompiledLocal.  Each
+ *	namespace may also have its own set of resolution procedures
+ *	which take precedence over those for the interpreter.
+ *
+ *	When a name is resolved, it is handled as follows.  First,
+ *	the name is passed to the resolution procedures for the
+ *	namespace.  If not resolved, the name is passed to each of
+ *	the resolution procedures added to the interpreter.  Finally,
+ *	if still not resolved, the name is handled using the default
+ *	Tcl rules for name resolution.
+ *
+ * Results:
+ *	Returns pointers to the current name resolution procedures
+ *	in the cmdProcPtr, varProcPtr and compiledVarProcPtr
+ *	arguments.
+ *
+ * Side effects:
+ *	If a compiledVarProc is specified, this procedure bumps the
+ *	compileEpoch for the interpreter, forcing all code to be
+ *	recompiled.  If a cmdProc is specified, this procedure bumps
+ *	the cmdRefEpoch in all namespaces, forcing commands to be
+ *	resolved again using the new rules.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AddInterpResolvers(interp, name, cmdProc, varProc, compiledVarProc)
+
+    Tcl_Interp *interp;			/* Interpreter whose name resolution
+					 * rules are being modified. */
+    char *name;				/* Name of this resolution scheme. */
+    Tcl_ResolveCmdProc *cmdProc;	/* New procedure for command
+					 * resolution */
+    Tcl_ResolveVarProc *varProc;	/* Procedure for variable resolution
+					 * at runtime */
+    Tcl_ResolveCompiledVarProc *compiledVarProc;
+					/* Procedure for variable resolution
+					 * at compile time. */
+{
+    Interp *iPtr = (Interp*)interp;
+    ResolverScheme *resPtr;
+
+    /*
+     *  Since we're adding a new name resolution scheme, we must force
+     *  all code to be recompiled to use the new scheme.  If there
+     *  are new compiled variable resolution rules, bump the compiler
+     *  epoch to invalidate compiled code.  If there are new command
+     *  resolution rules, bump the cmdRefEpoch in all namespaces.
+     */
+    if (compiledVarProc) {
+        iPtr->compileEpoch++;
+    }
+    if (cmdProc) {
+        BumpCmdRefEpochs(iPtr->globalNsPtr);
+    }
+
+    /*
+     *  Look for an existing scheme with the given name.  If found,
+     *  then replace its rules.
+     */
+    for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) {
+        if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) {
+            resPtr->cmdResProc = cmdProc;
+            resPtr->varResProc = varProc;
+            resPtr->compiledVarResProc = compiledVarProc;
+            return;
+        }
+    }
+
+    /*
+     *  Otherwise, this is a new scheme.  Add it to the FRONT
+     *  of the linked list, so that it overrides existing schemes.
+     */
+    resPtr = (ResolverScheme *) ckalloc(sizeof(ResolverScheme));
+    resPtr->name = (char*)ckalloc((unsigned)(strlen(name)+1));
+    strcpy(resPtr->name, name);
+    resPtr->cmdResProc = cmdProc;
+    resPtr->varResProc = varProc;
+    resPtr->compiledVarResProc = compiledVarProc;
+    resPtr->nextPtr = iPtr->resolverPtr;
+    iPtr->resolverPtr = resPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetInterpResolvers --
+ *
+ *	Looks for a set of command/variable resolution procedures with
+ *	the given name in an interpreter.  These procedures are
+ *	registered by calling Tcl_AddInterpResolvers.
+ *
+ * Results:
+ *	If the name is recognized, this procedure returns non-zero,
+ *	along with pointers to the name resolution procedures in
+ *	the Tcl_ResolverInfo structure.  If the name is not recognized,
+ *	this procedure returns zero.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetInterpResolvers(interp, name, resInfoPtr)
+
+    Tcl_Interp *interp;			/* Interpreter whose name resolution
+					 * rules are being queried. */
+    char *name;                         /* Look for a scheme with this name. */
+    Tcl_ResolverInfo *resInfoPtr;	/* Returns pointers to the procedures,
+					 * if found */
+{
+    Interp *iPtr = (Interp*)interp;
+    ResolverScheme *resPtr;
+
+    /*
+     *  Look for an existing scheme with the given name.  If found,
+     *  then return pointers to its procedures.
+     */
+    for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) {
+        if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) {
+	    resInfoPtr->cmdResProc = resPtr->cmdResProc;
+	    resInfoPtr->varResProc = resPtr->varResProc;
+	    resInfoPtr->compiledVarResProc = resPtr->compiledVarResProc;
+            return 1;
+        }
+    }
+
+    return 0;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_RemoveInterpResolvers --
+ *
+ *	Removes a set of command/variable resolution procedures
+ *	previously added by Tcl_AddInterpResolvers.  The next time
+ *	a command/variable name is resolved, these procedures
+ *	won't be consulted.
+ *
+ * Results:
+ *	Returns non-zero if the name was recognized and the
+ *	resolution scheme was deleted.  Returns zero otherwise.
+ *
+ * Side effects:
+ *	If a scheme with a compiledVarProc was deleted, this procedure
+ *	bumps the compileEpoch for the interpreter, forcing all code
+ *	to be recompiled.  If a scheme with a cmdProc was deleted,
+ *	this procedure bumps the cmdRefEpoch in all namespaces,
+ *	forcing commands to be resolved again using the new rules.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_RemoveInterpResolvers(interp, name)
+
+    Tcl_Interp *interp;			/* Interpreter whose name resolution
+					 * rules are being modified. */
+    char *name;                         /* Name of the scheme to be removed. */
+{
+    Interp *iPtr = (Interp*)interp;
+    ResolverScheme **prevPtrPtr, *resPtr;
+
+    /*
+     *  Look for an existing scheme with the given name.
+     */
+    prevPtrPtr = &iPtr->resolverPtr;
+    for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) {
+        if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) {
+            break;
+        }
+        prevPtrPtr = &resPtr->nextPtr;
+    }
+
+    /*
+     *  If we found the scheme, delete it.
+     */
+    if (resPtr) {
+        /*
+         *  If we're deleting a scheme with compiled variable resolution
+         *  rules, bump the compiler epoch to invalidate compiled code.
+         *  If we're deleting a scheme with command resolution rules,
+         *  bump the cmdRefEpoch in all namespaces.
+         */
+        if (resPtr->compiledVarResProc) {
+            iPtr->compileEpoch++;
+        }
+        if (resPtr->cmdResProc) {
+            BumpCmdRefEpochs(iPtr->globalNsPtr);
+        }
+
+        *prevPtrPtr = resPtr->nextPtr;
+        ckfree(resPtr->name);
+        ckfree((char *) resPtr);
+
+        return 1;
+    }
+    return 0;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BumpCmdRefEpochs --
+ *
+ *	This procedure is used to bump the cmdRefEpoch counters in
+ *	the specified namespace and all of its child namespaces.
+ *	It is used whenever name resolution schemes are added/removed
+ *	from an interpreter, to invalidate all command references.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Bumps the cmdRefEpoch in the specified namespace and its
+ *	children, recursively.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+BumpCmdRefEpochs(nsPtr)
+    Namespace *nsPtr;			/* Namespace being modified. */
+{
+    Tcl_HashEntry *entry;
+    Tcl_HashSearch search;
+    Namespace *childNsPtr;
+
+    nsPtr->cmdRefEpoch++;
+
+    for (entry = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
+	    entry != NULL;
+	    entry = Tcl_NextHashEntry(&search)) {
+
+        childNsPtr = (Namespace *) Tcl_GetHashValue(entry);
+        BumpCmdRefEpochs(childNsPtr);
+    }
+}
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetNamespaceResolvers --
+ *
+ *	Sets the command/variable resolution procedures for a namespace,
+ *	thereby changing the way that command/variable names are
+ *	interpreted.  This allows extension writers to support different
+ *	name resolution schemes, such as those for object-oriented
+ *	packages.
+ *
+ *	Command resolution is handled by a procedure of the following
+ *	type:
+ *
+ *	  typedef int (Tcl_ResolveCmdProc) _ANSI_ARGS_((
+ *		Tcl_Interp* interp, char* name, Tcl_Namespace *context,
+ *              int flags, Tcl_Command *rPtr));
+ *          
+ *	Whenever a command is executed or Tcl_FindCommand is invoked
+ *	within the namespace, this procedure is called to resolve the
+ *	command name.  If this procedure is able to resolve the name,
+ *	it should return the status code TCL_OK, along with the
+ *	corresponding Tcl_Command in the rPtr argument.  Otherwise,
+ *	the procedure can return TCL_CONTINUE, and the command will
+ *	be treated under the usual name resolution rules.  Or, it can
+ *	return TCL_ERROR, and the command will be considered invalid.
+ *
+ *	Variable resolution is handled by two procedures.  The first
+ *	is called whenever a variable needs to be resolved at compile
+ *	time:
+ *
+ *        typedef int (Tcl_ResolveCompiledVarProc) _ANSI_ARGS_((
+ *	        Tcl_Interp* interp, char* name, Tcl_Namespace *context,
+ *	        Tcl_ResolvedVarInfo *rPtr));
+ *
+ *      If this procedure is able to resolve the name, it should return
+ *      the status code TCL_OK, along with variable resolution info in
+ *      the rPtr argument; this info will be used to set up compiled
+ *	locals in the call frame at runtime.  The procedure may also
+ *	return TCL_CONTINUE, and the variable will be treated under
+ *	the usual name resolution rules.  Or, it can return TCL_ERROR,
+ *	and the variable will be considered invalid.
+ *
+ *	Another procedure is used whenever a variable needs to be
+ *	resolved at runtime but it is not recognized as a compiled local.
+ *	(For example, the variable may be requested via
+ *	Tcl_FindNamespaceVar.) This procedure has the following type:
+ *
+ *	  typedef int (Tcl_ResolveVarProc) _ANSI_ARGS_((
+ *	        Tcl_Interp* interp, char* name, Tcl_Namespace *context,
+ *	        int flags, Tcl_Var *rPtr));
+ *
+ *	This procedure is quite similar to the compile-time version.
+ *	It returns the same status codes, but if variable resolution
+ *	succeeds, this procedure returns a Tcl_Var directly via the
+ *	rPtr argument.
+ *
+ * Results:
+ *	Nothing.
+ *
+ * Side effects:
+ *	Bumps the command epoch counter for the namespace, invalidating
+ *	all command references in that namespace.  Also bumps the
+ *	resolver epoch counter for the namespace, forcing all code
+ *	in the namespace to be recompiled.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetNamespaceResolvers(namespacePtr, cmdProc, varProc, compiledVarProc)
+    Tcl_Namespace *namespacePtr;	/* Namespace whose resolution rules
+					 * are being modified. */
+    Tcl_ResolveCmdProc *cmdProc;	/* Procedure for command resolution */
+    Tcl_ResolveVarProc *varProc;	/* Procedure for variable resolution
+					 * at runtime */
+    Tcl_ResolveCompiledVarProc *compiledVarProc;
+					/* Procedure for variable resolution
+					 * at compile time. */
+{
+    Namespace *nsPtr = (Namespace*)namespacePtr;
+
+    /*
+     *  Plug in the new command resolver, and bump the epoch counters
+     *  so that all code will have to be recompiled and all commands
+     *  will have to be resolved again using the new policy.
+     */
+    nsPtr->cmdResProc = cmdProc;
+    nsPtr->varResProc = varProc;
+    nsPtr->compiledVarResProc = compiledVarProc;
+
+    nsPtr->cmdRefEpoch++;
+    nsPtr->resolverEpoch++;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetNamespaceResolvers --
+ *
+ *	Returns the current command/variable resolution procedures
+ *	for a namespace.  By default, these procedures are NULL.
+ *	New procedures can be installed by calling
+ *	Tcl_SetNamespaceResolvers, to provide new name resolution
+ *	rules.
+ *
+ * Results:
+ *	Returns non-zero if any name resolution procedures have been
+ *	assigned to this namespace; also returns pointers to the
+ *	procedures in the Tcl_ResolverInfo structure.  Returns zero
+ *	otherwise.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetNamespaceResolvers(namespacePtr, resInfoPtr)
+
+    Tcl_Namespace *namespacePtr;	/* Namespace whose resolution rules
+					 * are being modified. */
+    Tcl_ResolverInfo *resInfoPtr;	/* Returns: pointers for all
+					 * name resolution procedures
+					 * assigned to this namespace. */
+{
+    Namespace *nsPtr = (Namespace*)namespacePtr;
+
+    resInfoPtr->cmdResProc = nsPtr->cmdResProc;
+    resInfoPtr->varResProc = nsPtr->varResProc;
+    resInfoPtr->compiledVarResProc = nsPtr->compiledVarResProc;
+
+    if (nsPtr->cmdResProc != NULL ||
+        nsPtr->varResProc != NULL ||
+        nsPtr->compiledVarResProc != NULL) {
+	return 1;
+    }
+    return 0;
+}
Index: /trunk/tcl/tclStringObj.c
===================================================================
--- /trunk/tcl/tclStringObj.c	(revision 2)
+++ /trunk/tcl/tclStringObj.c	(revision 2)
@@ -0,0 +1,608 @@
+/* 
+ * tclStringObj.c --
+ *
+ *	This file contains procedures that implement string operations
+ *	on Tcl objects.  To do this efficiently (i.e. to allow many
+ *	appends to be done to an object without constantly reallocating
+ *	the space for the string representation) we overallocate the
+ *	space for the string and use the internal representation to keep
+ *	track of the extra space.  Objects with this internal
+ *	representation are called "expandable string objects".
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclStringObj.c,v 1.1 2008-06-04 13:58:10 demin Exp $
+ */
+
+#include "tclInt.h"
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static void		ConvertToStringType _ANSI_ARGS_((Tcl_Obj *objPtr));
+static void		DupStringInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
+			    Tcl_Obj *copyPtr));
+static int		SetStringFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr));
+static void		UpdateStringOfString _ANSI_ARGS_((Tcl_Obj *objPtr));
+
+/*
+ * The structure below defines the string Tcl object type by means of
+ * procedures that can be invoked by generic object code.
+ */
+
+Tcl_ObjType tclStringType = {
+    "string",				/* name */
+    (Tcl_FreeInternalRepProc *) NULL,	/* freeIntRepProc */
+    DupStringInternalRep,		/* dupIntRepProc */
+    UpdateStringOfString,		/* updateStringProc */
+    SetStringFromAny			/* setFromAnyProc */
+};
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NewStringObj --
+ *
+ *	This procedure is normally called when not debugging: i.e., when
+ *	TCL_MEM_DEBUG is not defined. It creates a new string object and
+ *	initializes it from the byte pointer and length arguments.
+ *
+ *	When TCL_MEM_DEBUG is defined, this procedure just returns the
+ *	result of calling the debugging version Tcl_DbNewStringObj.
+ *
+ * Results:
+ *	A newly created string object is returned that has ref count zero.
+ *
+ * Side effects:
+ *	The new object's internal string representation will be set to a
+ *	copy of the length bytes starting at "bytes". If "length" is
+ *	negative, use bytes up to the first NULL byte; i.e., assume "bytes"
+ *	points to a C-style NULL-terminated string. The object's type is set
+ *	to NULL. An extra NULL is added to the end of the new object's byte
+ *	array.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+#undef Tcl_NewStringObj
+
+Tcl_Obj *
+Tcl_NewStringObj(bytes, length)
+    register char *bytes;	/* Points to the first of the length bytes
+				 * used to initialize the new object. */
+    register int length;	/* The number of bytes to copy from "bytes"
+				 * when initializing the new object. If 
+				 * negative, use bytes up to the first
+				 * NULL byte. */
+{
+    return Tcl_DbNewStringObj(bytes, length, "unknown", 0);
+}
+
+#else /* if not TCL_MEM_DEBUG */
+
+Tcl_Obj *
+Tcl_NewStringObj(bytes, length)
+    register char *bytes;	/* Points to the first of the length bytes
+				 * used to initialize the new object. */
+    register int length;	/* The number of bytes to copy from "bytes"
+				 * when initializing the new object. If 
+				 * negative, use bytes up to the first
+				 * NULL byte. */
+{
+    register Tcl_Obj *objPtr;
+
+    if (length < 0) {
+	length = (bytes? strlen(bytes) : 0);
+    }
+    TclNewObj(objPtr);
+    TclInitStringRep(objPtr, bytes, length);
+    return objPtr;
+}
+#endif /* TCL_MEM_DEBUG */
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DbNewStringObj --
+ *
+ *	This procedure is normally called when debugging: i.e., when
+ *	TCL_MEM_DEBUG is defined. It creates new string objects. It is the
+ *	same as the Tcl_NewStringObj procedure above except that it calls
+ *	Tcl_DbCkalloc directly with the file name and line number from its
+ *	caller. This simplifies debugging since then the checkmem command
+ *	will report the correct file name and line number when reporting
+ *	objects that haven't been freed.
+ *
+ *	When TCL_MEM_DEBUG is not defined, this procedure just returns the
+ *	result of calling Tcl_NewStringObj.
+ *
+ * Results:
+ *	A newly created string object is returned that has ref count zero.
+ *
+ * Side effects:
+ *	The new object's internal string representation will be set to a
+ *	copy of the length bytes starting at "bytes". If "length" is
+ *	negative, use bytes up to the first NULL byte; i.e., assume "bytes"
+ *	points to a C-style NULL-terminated string. The object's type is set
+ *	to NULL. An extra NULL is added to the end of the new object's byte
+ *	array.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+
+Tcl_Obj *
+Tcl_DbNewStringObj(bytes, length, file, line)
+    register char *bytes;	/* Points to the first of the length bytes
+				 * used to initialize the new object. */
+    register int length;	/* The number of bytes to copy from "bytes"
+				 * when initializing the new object. If 
+				 * negative, use bytes up to the first
+				 * NULL byte. */
+    char *file;			/* The name of the source file calling this
+				 * procedure; used for debugging. */
+    int line;			/* Line number in the source file; used
+				 * for debugging. */
+{
+    register Tcl_Obj *objPtr;
+
+    if (length < 0) {
+	length = (bytes? strlen(bytes) : 0);
+    }
+    TclDbNewObj(objPtr, file, line);
+    TclInitStringRep(objPtr, bytes, length);
+    return objPtr;
+}
+
+#else /* if not TCL_MEM_DEBUG */
+
+Tcl_Obj *
+Tcl_DbNewStringObj(bytes, length, file, line)
+    register char *bytes;	/* Points to the first of the length bytes
+				 * used to initialize the new object. */
+    register int length;	/* The number of bytes to copy from "bytes"
+				 * when initializing the new object. If 
+				 * negative, use bytes up to the first
+				 * NULL byte. */
+    char *file;			/* The name of the source file calling this
+				 * procedure; used for debugging. */
+    int line;			/* Line number in the source file; used
+				 * for debugging. */
+{
+    return Tcl_NewStringObj(bytes, length);
+}
+#endif /* TCL_MEM_DEBUG */
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetStringObj --
+ *
+ *	Modify an object to hold a string that is a copy of the bytes
+ *	indicated by the byte pointer and length arguments. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's string representation will be set to a copy of
+ *	the "length" bytes starting at "bytes". If "length" is negative, use
+ *	bytes up to the first NULL byte; i.e., assume "bytes" points to a
+ *	C-style NULL-terminated string. The object's old string and internal
+ *	representations are freed and the object's type is set NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetStringObj(objPtr, bytes, length)
+    register Tcl_Obj *objPtr;	/* Object whose internal rep to init. */
+    char *bytes;		/* Points to the first of the length bytes
+				 * used to initialize the object. */
+    register int length;	/* The number of bytes to copy from "bytes"
+				 * when initializing the object. If 
+				 * negative, use bytes up to the first
+				 * NULL byte.*/
+{
+    register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+
+    /*
+     * Free any old string rep, then set the string rep to a copy of
+     * the length bytes starting at "bytes".
+     */
+
+    if (Tcl_IsShared(objPtr)) {
+	panic("Tcl_SetStringObj called with shared object");
+    }
+
+    Tcl_InvalidateStringRep(objPtr);
+    if (length < 0) {
+	length = strlen(bytes);
+    }
+    TclInitStringRep(objPtr, bytes, length);
+        
+    /*
+     * Set the type to NULL and free any internal rep for the old type.
+     */
+
+    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+    }
+    objPtr->typePtr = NULL;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetObjLength --
+ *
+ *	This procedure changes the length of the string representation
+ *	of an object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	If the size of objPtr's string representation is greater than
+ *	length, then it is reduced to length and a new terminating null
+ *	byte is stored in the strength.  If the length of the string
+ *	representation is greater than length, the storage space is
+ *	reallocated to the given length; a null byte is stored at the
+ *	end, but other bytes past the end of the original string
+ *	representation are undefined.  The object's internal
+ *	representation is changed to "expendable string".
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetObjLength(objPtr, length)
+    register Tcl_Obj *objPtr;	/* Pointer to object.  This object must
+				 * not currently be shared. */
+    register int length;	/* Number of bytes desired for string
+				 * representation of object, not including
+				 * terminating null byte. */
+{
+    char *new;
+
+    if (Tcl_IsShared(objPtr)) {
+	panic("Tcl_SetObjLength called with shared object");
+    }
+    if (objPtr->typePtr != &tclStringType) {
+	ConvertToStringType(objPtr);
+    }
+    
+    if ((long)length > objPtr->internalRep.longValue) {
+	/*
+	 * Not enough space in current string. Reallocate the string
+	 * space and free the old string.
+	 */
+
+	new = (char *) ckalloc((unsigned) (length+1));
+	if (objPtr->bytes != NULL) {
+	    memcpy((VOID *) new, (VOID *) objPtr->bytes,
+		    (size_t) objPtr->length);
+	    Tcl_InvalidateStringRep(objPtr);
+	}
+	objPtr->bytes = new;
+	objPtr->internalRep.longValue = (long) length;
+    }
+    objPtr->length = length;
+    if ((objPtr->bytes != NULL) && (objPtr->bytes != tclEmptyStringRep)) {
+	objPtr->bytes[length] = 0;
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AppendToObj --
+ *
+ *	This procedure appends a sequence of bytes to an object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The bytes at *bytes are appended to the string representation
+ *	of objPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AppendToObj(objPtr, bytes, length)
+    register Tcl_Obj *objPtr;	/* Points to the object to append to. */
+    char *bytes;		/* Points to the bytes to append to the
+				 * object. */
+    register int length;	/* The number of bytes to append from
+				 * "bytes". If < 0, then append all bytes
+				 * up to NULL byte. */
+{
+    int newLength, oldLength;
+
+    if (Tcl_IsShared(objPtr)) {
+	panic("Tcl_AppendToObj called with shared object");
+    }
+    if (objPtr->typePtr != &tclStringType) {
+	ConvertToStringType(objPtr);
+    }
+    if (length < 0) {
+	length = strlen(bytes);
+    }
+    if (length == 0) {
+	return;
+    }
+    oldLength = objPtr->length;
+    newLength = length + oldLength;
+    if ((long)newLength > objPtr->internalRep.longValue) {
+	/*
+	 * There isn't currently enough space in the string
+	 * representation so allocate additional space.  In fact,
+	 * overallocate so that there is room for future growth without
+	 * having to reallocate again.
+	 */
+
+	Tcl_SetObjLength(objPtr, 2*newLength);
+    }
+    if (length > 0) {
+	memcpy((VOID *) (objPtr->bytes + oldLength), (VOID *) bytes,
+	       (size_t) length);
+	objPtr->length = newLength;
+	objPtr->bytes[objPtr->length] = 0;
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AppendStringsToObj --
+ *
+ *	This procedure appends one or more null-terminated strings
+ *	to an object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The contents of all the string arguments are appended to the
+ *	string representation of objPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AppendStringsToObj TCL_VARARGS_DEF(Tcl_Obj *,arg1)
+{
+    va_list argList;
+    register Tcl_Obj *objPtr;
+    int newLength, oldLength;
+    register char *string, *dst;
+
+    objPtr = (Tcl_Obj *) TCL_VARARGS_START(Tcl_Obj *,arg1,argList);
+    if (Tcl_IsShared(objPtr)) {
+	panic("Tcl_AppendStringsToObj called with shared object");
+    }
+    if (objPtr->typePtr != &tclStringType) {
+	ConvertToStringType(objPtr);
+    }
+
+    /*
+     * Figure out how much space is needed for all the strings, and
+     * expand the string representation if it isn't big enough. If no
+     * bytes would be appended, just return.
+     */
+
+    newLength = oldLength = objPtr->length;
+    while (1) {
+	string = va_arg(argList, char *);
+	if (string == NULL) {
+	    break;
+	}
+	newLength += strlen(string);
+    }
+    if (newLength == oldLength) {
+	return;
+    }
+
+    if ((long)newLength > objPtr->internalRep.longValue) {
+	/*
+	 * There isn't currently enough space in the string
+	 * representation so allocate additional space.  If the current
+	 * string representation isn't empty (i.e. it looks like we're
+	 * doing a series of appends) then overallocate the space so
+	 * that we won't have to do as much reallocation in the future.
+	 */
+
+	Tcl_SetObjLength(objPtr,
+		(objPtr->length == 0) ? newLength : 2*newLength);
+    }
+
+    /*
+     * Make a second pass through the arguments, appending all the
+     * strings to the object.
+     */
+
+    TCL_VARARGS_START(Tcl_Obj *,arg1,argList);
+    dst = objPtr->bytes + oldLength;
+    while (1) {
+	string = va_arg(argList, char *);
+	if (string == NULL) {
+	    break;
+	}
+	while (*string != 0) {
+	    *dst = *string;
+	    dst++;
+	    string++;
+	}
+    }
+
+    /*
+     * Add a null byte to terminate the string.  However, be careful:
+     * it's possible that the object is totally empty (if it was empty
+     * originally and there was nothing to append).  In this case dst is
+     * NULL; just leave everything alone.
+     */
+
+    if (dst != NULL) {
+	*dst = 0;
+    }
+    objPtr->length = newLength;
+    va_end(argList);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConvertToStringType --
+ *
+ *	This procedure converts the internal representation of an object
+ *	to "expandable string" type.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Any old internal reputation for objPtr is freed and the
+ *	internal representation is set to that for an expandable string
+ *	(the field internalRep.longValue holds 1 less than the allocated
+ *	length of objPtr's string representation).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ConvertToStringType(objPtr)
+    register Tcl_Obj *objPtr;	/* Pointer to object.  Must have a
+				 * typePtr that isn't &tclStringType. */
+{
+    if (objPtr->typePtr != NULL) {
+	if (objPtr->bytes == NULL) {
+	    objPtr->typePtr->updateStringProc(objPtr);
+	}
+	if (objPtr->typePtr->freeIntRepProc != NULL) {
+	    objPtr->typePtr->freeIntRepProc(objPtr);
+	}
+    }
+    objPtr->typePtr = &tclStringType;
+    if (objPtr->bytes != NULL) {
+	objPtr->internalRep.longValue = (long)objPtr->length;
+    } else {
+	objPtr->internalRep.longValue = 0;
+	objPtr->length = 0;
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupStringInternalRep --
+ *
+ *	Initialize the internal representation of a new Tcl_Obj to a
+ *	copy of the internal representation of an existing string object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	copyPtr's internal rep is set to a copy of srcPtr's internal
+ *	representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupStringInternalRep(srcPtr, copyPtr)
+    register Tcl_Obj *srcPtr;	/* Object with internal rep to copy.  Must
+				 * have an internal representation of type
+				 * "expandable string". */
+    register Tcl_Obj *copyPtr;	/* Object with internal rep to set.  Must
+				 * not currently have an internal rep.*/
+{
+    /*
+     * Tricky point: the string value was copied by generic object
+     * management code, so it doesn't contain any extra bytes that
+     * might exist in the source object.
+     */
+
+    copyPtr->internalRep.longValue = (long)copyPtr->length;
+    copyPtr->typePtr = &tclStringType;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetStringFromAny --
+ *
+ *	Create an internal representation of type "expandable string"
+ *	for an object.
+ *
+ * Results:
+ *	This operation always succeeds and returns TCL_OK.
+ *
+ * Side effects:
+ *	This procedure does nothing; there is no advantage in converting
+ *	the internal representation now, so we just defer it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetStringFromAny(interp, objPtr)
+    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
+    Tcl_Obj *objPtr;		/* The object to convert. */
+{
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfString --
+ *
+ *	Update the string representation for an object whose internal
+ *	representation is "expandable string".
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfString(objPtr)
+    Tcl_Obj *objPtr;		/* Object with string rep to update. */
+{
+    /*
+     * The string is almost always valid already, in which case there's
+     * nothing for us to do. The only case we have to worry about is if
+     * the object is totally null. In this case, set the string rep to
+     * an empty string.
+     */
+
+    if (objPtr->bytes == NULL) {
+	objPtr->bytes = tclEmptyStringRep;
+	objPtr->length = 0;
+    }
+    return;
+}
Index: /trunk/tcl/tclUnixPort.h
===================================================================
--- /trunk/tcl/tclUnixPort.h	(revision 2)
+++ /trunk/tcl/tclUnixPort.h	(revision 2)
@@ -0,0 +1,49 @@
+/*
+ * tclUnixPort.h --
+ *
+ *	This header file handles porting issues that occur because
+ *	of differences between systems.  It reads in UNIX-related
+ *	header files and sets up UNIX-related macros for Tcl's UNIX
+ *	core.  It should be the only file that contains #ifdefs to
+ *	handle different flavors of UNIX.  This file sets up the
+ *	union of all UNIX-related things needed by any of the Tcl
+ *	core files.  This file depends on configuration #defines such
+ *	as NO_DIRENT_H that are set up by the "configure" script.
+ *
+ *	Much of the material in this file was originally contributed
+ *	by Karl Lehenbauer, Mark Diekhans and Peter da Silva.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclUnixPort.h,v 1.1 2008-06-04 13:58:11 demin Exp $
+ */
+
+#ifndef _TCLUNIXPORT
+#define _TCLUNIXPORT
+
+#include <errno.h>
+#include <fcntl.h>
+#include <sys/stat.h>
+
+/*
+ * Define access mode constants if they aren't already defined.
+ */
+
+#ifndef F_OK
+#    define F_OK 00
+#endif
+#ifndef X_OK
+#    define X_OK 01
+#endif
+#ifndef W_OK
+#    define W_OK 02
+#endif
+#ifndef R_OK
+#    define R_OK 04
+#endif
+
+#endif /* _TCLUNIXPORT */
Index: /trunk/tcl/tclUtil.c
===================================================================
--- /trunk/tcl/tclUtil.c	(revision 2)
+++ /trunk/tcl/tclUtil.c	(revision 2)
@@ -0,0 +1,2659 @@
+/* 
+ * tclUtil.c --
+ *
+ *	This file contains utility procedures that are used by many Tcl
+ *	commands.
+ *
+ * Copyright (c) 1987-1993 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ *  RCS: @(#) $Id: tclUtil.c,v 1.1 2008-06-04 13:58:11 demin Exp $
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ * The following variable holds the full path name of the binary
+ * from which this application was executed, or NULL if it isn't
+ * know.  The value of the variable is set by the procedure
+ * Tcl_FindExecutable.  The storage space is dynamically allocated.
+ */
+ 
+char *tclExecutableName = NULL;
+
+/*
+ * The following values are used in the flags returned by Tcl_ScanElement
+ * and used by Tcl_ConvertElement.  The value TCL_DONT_USE_BRACES is also
+ * defined in tcl.h;  make sure its value doesn't overlap with any of the
+ * values below.
+ *
+ * TCL_DONT_USE_BRACES -	1 means the string mustn't be enclosed in
+ *				braces (e.g. it contains unmatched braces,
+ *				or ends in a backslash character, or user
+ *				just doesn't want braces);  handle all
+ *				special characters by adding backslashes.
+ * USE_BRACES -			1 means the string contains a special
+ *				character that can be handled simply by
+ *				enclosing the entire argument in braces.
+ * BRACES_UNMATCHED -		1 means that braces aren't properly matched
+ *				in the argument.
+ */
+
+#define USE_BRACES		2
+#define BRACES_UNMATCHED	4
+
+/*
+ * The following values determine the precision used when converting
+ * floating-point values to strings.  This information is linked to all
+ * of the tcl_precision variables in all interpreters via the procedure
+ * TclPrecTraceProc.
+ *
+ * NOTE: these variables are not thread-safe.
+ */
+
+static char precisionString[10] = "12";
+				/* The string value of all the tcl_precision
+				 * variables. */
+static char precisionFormat[10] = "%.12g";
+				/* The format string actually used in calls
+				 * to sprintf. */
+
+
+/*
+ * Function prototypes for local procedures in this file:
+ */
+
+static void		SetupAppendBuffer _ANSI_ARGS_((Interp *iPtr,
+			    int newSpace));
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFindElement --
+ *
+ *	Given a pointer into a Tcl list, locate the first (or next)
+ *	element in the list.
+ *
+ * Results:
+ *	The return value is normally TCL_OK, which means that the
+ *	element was successfully located.  If TCL_ERROR is returned
+ *	it means that list didn't have proper list structure;
+ *	interp->result contains a more detailed error message.
+ *
+ *	If TCL_OK is returned, then *elementPtr will be set to point to the
+ *	first element of list, and *nextPtr will be set to point to the
+ *	character just after any white space following the last character
+ *	that's part of the element. If this is the last argument in the
+ *	list, then *nextPtr will point just after the last character in the
+ *	list (i.e., at the character at list+listLength). If sizePtr is
+ *	non-NULL, *sizePtr is filled in with the number of characters in the
+ *	element.  If the element is in braces, then *elementPtr will point
+ *	to the character after the opening brace and *sizePtr will not
+ *	include either of the braces. If there isn't an element in the list,
+ *	*sizePtr will be zero, and both *elementPtr and *termPtr will point
+ *	just after the last character in the list. Note: this procedure does
+ *	NOT collapse backslash sequences.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
+	       bracePtr)
+    Tcl_Interp *interp;		/* Interpreter to use for error reporting. 
+				 * If NULL, then no error message is left
+				 * after errors. */
+    char *list;			/* Points to the first byte of a string
+				 * containing a Tcl list with zero or more
+				 * elements (possibly in braces). */
+    int listLength;		/* Number of bytes in the list's string. */
+    char **elementPtr;		/* Where to put address of first significant
+				 * character in first element of list. */
+    char **nextPtr;		/* Fill in with location of character just
+				 * after all white space following end of
+				 * argument (next arg or end of list). */
+    int *sizePtr;		/* If non-zero, fill in with size of
+				 * element. */
+    int *bracePtr;		/* If non-zero, fill in with non-zero/zero
+				 * to indicate that arg was/wasn't
+				 * in braces. */
+{
+    char *p = list;
+    char *elemStart;		/* Points to first byte of first element. */
+    char *limit;		/* Points just after list's last byte. */
+    int openBraces = 0;		/* Brace nesting level during parse. */
+    int inQuotes = 0;
+    int size = 0;		/* Init. avoids compiler warning. */
+    int numChars;
+    char *p2;
+    
+    /*
+     * Skim off leading white space and check for an opening brace or
+     * quote. We treat embedded NULLs in the list as bytes belonging to
+     * a list element. Note: use of "isascii" below and elsewhere in this
+     * procedure is a temporary hack (7/27/90) because Mx uses characters
+     * with the high-order bit set for some things. This should probably
+     * be changed back eventually, or all of Tcl should call isascii.
+     */
+
+    limit = (list + listLength);
+    while ((p < limit) && (isspace(UCHAR(*p)))) {
+	p++;
+    }
+    if (p == limit) {		/* no element found */
+	elemStart = limit;
+	goto done;
+    }
+
+    if (*p == '{') {
+	openBraces = 1;
+	p++;
+    } else if (*p == '"') {
+	inQuotes = 1;
+	p++;
+    }
+    elemStart = p;
+    if (bracePtr != 0) {
+	*bracePtr = openBraces;
+    }
+
+    /*
+     * Find element's end (a space, close brace, or the end of the string).
+     */
+
+    while (p < limit) {
+	switch (*p) {
+
+	    /*
+	     * Open brace: don't treat specially unless the element is in
+	     * braces. In this case, keep a nesting count.
+	     */
+
+	    case '{':
+		if (openBraces != 0) {
+		    openBraces++;
+		}
+		break;
+
+	    /*
+	     * Close brace: if element is in braces, keep nesting count and
+	     * quit when the last close brace is seen.
+	     */
+
+	    case '}':
+		if (openBraces > 1) {
+		    openBraces--;
+		} else if (openBraces == 1) {
+		    size = (p - elemStart);
+		    p++;
+		    if ((p >= limit) || isspace(UCHAR(*p))) {
+			goto done;
+		    }
+
+		    /*
+		     * Garbage after the closing brace; return an error.
+		     */
+		    
+		    if (interp != NULL) {
+			char buf[100];
+			
+			p2 = p;
+			while ((p2 < limit) && (!isspace(UCHAR(*p2)))
+			        && (p2 < p+20)) {
+			    p2++;
+			}
+			sprintf(buf,
+				"list element in braces followed by \"%.*s\" instead of space",
+				(int) (p2-p), p);
+			Tcl_SetResult(interp, buf, TCL_VOLATILE);
+		    }
+		    return TCL_ERROR;
+		}
+		break;
+
+	    /*
+	     * Backslash:  skip over everything up to the end of the
+	     * backslash sequence.
+	     */
+
+	    case '\\': {
+		(void) Tcl_Backslash(p, &numChars);
+		p += (numChars - 1);
+		break;
+	    }
+
+	    /*
+	     * Space: ignore if element is in braces or quotes; otherwise
+	     * terminate element.
+	     */
+
+	    case ' ':
+	    case '\f':
+	    case '\n':
+	    case '\r':
+	    case '\t':
+	    case '\v':
+		if ((openBraces == 0) && !inQuotes) {
+		    size = (p - elemStart);
+		    goto done;
+		}
+		break;
+
+	    /*
+	     * Double-quote: if element is in quotes then terminate it.
+	     */
+
+	    case '"':
+		if (inQuotes) {
+		    size = (p - elemStart);
+		    p++;
+		    if ((p >= limit) || isspace(UCHAR(*p))) {
+			goto done;
+		    }
+
+		    /*
+		     * Garbage after the closing quote; return an error.
+		     */
+		    
+		    if (interp != NULL) {
+			char buf[100];
+			
+			p2 = p;
+			while ((p2 < limit) && (!isspace(UCHAR(*p2)))
+				 && (p2 < p+20)) {
+			    p2++;
+			}
+			sprintf(buf,
+				"list element in quotes followed by \"%.*s\" %s",
+				(int) (p2-p), p, "instead of space");
+			Tcl_SetResult(interp, buf, TCL_VOLATILE);
+		    }
+		    return TCL_ERROR;
+		}
+		break;
+	}
+	p++;
+    }
+
+
+    /*
+     * End of list: terminate element.
+     */
+
+    if (p == limit) {
+	if (openBraces != 0) {
+	    if (interp != NULL) {
+		Tcl_SetResult(interp, "unmatched open brace in list",
+			TCL_STATIC);
+	    }
+	    return TCL_ERROR;
+	} else if (inQuotes) {
+	    if (interp != NULL) {
+		Tcl_SetResult(interp, "unmatched open quote in list",
+			TCL_STATIC);
+	    }
+	    return TCL_ERROR;
+	}
+	size = (p - elemStart);
+    }
+
+    done:
+    while ((p < limit) && (isspace(UCHAR(*p)))) {
+	p++;
+    }
+    *elementPtr = elemStart;
+    *nextPtr = p;
+    if (sizePtr != 0) {
+	*sizePtr = size;
+    }
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCopyAndCollapse --
+ *
+ *	Copy a string and eliminate any backslashes that aren't in braces.
+ *
+ * Results:
+ *	There is no return value. Count characters get copied from src to
+ *	dst. Along the way, if backslash sequences are found outside braces,
+ *	the backslashes are eliminated in the copy. After scanning count
+ *	chars from source, a null character is placed at the end of dst.
+ *	Returns the number of characters that got copied.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCopyAndCollapse(count, src, dst)
+    int count;			/* Number of characters to copy from src. */
+    char *src;			/* Copy from here... */
+    char *dst;			/* ... to here. */
+{
+    char c;
+    int numRead;
+    int newCount = 0;
+
+    for (c = *src;  count > 0;  src++, c = *src, count--) {
+	if (c == '\\') {
+	    *dst = Tcl_Backslash(src, &numRead);
+	    dst++;
+	    src += numRead-1;
+	    count -= numRead-1;
+	    newCount++;
+	} else {
+	    *dst = c;
+	    dst++;
+	    newCount++;
+	}
+    }
+    *dst = 0;
+    return newCount;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SplitList --
+ *
+ *	Splits a list up into its constituent fields.
+ *
+ * Results
+ *	The return value is normally TCL_OK, which means that
+ *	the list was successfully split up.  If TCL_ERROR is
+ *	returned, it means that "list" didn't have proper list
+ *	structure;  interp->result will contain a more detailed
+ *	error message.
+ *
+ *	*argvPtr will be filled in with the address of an array
+ *	whose elements point to the elements of list, in order.
+ *	*argcPtr will get filled in with the number of valid elements
+ *	in the array.  A single block of memory is dynamically allocated
+ *	to hold both the argv array and a copy of the list (with
+ *	backslashes and braces removed in the standard way).
+ *	The caller must eventually free this memory by calling free()
+ *	on *argvPtr.  Note:  *argvPtr and *argcPtr are only modified
+ *	if the procedure returns normally.
+ *
+ * Side effects:
+ *	Memory is allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_SplitList(interp, list, argcPtr, argvPtr)
+    Tcl_Interp *interp;		/* Interpreter to use for error reporting. 
+				 * If NULL, no error message is left. */
+    char *list;			/* Pointer to string with list structure. */
+    int *argcPtr;		/* Pointer to location to fill in with
+				 * the number of elements in the list. */
+    char ***argvPtr;		/* Pointer to place to store pointer to
+				 * array of pointers to list elements. */
+{
+    char **argv;
+    char *p;
+    int length, size, i, result, elSize, brace;
+    char *element;
+
+    /*
+     * Figure out how much space to allocate.  There must be enough
+     * space for both the array of pointers and also for a copy of
+     * the list.  To estimate the number of pointers needed, count
+     * the number of space characters in the list.
+     */
+
+    for (size = 1, p = list; *p != 0; p++) {
+	if (isspace(UCHAR(*p))) {
+	    size++;
+	}
+    }
+    size++;			/* Leave space for final NULL pointer. */
+    argv = (char **) ckalloc((unsigned)
+	    ((size * sizeof(char *)) + (p - list) + 1));
+    length = strlen(list);
+    for (i = 0, p = ((char *) argv) + size*sizeof(char *);
+	    *list != 0;  i++) {
+	char *prevList = list;
+	
+	result = TclFindElement(interp, list, length, &element,
+				&list, &elSize, &brace);
+	length -= (list - prevList);
+	if (result != TCL_OK) {
+	    ckfree((char *) argv);
+	    return result;
+	}
+	if (*element == 0) {
+	    break;
+	}
+	if (i >= size) {
+	    ckfree((char *) argv);
+	    if (interp != NULL) {
+		Tcl_SetResult(interp, "internal error in Tcl_SplitList",
+			TCL_STATIC);
+	    }
+	    return TCL_ERROR;
+	}
+	argv[i] = p;
+	if (brace) {
+	    memcpy((VOID *) p, (VOID *) element, (size_t) elSize);
+	    p += elSize;
+	    *p = 0;
+	    p++;
+	} else {
+	    TclCopyAndCollapse(elSize, element, p);
+	    p += elSize+1;
+	}
+    }
+
+    argv[i] = NULL;
+    *argvPtr = argv;
+    *argcPtr = i;
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ScanElement --
+ *
+ *	This procedure is a companion procedure to Tcl_ConvertElement.
+ *	It scans a string to see what needs to be done to it (e.g. add
+ *	backslashes or enclosing braces) to make the string into a
+ *	valid Tcl list element.
+ *
+ * Results:
+ *	The return value is an overestimate of the number of characters
+ *	that will be needed by Tcl_ConvertElement to produce a valid
+ *	list element from string.  The word at *flagPtr is filled in
+ *	with a value needed by Tcl_ConvertElement when doing the actual
+ *	conversion.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ScanElement(string, flagPtr)
+    CONST char *string;		/* String to convert to Tcl list element. */
+    int *flagPtr;		/* Where to store information to guide
+				 * Tcl_ConvertCountedElement. */
+{
+    return Tcl_ScanCountedElement(string, -1, flagPtr);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ScanCountedElement --
+ *
+ *	This procedure is a companion procedure to
+ *	Tcl_ConvertCountedElement.  It scans a string to see what
+ *	needs to be done to it (e.g. add backslashes or enclosing
+ *	braces) to make the string into a valid Tcl list element.
+ *	If length is -1, then the string is scanned up to the first
+ *	null byte.
+ *
+ * Results:
+ *	The return value is an overestimate of the number of characters
+ *	that will be needed by Tcl_ConvertCountedElement to produce a
+ *	valid list element from string.  The word at *flagPtr is
+ *	filled in with a value needed by Tcl_ConvertCountedElement
+ *	when doing the actual conversion.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ScanCountedElement(string, length, flagPtr)
+    CONST char *string;		/* String to convert to Tcl list element. */
+    int length;			/* Number of bytes in string, or -1. */
+    int *flagPtr;		/* Where to store information to guide
+				 * Tcl_ConvertElement. */
+{
+    int flags, nestingLevel;
+    CONST char *p, *lastChar;
+
+    /*
+     * This procedure and Tcl_ConvertElement together do two things:
+     *
+     * 1. They produce a proper list, one that will yield back the
+     * argument strings when evaluated or when disassembled with
+     * Tcl_SplitList.  This is the most important thing.
+     * 
+     * 2. They try to produce legible output, which means minimizing the
+     * use of backslashes (using braces instead).  However, there are
+     * some situations where backslashes must be used (e.g. an element
+     * like "{abc": the leading brace will have to be backslashed.
+     * For each element, one of three things must be done:
+     *
+     * (a) Use the element as-is (it doesn't contain any special
+     * characters).  This is the most desirable option.
+     *
+     * (b) Enclose the element in braces, but leave the contents alone.
+     * This happens if the element contains embedded space, or if it
+     * contains characters with special interpretation ($, [, ;, or \),
+     * or if it starts with a brace or double-quote, or if there are
+     * no characters in the element.
+     *
+     * (c) Don't enclose the element in braces, but add backslashes to
+     * prevent special interpretation of special characters.  This is a
+     * last resort used when the argument would normally fall under case
+     * (b) but contains unmatched braces.  It also occurs if the last
+     * character of the argument is a backslash or if the element contains
+     * a backslash followed by newline.
+     *
+     * The procedure figures out how many bytes will be needed to store
+     * the result (actually, it overestimates). It also collects information
+     * about the element in the form of a flags word.
+     *
+     * Note: list elements produced by this procedure and
+     * Tcl_ConvertCountedElement must have the property that they can be
+     * enclosing in curly braces to make sub-lists.  This means, for
+     * example, that we must not leave unmatched curly braces in the
+     * resulting list element.  This property is necessary in order for
+     * procedures like Tcl_DStringStartSublist to work.
+     */
+
+    nestingLevel = 0;
+    flags = 0;
+    if (string == NULL) {
+	string = "";
+    }
+    if (length == -1) {
+	length = strlen(string);
+    }
+    lastChar = string + length;
+    p = string;
+    if ((p == lastChar) || (*p == '{') || (*p == '"')) {
+	flags |= USE_BRACES;
+    }
+    for ( ; p != lastChar; p++) {
+	switch (*p) {
+	    case '{':
+		nestingLevel++;
+		break;
+	    case '}':
+		nestingLevel--;
+		if (nestingLevel < 0) {
+		    flags |= TCL_DONT_USE_BRACES|BRACES_UNMATCHED;
+		}
+		break;
+	    case '[':
+	    case '$':
+	    case ';':
+	    case ' ':
+	    case '\f':
+	    case '\n':
+	    case '\r':
+	    case '\t':
+	    case '\v':
+		flags |= USE_BRACES;
+		break;
+	    case '\\':
+		if ((p+1 == lastChar) || (p[1] == '\n')) {
+		    flags = TCL_DONT_USE_BRACES | BRACES_UNMATCHED;
+		} else {
+		    int size;
+
+		    (void) Tcl_Backslash(p, &size);
+		    p += size-1;
+		    flags |= USE_BRACES;
+		}
+		break;
+	}
+    }
+    if (nestingLevel != 0) {
+	flags = TCL_DONT_USE_BRACES | BRACES_UNMATCHED;
+    }
+    *flagPtr = flags;
+
+    /*
+     * Allow enough space to backslash every character plus leave
+     * two spaces for braces.
+     */
+
+    return 2*(p-string) + 2;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ConvertElement --
+ *
+ *	This is a companion procedure to Tcl_ScanElement.  Given
+ *	the information produced by Tcl_ScanElement, this procedure
+ *	converts a string to a list element equal to that string.
+ *
+ * Results:
+ *	Information is copied to *dst in the form of a list element
+ *	identical to src (i.e. if Tcl_SplitList is applied to dst it
+ *	will produce a string identical to src).  The return value is
+ *	a count of the number of characters copied (not including the
+ *	terminating NULL character).
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ConvertElement(src, dst, flags)
+    CONST char *src;		/* Source information for list element. */
+    char *dst;			/* Place to put list-ified element. */
+    int flags;			/* Flags produced by Tcl_ScanElement. */
+{
+    return Tcl_ConvertCountedElement(src, -1, dst, flags);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ConvertCountedElement --
+ *
+ *	This is a companion procedure to Tcl_ScanCountedElement.  Given
+ *	the information produced by Tcl_ScanCountedElement, this
+ *	procedure converts a string to a list element equal to that
+ *	string.
+ *
+ * Results:
+ *	Information is copied to *dst in the form of a list element
+ *	identical to src (i.e. if Tcl_SplitList is applied to dst it
+ *	will produce a string identical to src).  The return value is
+ *	a count of the number of characters copied (not including the
+ *	terminating NULL character).
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ConvertCountedElement(src, length, dst, flags)
+    CONST char *src;		/* Source information for list element. */
+    int length;			/* Number of bytes in src, or -1. */
+    char *dst;			/* Place to put list-ified element. */
+    int flags;			/* Flags produced by Tcl_ScanElement. */
+{
+    char *p = dst;
+    CONST char *lastChar;
+
+    /*
+     * See the comment block at the beginning of the Tcl_ScanElement
+     * code for details of how this works.
+     */
+
+    if (src && length == -1) {
+	length = strlen(src);
+    }
+    if ((src == NULL) || (length == 0)) {
+	p[0] = '{';
+	p[1] = '}';
+	p[2] = 0;
+	return 2;
+    }
+    lastChar = src + length;
+    if ((flags & USE_BRACES) && !(flags & TCL_DONT_USE_BRACES)) {
+	*p = '{';
+	p++;
+	for ( ; src != lastChar; src++, p++) {
+	    *p = *src;
+	}
+	*p = '}';
+	p++;
+    } else {
+	if (*src == '{') {
+	    /*
+	     * Can't have a leading brace unless the whole element is
+	     * enclosed in braces.  Add a backslash before the brace.
+	     * Furthermore, this may destroy the balance between open
+	     * and close braces, so set BRACES_UNMATCHED.
+	     */
+
+	    p[0] = '\\';
+	    p[1] = '{';
+	    p += 2;
+	    src++;
+	    flags |= BRACES_UNMATCHED;
+	}
+	for (; src != lastChar; src++) {
+	    switch (*src) {
+		case ']':
+		case '[':
+		case '$':
+		case ';':
+		case ' ':
+		case '\\':
+		case '"':
+		    *p = '\\';
+		    p++;
+		    break;
+		case '{':
+		case '}':
+		    /*
+		     * It may not seem necessary to backslash braces, but
+		     * it is.  The reason for this is that the resulting
+		     * list element may actually be an element of a sub-list
+		     * enclosed in braces (e.g. if Tcl_DStringStartSublist
+		     * has been invoked), so there may be a brace mismatch
+		     * if the braces aren't backslashed.
+		     */
+
+		    if (flags & BRACES_UNMATCHED) {
+			*p = '\\';
+			p++;
+		    }
+		    break;
+		case '\f':
+		    *p = '\\';
+		    p++;
+		    *p = 'f';
+		    p++;
+		    continue;
+		case '\n':
+		    *p = '\\';
+		    p++;
+		    *p = 'n';
+		    p++;
+		    continue;
+		case '\r':
+		    *p = '\\';
+		    p++;
+		    *p = 'r';
+		    p++;
+		    continue;
+		case '\t':
+		    *p = '\\';
+		    p++;
+		    *p = 't';
+		    p++;
+		    continue;
+		case '\v':
+		    *p = '\\';
+		    p++;
+		    *p = 'v';
+		    p++;
+		    continue;
+	    }
+	    *p = *src;
+	    p++;
+	}
+    }
+    *p = '\0';
+    return p-dst;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Merge --
+ *
+ *	Given a collection of strings, merge them together into a
+ *	single string that has proper Tcl list structured (i.e.
+ *	Tcl_SplitList may be used to retrieve strings equal to the
+ *	original elements, and Tcl_Eval will parse the string back
+ *	into its original elements).
+ *
+ * Results:
+ *	The return value is the address of a dynamically-allocated
+ *	string containing the merged list.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_Merge(argc, argv)
+    int argc;			/* How many strings to merge. */
+    char **argv;		/* Array of string values. */
+{
+#   define LOCAL_SIZE 20
+    int localFlags[LOCAL_SIZE], *flagPtr;
+    int numChars;
+    char *result;
+    char *dst;
+    int i;
+
+    /*
+     * Pass 1: estimate space, gather flags.
+     */
+
+    if (argc <= LOCAL_SIZE) {
+	flagPtr = localFlags;
+    } else {
+	flagPtr = (int *) ckalloc((unsigned) argc*sizeof(int));
+    }
+    numChars = 1;
+    for (i = 0; i < argc; i++) {
+	numChars += Tcl_ScanElement(argv[i], &flagPtr[i]) + 1;
+    }
+
+    /*
+     * Pass two: copy into the result area.
+     */
+
+    result = (char *) ckalloc((unsigned) numChars);
+    dst = result;
+    for (i = 0; i < argc; i++) {
+	numChars = Tcl_ConvertElement(argv[i], dst, flagPtr[i]);
+	dst += numChars;
+	*dst = ' ';
+	dst++;
+    }
+    if (dst == result) {
+	*dst = 0;
+    } else {
+	dst[-1] = 0;
+    }
+
+    if (flagPtr != localFlags) {
+	ckfree((char *) flagPtr);
+    }
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Concat --
+ *
+ *	Concatenate a set of strings into a single large string.
+ *
+ * Results:
+ *	The return value is dynamically-allocated string containing
+ *	a concatenation of all the strings in argv, with spaces between
+ *	the original argv elements.
+ *
+ * Side effects:
+ *	Memory is allocated for the result;  the caller is responsible
+ *	for freeing the memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_Concat(argc, argv)
+    int argc;			/* Number of strings to concatenate. */
+    char **argv;		/* Array of strings to concatenate. */
+{
+    int totalSize, i;
+    char *p;
+    char *result;
+
+    for (totalSize = 1, i = 0; i < argc; i++) {
+	totalSize += strlen(argv[i]) + 1;
+    }
+    result = (char *) ckalloc((unsigned) totalSize);
+    if (argc == 0) {
+	*result = '\0';
+	return result;
+    }
+    for (p = result, i = 0; i < argc; i++) {
+	char *element;
+	int length;
+
+	/*
+	 * Clip white space off the front and back of the string
+	 * to generate a neater result, and ignore any empty
+	 * elements.
+	 */
+
+	element = argv[i];
+	while (isspace(UCHAR(*element))) {
+	    element++;
+	}
+	for (length = strlen(element);
+		(length > 0) && (isspace(UCHAR(element[length-1])))
+		&& ((length < 2) || (element[length-2] != '\\'));
+		length--) {
+	    /* Null loop body. */
+	}
+	if (length == 0) {
+	    continue;
+	}
+	memcpy((VOID *) p, (VOID *) element, (size_t) length);
+	p += length;
+	*p = ' ';
+	p++;
+    }
+    if (p != result) {
+	p[-1] = 0;
+    } else {
+	*p = 0;
+    }
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ConcatObj --
+ *
+ *	Concatenate the strings from a set of objects into a single string
+ *	object with spaces between the original strings.
+ *
+ * Results:
+ *	The return value is a new string object containing a concatenation
+ *	of the strings in objv. Its ref count is zero.
+ *
+ * Side effects:
+ *	A new object is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_ConcatObj(objc, objv)
+    int objc;			/* Number of objects to concatenate. */
+    Tcl_Obj *CONST objv[];	/* Array of objects to concatenate. */
+{
+    int allocSize, finalSize, length, elemLength, i;
+    char *p;
+    char *element;
+    char *concatStr;
+    Tcl_Obj *objPtr;
+
+    allocSize = 0;
+    for (i = 0;  i < objc;  i++) {
+	objPtr = objv[i];
+	element = TclGetStringFromObj(objPtr, &length);
+	if ((element != NULL) && (length > 0)) {
+	    allocSize += (length + 1);
+	}
+    }
+    if (allocSize == 0) {
+	allocSize = 1;		/* enough for the NULL byte at end */
+    }
+
+    /*
+     * Allocate storage for the concatenated result. Note that allocSize
+     * is one more than the total number of characters, and so includes
+     * room for the terminating NULL byte.
+     */
+    
+    concatStr = (char *) ckalloc((unsigned) allocSize);
+
+    /*
+     * Now concatenate the elements. Clip white space off the front and back
+     * to generate a neater result, and ignore any empty elements. Also put
+     * a null byte at the end.
+     */
+
+    finalSize = 0;
+    if (objc == 0) {
+	*concatStr = '\0';
+    } else {
+	p = concatStr;
+        for (i = 0;  i < objc;  i++) {
+	    objPtr = objv[i];
+	    element = TclGetStringFromObj(objPtr, &elemLength);
+	    while ((elemLength > 0) && (isspace(UCHAR(*element)))) {
+	         element++;
+		 elemLength--;
+	    }
+
+	    /*
+	     * Trim trailing white space.  But, be careful not to trim
+	     * a space character if it is preceded by a backslash: in
+	     * this case it could be significant.
+	     */
+
+	    while ((elemLength > 0)
+		    && isspace(UCHAR(element[elemLength-1]))
+		    && ((elemLength < 2) || (element[elemLength-2] != '\\'))) {
+		elemLength--;
+	    }
+	    if (elemLength == 0) {
+	         continue;	/* nothing left of this element */
+	    }
+	    memcpy((VOID *) p, (VOID *) element, (size_t) elemLength);
+	    p += elemLength;
+	    *p = ' ';
+	    p++;
+	    finalSize += (elemLength + 1);
+        }
+        if (p != concatStr) {
+	    p[-1] = 0;
+	    finalSize -= 1;	/* we overwrote the final ' ' */
+        } else {
+	    *p = 0;
+        }
+    }
+    
+    TclNewObj(objPtr);
+    objPtr->bytes  = concatStr;
+    objPtr->length = finalSize;
+    return objPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_StringMatch --
+ *
+ *	See if a particular string matches a particular pattern.
+ *
+ * Results:
+ *	The return value is 1 if string matches pattern, and
+ *	0 otherwise.  The matching operation permits the following
+ *	special characters in the pattern: *?\[] (see the manual
+ *	entry for details on what these mean).
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_StringMatch(string, pattern)
+    char *string;		/* String. */
+    char *pattern;		/* Pattern, which may contain special
+				 * characters. */
+{
+    char c2;
+
+    while (1) {
+	/* See if we're at the end of both the pattern and the string.
+	 * If so, we succeeded.  If we're at the end of the pattern
+	 * but not at the end of the string, we failed.
+	 */
+	
+	if (*pattern == 0) {
+	    if (*string == 0) {
+		return 1;
+	    } else {
+		return 0;
+	    }
+	}
+	if ((*string == 0) && (*pattern != '*')) {
+	    return 0;
+	}
+
+	/* Check for a "*" as the next pattern character.  It matches
+	 * any substring.  We handle this by calling ourselves
+	 * recursively for each postfix of string, until either we
+	 * match or we reach the end of the string.
+	 */
+	
+	if (*pattern == '*') {
+	    pattern += 1;
+	    if (*pattern == 0) {
+		return 1;
+	    }
+	    while (1) {
+		if (Tcl_StringMatch(string, pattern)) {
+		    return 1;
+		}
+		if (*string == 0) {
+		    return 0;
+		}
+		string += 1;
+	    }
+	}
+    
+	/* Check for a "?" as the next pattern character.  It matches
+	 * any single character.
+	 */
+
+	if (*pattern == '?') {
+	    goto thisCharOK;
+	}
+
+	/* Check for a "[" as the next pattern character.  It is followed
+	 * by a list of characters that are acceptable, or by a range
+	 * (two characters separated by "-").
+	 */
+	
+	if (*pattern == '[') {
+	    pattern += 1;
+	    while (1) {
+		if ((*pattern == ']') || (*pattern == 0)) {
+		    return 0;
+		}
+		if (*pattern == *string) {
+		    break;
+		}
+		if (pattern[1] == '-') {
+		    c2 = pattern[2];
+		    if (c2 == 0) {
+			return 0;
+		    }
+		    if ((*pattern <= *string) && (c2 >= *string)) {
+			break;
+		    }
+		    if ((*pattern >= *string) && (c2 <= *string)) {
+			break;
+		    }
+		    pattern += 2;
+		}
+		pattern += 1;
+	    }
+	    while (*pattern != ']') {
+		if (*pattern == 0) {
+		    pattern--;
+		    break;
+		}
+		pattern += 1;
+	    }
+	    goto thisCharOK;
+	}
+    
+	/* If the next pattern character is '/', just strip off the '/'
+	 * so we do exact matching on the character that follows.
+	 */
+	
+	if (*pattern == '\\') {
+	    pattern += 1;
+	    if (*pattern == 0) {
+		return 0;
+	    }
+	}
+
+	/* There's no special character.  Just make sure that the next
+	 * characters of each string match.
+	 */
+	
+	if (*pattern != *string) {
+	    return 0;
+	}
+
+	thisCharOK: pattern += 1;
+	string += 1;
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetResult --
+ *
+ *	Arrange for "string" to be the Tcl return value.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	interp->result is left pointing either to "string" (if "copy" is 0)
+ *	or to a copy of string. Also, the object result is reset.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetResult(interp, string, freeProc)
+    Tcl_Interp *interp;		/* Interpreter with which to associate the
+				 * return value. */
+    char *string;		/* Value to be returned.  If NULL, the
+				 * result is set to an empty string. */
+    Tcl_FreeProc *freeProc;	/* Gives information about the string:
+				 * TCL_STATIC, TCL_VOLATILE, or the address
+				 * of a Tcl_FreeProc such as free. */
+{
+    Interp *iPtr = (Interp *) interp;
+    int length;
+    Tcl_FreeProc *oldFreeProc = iPtr->freeProc;
+    char *oldResult = iPtr->result;
+
+    if (string == NULL) {
+	iPtr->resultSpace[0] = 0;
+	iPtr->result = iPtr->resultSpace;
+	iPtr->freeProc = 0;
+    } else if (freeProc == TCL_VOLATILE) {
+	length = strlen(string);
+	if (length > TCL_RESULT_SIZE) {
+	    iPtr->result = (char *) ckalloc((unsigned) length+1);
+	    iPtr->freeProc = TCL_DYNAMIC;
+	} else {
+	    iPtr->result = iPtr->resultSpace;
+	    iPtr->freeProc = 0;
+	}
+	strcpy(iPtr->result, string);
+    } else {
+	iPtr->result = string;
+	iPtr->freeProc = freeProc;
+    }
+
+    /*
+     * If the old result was dynamically-allocated, free it up.  Do it
+     * here, rather than at the beginning, in case the new result value
+     * was part of the old result value.
+     */
+
+    if (oldFreeProc != 0) {
+	if ((oldFreeProc == TCL_DYNAMIC)
+		|| (oldFreeProc == (Tcl_FreeProc *) free)) {
+	    ckfree(oldResult);
+	} else {
+	    (*oldFreeProc)(oldResult);
+	}
+    }
+
+    /*
+     * Reset the object result since we just set the string result.
+     */
+
+    TclResetObjResult(iPtr);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetStringResult --
+ *
+ *	Returns an interpreter's result value as a string.
+ *
+ * Results:
+ *	The interpreter's result as a string.
+ *
+ * Side effects:
+ *	If the string result is empty, the object result is moved to the
+ *	string result, then the object result is reset.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_GetStringResult(interp)
+     Tcl_Interp *interp;	/* Interpreter whose result to return. */
+{
+    /*
+     * If the string result is empty, move the object result to the
+     * string result, then reset the object result.
+     * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
+     */
+    
+    if (*(interp->result) == 0) {
+	Tcl_SetResult(interp,
+	        TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
+	        TCL_VOLATILE);
+    }
+    return interp->result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetObjResult --
+ *
+ *	Arrange for objPtr to be an interpreter's result value.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	interp->objResultPtr is left pointing to the object referenced
+ *	by objPtr. The object's reference count is incremented since
+ *	there is now a new reference to it. The reference count for any
+ *	old objResultPtr value is decremented. Also, the string result
+ *	is reset.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetObjResult(interp, objPtr)
+    Tcl_Interp *interp;		/* Interpreter with which to associate the
+				 * return object value. */
+    Tcl_Obj *objPtr;		/* Tcl object to be returned. If NULL, the
+				 * obj result is made an empty string
+				 * object. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_Obj *oldObjResult = iPtr->objResultPtr;
+
+    iPtr->objResultPtr = objPtr;
+    Tcl_IncrRefCount(objPtr);	/* since interp result is a reference */
+
+    /*
+     * We wait until the end to release the old object result, in case
+     * we are setting the result to itself.
+     */
+    
+    TclDecrRefCount(oldObjResult);
+
+    /*
+     * Reset the string result since we just set the result object.
+     */
+
+    if (iPtr->freeProc != NULL) {
+	if ((iPtr->freeProc == TCL_DYNAMIC)
+	        || (iPtr->freeProc == (Tcl_FreeProc *) free)) {
+	    ckfree(iPtr->result);
+	} else {
+	    (*iPtr->freeProc)(iPtr->result);
+	}
+	iPtr->freeProc = 0;
+    }
+    iPtr->result = iPtr->resultSpace;
+    iPtr->resultSpace[0] = 0;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetObjResult --
+ *
+ *	Returns an interpreter's result value as a Tcl object. The object's
+ *	reference count is not modified; the caller must do that if it
+ *	needs to hold on to a long-term reference to it.
+ *
+ * Results:
+ *	The interpreter's result as an object.
+ *
+ * Side effects:
+ *	If the interpreter has a non-empty string result, the result object
+ *	is either empty or stale because some procedure set interp->result
+ *	directly. If so, the string result is moved to the result object
+ *	then the string result is reset.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_GetObjResult(interp)
+    Tcl_Interp *interp;		/* Interpreter whose result to return. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_Obj *objResultPtr;
+    int length;
+
+    /*
+     * If the string result is non-empty, move the string result to the
+     * object result, then reset the string result.
+     */
+    
+    if (*(iPtr->result) != 0) {
+	TclResetObjResult(iPtr);
+	
+	objResultPtr = iPtr->objResultPtr;
+	length = strlen(iPtr->result);
+	TclInitStringRep(objResultPtr, iPtr->result, length);
+	
+	if (iPtr->freeProc != NULL) {
+	    if ((iPtr->freeProc == TCL_DYNAMIC)
+	            || (iPtr->freeProc == (Tcl_FreeProc *) free)) {
+		ckfree(iPtr->result);
+	    } else {
+		(*iPtr->freeProc)(iPtr->result);
+	    }
+	    iPtr->freeProc = 0;
+	}
+	iPtr->result = iPtr->resultSpace;
+	iPtr->resultSpace[0] = 0;
+    }
+    return iPtr->objResultPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AppendResult --
+ *
+ *	Append a variable number of strings onto the interpreter's string
+ *	result.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The result of the interpreter given by the first argument is
+ *	extended by the strings given by the second and following arguments
+ *	(up to a terminating NULL argument).
+ *
+ *	If the string result is empty, the object result is moved to the
+ *	string result, then the object result is reset.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1)
+{
+    va_list argList;
+    Interp *iPtr;
+    char *string;
+    int newSpace;
+
+    /*
+     * If the string result is empty, move the object result to the
+     * string result, then reset the object result.
+     * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
+     */
+
+    iPtr = (Interp *) TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
+    if (*(iPtr->result) == 0) {
+	Tcl_SetResult((Tcl_Interp *) iPtr,
+	        TclGetStringFromObj(Tcl_GetObjResult((Tcl_Interp *) iPtr),
+		        (int *) NULL),
+	        TCL_VOLATILE);
+    }
+    
+    /*
+     * Scan through all the arguments to see how much space is needed.
+     */
+
+    newSpace = 0;
+    while (1) {
+	string = va_arg(argList, char *);
+	if (string == NULL) {
+	    break;
+	}
+	newSpace += strlen(string);
+    }
+    va_end(argList);
+
+    /*
+     * If the append buffer isn't already setup and large enough to hold
+     * the new data, set it up.
+     */
+
+    if ((iPtr->result != iPtr->appendResult)
+	    || (iPtr->appendResult[iPtr->appendUsed] != 0)
+	    || ((newSpace + iPtr->appendUsed) >= iPtr->appendAvl)) {
+       SetupAppendBuffer(iPtr, newSpace);
+    }
+
+    /*
+     * Now go through all the argument strings again, copying them into the
+     * buffer.
+     */
+
+    TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
+    while (1) {
+	string = va_arg(argList, char *);
+	if (string == NULL) {
+	    break;
+	}
+	strcpy(iPtr->appendResult + iPtr->appendUsed, string);
+	iPtr->appendUsed += strlen(string);
+    }
+    va_end(argList);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AppendElement --
+ *
+ *	Convert a string to a valid Tcl list element and append it to the
+ *	result (which is ostensibly a list).
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The result in the interpreter given by the first argument is
+ *	extended with a list element converted from string. A separator
+ *	space is added before the converted list element unless the current
+ *	result is empty, contains the single character "{", or ends in " {".
+ *
+ *	If the string result is empty, the object result is moved to the
+ *	string result, then the object result is reset.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AppendElement(interp, string)
+    Tcl_Interp *interp;		/* Interpreter whose result is to be
+				 * extended. */
+    char *string;		/* String to convert to list element and
+				 * add to result. */
+{
+    Interp *iPtr = (Interp *) interp;
+    char *dst;
+    int size;
+    int flags;
+
+    /*
+     * If the string result is empty, move the object result to the
+     * string result, then reset the object result.
+     * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
+     */
+
+    if (*(iPtr->result) == 0) {
+	Tcl_SetResult(interp,
+	        TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
+	        TCL_VOLATILE);
+    }
+
+    /*
+     * See how much space is needed, and grow the append buffer if
+     * needed to accommodate the list element.
+     */
+
+    size = Tcl_ScanElement(string, &flags) + 1;
+    if ((iPtr->result != iPtr->appendResult)
+	    || (iPtr->appendResult[iPtr->appendUsed] != 0)
+	    || ((size + iPtr->appendUsed) >= iPtr->appendAvl)) {
+       SetupAppendBuffer(iPtr, size+iPtr->appendUsed);
+    }
+
+    /*
+     * Convert the string into a list element and copy it to the
+     * buffer that's forming, with a space separator if needed.
+     */
+
+    dst = iPtr->appendResult + iPtr->appendUsed;
+    if (TclNeedSpace(iPtr->appendResult, dst)) {
+	iPtr->appendUsed++;
+	*dst = ' ';
+	dst++;
+    }
+    iPtr->appendUsed += Tcl_ConvertElement(string, dst, flags);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetupAppendBuffer --
+ *
+ *	This procedure makes sure that there is an append buffer properly
+ *	initialized, if necessary, from the interpreter's result, and
+ *	that it has at least enough room to accommodate newSpace new
+ *	bytes of information.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SetupAppendBuffer(iPtr, newSpace)
+    Interp *iPtr;		/* Interpreter whose result is being set up. */
+    int newSpace;		/* Make sure that at least this many bytes
+				 * of new information may be added. */
+{
+    int totalSpace;
+
+    /*
+     * Make the append buffer larger, if that's necessary, then copy the
+     * result into the append buffer and make the append buffer the official
+     * Tcl result.
+     */
+
+    if (iPtr->result != iPtr->appendResult) {
+	/*
+	 * If an oversized buffer was used recently, then free it up
+	 * so we go back to a smaller buffer.  This avoids tying up
+	 * memory forever after a large operation.
+	 */
+
+	if (iPtr->appendAvl > 500) {
+	    ckfree(iPtr->appendResult);
+	    iPtr->appendResult = NULL;
+	    iPtr->appendAvl = 0;
+	}
+	iPtr->appendUsed = strlen(iPtr->result);
+    } else if (iPtr->result[iPtr->appendUsed] != 0) {
+	/*
+	 * Most likely someone has modified a result created by
+	 * Tcl_AppendResult et al. so that it has a different size.
+	 * Just recompute the size.
+	 */
+
+	iPtr->appendUsed = strlen(iPtr->result);
+    }
+    
+    totalSpace = newSpace + iPtr->appendUsed;
+    if (totalSpace >= iPtr->appendAvl) {
+	char *new;
+
+	if (totalSpace < 100) {
+	    totalSpace = 200;
+	} else {
+	    totalSpace *= 2;
+	}
+	new = (char *) ckalloc((unsigned) totalSpace);
+	strcpy(new, iPtr->result);
+	if (iPtr->appendResult != NULL) {
+	    ckfree(iPtr->appendResult);
+	}
+	iPtr->appendResult = new;
+	iPtr->appendAvl = totalSpace;
+    } else if (iPtr->result != iPtr->appendResult) {
+	strcpy(iPtr->appendResult, iPtr->result);
+    }
+    
+    Tcl_FreeResult((Tcl_Interp *) iPtr);
+    iPtr->result = iPtr->appendResult;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FreeResult --
+ *
+ *	This procedure frees up the memory associated with an interpreter's
+ *	string result. It also resets the interpreter's result object.
+ *	Tcl_FreeResult is most commonly used when a procedure is about to
+ *	replace one result value with another.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Frees the memory associated with interp's string result and sets
+ *	interp->freeProc to zero, but does not change interp->result or
+ *	clear error state. Resets interp's result object to an unshared
+ *	empty object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_FreeResult(interp)
+    Tcl_Interp *interp;		/* Interpreter for which to free result. */
+{
+    Interp *iPtr = (Interp *) interp;
+    
+    if (iPtr->freeProc != NULL) {
+	if ((iPtr->freeProc == TCL_DYNAMIC)
+	        || (iPtr->freeProc == (Tcl_FreeProc *) free)) {
+	    ckfree(iPtr->result);
+	} else {
+	    (*iPtr->freeProc)(iPtr->result);
+	}
+	iPtr->freeProc = 0;
+    }
+    
+    TclResetObjResult(iPtr);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ResetResult --
+ *
+ *	This procedure resets both the interpreter's string and object
+ *	results.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	It resets the result object to an unshared empty object. It
+ *	then restores the interpreter's string result area to its default
+ *	initialized state, freeing up any memory that may have been
+ *	allocated. It also clears any error information for the interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_ResetResult(interp)
+    Tcl_Interp *interp;		/* Interpreter for which to clear result. */
+{
+    Interp *iPtr = (Interp *) interp;
+
+    TclResetObjResult(iPtr);
+    
+    Tcl_FreeResult(interp);
+    iPtr->result = iPtr->resultSpace;
+    iPtr->resultSpace[0] = 0;
+    
+    iPtr->flags &= ~(ERR_ALREADY_LOGGED | ERR_IN_PROGRESS | ERROR_CODE_SET);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetErrorCode --
+ *
+ *	This procedure is called to record machine-readable information
+ *	about an error that is about to be returned.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The errorCode global variable is modified to hold all of the
+ *	arguments to this procedure, in a list form with each argument
+ *	becoming one element of the list.  A flag is set internally
+ *	to remember that errorCode has been set, so the variable doesn't
+ *	get set automatically when the error is returned.
+ *
+ *----------------------------------------------------------------------
+ */
+	/* VARARGS2 */
+void
+Tcl_SetErrorCode TCL_VARARGS_DEF(Tcl_Interp *,arg1)
+{
+    va_list argList;
+    char *string;
+    int flags;
+    Interp *iPtr;
+
+    /*
+     * Scan through the arguments one at a time, appending them to
+     * $errorCode as list elements.
+     */
+
+    iPtr = (Interp *) TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
+    flags = TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT;
+    while (1) {
+	string = va_arg(argList, char *);
+	if (string == NULL) {
+	    break;
+	}
+	(void) Tcl_SetVar2((Tcl_Interp *) iPtr, "errorCode",
+		(char *) NULL, string, flags);
+	flags |= TCL_APPEND_VALUE;
+    }
+    va_end(argList);
+    iPtr->flags |= ERROR_CODE_SET;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetObjErrorCode --
+ *
+ *	This procedure is called to record machine-readable information
+ *	about an error that is about to be returned. The caller should
+ *	build a list object up and pass it to this routine.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The errorCode global variable is modified to be the new value.
+ *	A flag is set internally to remember that errorCode has been
+ *	set, so the variable doesn't get set automatically when the
+ *	error is returned.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetObjErrorCode(interp, errorObjPtr)
+    Tcl_Interp *interp;
+    Tcl_Obj *errorObjPtr;
+{
+    Tcl_Obj *namePtr;
+    Interp *iPtr;
+    
+    namePtr = Tcl_NewStringObj("errorCode", -1);
+    iPtr = (Interp *) interp;
+    Tcl_ObjSetVar2(interp, namePtr, (Tcl_Obj *) NULL, errorObjPtr,
+	    TCL_GLOBAL_ONLY);
+    iPtr->flags |= ERROR_CODE_SET;
+    Tcl_DecrRefCount(namePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DStringInit --
+ *
+ *	Initializes a dynamic string, discarding any previous contents
+ *	of the string (Tcl_DStringFree should have been called already
+ *	if the dynamic string was previously in use).
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The dynamic string is initialized to be empty.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DStringInit(dsPtr)
+    Tcl_DString *dsPtr;		/* Pointer to structure for dynamic string. */
+{
+    dsPtr->string = dsPtr->staticSpace;
+    dsPtr->length = 0;
+    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
+    dsPtr->staticSpace[0] = 0;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DStringAppend --
+ *
+ *	Append more characters to the current value of a dynamic string.
+ *
+ * Results:
+ *	The return value is a pointer to the dynamic string's new value.
+ *
+ * Side effects:
+ *	Length bytes from string (or all of string if length is less
+ *	than zero) are added to the current value of the string. Memory
+ *	gets reallocated if needed to accomodate the string's new size.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_DStringAppend(dsPtr, string, length)
+    Tcl_DString *dsPtr;		/* Structure describing dynamic string. */
+    CONST char *string;		/* String to append.  If length is -1 then
+				 * this must be null-terminated. */
+    int length;			/* Number of characters from string to
+				 * append.  If < 0, then append all of string,
+				 * up to null at end. */
+{
+    int newSize;
+    char *newString, *dst;
+    CONST char *end;
+
+    if (length < 0) {
+	length = strlen(string);
+    }
+    newSize = length + dsPtr->length;
+
+    /*
+     * Allocate a larger buffer for the string if the current one isn't
+     * large enough. Allocate extra space in the new buffer so that there
+     * will be room to grow before we have to allocate again.
+     */
+
+    if (newSize >= dsPtr->spaceAvl) {
+	dsPtr->spaceAvl = newSize*2;
+	newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
+	memcpy((VOID *) newString, (VOID *) dsPtr->string,
+		(size_t) dsPtr->length);
+	if (dsPtr->string != dsPtr->staticSpace) {
+	    ckfree(dsPtr->string);
+	}
+	dsPtr->string = newString;
+    }
+
+    /*
+     * Copy the new string into the buffer at the end of the old
+     * one.
+     */
+
+    for (dst = dsPtr->string + dsPtr->length, end = string+length;
+	    string < end; string++, dst++) {
+	*dst = *string;
+    }
+    *dst = '\0';
+    dsPtr->length += length;
+    return dsPtr->string;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DStringAppendElement --
+ *
+ *	Append a list element to the current value of a dynamic string.
+ *
+ * Results:
+ *	The return value is a pointer to the dynamic string's new value.
+ *
+ * Side effects:
+ *	String is reformatted as a list element and added to the current
+ *	value of the string.  Memory gets reallocated if needed to
+ *	accomodate the string's new size.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_DStringAppendElement(dsPtr, string)
+    Tcl_DString *dsPtr;		/* Structure describing dynamic string. */
+    CONST char *string;		/* String to append.  Must be
+				 * null-terminated. */
+{
+    int newSize, flags;
+    char *dst, *newString;
+
+    newSize = Tcl_ScanElement(string, &flags) + dsPtr->length + 1;
+
+    /*
+     * Allocate a larger buffer for the string if the current one isn't
+     * large enough.  Allocate extra space in the new buffer so that there
+     * will be room to grow before we have to allocate again.
+     * SPECIAL NOTE: must use memcpy, not strcpy, to copy the string
+     * to a larger buffer, since there may be embedded NULLs in the
+     * string in some cases.
+     */
+
+    if (newSize >= dsPtr->spaceAvl) {
+	dsPtr->spaceAvl = newSize*2;
+	newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
+	memcpy((VOID *) newString, (VOID *) dsPtr->string,
+		(size_t) dsPtr->length);
+	if (dsPtr->string != dsPtr->staticSpace) {
+	    ckfree(dsPtr->string);
+	}
+	dsPtr->string = newString;
+    }
+
+    /*
+     * Convert the new string to a list element and copy it into the
+     * buffer at the end, with a space, if needed.
+     */
+
+    dst = dsPtr->string + dsPtr->length;
+    if (TclNeedSpace(dsPtr->string, dst)) {
+	*dst = ' ';
+	dst++;
+	dsPtr->length++;
+    }
+    dsPtr->length += Tcl_ConvertElement(string, dst, flags);
+    return dsPtr->string;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DStringSetLength --
+ *
+ *	Change the length of a dynamic string.  This can cause the
+ *	string to either grow or shrink, depending on the value of
+ *	length.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The length of dsPtr is changed to length and a null byte is
+ *	stored at that position in the string.  If length is larger
+ *	than the space allocated for dsPtr, then a panic occurs.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DStringSetLength(dsPtr, length)
+    Tcl_DString *dsPtr;		/* Structure describing dynamic string. */
+    int length;			/* New length for dynamic string. */
+{
+    if (length < 0) {
+	length = 0;
+    }
+    if (length >= dsPtr->spaceAvl) {
+	char *newString;
+
+	dsPtr->spaceAvl = length+1;
+	newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
+
+	/*
+	 * SPECIAL NOTE: must use memcpy, not strcpy, to copy the string
+	 * to a larger buffer, since there may be embedded NULLs in the
+	 * string in some cases.
+	 */
+
+	memcpy((VOID *) newString, (VOID *) dsPtr->string,
+		(size_t) dsPtr->length);
+	if (dsPtr->string != dsPtr->staticSpace) {
+	    ckfree(dsPtr->string);
+	}
+	dsPtr->string = newString;
+    }
+    dsPtr->length = length;
+    dsPtr->string[length] = 0;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DStringFree --
+ *
+ *	Frees up any memory allocated for the dynamic string and
+ *	reinitializes the string to an empty state.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The previous contents of the dynamic string are lost, and
+ *	the new value is an empty string.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DStringFree(dsPtr)
+    Tcl_DString *dsPtr;		/* Structure describing dynamic string. */
+{
+    if (dsPtr->string != dsPtr->staticSpace) {
+	ckfree(dsPtr->string);
+    }
+    dsPtr->string = dsPtr->staticSpace;
+    dsPtr->length = 0;
+    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
+    dsPtr->staticSpace[0] = 0;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DStringResult --
+ *
+ *	This procedure moves the value of a dynamic string into an
+ *	interpreter as its string result. Afterwards, the dynamic string
+ *	is reset to an empty string.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The string is "moved" to interp's result, and any existing
+ *	string result for interp is freed. dsPtr is reinitialized to
+ *	an empty string.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DStringResult(interp, dsPtr)
+    Tcl_Interp *interp;		/* Interpreter whose result is to be reset. */
+    Tcl_DString *dsPtr;		/* Dynamic string that is to become the
+				 * result of interp. */
+{
+    Tcl_ResetResult(interp);
+    
+    if (dsPtr->string != dsPtr->staticSpace) {
+	interp->result = dsPtr->string;
+	interp->freeProc = TCL_DYNAMIC;
+    } else if (dsPtr->length < TCL_RESULT_SIZE) {
+	interp->result = ((Interp *) interp)->resultSpace;
+	strcpy(interp->result, dsPtr->string);
+    } else {
+	Tcl_SetResult(interp, dsPtr->string, TCL_VOLATILE);
+    }
+    
+    dsPtr->string = dsPtr->staticSpace;
+    dsPtr->length = 0;
+    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
+    dsPtr->staticSpace[0] = 0;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DStringGetResult --
+ *
+ *	This procedure moves an interpreter's result into a dynamic string.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The interpreter's string result is cleared, and the previous
+ *	contents of dsPtr are freed.
+ *
+ *	If the string result is empty, the object result is moved to the
+ *	string result, then the object result is reset.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DStringGetResult(interp, dsPtr)
+    Tcl_Interp *interp;		/* Interpreter whose result is to be reset. */
+    Tcl_DString *dsPtr;		/* Dynamic string that is to become the
+				 * result of interp. */
+{
+    Interp *iPtr = (Interp *) interp;
+    
+    if (dsPtr->string != dsPtr->staticSpace) {
+	ckfree(dsPtr->string);
+    }
+
+    /*
+     * If the string result is empty, move the object result to the
+     * string result, then reset the object result.
+     * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
+     */
+
+    if (*(iPtr->result) == 0) {
+	Tcl_SetResult(interp,
+	        TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
+	        TCL_VOLATILE);
+    }
+
+    dsPtr->length = strlen(iPtr->result);
+    if (iPtr->freeProc != NULL) {
+	if ((iPtr->freeProc == TCL_DYNAMIC)
+		|| (iPtr->freeProc == (Tcl_FreeProc *) free)) {
+	    dsPtr->string = iPtr->result;
+	    dsPtr->spaceAvl = dsPtr->length+1;
+	} else {
+	    dsPtr->string = (char *) ckalloc((unsigned) (dsPtr->length+1));
+	    strcpy(dsPtr->string, iPtr->result);
+	    (*iPtr->freeProc)(iPtr->result);
+	}
+	dsPtr->spaceAvl = dsPtr->length+1;
+	iPtr->freeProc = NULL;
+    } else {
+	if (dsPtr->length < TCL_DSTRING_STATIC_SIZE) {
+	    dsPtr->string = dsPtr->staticSpace;
+	    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
+	} else {
+	    dsPtr->string = (char *) ckalloc((unsigned) (dsPtr->length + 1));
+	    dsPtr->spaceAvl = dsPtr->length + 1;
+	}
+	strcpy(dsPtr->string, iPtr->result);
+    }
+    
+    iPtr->result = iPtr->resultSpace;
+    iPtr->resultSpace[0] = 0;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DStringStartSublist --
+ *
+ *	This procedure adds the necessary information to a dynamic
+ *	string (e.g. " {" to start a sublist.  Future element
+ *	appends will be in the sublist rather than the main list.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Characters get added to the dynamic string.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DStringStartSublist(dsPtr)
+    Tcl_DString *dsPtr;			/* Dynamic string. */
+{
+    if (TclNeedSpace(dsPtr->string, dsPtr->string + dsPtr->length)) {
+	Tcl_DStringAppend(dsPtr, " {", -1);
+    } else {
+	Tcl_DStringAppend(dsPtr, "{", -1);
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DStringEndSublist --
+ *
+ *	This procedure adds the necessary characters to a dynamic
+ *	string to end a sublist (e.g. "}").  Future element appends
+ *	will be in the enclosing (sub)list rather than the current
+ *	sublist.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DStringEndSublist(dsPtr)
+    Tcl_DString *dsPtr;			/* Dynamic string. */
+{
+    Tcl_DStringAppend(dsPtr, "}", -1);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_PrintDouble --
+ *
+ *	Given a floating-point value, this procedure converts it to
+ *	an ASCII string using.
+ *
+ * Results:
+ *	The ASCII equivalent of "value" is written at "dst".  It is
+ *	written using the current precision, and it is guaranteed to
+ *	contain a decimal point or exponent, so that it looks like
+ *	a floating-point value and not an integer.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_PrintDouble(interp, value, dst)
+    Tcl_Interp *interp;			/* Interpreter whose tcl_precision
+					 * variable used to be used to control
+					 * printing.  It's ignored now. */
+    double value;			/* Value to print as string. */
+    char *dst;				/* Where to store converted value;
+					 * must have at least TCL_DOUBLE_SPACE
+					 * characters. */
+{
+    char *p;
+
+    sprintf(dst, precisionFormat, value);
+
+    /*
+     * If the ASCII result looks like an integer, add ".0" so that it
+     * doesn't look like an integer anymore.  This prevents floating-point
+     * values from being converted to integers unintentionally.
+     */
+
+    for (p = dst; *p != 0; p++) {
+	if ((*p == '.') || (isalpha(UCHAR(*p)))) {
+	    return;
+	}
+    }
+    p[0] = '.';
+    p[1] = '0';
+    p[2] = 0;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPrecTraceProc --
+ *
+ *	This procedure is invoked whenever the variable "tcl_precision"
+ *	is written.
+ *
+ * Results:
+ *	Returns NULL if all went well, or an error message if the
+ *	new value for the variable doesn't make sense.
+ *
+ * Side effects:
+ *	If the new value doesn't make sense then this procedure
+ *	undoes the effect of the variable modification.  Otherwise
+ *	it modifies the format string that's used by Tcl_PrintDouble.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+char *
+TclPrecTraceProc(clientData, interp, name1, name2, flags)
+    ClientData clientData;	/* Not used. */
+    Tcl_Interp *interp;		/* Interpreter containing variable. */
+    char *name1;		/* Name of variable. */
+    char *name2;		/* Second part of variable name. */
+    int flags;			/* Information about what happened. */
+{
+    char *value, *end;
+    int prec;
+
+    /*
+     * If the variable is unset, then recreate the trace.
+     */
+
+    if (flags & TCL_TRACE_UNSETS) {
+	if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
+	    Tcl_TraceVar2(interp, name1, name2,
+		    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
+		    |TCL_TRACE_UNSETS, TclPrecTraceProc, clientData);
+	}
+	return (char *) NULL;
+    }
+
+    /*
+     * When the variable is read, reset its value from our shared
+     * value.  This is needed in case the variable was modified in
+     * some other interpreter so that this interpreter's value is
+     * out of date.
+     */
+
+    if (flags & TCL_TRACE_READS) {
+	Tcl_SetVar2(interp, name1, name2, precisionString,
+		flags & TCL_GLOBAL_ONLY);
+	return (char *) NULL;
+    }
+
+    /*
+     * The variable is being written.  Check the new value and disallow
+     * it if it isn't reasonable or if this is a safe interpreter (we
+     * don't want safe interpreters messing up the precision of other
+     * interpreters).
+     */
+
+    value = Tcl_GetVar2(interp, name1, name2, flags & TCL_GLOBAL_ONLY);
+    if (value == NULL) {
+	value = "";
+    }
+    prec = strtoul(value, &end, 10);
+    if ((prec <= 0) || (prec > TCL_MAX_PREC) || (prec > 100) ||
+	    (end == value) || (*end != 0)) {
+	Tcl_SetVar2(interp, name1, name2, precisionString,
+		flags & TCL_GLOBAL_ONLY);
+	return "improper value for precision";
+    }
+    TclFormatInt(precisionString, prec);
+    sprintf(precisionFormat, "%%.%dg", prec);
+    return (char *) NULL;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNeedSpace --
+ *
+ *	This procedure checks to see whether it is appropriate to
+ *	add a space before appending a new list element to an
+ *	existing string.
+ *
+ * Results:
+ *	The return value is 1 if a space is appropriate, 0 otherwise.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclNeedSpace(start, end)
+    char *start;		/* First character in string. */
+    char *end;			/* End of string (place where space will
+				 * be added, if appropriate). */
+{
+    /*
+     * A space is needed unless either
+     * (a) we're at the start of the string, or
+     * (b) the trailing characters of the string consist of one or more
+     *     open curly braces preceded by a space or extending back to
+     *     the beginning of the string.
+     * (c) the trailing characters of the string consist of a space
+     *	   preceded by a character other than backslash.
+     */
+
+    if (end == start) {
+	return 0;
+    }
+    end--;
+    if (*end != '{') {
+	if (isspace(UCHAR(*end)) && ((end == start) || (end[-1] != '\\'))) {
+	    return 0;
+	}
+	return 1;
+    }
+    do {
+	if (end == start) {
+	    return 0;
+	}
+	end--;
+    } while (*end == '{');
+    if (isspace(UCHAR(*end))) {
+	return 0;
+    }
+    return 1;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFormatInt --
+ *
+ *	This procedure formats an integer into a sequence of decimal digit
+ *	characters in a buffer. If the integer is negative, a minus sign is
+ *	inserted at the start of the buffer. A null character is inserted at
+ *	the end of the formatted characters. It is the caller's
+ *	responsibility to ensure that enough storage is available. This
+ *	procedure has the effect of sprintf(buffer, "%d", n) but is faster.
+ *
+ * Results:
+ *	An integer representing the number of characters formatted, not
+ *	including the terminating \0.
+ *
+ * Side effects:
+ *	The formatted characters are written into the storage pointer to
+ *	by the "buffer" argument.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclFormatInt(buffer, n)
+    char *buffer;		/* Points to the storage into which the
+				 * formatted characters are written. */
+    long n;			/* The integer to format. */
+{
+    long intVal;
+    int i;
+    int numFormatted, j;
+    char *digits = "0123456789";
+
+    /*
+     * Check first whether "n" is the maximum negative value. This is
+     * -2^(m-1) for an m-bit word, and has no positive equivalent;
+     * negating it produces the same value.
+     */
+
+    if (n == -n) {
+	sprintf(buffer, "%ld", n);
+	return strlen(buffer);
+    }
+
+    /*
+     * Generate the characters of the result backwards in the buffer.
+     */
+
+    intVal = (n < 0? -n : n);
+    i = 0;
+    buffer[0] = '\0';
+    do {
+	i++;
+	buffer[i] = digits[intVal % 10];
+	intVal = intVal/10;
+    } while (intVal > 0);
+    if (n < 0) {
+	i++;
+	buffer[i] = '-';
+    }
+    numFormatted = i;
+
+    /*
+     * Now reverse the characters.
+     */
+
+    for (j = 0;  j < i;  j++, i--) {
+	char tmp = buffer[i];
+	buffer[i] = buffer[j];
+	buffer[j] = tmp;
+    }
+    return numFormatted;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLooksLikeInt --
+ *
+ *	This procedure decides whether the leading characters of a
+ *	string look like an integer or something else (such as a
+ *	floating-point number or string).
+ *
+ * Results:
+ *	The return value is 1 if the leading characters of p look
+ *	like a valid Tcl integer.  If they look like a floating-point
+ *	number (e.g. "e01" or "2.4"), or if they don't look like a
+ *	number at all, then 0 is returned.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclLooksLikeInt(p)
+    char *p;			/* Pointer to string. */
+{
+    while (isspace(UCHAR(*p))) {
+	p++;
+    }
+    if ((*p == '+') || (*p == '-')) {
+	p++;
+    }
+    if (!isdigit(UCHAR(*p))) {
+	return 0;
+    }
+    p++;
+    while (isdigit(UCHAR(*p))) {
+	p++;
+    }
+    if ((*p != '.') && (*p != 'e') && (*p != 'E')) {
+	return 1;
+    }
+    return 0;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetIntForIndex --
+ *
+ *	This procedure returns an integer corresponding to the list index
+ *	held in a Tcl object. The Tcl object's value is expected to be
+ *	either an integer or the string "end". 
+ *
+ * Results:
+ *	The return value is normally TCL_OK, which means that the index was
+ *	successfully stored into the location referenced by "indexPtr".  If
+ *	the Tcl object referenced by "objPtr" has the value "end", the
+ *	value stored is "endValue". If "objPtr"s values is not "end" and
+ *	can not be converted to an integer, TCL_ERROR is returned and, if
+ *	"interp" is non-NULL, an error message is left in the interpreter's
+ *	result object.
+ *
+ * Side effects:
+ *	The object referenced by "objPtr" might be converted to an
+ *	integer object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclGetIntForIndex(interp, objPtr, endValue, indexPtr)
+     Tcl_Interp *interp;	/* Interpreter to use for error reporting. 
+				 * If NULL, then no error message is left
+				 * after errors. */
+     Tcl_Obj *objPtr;		/* Points to an object containing either
+				 * "end" or an integer. */
+     int endValue;		/* The value to be stored at "indexPtr" if
+				 * "objPtr" holds "end". */
+     int *indexPtr;		/* Location filled in with an integer
+				 * representing an index. */
+{
+    Interp *iPtr = (Interp *) interp;
+    char *bytes;
+    int index, length, result;
+
+    /*
+     * THIS FAILS IF THE INDEX OBJECT'S STRING REP CONTAINS NULLS.
+     */
+    
+    if (objPtr->typePtr == &tclIntType) {
+	*indexPtr = (int)objPtr->internalRep.longValue;
+	return TCL_OK;
+    }
+    
+    bytes = TclGetStringFromObj(objPtr, &length);
+    if ((*bytes == 'e')
+	    && (strncmp(bytes, "end", (unsigned) length) == 0)) {
+	index = endValue;
+    } else {
+	result = Tcl_GetIntFromObj((Tcl_Interp *) NULL, objPtr, &index);
+	if (result != TCL_OK) {
+	    if (iPtr != NULL) {
+		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+			"bad index \"", bytes,
+			"\": must be integer or \"end\"", (char *) NULL);
+	    }
+	    return result;
+	}
+    }
+    *indexPtr = index;
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetNameOfExecutable --
+ *
+ *	This procedure simply returns a pointer to the internal full
+ *	path name of the executable file as computed by
+ *	Tcl_FindExecutable.  This procedure call is the C API
+ *	equivalent to the "info nameofexecutable" command.
+ *
+ * Results:
+ *	A pointer to the internal string or NULL if the internal full
+ *	path name has not been computed or unknown.
+ *
+ * Side effects:
+ *	The object referenced by "objPtr" might be converted to an
+ *	integer object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+CONST char *
+Tcl_GetNameOfExecutable()
+{
+    return (tclExecutableName);
+}
Index: /trunk/tcl/tclVar.c
===================================================================
--- /trunk/tcl/tclVar.c	(revision 2)
+++ /trunk/tcl/tclVar.c	(revision 2)
@@ -0,0 +1,4682 @@
+/* 
+ * tclVar.c --
+ *
+ *	This file contains routines that implement Tcl variables
+ *	(both scalars and arrays).
+ *
+ *	The implementation of arrays is modelled after an initial
+ *	implementation by Mark Diekhans and Karl Lehenbauer.
+ *
+ * Copyright (c) 1987-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclVar.c,v 1.1 2008-06-04 13:58:11 demin Exp $
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ * The strings below are used to indicate what went wrong when a
+ * variable access is denied.
+ */
+
+static char *noSuchVar =	"no such variable";
+static char *isArray =		"variable is array";
+static char *needArray =	"variable isn't array";
+static char *noSuchElement =	"no such element in array";
+static char *danglingElement =  "upvar refers to element in deleted array";
+static char *danglingVar =     "upvar refers to variable in deleted namespace";
+static char *badNamespace =	"parent namespace doesn't exist";
+static char *missingName =	"missing variable name";
+
+/*
+ * Forward references to procedures defined later in this file:
+ */
+
+static  char *		CallTraces _ANSI_ARGS_((Interp *iPtr, Var *arrayPtr,
+			    Var *varPtr, char *part1, char *part2,
+			    int flags));
+static void		CleanupVar _ANSI_ARGS_((Var *varPtr,
+			    Var *arrayPtr));
+static void		DeleteSearches _ANSI_ARGS_((Var *arrayVarPtr));
+static void		DeleteArray _ANSI_ARGS_((Interp *iPtr,
+			    char *arrayName, Var *varPtr, int flags));
+static int		MakeUpvar _ANSI_ARGS_((
+			    Interp *iPtr, CallFrame *framePtr,
+			    char *otherP1, char *otherP2, int otherFlags,
+			    char *myName, int myFlags));
+static Var *		NewVar _ANSI_ARGS_((void));
+static ArraySearch *	ParseSearchId _ANSI_ARGS_((Tcl_Interp *interp,
+			    Var *varPtr, char *varName, char *string));
+static void		VarErrMsg _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *part1, char *part2, char *operation,
+			    char *reason));
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLookupVar --
+ *
+ *	This procedure is used by virtually all of the variable code to
+ *	locate a variable given its name(s).
+ *
+ * Results:
+ *	The return value is a pointer to the variable structure indicated by
+ *	part1 and part2, or NULL if the variable couldn't be found. If the
+ *	variable is found, *arrayPtrPtr is filled in with the address of the
+ *	variable structure for the array that contains the variable (or NULL
+ *	if the variable is a scalar). If the variable can't be found and
+ *	either createPart1 or createPart2 are 1, a new as-yet-undefined
+ *	(VAR_UNDEFINED) variable structure is created, entered into a hash
+ *	table, and returned.
+ *
+ *	If the variable isn't found and creation wasn't specified, or some
+ *	other error occurs, NULL is returned and an error message is left in
+ *	interp->result if TCL_LEAVE_ERR_MSG is set in flags. (The result
+ *	isn't put in interp->objResultPtr because this procedure is used
+ *	by so many string-based routines.)
+ *
+ *	Note: it's possible for the variable returned to be VAR_UNDEFINED
+ *	even if createPart1 or createPart2 are 1 (these only cause the hash
+ *	table entry or array to be created). For example, the variable might
+ *	be a global that has been unset but is still referenced by a
+ *	procedure, or a variable that has been unset but it only being kept
+ *	in existence (if VAR_UNDEFINED) by a trace.
+ *
+ * Side effects:
+ *	New hashtable entries may be created if createPart1 or createPart2
+ *	are 1.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Var *
+TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
+        arrayPtrPtr)
+    Tcl_Interp *interp;		/* Interpreter to use for lookup. */
+    char *part1;		/* If part2 isn't NULL, this is the name of
+				 * an array. Otherwise, if the
+				 * TCL_PARSE_PART1 flag bit is set this
+				 * is a full variable name that could
+				 * include a parenthesized array elemnt. If
+				 * TCL_PARSE_PART1 isn't present, then
+				 * this is the name of a scalar variable. */
+    char *part2;		/* Name of element within array, or NULL. */
+    int flags;			/* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
+				 * TCL_LEAVE_ERR_MSG, and
+				 * TCL_PARSE_PART1 bits matter. */
+    char *msg;			/* Verb to use in error messages, e.g.
+				 * "read" or "set". Only needed if
+				 * TCL_LEAVE_ERR_MSG is set in flags. */
+    int createPart1;		/* If 1, create hash table entry for part 1
+				 * of name, if it doesn't already exist. If
+				 * 0, return error if it doesn't exist. */
+    int createPart2;		/* If 1, create hash table entry for part 2
+				 * of name, if it doesn't already exist. If
+				 * 0, return error if it doesn't exist. */
+    Var **arrayPtrPtr;		/* If the name refers to an element of an
+				 * array, *arrayPtrPtr gets filled in with
+				 * address of array variable. Otherwise
+				 * this is set to NULL. */
+{
+    Interp *iPtr = (Interp *) interp;
+    CallFrame *varFramePtr = iPtr->varFramePtr;
+				/* Points to the procedure call frame whose
+				 * variables are currently in use. Same as
+				 * the current procedure's frame, if any,
+				 * unless an "uplevel" is executing. */
+    Tcl_HashTable *tablePtr;	/* Points to the hashtable, if any, in which
+				 * to look up the variable. */
+    Tcl_Var var;                /* Used to search for global names. */
+    Var *varPtr;		/* Points to the Var structure returned for
+    				 * the variable. */
+    char *elName;		/* Name of array element or NULL; may be
+				 * same as part2, or may be openParen+1. */
+    char *openParen, *closeParen;
+                                /* If this procedure parses a name into
+				 * array and index, these point to the
+				 * parens around the index.  Otherwise they
+				 * are NULL. These are needed to restore
+				 * the parens after parsing the name. */
+    Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr;
+    ResolverScheme *resPtr;
+    Tcl_HashEntry *hPtr;
+    register char *p;
+    int new, i, result;
+
+    varPtr = NULL;
+    *arrayPtrPtr = NULL;
+    openParen = closeParen = NULL;
+    varNsPtr = NULL;		/* set non-NULL if a nonlocal variable */
+
+    /*
+     * If the name hasn't been parsed into array name and index yet,
+     * do it now.
+     */
+
+    elName = part2;
+    if (flags & TCL_PARSE_PART1) {
+	for (p = part1; ; p++) {
+	    if (*p == 0) {
+		elName = NULL;
+		break;
+	    }
+	    if (*p == '(') {
+		openParen = p;
+		do {
+		    p++;
+		} while (*p != '\0');
+		p--;
+		if (*p == ')') {
+		    closeParen = p;
+		    *openParen = 0;
+		    elName = openParen+1;
+		} else {
+		    openParen = NULL;
+		    elName = NULL;
+		}
+		break;
+	    }
+	}
+    }
+
+    /*
+     * If this namespace has a variable resolver, then give it first
+     * crack at the variable resolution.  It may return a Tcl_Var
+     * value, it may signal to continue onward, or it may signal
+     * an error.
+     */
+    if ((flags & TCL_GLOBAL_ONLY) != 0 || iPtr->varFramePtr == NULL) {
+        cxtNsPtr = iPtr->globalNsPtr;
+    } else {
+        cxtNsPtr = iPtr->varFramePtr->nsPtr;
+    }
+
+    if (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) {
+        resPtr = iPtr->resolverPtr;
+
+        if (cxtNsPtr->varResProc) {
+            result = (*cxtNsPtr->varResProc)(interp, part1,
+		    (Tcl_Namespace *) cxtNsPtr, flags, &var);
+        } else {
+            result = TCL_CONTINUE;
+        }
+
+        while (result == TCL_CONTINUE && resPtr) {
+            if (resPtr->varResProc) {
+                result = (*resPtr->varResProc)(interp, part1,
+			(Tcl_Namespace *) cxtNsPtr, flags, &var);
+            }
+            resPtr = resPtr->nextPtr;
+        }
+
+        if (result == TCL_OK) {
+            varPtr = (Var *) var;
+            goto lookupVarPart2;
+        } else if (result != TCL_CONTINUE) {
+            return (Var *) NULL;
+        }
+    }
+
+    /*
+     * Look up part1. Look it up as either a namespace variable or as a
+     * local variable in a procedure call frame (varFramePtr).
+     * Interpret part1 as a namespace variable if:
+     *    1) so requested by a TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY flag,
+     *    2) there is no active frame (we're at the global :: scope),
+     *    3) the active frame was pushed to define the namespace context
+     *       for a "namespace eval" or "namespace inscope" command,
+     *    4) the name has namespace qualifiers ("::"s).
+     * Otherwise, if part1 is a local variable, search first in the
+     * frame's array of compiler-allocated local variables, then in its
+     * hashtable for runtime-created local variables.
+     *
+     * If createPart1 and the variable isn't found, create the variable and,
+     * if necessary, create varFramePtr's local var hashtable.
+     */
+
+    if (((flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) != 0)
+	    || (varFramePtr == NULL)
+	    || !varFramePtr->isProcCallFrame
+	    || (strstr(part1, "::") != NULL)) {
+	char *tail;
+	
+	/*
+	 * Don't pass TCL_LEAVE_ERR_MSG, we may yet create the variable,
+	 * or otherwise generate our own error!
+	 */
+	var = Tcl_FindNamespaceVar(interp, part1, (Tcl_Namespace *) NULL,
+		flags & ~TCL_LEAVE_ERR_MSG);
+	if (var != (Tcl_Var) NULL) {
+            varPtr = (Var *) var;
+        }
+	if (varPtr == NULL) {
+	    if (createPart1) {   /* var wasn't found so create it  */
+		TclGetNamespaceForQualName(interp, part1, (Namespace *) NULL,
+			flags, &varNsPtr, &dummy1Ptr, &dummy2Ptr, &tail);
+		if (varNsPtr == NULL) {
+		    if (flags & TCL_LEAVE_ERR_MSG) {
+			VarErrMsg(interp, part1, part2, msg, badNamespace);
+		    }
+		    goto done;
+		}
+		if (tail == NULL) {
+		    if (flags & TCL_LEAVE_ERR_MSG) {
+			VarErrMsg(interp, part1, part2, msg, missingName);
+		    }
+		    goto done;
+		}
+		hPtr = Tcl_CreateHashEntry(&varNsPtr->varTable, tail, &new);
+		varPtr = NewVar();
+		Tcl_SetHashValue(hPtr, varPtr);
+		varPtr->hPtr = hPtr;
+		varPtr->nsPtr = varNsPtr;
+	    } else {		/* var wasn't found and not to create it */
+		if (flags & TCL_LEAVE_ERR_MSG) {
+		    VarErrMsg(interp, part1, part2, msg, noSuchVar);
+		}
+		goto done;
+	    }
+	}
+    } else {			/* local var: look in frame varFramePtr */
+	Proc *procPtr = varFramePtr->procPtr;
+	int localCt = procPtr->numCompiledLocals;
+	CompiledLocal *localPtr = procPtr->firstLocalPtr;
+	Var *localVarPtr = varFramePtr->compiledLocals;
+	int part1Len = strlen(part1);
+	
+	for (i = 0;  i < localCt;  i++) {
+	    if (!TclIsVarTemporary(localPtr)) {
+		char *localName = localVarPtr->name;
+		if ((part1[0] == localName[0])
+		        && (part1Len == localPtr->nameLength)
+		        && (strcmp(part1, localName) == 0)) {
+		    varPtr = localVarPtr;
+		    break;
+		}
+	    }
+	    localVarPtr++;
+	    localPtr = localPtr->nextPtr;
+	}
+	if (varPtr == NULL) {	/* look in the frame's var hash table */
+	    tablePtr = varFramePtr->varTablePtr;
+	    if (createPart1) {
+		if (tablePtr == NULL) {
+		    tablePtr = (Tcl_HashTable *)
+			ckalloc(sizeof(Tcl_HashTable));
+		    Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS);
+		    varFramePtr->varTablePtr = tablePtr;
+		}
+		hPtr = Tcl_CreateHashEntry(tablePtr, part1, &new);
+		if (new) {
+		    varPtr = NewVar();
+		    Tcl_SetHashValue(hPtr, varPtr);
+		    varPtr->hPtr = hPtr;
+                    varPtr->nsPtr = NULL; /* a local variable */
+		} else {
+		    varPtr = (Var *) Tcl_GetHashValue(hPtr);
+		}
+	    } else {
+		hPtr = NULL;
+		if (tablePtr != NULL) {
+		    hPtr = Tcl_FindHashEntry(tablePtr, part1);
+		}
+		if (hPtr == NULL) {
+		    if (flags & TCL_LEAVE_ERR_MSG) {
+			VarErrMsg(interp, part1, part2, msg, noSuchVar);
+		    }
+		    goto done;
+		}
+		varPtr = (Var *) Tcl_GetHashValue(hPtr);
+	    }
+	}
+    }
+
+    lookupVarPart2:
+    if (openParen != NULL) {
+	*openParen = '(';
+	openParen = NULL;
+    }
+
+    /*
+     * If varPtr is a link variable, we have a reference to some variable
+     * that was created through an "upvar" or "global" command. Traverse
+     * through any links until we find the referenced variable.
+     */
+	
+    while (TclIsVarLink(varPtr)) {
+	varPtr = varPtr->value.linkPtr;
+    }
+
+    /*
+     * If we're not dealing with an array element, return varPtr.
+     */
+    
+    if (elName == NULL) {
+        goto done;
+    }
+
+    /*
+     * We're dealing with an array element. Make sure the variable is an
+     * array and look up the element (create the element if desired).
+     */
+
+    if (TclIsVarUndefined(varPtr) && !TclIsVarArrayElement(varPtr)) {
+	if (!createPart1) {
+	    if (flags & TCL_LEAVE_ERR_MSG) {
+		VarErrMsg(interp, part1, part2, msg, noSuchVar);
+	    }
+	    varPtr = NULL;
+	    goto done;
+	}
+
+	/*
+	 * Make sure we are not resurrecting a namespace variable from a
+	 * deleted namespace!
+	 */
+	if ((varPtr->flags & VAR_IN_HASHTABLE) && (varPtr->hPtr == NULL)) {
+	    if (flags & TCL_LEAVE_ERR_MSG) {
+		VarErrMsg(interp, part1, part2, msg, danglingVar);
+	    }
+	    varPtr = NULL;
+	    goto done;
+	}
+
+	TclSetVarArray(varPtr);
+	TclClearVarUndefined(varPtr);
+	varPtr->value.tablePtr =
+	    (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+	Tcl_InitHashTable(varPtr->value.tablePtr, TCL_STRING_KEYS);
+    } else if (!TclIsVarArray(varPtr)) {
+	if (flags & TCL_LEAVE_ERR_MSG) {
+	    VarErrMsg(interp, part1, part2, msg, needArray);
+	}
+	varPtr = NULL;
+	goto done;
+    }
+    *arrayPtrPtr = varPtr;
+    if (closeParen != NULL) {
+	*closeParen = 0;
+    }
+    if (createPart2) {
+	hPtr = Tcl_CreateHashEntry(varPtr->value.tablePtr, elName, &new);
+	if (closeParen != NULL) {
+	    *closeParen = ')';
+	}
+	if (new) {
+	    if (varPtr->searchPtr != NULL) {
+		DeleteSearches(varPtr);
+	    }
+	    varPtr = NewVar();
+	    Tcl_SetHashValue(hPtr, varPtr);
+	    varPtr->hPtr = hPtr;
+	    varPtr->nsPtr = varNsPtr;
+	    TclSetVarArrayElement(varPtr);
+	}
+    } else {
+	hPtr = Tcl_FindHashEntry(varPtr->value.tablePtr, elName);
+	if (closeParen != NULL) {
+	    *closeParen = ')';
+	}
+	if (hPtr == NULL) {
+	    if (flags & TCL_LEAVE_ERR_MSG) {
+		VarErrMsg(interp, part1, part2, msg, noSuchElement);
+	    }
+	    varPtr = NULL;
+	    goto done;
+	}
+    }
+    varPtr = (Var *) Tcl_GetHashValue(hPtr);
+
+    done:
+    if (openParen != NULL) {
+        *openParen = '(';
+    }
+    return varPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetVar --
+ *
+ *	Return the value of a Tcl variable as a string.
+ *
+ * Results:
+ *	The return value points to the current value of varName as a string.
+ *	If the variable is not defined or can't be read because of a clash
+ *	in array usage then a NULL pointer is returned and an error message
+ *	is left in interp->result if the TCL_LEAVE_ERR_MSG flag is set.
+ *	Note: the return value is only valid up until the next change to the
+ *	variable; if you depend on the value lasting longer than that, then
+ *	make yourself a private copy.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_GetVar(interp, varName, flags)
+    Tcl_Interp *interp;		/* Command interpreter in which varName is
+				 * to be looked up. */
+    char *varName;		/* Name of a variable in interp. */
+    int flags;			/* OR-ed combination of TCL_GLOBAL_ONLY,
+				 * TCL_NAMESPACE_ONLY or TCL_LEAVE_ERR_MSG
+				 * bits. */
+{
+    return Tcl_GetVar2(interp, varName, (char *) NULL,
+	    (flags | TCL_PARSE_PART1));
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetVar2 --
+ *
+ *	Return the value of a Tcl variable as a string, given a two-part
+ *	name consisting of array name and element within array.
+ *
+ * Results:
+ *	The return value points to the current value of the variable given
+ *	by part1 and part2 as a string. If the specified variable doesn't
+ *	exist, or if there is a clash in array usage, then NULL is returned
+ *	and a message will be left in interp->result if the
+ *	TCL_LEAVE_ERR_MSG flag is set. Note: the return value is only valid
+ *	up until the next change to the variable; if you depend on the value
+ *	lasting longer than that, then make yourself a private copy.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_GetVar2(interp, part1, part2, flags)
+    Tcl_Interp *interp;		/* Command interpreter in which variable is
+				 * to be looked up. */
+    char *part1;		/* Name of an array (if part2 is non-NULL)
+				 * or the name of a variable. */
+    char *part2;		/* If non-NULL, gives the name of an element
+				 * in the array part1. */
+    int flags;			/* OR-ed combination of TCL_GLOBAL_ONLY,
+				 * TCL_NAMESPACE_ONLY, TCL_LEAVE_ERR_MSG,
+                                 * and TCL_PARSE_PART1 bits. */
+{
+    register Tcl_Obj *part1Ptr;
+    register Tcl_Obj *part2Ptr = NULL;
+    Tcl_Obj *objPtr;
+    int length;
+
+    length = strlen(part1);
+    TclNewObj(part1Ptr);
+    TclInitStringRep(part1Ptr, part1, length);
+    Tcl_IncrRefCount(part1Ptr);
+
+    if (part2 != NULL) {
+        length = strlen(part2);
+        TclNewObj(part2Ptr);
+        TclInitStringRep(part2Ptr, part2, length);
+	Tcl_IncrRefCount(part2Ptr);
+    }
+    
+    objPtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags);
+    
+    TclDecrRefCount(part1Ptr);	    /* done with the part1 name object */
+    if (part2Ptr != NULL) {
+	TclDecrRefCount(part2Ptr);  /* and the part2 name object */
+    }
+    
+    if (objPtr == NULL) {
+	/*
+	 * Move the interpreter's object result to the string result, 
+	 * then reset the object result.
+	 * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
+	 */
+
+	Tcl_SetResult(interp,
+	        TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
+	        TCL_VOLATILE);
+	return NULL;
+    }
+
+    /*
+     * THIS FAILS IF Tcl_ObjGetVar2's RESULT'S STRING REP HAS A NULL BYTE.
+     */
+    
+    return TclGetStringFromObj(objPtr, (int *) NULL);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ObjGetVar2 --
+ *
+ *	Return the value of a Tcl variable as a Tcl object, given a
+ *	two-part name consisting of array name and element within array.
+ *
+ * Results:
+ *	The return value points to the current object value of the variable
+ *	given by part1Ptr and part2Ptr. If the specified variable doesn't
+ *	exist, or if there is a clash in array usage, then NULL is returned
+ *	and a message will be left in the interpreter's result if the
+ *	TCL_LEAVE_ERR_MSG flag is set.
+ *
+ * Side effects:
+ *	The ref count for the returned object is _not_ incremented to
+ *	reflect the returned reference; if you want to keep a reference to
+ *	the object you must increment its ref count yourself.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags)
+    Tcl_Interp *interp;		/* Command interpreter in which variable is
+				 * to be looked up. */
+    register Tcl_Obj *part1Ptr;	/* Points to an object holding the name of
+				 * an array (if part2 is non-NULL) or the
+				 * name of a variable. */
+    register Tcl_Obj *part2Ptr;	/* If non-null, points to an object holding
+				 * the name of an element in the array
+				 * part1Ptr. */
+    int flags;			/* OR-ed combination of TCL_GLOBAL_ONLY,
+				 * TCL_LEAVE_ERR_MSG, and
+				 * TCL_PARSE_PART1 bits. */
+{
+    Interp *iPtr = (Interp *) interp;
+    register Var *varPtr;
+    Var *arrayPtr;
+    char *part1, *msg;
+    char *part2 = NULL;
+
+    /*
+     * THIS FAILS IF A NAME OBJECT'S STRING REP HAS A NULL BYTE.
+     */
+
+    part1 = TclGetStringFromObj(part1Ptr, (int *) NULL);
+    if (part2Ptr != NULL) {
+	part2 = TclGetStringFromObj(part2Ptr, (int *) NULL);
+    }
+    varPtr = TclLookupVar(interp, part1, part2, flags, "read",
+            /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);
+    if (varPtr == NULL) {
+	return NULL;
+    }
+
+    /*
+     * Invoke any traces that have been set for the variable.
+     */
+
+    if ((varPtr->tracePtr != NULL)
+	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
+	msg = CallTraces(iPtr, arrayPtr, varPtr, part1, part2,
+		(flags & (TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|TCL_PARSE_PART1)) | TCL_TRACE_READS);
+	if (msg != NULL) {
+	    if (flags & TCL_LEAVE_ERR_MSG) {
+		VarErrMsg(interp, part1, part2, "read", msg);
+	    }
+	    goto errorReturn;
+	}
+    }
+
+    /*
+     * Return the element if it's an existing scalar variable.
+     */
+    
+    if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) {
+	return varPtr->value.objPtr;
+    }
+    
+    if (flags & TCL_LEAVE_ERR_MSG) {
+	if (TclIsVarUndefined(varPtr) && (arrayPtr != NULL)
+	        && !TclIsVarUndefined(arrayPtr)) {
+	    msg = noSuchElement;
+	} else if (TclIsVarArray(varPtr)) {
+	    msg = isArray;
+	} else {
+	    msg = noSuchVar;
+	}
+	VarErrMsg(interp, part1, part2, "read", msg);
+    }
+
+    /*
+     * An error. If the variable doesn't exist anymore and no-one's using
+     * it, then free up the relevant structures and hash table entries.
+     */
+
+    errorReturn:
+    if (TclIsVarUndefined(varPtr)) {
+	CleanupVar(varPtr, arrayPtr);
+    }
+    return NULL;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetIndexedScalar --
+ *
+ *	Return the Tcl object value of a local scalar variable in the active
+ *	procedure, given its index in the procedure's array of compiler
+ *	allocated local variables.
+ *
+ * Results:
+ *	The return value points to the current object value of the variable
+ *	given by localIndex. If the specified variable doesn't exist, or
+ *	there is a clash in array usage, or an error occurs while executing
+ *	variable traces, then NULL is returned and a message will be left in
+ *	the interpreter's result if leaveErrorMsg is 1.
+ *
+ * Side effects:
+ *	The ref count for the returned object is _not_ incremented to
+ *	reflect the returned reference; if you want to keep a reference to
+ *	the object you must increment its ref count yourself.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclGetIndexedScalar(interp, localIndex, leaveErrorMsg)
+    Tcl_Interp *interp;		/* Command interpreter in which variable is
+				 * to be looked up. */
+    int localIndex;		/* Index of variable in procedure's array
+				 * of local variables. */
+    int leaveErrorMsg;		/* 1 if to leave an error message in
+				 * interpreter's result on an error.
+				 * Otherwise no error message is left. */
+{
+    Interp *iPtr = (Interp *) interp;
+    CallFrame *varFramePtr = iPtr->varFramePtr;
+				/* Points to the procedure call frame whose
+				 * variables are currently in use. Same as
+				 * the current procedure's frame, if any,
+				 * unless an "uplevel" is executing. */
+    Var *compiledLocals = varFramePtr->compiledLocals;
+    Var *varPtr;		/* Points to the variable's in-frame Var
+				 * structure. */
+    char *varName;		/* Name of the local variable. */
+    char *msg;
+
+#ifdef TCL_COMPILE_DEBUG
+    Proc *procPtr = varFramePtr->procPtr;
+    int localCt = procPtr->numCompiledLocals;
+
+    if (compiledLocals == NULL) {
+	fprintf(stderr, "\nTclGetIndexedScalar: can't get local %i in frame 0x%x, no compiled locals\n",
+		localIndex, (unsigned int) varFramePtr);
+	panic("TclGetIndexedScalar: no compiled locals in frame 0x%x",
+		(unsigned int) varFramePtr);
+    }
+    if ((localIndex < 0) || (localIndex >= localCt)) {
+	fprintf(stderr, "\nTclGetIndexedScalar: can't get local %i in frame 0x%x with %i locals\n",
+		localIndex, (unsigned int) varFramePtr, localCt);
+	panic("TclGetIndexedScalar: bad local index %i in frame 0x%x",
+		localIndex, (unsigned int) varFramePtr);
+    }
+#endif /* TCL_COMPILE_DEBUG */
+    
+    varPtr = &(compiledLocals[localIndex]);
+    varName = varPtr->name;
+
+    /*
+     * If varPtr is a link variable, we have a reference to some variable
+     * that was created through an "upvar" or "global" command, or we have a
+     * reference to a variable in an enclosing namespace. Traverse through
+     * any links until we find the referenced variable.
+     */
+	
+    while (TclIsVarLink(varPtr)) {
+	varPtr = varPtr->value.linkPtr;
+    }
+
+    /*
+     * Invoke any traces that have been set for the variable.
+     */
+
+    if (varPtr->tracePtr != NULL) {
+	msg = CallTraces(iPtr, /*arrayPtr*/ NULL, varPtr, varName, NULL,
+	        TCL_TRACE_READS);
+	if (msg != NULL) {
+	    if (leaveErrorMsg) {
+		VarErrMsg(interp, varName, NULL, "read", msg);
+	    }
+	    return NULL;
+	}
+    }
+
+    /*
+     * Make sure we're dealing with a scalar variable and not an array, and
+     * that the variable exists (isn't undefined).
+     */
+
+    if (!TclIsVarScalar(varPtr) || TclIsVarUndefined(varPtr)) {
+	if (leaveErrorMsg) {
+	    if (TclIsVarArray(varPtr)) {
+		msg = isArray;
+	    } else {
+		msg = noSuchVar;
+	    }
+	    VarErrMsg(interp, varName, NULL, "read", msg);
+	}
+	return NULL;
+    }
+    return varPtr->value.objPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetElementOfIndexedArray --
+ *
+ *	Return the Tcl object value for an element in a local array
+ *	variable. The element is named by the object elemPtr while the 
+ *	array is specified by its index in the active procedure's array
+ *	of compiler allocated local variables.
+ *
+ * Results:
+ *	The return value points to the current object value of the
+ *	element. If the specified array or element doesn't exist, or there
+ *	is a clash in array usage, or an error occurs while executing
+ *	variable traces, then NULL is returned and a message will be left in
+ *	the interpreter's result if leaveErrorMsg is 1.
+ *
+ * Side effects:
+ *	The ref count for the returned object is _not_ incremented to
+ *	reflect the returned reference; if you want to keep a reference to
+ *	the object you must increment its ref count yourself.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclGetElementOfIndexedArray(interp, localIndex, elemPtr, leaveErrorMsg)
+    Tcl_Interp *interp;		/* Command interpreter in which variable is
+				 * to be looked up. */
+    int localIndex;		/* Index of array variable in procedure's
+				 * array of local variables. */
+    Tcl_Obj *elemPtr;		/* Points to an object holding the name of
+				 * an element to get in the array. */
+    int leaveErrorMsg;		/* 1 if to leave an error message in
+				 * the interpreter's result on an error.
+				 * Otherwise no error message is left. */
+{
+    Interp *iPtr = (Interp *) interp;
+    CallFrame *varFramePtr = iPtr->varFramePtr;
+				/* Points to the procedure call frame whose
+				 * variables are currently in use. Same as
+				 * the current procedure's frame, if any,
+				 * unless an "uplevel" is executing. */
+    Var *compiledLocals = varFramePtr->compiledLocals;
+    Var *arrayPtr;		/* Points to the array's in-frame Var
+				 * structure. */
+    char *arrayName;		/* Name of the local array. */
+    Tcl_HashEntry *hPtr;
+    Var *varPtr = NULL;		/* Points to the element's Var structure
+				 * that we return. Initialized to avoid
+				 * compiler warning. */
+    char *elem, *msg;
+    int new;
+
+#ifdef TCL_COMPILE_DEBUG
+    Proc *procPtr = varFramePtr->procPtr;
+    int localCt = procPtr->numCompiledLocals;
+
+    if (compiledLocals == NULL) {
+	fprintf(stderr, "\nTclGetElementOfIndexedArray: can't get element of local %i in frame 0x%x, no compiled locals\n",
+		localIndex, (unsigned int) varFramePtr);
+	panic("TclGetIndexedScalar: no compiled locals in frame 0x%x",
+		(unsigned int) varFramePtr);
+    }
+    if ((localIndex < 0) || (localIndex >= localCt)) {
+	fprintf(stderr, "\nTclGetIndexedScalar: can't get element of local %i in frame 0x%x with %i locals\n",
+		localIndex, (unsigned int) varFramePtr, localCt);
+	panic("TclGetElementOfIndexedArray: bad local index %i in frame 0x%x",
+		localIndex, (unsigned int) varFramePtr);
+    }
+#endif /* TCL_COMPILE_DEBUG */
+
+    /*
+     * THIS FAILS IF THE ELEMENT NAME OBJECT'S STRING REP HAS A NULL BYTE.
+     */
+    
+    elem = Tcl_GetStringFromObj(elemPtr, (int *) NULL);
+    arrayPtr = &(compiledLocals[localIndex]);
+    arrayName = arrayPtr->name;
+
+    /*
+     * If arrayPtr is a link variable, we have a reference to some variable
+     * that was created through an "upvar" or "global" command, or we have a
+     * reference to a variable in an enclosing namespace. Traverse through
+     * any links until we find the referenced variable.
+     */
+	
+    while (TclIsVarLink(arrayPtr)) {
+	arrayPtr = arrayPtr->value.linkPtr;
+    }
+
+    /*
+     * Make sure we're dealing with an array and that the array variable
+     * exists (isn't undefined).
+     */
+
+    if (!TclIsVarArray(arrayPtr) || TclIsVarUndefined(arrayPtr)) {
+	if (leaveErrorMsg) {
+	    VarErrMsg(interp, arrayName, elem, "read", noSuchVar);
+	}
+	goto errorReturn;
+    } 
+
+    /*
+     * Look up the element. Note that we must create the element (but leave
+     * it marked undefined) if it does not already exist. This allows a
+     * trace to create new array elements "on the fly" that did not exist
+     * before. A trace is always passed a variable for the array element. If
+     * the trace does not define the variable, it will be deleted below (at
+     * errorReturn) and an error returned.
+     */
+
+    hPtr = Tcl_CreateHashEntry(arrayPtr->value.tablePtr, elem, &new);
+    if (new) {
+	if (arrayPtr->searchPtr != NULL) {
+	    DeleteSearches(arrayPtr);
+	}
+	varPtr = NewVar();
+	Tcl_SetHashValue(hPtr, varPtr);
+	varPtr->hPtr = hPtr;
+	varPtr->nsPtr = varFramePtr->nsPtr;
+	TclSetVarArrayElement(varPtr);
+    } else {
+	varPtr = (Var *) Tcl_GetHashValue(hPtr);
+    }
+
+    /*
+     * Invoke any traces that have been set for the element variable.
+     */
+
+    if ((varPtr->tracePtr != NULL)
+            || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
+	msg = CallTraces(iPtr, arrayPtr, varPtr, arrayName, elem,
+	        TCL_TRACE_READS);
+	if (msg != NULL) {
+	    if (leaveErrorMsg) {
+		VarErrMsg(interp, arrayName, elem, "read", msg);
+	    }
+	    goto errorReturn;
+	}
+    }
+
+    /*
+     * Return the element if it's an existing scalar variable.
+     */
+    
+    if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) {
+	return varPtr->value.objPtr;
+    }
+    
+    if (leaveErrorMsg) {
+	if (TclIsVarArray(varPtr)) {
+	    msg = isArray;
+	} else {
+	    msg = noSuchVar;
+	}
+	VarErrMsg(interp, arrayName, elem, "read", msg);
+    }
+
+    /*
+     * An error. If the variable doesn't exist anymore and no-one's using
+     * it, then free up the relevant structures and hash table entries.
+     */
+
+    errorReturn:
+    if ((varPtr != NULL) && TclIsVarUndefined(varPtr)) {
+	CleanupVar(varPtr, NULL); /* the array is not in a hashtable */
+    }
+    return NULL;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetCmd --
+ *
+ *	This procedure is invoked to process the "set" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result value.
+ *
+ * Side effects:
+ *	A variable's value may be changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_SetCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    register Tcl_Interp *interp;	/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    if (argc == 2) {
+	char *value;
+
+	value = Tcl_GetVar2(interp, argv[1], (char *) NULL,
+		TCL_LEAVE_ERR_MSG|TCL_PARSE_PART1);
+	if (value == NULL) {
+	    return TCL_ERROR;
+	}
+	Tcl_SetResult(interp, value, TCL_VOLATILE);
+	return TCL_OK;
+    } else if (argc == 3) {
+	char *result;
+
+	result = Tcl_SetVar2(interp, argv[1], (char *) NULL, argv[2],
+		TCL_LEAVE_ERR_MSG|TCL_PARSE_PART1);
+	if (result == NULL) {
+	    return TCL_ERROR;
+	}
+	Tcl_SetResult(interp, result, TCL_VOLATILE);
+	return TCL_OK;
+    } else {
+	Tcl_AppendResult(interp, "wrong # args: should be \"",
+		argv[0], " varName ?newValue?\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetVar --
+ *
+ *	Change the value of a variable.
+ *
+ * Results:
+ *	Returns a pointer to the malloc'ed string which is the character
+ *	representation of the variable's new value. The caller must not
+ *	modify this string. If the write operation was disallowed then NULL
+ *	is returned; if the TCL_LEAVE_ERR_MSG flag is set, then an
+ *	explanatory message will be left in interp->result. Note that the
+ *	returned string may not be the same as newValue; this is because
+ *	variable traces may modify the variable's value.
+ *
+ * Side effects:
+ *	If varName is defined as a local or global variable in interp,
+ *	its value is changed to newValue. If varName isn't currently
+ *	defined, then a new global variable by that name is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_SetVar(interp, varName, newValue, flags)
+    Tcl_Interp *interp;		/* Command interpreter in which varName is
+				 * to be looked up. */
+    char *varName;		/* Name of a variable in interp. */
+    char *newValue;		/* New value for varName. */
+    int flags;			/* Various flags that tell how to set value:
+				 * any of TCL_GLOBAL_ONLY,
+				 * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE,
+				 * TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG. */
+{
+    return Tcl_SetVar2(interp, varName, (char *) NULL, newValue,
+	    (flags | TCL_PARSE_PART1));
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetVar2 --
+ *
+ *      Given a two-part variable name, which may refer either to a
+ *      scalar variable or an element of an array, change the value
+ *      of the variable.  If the named scalar or array or element
+ *      doesn't exist then create one.
+ *
+ * Results:
+ *	Returns a pointer to the malloc'ed string which is the character
+ *	representation of the variable's new value. The caller must not
+ *	modify this string. If the write operation was disallowed because an
+ *	array was expected but not found (or vice versa), then NULL is
+ *	returned; if the TCL_LEAVE_ERR_MSG flag is set, then an explanatory
+ *	message will be left in interp->result. Note that the returned
+ *	string may not be the same as newValue; this is because variable
+ *	traces may modify the variable's value.
+ *
+ * Side effects:
+ *      The value of the given variable is set. If either the array
+ *      or the entry didn't exist then a new one is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_SetVar2(interp, part1, part2, newValue, flags)
+    Tcl_Interp *interp;         /* Command interpreter in which variable is
+                                 * to be looked up. */
+    char *part1;                /* If part2 is NULL, this is name of scalar
+                                 * variable. Otherwise it is the name of
+                                 * an array. */
+    char *part2;                /* Name of an element within an array, or
+				 * NULL. */
+    char *newValue;             /* New value for variable. */
+    int flags;                  /* Various flags that tell how to set value:
+				 * any of TCL_GLOBAL_ONLY,
+				 * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE,
+				 * TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG, or 
+				 * TCL_PARSE_PART1. */
+{
+    register Tcl_Obj *valuePtr;
+    register Tcl_Obj *part1Ptr;
+    register Tcl_Obj *part2Ptr = NULL;
+    Tcl_Obj *varValuePtr;
+    int length;
+
+    /*
+     * Create an object holding the variable's new value and use
+     * Tcl_ObjSetVar2 to actually set the variable.
+     */
+
+    length = newValue ? strlen(newValue) : 0;
+    TclNewObj(valuePtr);
+    TclInitStringRep(valuePtr, newValue, length);
+    Tcl_IncrRefCount(valuePtr);
+
+    length = strlen(part1) ;
+    TclNewObj(part1Ptr);
+    TclInitStringRep(part1Ptr, part1, length);
+    Tcl_IncrRefCount(part1Ptr);
+
+    if (part2 != NULL) {
+        length = strlen(part2);
+        TclNewObj(part2Ptr);
+        TclInitStringRep(part2Ptr, part2, length);
+	Tcl_IncrRefCount(part2Ptr);
+    }
+    
+    varValuePtr = Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, valuePtr,
+	    flags);
+    
+    TclDecrRefCount(part1Ptr);      /* done with the part1 name object */
+    if (part2Ptr != NULL) {
+	TclDecrRefCount(part2Ptr);  /* and the part2 name object */
+    }
+    Tcl_DecrRefCount(valuePtr); /* done with the object */
+    
+    if (varValuePtr == NULL) {
+	/*
+	 * Move the interpreter's object result to the string result, 
+	 * then reset the object result.
+	 * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
+	 */
+
+	Tcl_SetResult(interp,
+	        TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
+	        TCL_VOLATILE);
+	return NULL;
+    }
+
+    /*
+     * THIS FAILS IF Tcl_ObjSetVar2's RESULT'S STRING REP HAS A NULL BYTE.
+     */
+
+    return TclGetStringFromObj(varValuePtr, (int *) NULL);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ObjSetVar2 --
+ *
+ *	Given a two-part variable name, which may refer either to a scalar
+ *	variable or an element of an array, change the value of the variable
+ *	to a new Tcl object value. If the named scalar or array or element
+ *	doesn't exist then create one.
+ *
+ * Results:
+ *	Returns a pointer to the Tcl_Obj holding the new value of the
+ *	variable. If the write operation was disallowed because an array was
+ *	expected but not found (or vice versa), then NULL is returned; if
+ *	the TCL_LEAVE_ERR_MSG flag is set, then an explanatory message will
+ *	be left in the interpreter's result. Note that the returned object
+ *	may not be the same one referenced by newValuePtr; this is because
+ *	variable traces may modify the variable's value.
+ *
+ * Side effects:
+ *	The value of the given variable is set. If either the array or the
+ *	entry didn't exist then a new variable is created.
+ *
+ *	The reference count is decremented for any old value of the variable
+ *	and incremented for its new value. If the new value for the variable
+ *	is not the same one referenced by newValuePtr (perhaps as a result
+ *	of a variable trace), then newValuePtr's ref count is left unchanged
+ *	by Tcl_ObjSetVar2. newValuePtr's ref count is also left unchanged if
+ *	we are appending it as a string value: that is, if "flags" includes
+ *	TCL_APPEND_VALUE but not TCL_LIST_ELEMENT.
+ *
+ *	The reference count for the returned object is _not_ incremented: if
+ *	you want to keep a reference to the object you must increment its
+ *	ref count yourself.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags)
+    Tcl_Interp *interp;		/* Command interpreter in which variable is
+				 * to be found. */
+    register Tcl_Obj *part1Ptr;	/* Points to an object holding the name of
+				 * an array (if part2 is non-NULL) or the
+				 * name of a variable. */
+    register Tcl_Obj *part2Ptr;	/* If non-null, points to an object holding
+				 * the name of an element in the array
+				 * part1Ptr. */
+    Tcl_Obj *newValuePtr;	/* New value for variable. */
+    int flags;			/* Various flags that tell how to set value:
+				 * any of TCL_GLOBAL_ONLY,
+				 * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE,
+				 * TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG, or
+				 * TCL_PARSE_PART1. */
+{
+    Interp *iPtr = (Interp *) interp;
+    register Var *varPtr;
+    Var *arrayPtr;
+    Tcl_Obj *oldValuePtr;
+    Tcl_Obj *resultPtr = NULL;
+    char *part1, *bytes;
+    char *part2 = NULL;
+    int length, result;
+
+    /*
+     * THIS FAILS IF A NAME OBJECT'S STRING REP HAS A NULL BYTE.
+     */
+
+    part1 = TclGetStringFromObj(part1Ptr, (int *) NULL);
+    if (part2Ptr != NULL) {
+	part2 = TclGetStringFromObj(part2Ptr, (int *) NULL);
+    }
+    
+    varPtr = TclLookupVar(interp, part1, part2, flags, "set",
+	    /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
+    if (varPtr == NULL) {
+	return NULL;
+    }
+
+    /*
+     * If the variable is in a hashtable and its hPtr field is NULL, then we
+     * may have an upvar to an array element where the array was deleted
+     * or an upvar to a namespace variable whose namespace was deleted.
+     * Generate an error (allowing the variable to be reset would screw up
+     * our storage allocation and is meaningless anyway).
+     */
+
+    if ((varPtr->flags & VAR_IN_HASHTABLE) && (varPtr->hPtr == NULL)) {
+	if (flags & TCL_LEAVE_ERR_MSG) {
+	    if (TclIsVarArrayElement(varPtr)) {
+		VarErrMsg(interp, part1, part2, "set", danglingElement);
+	    } else {
+		VarErrMsg(interp, part1, part2, "set", danglingVar);
+	    }
+	}
+	return NULL;
+    }
+
+    /*
+     * It's an error to try to set an array variable itself.
+     */
+
+    if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
+	if (flags & TCL_LEAVE_ERR_MSG) {
+	    VarErrMsg(interp, part1, part2, "set", isArray);
+	}
+	return NULL;
+    }
+
+    /*
+     * At this point, if we were appending, we used to call read traces: we
+     * treated append as a read-modify-write. However, it seemed unlikely to
+     * us that a real program would be interested in such reads being done
+     * during a set operation.
+     */
+
+    /*
+     * Set the variable's new value. If appending, append the new value to
+     * the variable, either as a list element or as a string. Also, if
+     * appending, then if the variable's old value is unshared we can modify
+     * it directly, otherwise we must create a new copy to modify: this is
+     * "copy on write".
+     */
+
+    oldValuePtr = varPtr->value.objPtr;
+    if (flags & TCL_APPEND_VALUE) {
+	if (TclIsVarUndefined(varPtr) && (oldValuePtr != NULL)) {
+	    Tcl_DecrRefCount(oldValuePtr);     /* discard old value */
+	    varPtr->value.objPtr = NULL;
+	    oldValuePtr = NULL;
+	}
+	if (flags & TCL_LIST_ELEMENT) {	       /* append list element */
+	    if (oldValuePtr == NULL) {
+		TclNewObj(oldValuePtr);
+		varPtr->value.objPtr = oldValuePtr;
+		Tcl_IncrRefCount(oldValuePtr); /* since var is reference */
+	    } else if (Tcl_IsShared(oldValuePtr)) {
+		varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
+		Tcl_DecrRefCount(oldValuePtr);
+		oldValuePtr = varPtr->value.objPtr;
+		Tcl_IncrRefCount(oldValuePtr); /* since var is reference */
+	    }
+	    result = Tcl_ListObjAppendElement(interp, oldValuePtr,
+		    newValuePtr);
+	    if (result != TCL_OK) {
+		return NULL;
+	    }
+	} else {		               /* append string */
+	    /*
+	     * We append newValuePtr's bytes but don't change its ref count.
+	     */
+
+	    bytes = Tcl_GetStringFromObj(newValuePtr, &length);
+	    if (oldValuePtr == NULL) {
+		varPtr->value.objPtr = Tcl_NewStringObj(bytes, length);
+		Tcl_IncrRefCount(varPtr->value.objPtr);
+	    } else {
+		if (Tcl_IsShared(oldValuePtr)) {   /* append to copy */
+		    varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
+		    TclDecrRefCount(oldValuePtr);
+		    oldValuePtr = varPtr->value.objPtr;
+		    Tcl_IncrRefCount(oldValuePtr); /* since var is ref */
+		}
+		Tcl_AppendToObj(oldValuePtr, bytes, length);
+	    }
+	}
+    } else {
+	if (flags & TCL_LIST_ELEMENT) {	       /* set var to list element */
+	    int neededBytes, listFlags;
+
+	    /*
+	     * We set the variable to the result of converting newValuePtr's
+	     * string rep to a list element. We do not change newValuePtr's
+	     * ref count.
+	     */
+
+	    if (oldValuePtr != NULL) {
+		Tcl_DecrRefCount(oldValuePtr); /* discard old value */
+	    }
+	    bytes = Tcl_GetStringFromObj(newValuePtr, &length);
+	    neededBytes = Tcl_ScanElement(bytes, &listFlags);
+	    oldValuePtr = Tcl_NewObj();
+	    oldValuePtr->bytes = (char *)
+		ckalloc((unsigned) (neededBytes + 1));
+	    oldValuePtr->length = Tcl_ConvertElement(bytes,
+		    oldValuePtr->bytes, listFlags);
+	    varPtr->value.objPtr = oldValuePtr;
+	    Tcl_IncrRefCount(varPtr->value.objPtr);
+	} else if (newValuePtr != oldValuePtr) {
+	    varPtr->value.objPtr = newValuePtr;
+	    Tcl_IncrRefCount(newValuePtr);      /* var is another ref */
+	    if (oldValuePtr != NULL) {
+		TclDecrRefCount(oldValuePtr);   /* discard old value */
+	    }
+	}
+    }
+    TclSetVarScalar(varPtr);
+    TclClearVarUndefined(varPtr);
+    if (arrayPtr != NULL) {
+	TclClearVarUndefined(arrayPtr);
+    }
+
+    /*
+     * Invoke any write traces for the variable.
+     */
+
+    if ((varPtr->tracePtr != NULL)
+	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
+	char *msg = CallTraces(iPtr, arrayPtr, varPtr, part1, part2,
+	        (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_PARSE_PART1)) | TCL_TRACE_WRITES);
+	if (msg != NULL) {
+	    if (flags & TCL_LEAVE_ERR_MSG) {
+		VarErrMsg(interp, part1, part2, "set", msg);
+	    }
+	    goto cleanup;
+	}
+    }
+
+    /*
+     * Return the variable's value unless the variable was changed in some
+     * gross way by a trace (e.g. it was unset and then recreated as an
+     * array). 
+     */
+
+    if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) {
+	return varPtr->value.objPtr;
+    }
+
+    /*
+     * A trace changed the value in some gross way. Return an empty string
+     * object.
+     */
+    
+    resultPtr = iPtr->emptyObjPtr;
+
+    /*
+     * If the variable doesn't exist anymore and no-one's using it, then
+     * free up the relevant structures and hash table entries.
+     */
+
+    cleanup:
+    if (TclIsVarUndefined(varPtr)) {
+	CleanupVar(varPtr, arrayPtr);
+    }
+    return resultPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSetIndexedScalar --
+ *
+ *	Change the Tcl object value of a local scalar variable in the active
+ *	procedure, given its compile-time allocated index in the procedure's
+ *	array of local variables.
+ *
+ * Results:
+ *	Returns a pointer to the Tcl_Obj holding the new value of the
+ *	variable given by localIndex. If the specified variable doesn't
+ *	exist, or there is a clash in array usage, or an error occurs while
+ *	executing variable traces, then NULL is returned and a message will
+ *	be left in the interpreter's result if leaveErrorMsg is 1. Note
+ *	that the returned object may not be the same one referenced by
+ *	newValuePtr; this is because variable traces may modify the
+ *	variable's value.
+ *
+ * Side effects:
+ *	The value of the given variable is set. The reference count is
+ *	decremented for any old value of the variable and incremented for
+ *	its new value. If as a result of a variable trace the new value for
+ *	the variable is not the same one referenced by newValuePtr, then
+ *	newValuePtr's ref count is left unchanged. The ref count for the
+ *	returned object is _not_ incremented to reflect the returned
+ *	reference; if you want to keep a reference to the object you must
+ *	increment its ref count yourself. This procedure does not create
+ *	new variables, but only sets those recognized at compile time.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclSetIndexedScalar(interp, localIndex, newValuePtr, leaveErrorMsg)
+    Tcl_Interp *interp;		/* Command interpreter in which variable is
+				 * to be found. */
+    int localIndex;		/* Index of variable in procedure's array
+				 * of local variables. */
+    Tcl_Obj *newValuePtr;	/* New value for variable. */
+    int leaveErrorMsg;		/* 1 if to leave an error message in
+				 * the interpreter's result on an error.
+				 * Otherwise no error message is left. */
+{
+    Interp *iPtr = (Interp *) interp;
+    CallFrame *varFramePtr = iPtr->varFramePtr;
+				/* Points to the procedure call frame whose
+				 * variables are currently in use. Same as
+				 * the current procedure's frame, if any,
+				 * unless an "uplevel" is executing. */
+    Var *compiledLocals = varFramePtr->compiledLocals;
+    register Var *varPtr;	/* Points to the variable's in-frame Var
+				 * structure. */
+    char *varName;		/* Name of the local variable. */
+    Tcl_Obj *oldValuePtr;
+    Tcl_Obj *resultPtr = NULL;
+
+#ifdef TCL_COMPILE_DEBUG
+    Proc *procPtr = varFramePtr->procPtr;
+    int localCt = procPtr->numCompiledLocals;
+
+    if (compiledLocals == NULL) {
+	fprintf(stderr, "\nTclSetIndexedScalar: can't set local %i in frame 0x%x, no compiled locals\n",
+		localIndex, (unsigned int) varFramePtr);
+	panic("TclSetIndexedScalar: no compiled locals in frame 0x%x",
+		(unsigned int) varFramePtr);
+    }
+    if ((localIndex < 0) || (localIndex >= localCt)) {
+	fprintf(stderr, "\nTclSetIndexedScalar: can't set local %i in frame 0x%x with %i locals\n",
+		localIndex, (unsigned int) varFramePtr, localCt);
+	panic("TclSetIndexedScalar: bad local index %i in frame 0x%x",
+		localIndex, (unsigned int) varFramePtr);
+    }
+#endif /* TCL_COMPILE_DEBUG */
+    
+    varPtr = &(compiledLocals[localIndex]);
+    varName = varPtr->name;
+
+    /*
+     * If varPtr is a link variable, we have a reference to some variable
+     * that was created through an "upvar" or "global" command, or we have a
+     * reference to a variable in an enclosing namespace. Traverse through
+     * any links until we find the referenced variable.
+     */
+	
+    while (TclIsVarLink(varPtr)) {
+	varPtr = varPtr->value.linkPtr;
+    }
+
+    /*
+     * If the variable is in a hashtable and its hPtr field is NULL, then we
+     * may have an upvar to an array element where the array was deleted
+     * or an upvar to a namespace variable whose namespace was deleted.
+     * Generate an error (allowing the variable to be reset would screw up
+     * our storage allocation and is meaningless anyway).
+     */
+
+    if ((varPtr->flags & VAR_IN_HASHTABLE) && (varPtr->hPtr == NULL)) {
+	if (leaveErrorMsg) {
+	    if (TclIsVarArrayElement(varPtr)) {
+		VarErrMsg(interp, varName, NULL, "set", danglingElement);
+	    } else {
+		VarErrMsg(interp, varName, NULL, "set", danglingVar);
+	    }
+	}
+	return NULL;
+    }
+
+    /*
+     * It's an error to try to set an array variable itself.
+     */
+
+    if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
+	if (leaveErrorMsg) {
+	    VarErrMsg(interp, varName, NULL, "set", isArray);
+	}
+	return NULL;
+    }
+
+    /*
+     * Set the variable's new value and discard its old value. We don't
+     * append with this "set" procedure so the old value isn't needed.
+     */
+
+    oldValuePtr = varPtr->value.objPtr;
+    if (newValuePtr != oldValuePtr) {        /* set new value */
+	varPtr->value.objPtr = newValuePtr;
+	Tcl_IncrRefCount(newValuePtr);       /* var is another ref to obj */
+	if (oldValuePtr != NULL) {
+	    TclDecrRefCount(oldValuePtr);    /* discard old value */
+	}
+    }
+    TclSetVarScalar(varPtr);
+    TclClearVarUndefined(varPtr);
+
+    /*
+     * Invoke any write traces for the variable.
+     */
+
+    if (varPtr->tracePtr != NULL) {
+	char *msg = CallTraces(iPtr, /*arrayPtr*/ NULL, varPtr,
+	        varName, (char *) NULL, TCL_TRACE_WRITES);
+	if (msg != NULL) {
+	    if (leaveErrorMsg) {
+		VarErrMsg(interp, varName, NULL, "set", msg);
+	    }
+	    goto cleanup;
+	}
+    }
+
+    /*
+     * Return the variable's value unless the variable was changed in some
+     * gross way by a trace (e.g. it was unset and then recreated as an
+     * array). If it was changed is a gross way, just return an empty string
+     * object.
+     */
+
+    if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) {
+	return varPtr->value.objPtr;
+    }
+    
+    resultPtr = Tcl_NewObj();
+
+    /*
+     * If the variable doesn't exist anymore and no-one's using it, then
+     * free up the relevant structures and hash table entries.
+     */
+
+    cleanup:
+    if (TclIsVarUndefined(varPtr)) {
+	CleanupVar(varPtr, NULL);
+    }
+    return resultPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSetElementOfIndexedArray --
+ *
+ *	Change the Tcl object value of an element in a local array
+ *	variable. The element is named by the object elemPtr while the array
+ *	is specified by its index in the active procedure's array of
+ *	compiler allocated local variables.
+ *
+ * Results:
+ *	Returns a pointer to the Tcl_Obj holding the new value of the
+ *	element. If the specified array or element doesn't exist, or there
+ *	is a clash in array usage, or an error occurs while executing
+ *	variable traces, then NULL is returned and a message will be left in
+ *	the interpreter's result if leaveErrorMsg is 1. Note that the
+ *	returned object may not be the same one referenced by newValuePtr;
+ *	this is because variable traces may modify the variable's value.
+ *
+ * Side effects:
+ *	The value of the given array element is set. The reference count is
+ *	decremented for any old value of the element and incremented for its
+ *	new value. If as a result of a variable trace the new value for the
+ *	element is not the same one referenced by newValuePtr, then
+ *	newValuePtr's ref count is left unchanged. The ref count for the
+ *	returned object is _not_ incremented to reflect the returned
+ *	reference; if you want to keep a reference to the object you must
+ *	increment its ref count yourself. This procedure will not create new
+ *	array variables, but only sets elements of those arrays recognized
+ *	at compile time. However, if the entry doesn't exist then a new
+ *	variable is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclSetElementOfIndexedArray(interp, localIndex, elemPtr, newValuePtr,
+        leaveErrorMsg)
+    Tcl_Interp *interp;		/* Command interpreter in which the array is
+				 * to be found. */
+    int localIndex;		/* Index of array variable in procedure's
+				 * array of local variables. */
+    Tcl_Obj *elemPtr;		/* Points to an object holding the name of
+				 * an element to set in the array. */
+    Tcl_Obj *newValuePtr;	/* New value for variable. */
+    int leaveErrorMsg;		/* 1 if to leave an error message in
+				 * the interpreter's result on an error.
+				 * Otherwise no error message is left. */
+{
+    Interp *iPtr = (Interp *) interp;
+    CallFrame *varFramePtr = iPtr->varFramePtr;
+				/* Points to the procedure call frame whose
+				 * variables are currently in use. Same as
+				 * the current procedure's frame, if any,
+				 * unless an "uplevel" is executing. */
+    Var *compiledLocals = varFramePtr->compiledLocals;
+    Var *arrayPtr;		/* Points to the array's in-frame Var
+				 * structure. */
+    char *arrayName;		/* Name of the local array. */
+    char *elem;
+    Tcl_HashEntry *hPtr;
+    Var *varPtr = NULL;		/* Points to the element's Var structure
+				 * that we return. */
+    Tcl_Obj *resultPtr = NULL;
+    Tcl_Obj *oldValuePtr;
+    int new;
+    
+#ifdef TCL_COMPILE_DEBUG
+    Proc *procPtr = varFramePtr->procPtr;
+    int localCt = procPtr->numCompiledLocals;
+
+    if (compiledLocals == NULL) {
+	fprintf(stderr, "\nTclSetElementOfIndexedArray: can't set element of local %i in frame 0x%x, no compiled locals\n",
+		localIndex, (unsigned int) varFramePtr);
+	panic("TclSetIndexedScalar: no compiled locals in frame 0x%x",
+		(unsigned int) varFramePtr);
+    }
+    if ((localIndex < 0) || (localIndex >= localCt)) {
+	fprintf(stderr, "\nTclSetIndexedScalar: can't set elememt of local %i in frame 0x%x with %i locals\n",
+		localIndex, (unsigned int) varFramePtr, localCt);
+	panic("TclSetElementOfIndexedArray: bad local index %i in frame 0x%x",
+		localIndex, (unsigned int) varFramePtr);
+    }
+#endif /* TCL_COMPILE_DEBUG */
+
+    /*
+     * THIS FAILS IF THE ELEMENT NAME OBJECT'S STRING REP HAS A NULL BYTE.
+     */
+    
+    elem = Tcl_GetStringFromObj(elemPtr, (int *) NULL);
+    arrayPtr = &(compiledLocals[localIndex]);
+    arrayName = arrayPtr->name;
+
+    /*
+     * If arrayPtr is a link variable, we have a reference to some variable
+     * that was created through an "upvar" or "global" command, or we have a
+     * reference to a variable in an enclosing namespace. Traverse through
+     * any links until we find the referenced variable.
+     */
+	
+    while (TclIsVarLink(arrayPtr)) {
+	arrayPtr = arrayPtr->value.linkPtr;
+    }
+
+    /*
+     * If the variable is in a hashtable and its hPtr field is NULL, then we
+     * may have an upvar to an array element where the array was deleted
+     * or an upvar to a namespace variable whose namespace was deleted.
+     * Generate an error (allowing the variable to be reset would screw up
+     * our storage allocation and is meaningless anyway).
+     */
+
+    if ((arrayPtr->flags & VAR_IN_HASHTABLE) && (arrayPtr->hPtr == NULL)) {
+	if (leaveErrorMsg) {
+	    if (TclIsVarArrayElement(arrayPtr)) {
+		VarErrMsg(interp, arrayName, elem, "set", danglingElement);
+	    } else {
+		VarErrMsg(interp, arrayName, elem, "set", danglingVar);
+	    }
+	}
+	goto errorReturn;
+    }
+
+    /*
+     * Make sure we're dealing with an array.
+     */
+
+    if (TclIsVarUndefined(arrayPtr) && !TclIsVarArrayElement(arrayPtr)) {
+	TclSetVarArray(arrayPtr);
+	arrayPtr->value.tablePtr =
+	    (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+	Tcl_InitHashTable(arrayPtr->value.tablePtr, TCL_STRING_KEYS);
+	TclClearVarUndefined(arrayPtr);
+    } else if (!TclIsVarArray(arrayPtr)) {
+	if (leaveErrorMsg) {
+	    VarErrMsg(interp, arrayName, elem, "set", needArray);
+	}
+	goto errorReturn;
+    } 
+
+    /*
+     * Look up the element.
+     */
+
+    hPtr = Tcl_CreateHashEntry(arrayPtr->value.tablePtr, elem, &new);
+    if (new) {
+	if (arrayPtr->searchPtr != NULL) {
+	    DeleteSearches(arrayPtr);
+	}
+	varPtr = NewVar();
+	Tcl_SetHashValue(hPtr, varPtr);
+	varPtr->hPtr = hPtr;
+        varPtr->nsPtr = varFramePtr->nsPtr;
+	TclSetVarArrayElement(varPtr);
+    }
+    varPtr = (Var *) Tcl_GetHashValue(hPtr);
+
+    /*
+     * It's an error to try to set an array variable itself.
+     */
+
+    if (TclIsVarArray(varPtr)) {
+	if (leaveErrorMsg) {
+	    VarErrMsg(interp, arrayName, elem, "set", isArray);
+	}
+	goto errorReturn;
+    }
+
+    /*
+     * Set the variable's new value and discard the old one. We don't
+     * append with this "set" procedure so the old value isn't needed.
+     */
+
+    oldValuePtr = varPtr->value.objPtr;
+    if (newValuePtr != oldValuePtr) {	     /* set new value */
+	varPtr->value.objPtr = newValuePtr;
+	Tcl_IncrRefCount(newValuePtr);       /* var is another ref to obj */
+	if (oldValuePtr != NULL) {
+	    TclDecrRefCount(oldValuePtr);    /* discard old value */
+	}
+    }
+    TclSetVarScalar(varPtr);
+    TclClearVarUndefined(varPtr);
+
+    /*
+     * Invoke any write traces for the element variable.
+     */
+
+    if ((varPtr->tracePtr != NULL)
+	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
+	char *msg = CallTraces(iPtr, arrayPtr, varPtr, arrayName, elem,
+		TCL_TRACE_WRITES);
+	if (msg != NULL) {
+	    if (leaveErrorMsg) {
+		VarErrMsg(interp, arrayName, elem, "set", msg);
+	    }
+	    goto errorReturn;
+	}
+    }
+
+    /*
+     * Return the element's value unless it was changed in some gross way by
+     * a trace (e.g. it was unset and then recreated as an array). If it was
+     * changed is a gross way, just return an empty string object.
+     */
+
+    if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) {
+	return varPtr->value.objPtr;
+    }
+    
+    resultPtr = Tcl_NewObj();
+
+    /*
+     * An error. If the variable doesn't exist anymore and no-one's using
+     * it, then free up the relevant structures and hash table entries.
+     */
+
+    errorReturn:
+    if (varPtr != NULL) {
+	if (TclIsVarUndefined(varPtr)) {
+	    CleanupVar(varPtr, NULL); /* note: array isn't in hashtable */
+	}
+    }
+    return resultPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclIncrVar2 --
+ *
+ *	Given a two-part variable name, which may refer either to a scalar
+ *	variable or an element of an array, increment the Tcl object value
+ *	of the variable by a specified amount.
+ *
+ * Results:
+ *	Returns a pointer to the Tcl_Obj holding the new value of the
+ *	variable. If the specified variable doesn't exist, or there is a
+ *	clash in array usage, or an error occurs while executing variable
+ *	traces, then NULL is returned and a message will be left in
+ *	the interpreter's result.
+ *
+ * Side effects:
+ *	The value of the given variable is incremented by the specified
+ *	amount. If either the array or the entry didn't exist then a new
+ *	variable is created. The ref count for the returned object is _not_
+ *	incremented to reflect the returned reference; if you want to keep a
+ *	reference to the object you must increment its ref count yourself.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclIncrVar2(interp, part1Ptr, part2Ptr, incrAmount, part1NotParsed)
+    Tcl_Interp *interp;		/* Command interpreter in which variable is
+				 * to be found. */
+    Tcl_Obj *part1Ptr;		/* Points to an object holding the name of
+				 * an array (if part2 is non-NULL) or the
+				 * name of a variable. */
+    Tcl_Obj *part2Ptr;		/* If non-null, points to an object holding
+				 * the name of an element in the array
+				 * part1Ptr. */
+    long incrAmount;		/* Amount to be added to variable. */
+    int part1NotParsed;		/* 1 if part1 hasn't yet been parsed into
+				 * an array name and index (if any). */
+{
+    register Tcl_Obj *varValuePtr;
+    Tcl_Obj *resultPtr;
+    int createdNewObj;		/* Set 1 if var's value object is shared
+				 * so we must increment a copy (i.e. copy
+				 * on write). */
+    long i;
+    int flags, result;
+
+    flags = TCL_LEAVE_ERR_MSG;
+    if (part1NotParsed) {
+	flags |= TCL_PARSE_PART1;
+    }
+    
+    varValuePtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags);
+    if (varValuePtr == NULL) {
+	Tcl_AddObjErrorInfo(interp,
+		"\n    (reading value of variable to increment)", -1);
+	return NULL;
+    }
+
+    /*
+     * Increment the variable's value. If the object is unshared we can
+     * modify it directly, otherwise we must create a new copy to modify:
+     * this is "copy on write". Then free the variable's old string
+     * representation, if any, since it will no longer be valid.
+     */
+
+    createdNewObj = 0;
+    if (Tcl_IsShared(varValuePtr)) {
+	varValuePtr = Tcl_DuplicateObj(varValuePtr);
+	createdNewObj = 1;
+    }
+    result = Tcl_GetLongFromObj(interp, varValuePtr, &i);
+    if (result != TCL_OK) {
+	if (createdNewObj) {
+	    Tcl_DecrRefCount(varValuePtr); /* free unneeded copy */
+	}
+	return NULL;
+    }
+    Tcl_SetLongObj(varValuePtr, (i + incrAmount));
+
+    /*
+     * Store the variable's new value and run any write traces.
+     */
+    
+    resultPtr = Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, varValuePtr,
+	    flags);
+    if (resultPtr == NULL) {
+	return NULL;
+    }
+    return resultPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclIncrIndexedScalar --
+ *
+ *	Increments the Tcl object value of a local scalar variable in the
+ *	active procedure, given its compile-time allocated index in the
+ *	procedure's array of local variables.
+ *
+ * Results:
+ *	Returns a pointer to the Tcl_Obj holding the new value of the
+ *	variable given by localIndex. If the specified variable doesn't
+ *	exist, or there is a clash in array usage, or an error occurs while
+ *	executing variable traces, then NULL is returned and a message will
+ *	be left in the interpreter's result. 
+ *
+ * Side effects:
+ *	The value of the given variable is incremented by the specified
+ *	amount. The ref count for the returned object is _not_ incremented
+ *	to reflect the returned reference; if you want to keep a reference
+ *	to the object you must increment its ref count yourself.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclIncrIndexedScalar(interp, localIndex, incrAmount)
+    Tcl_Interp *interp;		/* Command interpreter in which variable is
+				 * to be found. */
+    int localIndex;		/* Index of variable in procedure's array
+				 * of local variables. */
+    long incrAmount;		/* Amount to be added to variable. */
+{
+    register Tcl_Obj *varValuePtr;
+    Tcl_Obj *resultPtr;
+    int createdNewObj;		/* Set 1 if var's value object is shared
+				 * so we must increment a copy (i.e. copy
+				 * on write). */
+    long i;
+    int result;
+
+    varValuePtr = TclGetIndexedScalar(interp, localIndex,
+	    /*leaveErrorMsg*/ 1);
+    if (varValuePtr == NULL) {
+	Tcl_AddObjErrorInfo(interp,
+		"\n    (reading value of variable to increment)", -1);
+	return NULL;
+    }
+
+    /*
+     * Reach into the object's representation to extract and increment the
+     * variable's value. If the object is unshared we can modify it
+     * directly, otherwise we must create a new copy to modify: this is
+     * "copy on write". Then free the variable's old string representation,
+     * if any, since it will no longer be valid.
+     */
+
+    createdNewObj = 0;
+    if (Tcl_IsShared(varValuePtr)) {
+	createdNewObj = 1;
+	varValuePtr = Tcl_DuplicateObj(varValuePtr);
+    }
+    result = Tcl_GetLongFromObj(interp, varValuePtr, &i);
+    if (result != TCL_OK) {
+	if (createdNewObj) {
+	    Tcl_DecrRefCount(varValuePtr); /* free unneeded copy */
+	}
+	return NULL;
+    }
+    Tcl_SetLongObj(varValuePtr, (i + incrAmount));
+
+    /*
+     * Store the variable's new value and run any write traces.
+     */
+    
+    resultPtr = TclSetIndexedScalar(interp, localIndex, varValuePtr,
+	    /*leaveErrorMsg*/ 1);
+    if (resultPtr == NULL) {
+	return NULL;
+    }
+    return resultPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclIncrElementOfIndexedArray --
+ *
+ *	Increments the Tcl object value of an element in a local array
+ *	variable. The element is named by the object elemPtr while the array
+ *	is specified by its index in the active procedure's array of
+ *	compiler allocated local variables.
+ *
+ * Results:
+ *	Returns a pointer to the Tcl_Obj holding the new value of the
+ *	element. If the specified array or element doesn't exist, or there
+ *	is a clash in array usage, or an error occurs while executing
+ *	variable traces, then NULL is returned and a message will be left in
+ *	the interpreter's result.
+ *
+ * Side effects:
+ *	The value of the given array element is incremented by the specified
+ *	amount. The ref count for the returned object is _not_ incremented
+ *	to reflect the returned reference; if you want to keep a reference
+ *	to the object you must increment its ref count yourself. If the
+ *	entry doesn't exist then a new variable is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclIncrElementOfIndexedArray(interp, localIndex, elemPtr, incrAmount)
+    Tcl_Interp *interp;		/* Command interpreter in which the array is
+				 * to be found. */
+    int localIndex;		/* Index of array variable in procedure's
+				 * array of local variables. */
+    Tcl_Obj *elemPtr;		/* Points to an object holding the name of
+				 * an element to increment in the array. */
+    long incrAmount;		/* Amount to be added to variable. */
+{
+    register Tcl_Obj *varValuePtr;
+    Tcl_Obj *resultPtr;
+    int createdNewObj;		/* Set 1 if var's value object is shared
+				 * so we must increment a copy (i.e. copy
+				 * on write). */
+    long i;
+    int result;
+
+    varValuePtr = TclGetElementOfIndexedArray(interp, localIndex, elemPtr,
+	    /*leaveErrorMsg*/ 1);
+    if (varValuePtr == NULL) {
+	Tcl_AddObjErrorInfo(interp,
+		"\n    (reading value of variable to increment)", -1);
+	return NULL;
+    }
+
+    /*
+     * Reach into the object's representation to extract and increment the
+     * variable's value. If the object is unshared we can modify it
+     * directly, otherwise we must create a new copy to modify: this is
+     * "copy on write". Then free the variable's old string representation,
+     * if any, since it will no longer be valid.
+     */
+
+    createdNewObj = 0;
+    if (Tcl_IsShared(varValuePtr)) {
+	createdNewObj = 1;
+	varValuePtr = Tcl_DuplicateObj(varValuePtr);
+    }
+    result = Tcl_GetLongFromObj(interp, varValuePtr, &i);
+    if (result != TCL_OK) {
+	if (createdNewObj) {
+	    Tcl_DecrRefCount(varValuePtr); /* free unneeded copy */
+	}
+	return NULL;
+    }
+    Tcl_SetLongObj(varValuePtr, (i + incrAmount));
+    
+    /*
+     * Store the variable's new value and run any write traces.
+     */
+    
+    resultPtr = TclSetElementOfIndexedArray(interp, localIndex, elemPtr,
+	    varValuePtr,
+	    /*leaveErrorMsg*/ 1);
+    if (resultPtr == NULL) {
+	return NULL;
+    }
+    return resultPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UnsetVar --
+ *
+ *	Delete a variable, so that it may not be accessed anymore.
+ *
+ * Results:
+ *	Returns TCL_OK if the variable was successfully deleted, TCL_ERROR
+ *	if the variable can't be unset.  In the event of an error,
+ *	if the TCL_LEAVE_ERR_MSG flag is set then an error message
+ *	is left in interp->result.
+ *
+ * Side effects:
+ *	If varName is defined as a local or global variable in interp,
+ *	it is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_UnsetVar(interp, varName, flags)
+    Tcl_Interp *interp;		/* Command interpreter in which varName is
+				 * to be looked up. */
+    char *varName;		/* Name of a variable in interp.  May be
+				 * either a scalar name or an array name
+				 * or an element in an array. */
+    int flags;			/* OR-ed combination of any of
+				 * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY or
+				 * TCL_LEAVE_ERR_MSG. */
+{
+    return Tcl_UnsetVar2(interp, varName, (char *) NULL,
+	    (flags | TCL_PARSE_PART1));
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UnsetVar2 --
+ *
+ *	Delete a variable, given a 2-part name.
+ *
+ * Results:
+ *	Returns TCL_OK if the variable was successfully deleted, TCL_ERROR
+ *	if the variable can't be unset.  In the event of an error,
+ *	if the TCL_LEAVE_ERR_MSG flag is set then an error message
+ *	is left in interp->result.
+ *
+ * Side effects:
+ *	If part1 and part2 indicate a local or global variable in interp,
+ *	it is deleted.  If part1 is an array name and part2 is NULL, then
+ *	the whole array is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_UnsetVar2(interp, part1, part2, flags)
+    Tcl_Interp *interp;		/* Command interpreter in which varName is
+				 * to be looked up. */
+    char *part1;		/* Name of variable or array. */
+    char *part2;		/* Name of element within array or NULL. */
+    int flags;			/* OR-ed combination of any of
+				 * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
+				 * TCL_LEAVE_ERR_MSG, or
+				 * TCL_PARSE_PART1. */
+{
+    Var dummyVar;
+    Var *varPtr, *dummyVarPtr;
+    Interp *iPtr = (Interp *) interp;
+    Var *arrayPtr;
+    ActiveVarTrace *activePtr;
+    Tcl_Obj *objPtr;
+    int result;
+
+    varPtr = TclLookupVar(interp, part1, part2, flags, "unset",
+	    /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+    if (varPtr == NULL) {
+	return TCL_ERROR;
+    }
+    result = (TclIsVarUndefined(varPtr)? TCL_ERROR : TCL_OK);
+
+    if ((arrayPtr != NULL) && (arrayPtr->searchPtr != NULL)) {
+	DeleteSearches(arrayPtr);
+    }
+
+    /*
+     * The code below is tricky, because of the possibility that
+     * a trace procedure might try to access a variable being
+     * deleted. To handle this situation gracefully, do things
+     * in three steps:
+     * 1. Copy the contents of the variable to a dummy variable
+     *    structure, and mark the original Var structure as undefined.
+     * 2. Invoke traces and clean up the variable, using the dummy copy.
+     * 3. If at the end of this the original variable is still
+     *    undefined and has no outstanding references, then delete
+     *	  it (but it could have gotten recreated by a trace).
+     */
+
+    dummyVar = *varPtr;
+    TclSetVarUndefined(varPtr);
+    TclSetVarScalar(varPtr);
+    varPtr->value.objPtr = NULL; /* dummyVar points to any value object */
+    varPtr->tracePtr = NULL;
+    varPtr->searchPtr = NULL;
+
+    /*
+     * Call trace procedures for the variable being deleted. Then delete
+     * its traces. Be sure to abort any other traces for the variable
+     * that are still pending. Special tricks:
+     * 1. We need to increment varPtr's refCount around this: CallTraces
+     *    will use dummyVar so it won't increment varPtr's refCount itself.
+     * 2. Turn off the VAR_TRACE_ACTIVE flag in dummyVar: we want to
+     *    call unset traces even if other traces are pending.
+     */
+
+    if ((dummyVar.tracePtr != NULL)
+	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
+	varPtr->refCount++;
+	dummyVar.flags &= ~VAR_TRACE_ACTIVE;
+	(void) CallTraces(iPtr, arrayPtr, &dummyVar, part1, part2,
+		(flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_PARSE_PART1)) | TCL_TRACE_UNSETS);
+	while (dummyVar.tracePtr != NULL) {
+	    VarTrace *tracePtr = dummyVar.tracePtr;
+	    dummyVar.tracePtr = tracePtr->nextPtr;
+	    ckfree((char *) tracePtr);
+	}
+	for (activePtr = iPtr->activeTracePtr;  activePtr != NULL;
+	     activePtr = activePtr->nextPtr) {
+	    if (activePtr->varPtr == varPtr) {
+		activePtr->nextTracePtr = NULL;
+	    }
+	}
+	varPtr->refCount--;
+    }
+
+    /*
+     * If the variable is an array, delete all of its elements. This must be
+     * done after calling the traces on the array, above (that's the way
+     * traces are defined). If it is a scalar, "discard" its object
+     * (decrement the ref count of its object, if any).
+     */
+
+    dummyVarPtr = &dummyVar;
+    if (TclIsVarArray(dummyVarPtr) && !TclIsVarUndefined(dummyVarPtr)) {
+	DeleteArray(iPtr, part1, dummyVarPtr,
+		(flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_UNSETS);
+    }
+    if (TclIsVarScalar(dummyVarPtr)
+	    && (dummyVarPtr->value.objPtr != NULL)) {
+	objPtr = dummyVarPtr->value.objPtr;
+	TclDecrRefCount(objPtr);
+	dummyVarPtr->value.objPtr = NULL;
+    }
+
+    /*
+     * If the variable was a namespace variable, decrement its reference count.
+     */
+    
+    if (varPtr->flags & VAR_NAMESPACE_VAR) {
+	varPtr->flags &= ~VAR_NAMESPACE_VAR;
+	varPtr->refCount--;
+    }
+
+    /*
+     * It's an error to unset an undefined variable.
+     */
+	
+    if (result != TCL_OK) {
+	if (flags & TCL_LEAVE_ERR_MSG) {
+	    VarErrMsg(interp, part1, part2, "unset", 
+		    ((arrayPtr == NULL) ? noSuchVar : noSuchElement));
+	}
+    }
+
+    /*
+     * Finally, if the variable is truly not in use then free up its Var
+     * structure and remove it from its hash table, if any. The ref count of
+     * its value object, if any, was decremented above.
+     */
+
+    CleanupVar(varPtr, arrayPtr);
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_TraceVar --
+ *
+ *	Arrange for reads and/or writes to a variable to cause a
+ *	procedure to be invoked, which can monitor the operations
+ *	and/or change their actions.
+ *
+ * Results:
+ *	A standard Tcl return value.
+ *
+ * Side effects:
+ *	A trace is set up on the variable given by varName, such that
+ *	future references to the variable will be intermediated by
+ *	proc.  See the manual entry for complete details on the calling
+ *	sequence for proc.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_TraceVar(interp, varName, flags, proc, clientData)
+    Tcl_Interp *interp;		/* Interpreter in which variable is
+				 * to be traced. */
+    char *varName;		/* Name of variable;  may end with "(index)"
+				 * to signify an array reference. */
+    int flags;			/* OR-ed collection of bits, including any
+				 * of TCL_TRACE_READS, TCL_TRACE_WRITES,
+				 * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and
+				 * TCL_NAMESPACE_ONLY. */
+    Tcl_VarTraceProc *proc;	/* Procedure to call when specified ops are
+				 * invoked upon varName. */
+    ClientData clientData;	/* Arbitrary argument to pass to proc. */
+{
+    return Tcl_TraceVar2(interp, varName, (char *) NULL,
+	    (flags | TCL_PARSE_PART1), proc, clientData);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_TraceVar2 --
+ *
+ *	Arrange for reads and/or writes to a variable to cause a
+ *	procedure to be invoked, which can monitor the operations
+ *	and/or change their actions.
+ *
+ * Results:
+ *	A standard Tcl return value.
+ *
+ * Side effects:
+ *	A trace is set up on the variable given by part1 and part2, such
+ *	that future references to the variable will be intermediated by
+ *	proc.  See the manual entry for complete details on the calling
+ *	sequence for proc.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData)
+    Tcl_Interp *interp;		/* Interpreter in which variable is
+				 * to be traced. */
+    char *part1;		/* Name of scalar variable or array. */
+    char *part2;		/* Name of element within array;  NULL means
+				 * trace applies to scalar variable or array
+				 * as-a-whole. */
+    int flags;			/* OR-ed collection of bits, including any
+				 * of TCL_TRACE_READS, TCL_TRACE_WRITES,
+				 * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY,
+				 * TCL_NAMESPACE_ONLY and
+				 * TCL_PARSE_PART1. */
+    Tcl_VarTraceProc *proc;	/* Procedure to call when specified ops are
+				 * invoked upon varName. */
+    ClientData clientData;	/* Arbitrary argument to pass to proc. */
+{
+    Var *varPtr, *arrayPtr;
+    register VarTrace *tracePtr;
+
+    varPtr = TclLookupVar(interp, part1, part2, (flags | TCL_LEAVE_ERR_MSG),
+	    "trace", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
+    if (varPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Set up trace information.
+     */
+
+    tracePtr = (VarTrace *) ckalloc(sizeof(VarTrace));
+    tracePtr->traceProc = proc;
+    tracePtr->clientData = clientData;
+    tracePtr->flags = 
+	flags & (TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS);
+    tracePtr->nextPtr = varPtr->tracePtr;
+    varPtr->tracePtr = tracePtr;
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UntraceVar --
+ *
+ *	Remove a previously-created trace for a variable.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	If there exists a trace for the variable given by varName
+ *	with the given flags, proc, and clientData, then that trace
+ *	is removed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_UntraceVar(interp, varName, flags, proc, clientData)
+    Tcl_Interp *interp;		/* Interpreter containing variable. */
+    char *varName;		/* Name of variable; may end with "(index)"
+				 * to signify an array reference. */
+    int flags;			/* OR-ed collection of bits describing
+				 * current trace, including any of
+				 * TCL_TRACE_READS, TCL_TRACE_WRITES,
+				 * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY
+				 * and TCL_NAMESPACE_ONLY. */
+    Tcl_VarTraceProc *proc;	/* Procedure assocated with trace. */
+    ClientData clientData;	/* Arbitrary argument to pass to proc. */
+{
+    Tcl_UntraceVar2(interp, varName, (char *) NULL,
+	    (flags | TCL_PARSE_PART1), proc, clientData);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UntraceVar2 --
+ *
+ *	Remove a previously-created trace for a variable.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	If there exists a trace for the variable given by part1
+ *	and part2 with the given flags, proc, and clientData, then
+ *	that trace is removed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
+    Tcl_Interp *interp;		/* Interpreter containing variable. */
+    char *part1;		/* Name of variable or array. */
+    char *part2;		/* Name of element within array;  NULL means
+				 * trace applies to scalar variable or array
+				 * as-a-whole. */
+    int flags;			/* OR-ed collection of bits describing
+				 * current trace, including any of
+				 * TCL_TRACE_READS, TCL_TRACE_WRITES,
+				 * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY,
+				 * TCL_NAMESPACE_ONLY and
+				 * TCL_PARSE_PART1. */
+    Tcl_VarTraceProc *proc;	/* Procedure assocated with trace. */
+    ClientData clientData;	/* Arbitrary argument to pass to proc. */
+{
+    register VarTrace *tracePtr;
+    VarTrace *prevPtr;
+    Var *varPtr, *arrayPtr;
+    Interp *iPtr = (Interp *) interp;
+    ActiveVarTrace *activePtr;
+
+    varPtr = TclLookupVar(interp, part1, part2,
+	    flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_PARSE_PART1),
+	    /*msg*/ (char *) NULL,
+	    /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+    if (varPtr == NULL) {
+	return;
+    }
+
+    flags &= (TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS);
+    for (tracePtr = varPtr->tracePtr, prevPtr = NULL;  ;
+	 prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
+	if (tracePtr == NULL) {
+	    return;
+	}
+	if ((tracePtr->traceProc == proc) && (tracePtr->flags == flags)
+		&& (tracePtr->clientData == clientData)) {
+	    break;
+	}
+    }
+
+    /*
+     * The code below makes it possible to delete traces while traces
+     * are active: it makes sure that the deleted trace won't be
+     * processed by CallTraces.
+     */
+
+    for (activePtr = iPtr->activeTracePtr;  activePtr != NULL;
+	 activePtr = activePtr->nextPtr) {
+	if (activePtr->nextTracePtr == tracePtr) {
+	    activePtr->nextTracePtr = tracePtr->nextPtr;
+	}
+    }
+    if (prevPtr == NULL) {
+	varPtr->tracePtr = tracePtr->nextPtr;
+    } else {
+	prevPtr->nextPtr = tracePtr->nextPtr;
+    }
+    ckfree((char *) tracePtr);
+
+    /*
+     * If this is the last trace on the variable, and the variable is
+     * unset and unused, then free up the variable.
+     */
+
+    if (TclIsVarUndefined(varPtr)) {
+	CleanupVar(varPtr, (Var *) NULL);
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_VarTraceInfo --
+ *
+ *	Return the clientData value associated with a trace on a
+ *	variable.  This procedure can also be used to step through
+ *	all of the traces on a particular variable that have the
+ *	same trace procedure.
+ *
+ * Results:
+ *	The return value is the clientData value associated with
+ *	a trace on the given variable.  Information will only be
+ *	returned for a trace with proc as trace procedure.  If
+ *	the clientData argument is NULL then the first such trace is
+ *	returned;  otherwise, the next relevant one after the one
+ *	given by clientData will be returned.  If the variable
+ *	doesn't exist, or if there are no (more) traces for it,
+ *	then NULL is returned.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ClientData
+Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData)
+    Tcl_Interp *interp;		/* Interpreter containing variable. */
+    char *varName;		/* Name of variable;  may end with "(index)"
+				 * to signify an array reference. */
+    int flags;			/* 0, TCL_GLOBAL_ONLY, or
+				 * TCL_NAMESPACE_ONLY. */
+    Tcl_VarTraceProc *proc;	/* Procedure assocated with trace. */
+    ClientData prevClientData;	/* If non-NULL, gives last value returned
+				 * by this procedure, so this call will
+				 * return the next trace after that one.
+				 * If NULL, this call will return the
+				 * first trace. */
+{
+    return Tcl_VarTraceInfo2(interp, varName, (char *) NULL,
+	    (flags | TCL_PARSE_PART1), proc, prevClientData);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_VarTraceInfo2 --
+ *
+ *	Same as Tcl_VarTraceInfo, except takes name in two pieces
+ *	instead of one.
+ *
+ * Results:
+ *	Same as Tcl_VarTraceInfo.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ClientData
+Tcl_VarTraceInfo2(interp, part1, part2, flags, proc, prevClientData)
+    Tcl_Interp *interp;		/* Interpreter containing variable. */
+    char *part1;		/* Name of variable or array. */
+    char *part2;		/* Name of element within array;  NULL means
+				 * trace applies to scalar variable or array
+				 * as-a-whole. */
+    int flags;			/* OR-ed combination of TCL_GLOBAL_ONLY,
+				 * TCL_NAMESPACE_ONLY, and
+				 * TCL_PARSE_PART1. */
+    Tcl_VarTraceProc *proc;	/* Procedure assocated with trace. */
+    ClientData prevClientData;	/* If non-NULL, gives last value returned
+				 * by this procedure, so this call will
+				 * return the next trace after that one.
+				 * If NULL, this call will return the
+				 * first trace. */
+{
+    register VarTrace *tracePtr;
+    Var *varPtr, *arrayPtr;
+
+    varPtr = TclLookupVar(interp, part1, part2,
+	    flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_PARSE_PART1),
+	    /*msg*/ (char *) NULL,
+	    /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+    if (varPtr == NULL) {
+	return NULL;
+    }
+
+    /*
+     * Find the relevant trace, if any, and return its clientData.
+     */
+
+    tracePtr = varPtr->tracePtr;
+    if (prevClientData != NULL) {
+	for ( ;  tracePtr != NULL;  tracePtr = tracePtr->nextPtr) {
+	    if ((tracePtr->clientData == prevClientData)
+		    && (tracePtr->traceProc == proc)) {
+		tracePtr = tracePtr->nextPtr;
+		break;
+	    }
+	}
+    }
+    for ( ;  tracePtr != NULL;  tracePtr = tracePtr->nextPtr) {
+	if (tracePtr->traceProc == proc) {
+	    return tracePtr->clientData;
+	}
+    }
+    return NULL;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UnsetObjCmd --
+ *
+ *	This object-based procedure is invoked to process the "unset" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl object result value.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_UnsetObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    register int i;
+    register char *name;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "varName ?varName ...?");
+	return TCL_ERROR;
+    }
+    
+    for (i = 1;  i < objc;  i++) {
+	/*
+	 * THIS FAILS IF A NAME OBJECT'S STRING REP HAS A NULL BYTE.
+	 */
+
+	name = Tcl_GetStringFromObj(objv[i], (int *) NULL);
+	if (Tcl_UnsetVar2(interp, name, (char *) NULL,
+	        (TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1)) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+    }
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AppendObjCmd --
+ *
+ *	This object-based procedure is invoked to process the "append" 
+ *	Tcl command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl object result value.
+ *
+ * Side effects:
+ *	A variable's value may be changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_AppendObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    register Tcl_Obj *varValuePtr = NULL;
+    /* Initialized to avoid compiler
+     * warning. */
+    int i;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value value ...?");
+	return TCL_ERROR;
+    }
+
+    if (objc == 2) {
+	varValuePtr = Tcl_ObjGetVar2(interp, objv[1], (Tcl_Obj *) NULL,
+	        (TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1));
+	if (varValuePtr == NULL) {
+	    return TCL_ERROR;
+	}
+    } else {
+	for (i = 2;  i < objc;  i++) {
+	    varValuePtr = Tcl_ObjSetVar2(interp, objv[1], (Tcl_Obj *) NULL,
+		    objv[i],
+		    (TCL_APPEND_VALUE | TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1));
+	    if (varValuePtr == NULL) {
+		return TCL_ERROR;
+	    }
+	}
+    }
+    
+    Tcl_SetObjResult(interp, varValuePtr);
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LappendObjCmd --
+ *
+ *	This object-based procedure is invoked to process the "lappend" 
+ *	Tcl command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl object result value.
+ *
+ * Side effects:
+ *	A variable's value may be changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_LappendObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Tcl_Obj *varValuePtr, *newValuePtr;
+    register List *listRepPtr;
+    register Tcl_Obj **elemPtrs;
+    int numElems, numRequired, createdNewObj, createVar, i, j;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value value ...?");
+	return TCL_ERROR;
+    }
+    
+    if (objc == 2) {
+	newValuePtr = Tcl_ObjGetVar2(interp, objv[1], (Tcl_Obj *) NULL,
+		(TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1));
+	if (newValuePtr == NULL) {
+	    /*
+	     * The variable doesn't exist yet. Just create it with an empty
+	     * initial value.
+	     */
+	    
+	    Tcl_Obj *nullObjPtr = Tcl_NewObj();
+	    newValuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL,
+		    nullObjPtr, (TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1));
+	    if (newValuePtr == NULL) {
+		Tcl_DecrRefCount(nullObjPtr); /* free unneeded object */
+		return TCL_ERROR;
+	    }
+	}
+    } else {
+	/*
+	 * We have arguments to append. We used to call Tcl_ObjSetVar2 to
+	 * append each argument one at a time to ensure that traces were run
+	 * for each append step. We now append the arguments all at once
+	 * because it's faster. Note that a read trace and a write trace for
+	 * the variable will now each only be called once. Also, if the
+	 * variable's old value is unshared we modify it directly, otherwise
+	 * we create a new copy to modify: this is "copy on write".
+	 */
+
+	createdNewObj = 0;
+	createVar = 1;
+	varValuePtr = Tcl_ObjGetVar2(interp, objv[1], (Tcl_Obj *) NULL,
+	        TCL_PARSE_PART1);
+	if (varValuePtr == NULL) {
+	    /*
+	     * We couldn't read the old value: either the var doesn't yet
+	     * exist or it's an array element. If it's new, we will try to
+	     * create it with Tcl_ObjSetVar2 below.
+	     */
+	    
+	    char *name, *p;
+	    int nameBytes, i;
+
+	    name = TclGetStringFromObj(objv[1], &nameBytes);
+	    for (i = 0, p = name;  i < nameBytes;  i++, p++) {
+		if (*p == '(') {
+		    p = (name + nameBytes-1);	
+		    if (*p == ')') { /* last char is ')' => array ref */
+			createVar = 0;
+		    }
+		    break;
+		}
+	    }
+	    varValuePtr = Tcl_NewObj();
+	    createdNewObj = 1;
+	} else if (Tcl_IsShared(varValuePtr)) {	
+	    varValuePtr = Tcl_DuplicateObj(varValuePtr);
+	    createdNewObj = 1;
+	}
+
+	/*
+	 * Convert the variable's old value to a list object if necessary.
+	 */
+
+	if (varValuePtr->typePtr != &tclListType) {
+	    int result = tclListType.setFromAnyProc(interp, varValuePtr);
+	    if (result != TCL_OK) {
+		if (createdNewObj) {
+		    Tcl_DecrRefCount(varValuePtr); /* free unneeded obj. */
+		}
+		return result;
+	    }
+	}
+	listRepPtr = (List *) varValuePtr->internalRep.otherValuePtr;
+	elemPtrs = listRepPtr->elements;
+	numElems = listRepPtr->elemCount;
+
+	/*
+	 * If there is no room in the current array of element pointers,
+	 * allocate a new, larger array and copy the pointers to it.
+	 */
+	
+	numRequired = numElems + (objc-2);
+	if (numRequired > listRepPtr->maxElemCount) {
+	    int newMax = (2 * numRequired);
+	    Tcl_Obj **newElemPtrs = (Tcl_Obj **)
+		ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
+	    
+	    memcpy((VOID *) newElemPtrs, (VOID *) elemPtrs,
+		    (size_t) (numElems * sizeof(Tcl_Obj *)));
+	    listRepPtr->maxElemCount = newMax;
+	    listRepPtr->elements = newElemPtrs;
+	    ckfree((char *) elemPtrs);
+	    elemPtrs = newElemPtrs;
+	}
+
+	/*
+	 * Insert the new elements at the end of the list.
+	 */
+
+	for (i = 2, j = numElems;  i < objc;  i++, j++) {
+            elemPtrs[j] = objv[i];
+            Tcl_IncrRefCount(objv[i]);
+        }
+	listRepPtr->elemCount = numRequired;
+
+	/*
+	 * Invalidate and free any old string representation since it no
+	 * longer reflects the list's internal representation.
+	 */
+
+	Tcl_InvalidateStringRep(varValuePtr);
+
+	/*
+	 * Now store the list object back into the variable. If there is an
+	 * error setting the new value, decrement its ref count if it
+	 * was new and we didn't create the variable.
+	 */
+	
+	newValuePtr = Tcl_ObjSetVar2(interp, objv[1], (Tcl_Obj *) NULL,
+		varValuePtr, (TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1));
+	if (newValuePtr == NULL) {
+	    if (createdNewObj && !createVar) {
+		Tcl_DecrRefCount(varValuePtr); /* free unneeded obj */
+	    }
+	    return TCL_ERROR;
+	}
+    }
+
+    /*
+     * Set the interpreter's object result to refer to the variable's value
+     * object.
+     */
+
+    Tcl_SetObjResult(interp, newValuePtr);
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ArrayObjCmd --
+ *
+ *	This object-based procedure is invoked to process the "array" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result object.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_ArrayObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    /*
+     * The list of constants below should match the arrayOptions string array
+     * below.
+     */
+
+    enum {ARRAY_ANYMORE, ARRAY_DONESEARCH,  ARRAY_EXISTS, ARRAY_GET,
+	  ARRAY_NAMES, ARRAY_NEXTELEMENT, ARRAY_SET, ARRAY_SIZE,
+	  ARRAY_STARTSEARCH}; 
+    static char *arrayOptions[] = {"anymore", "donesearch", "exists",
+				   "get", "names", "nextelement", "set", "size", "startsearch", 
+				   (char *) NULL};
+
+    Var *varPtr, *arrayPtr;
+    Tcl_HashEntry *hPtr;
+    Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
+    int notArray;
+    char *varName;
+    int index, result;
+
+
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "option arrayName ?arg ...?");
+	return TCL_ERROR;
+    }
+
+    if (Tcl_GetIndexFromObj(interp, objv[1], arrayOptions, "option", 0, &index)
+	    != TCL_OK) {
+    	return TCL_ERROR;
+    }
+
+    /*
+     * Locate the array variable (and it better be an array).
+     * THIS FAILS IF A NAME OBJECT'S STRING REP HAS A NULL BYTE.
+     */
+    
+    varName = TclGetStringFromObj(objv[2], (int *) NULL);
+    varPtr = TclLookupVar(interp, varName, (char *) NULL, /*flags*/ 0,
+            /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+
+    notArray = 0;
+    if ((varPtr == NULL) || !TclIsVarArray(varPtr)
+	    || TclIsVarUndefined(varPtr)) {
+	notArray = 1;
+    }
+    
+    switch (index) {
+        case ARRAY_ANYMORE: {
+	    ArraySearch *searchPtr;
+	    char *searchId;
+	    
+	    if (objc != 4) {
+	        Tcl_WrongNumArgs(interp, 2, objv, 
+                        "arrayName searchId");
+		return TCL_ERROR;
+	    }
+	    if (notArray) {
+	        goto error;
+	    }
+	    searchId = Tcl_GetStringFromObj(objv[3], (int *) NULL);
+	    searchPtr = ParseSearchId(interp, varPtr, varName, searchId);
+	    if (searchPtr == NULL) {
+	        return TCL_ERROR;
+	    }
+	    while (1) {
+	        Var *varPtr2;
+
+		if (searchPtr->nextEntry != NULL) {
+		    varPtr2 = (Var *) Tcl_GetHashValue(searchPtr->nextEntry);
+		    if (!TclIsVarUndefined(varPtr2)) {
+		        break;
+		    }
+		}
+		searchPtr->nextEntry = Tcl_NextHashEntry(&searchPtr->search);
+		if (searchPtr->nextEntry == NULL) {
+		    Tcl_SetIntObj(resultPtr, 0);
+		    return TCL_OK;
+		}
+	    }
+	    Tcl_SetIntObj(resultPtr, 1);
+	    break;
+	}
+        case ARRAY_DONESEARCH: {
+	    ArraySearch *searchPtr, *prevPtr;
+	    char *searchId;
+
+	    if (objc != 4) {
+	        Tcl_WrongNumArgs(interp, 2, objv, 
+                        "arrayName searchId");
+		return TCL_ERROR;
+	    }
+	    if (notArray) {
+	        goto error;
+	    }
+	    searchId = Tcl_GetStringFromObj(objv[3], (int *) NULL);
+	    searchPtr = ParseSearchId(interp, varPtr, varName, searchId);
+	    if (searchPtr == NULL) {
+	        return TCL_ERROR;
+	    }
+	    if (varPtr->searchPtr == searchPtr) {
+	        varPtr->searchPtr = searchPtr->nextPtr;
+	    } else {
+	        for (prevPtr = varPtr->searchPtr;  ;
+		     prevPtr = prevPtr->nextPtr) {
+		    if (prevPtr->nextPtr == searchPtr) {
+		        prevPtr->nextPtr = searchPtr->nextPtr;
+			break;
+		    }
+		}
+	    }
+	    ckfree((char *) searchPtr);
+	    break;
+	}
+        case ARRAY_EXISTS: {
+	    if (objc != 3) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
+	        return TCL_ERROR;
+	    }
+	    Tcl_SetIntObj(resultPtr, !notArray);
+	    break;
+	}
+        case ARRAY_GET: {
+	    Tcl_HashSearch search;
+	    Var *varPtr2;
+	    char *pattern = NULL;
+	    char *name;
+	    Tcl_Obj *namePtr, *valuePtr;
+	    
+	    if ((objc != 3) && (objc != 4)) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "arrayName ?pattern?");
+		return TCL_ERROR;
+	    }
+	    if (notArray) {
+	        return TCL_OK;
+	    }
+	    if (objc == 4) {
+	        pattern = Tcl_GetStringFromObj(objv[3], (int *) NULL);
+	    }
+	    for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
+		 hPtr != NULL;  hPtr = Tcl_NextHashEntry(&search)) {
+	        varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
+		if (TclIsVarUndefined(varPtr2)) {
+		    continue;
+		}
+		name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr);
+		if ((objc == 4) && !Tcl_StringMatch(name, pattern)) {
+		    continue;	/* element name doesn't match pattern */
+		}
+		
+		namePtr = Tcl_NewStringObj(name, -1);
+		result = Tcl_ListObjAppendElement(interp, resultPtr,
+		        namePtr);
+		if (result != TCL_OK) {
+		    Tcl_DecrRefCount(namePtr); /* free unneeded name obj */
+		    return result;
+		}
+
+		valuePtr = Tcl_ObjGetVar2(interp, objv[2], namePtr,
+	                TCL_LEAVE_ERR_MSG);
+		if (valuePtr == NULL) {
+		    Tcl_DecrRefCount(namePtr); /* free unneeded name obj */
+		    return result;
+		}
+		result = Tcl_ListObjAppendElement(interp, resultPtr,
+			valuePtr);
+		if (result != TCL_OK) {
+		    Tcl_DecrRefCount(namePtr); /* free unneeded name obj */
+		    return result;
+		}
+	    }
+	    break;
+	}
+        case ARRAY_NAMES: {
+	    Tcl_HashSearch search;
+	    Var *varPtr2;
+	    char *pattern = NULL;
+	    char *name;
+	    Tcl_Obj *namePtr;
+	    
+	    if ((objc != 3) && (objc != 4)) {
+  	        Tcl_WrongNumArgs(interp, 2, objv, "arrayName ?pattern?");
+		return TCL_ERROR;
+	    }
+	    if (notArray) {
+	        return TCL_OK;
+	    }
+	    if (objc == 4) {
+	        pattern = Tcl_GetStringFromObj(objv[3], (int *) NULL);
+	    }
+	    for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
+		 hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+	        varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
+		if (TclIsVarUndefined(varPtr2)) {
+		    continue;
+		}
+		name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr);
+		if ((objc == 4) && !Tcl_StringMatch(name, pattern)) {
+ 		    continue;	/* element name doesn't match pattern */
+		}
+		
+		namePtr = Tcl_NewStringObj(name, -1);
+		result = Tcl_ListObjAppendElement(interp, resultPtr, namePtr);
+		if (result != TCL_OK) {
+		    Tcl_DecrRefCount(namePtr); /* free unneeded name object */
+		    return result;
+		}
+	    }
+	    break;
+	}
+        case ARRAY_NEXTELEMENT: {
+	    ArraySearch *searchPtr;
+	    char *searchId;
+	    Tcl_HashEntry *hPtr;
+	    
+	    if (objc != 4) {
+	        Tcl_WrongNumArgs(interp, 2, objv, 
+                        "arrayName searchId");
+		return TCL_ERROR;
+	    }
+	    if (notArray) {
+  	        goto error;
+	    }
+	    searchId = Tcl_GetStringFromObj(objv[3], (int *) NULL);
+	    searchPtr = ParseSearchId(interp, varPtr, varName, searchId);
+	    if (searchPtr == NULL) {
+	        return TCL_ERROR;
+	    }
+	    while (1) {
+	        Var *varPtr2;
+
+		hPtr = searchPtr->nextEntry;
+		if (hPtr == NULL) {
+		    hPtr = Tcl_NextHashEntry(&searchPtr->search);
+		    if (hPtr == NULL) {
+		        return TCL_OK;
+		    }
+		} else {
+		    searchPtr->nextEntry = NULL;
+		}
+		varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
+		if (!TclIsVarUndefined(varPtr2)) {
+		    break;
+		}
+	    }
+	    Tcl_SetStringObj(resultPtr,
+	            Tcl_GetHashKey(varPtr->value.tablePtr, hPtr), -1);
+	    break;
+	}
+        case ARRAY_SET: {
+	    Tcl_Obj **elemPtrs;
+	    int listLen, i, result;
+	    
+	    if (objc != 4) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "arrayName list");
+		return TCL_ERROR;
+	    }
+	    result = Tcl_ListObjGetElements(interp, objv[3], &listLen, 
+                    &elemPtrs);
+	    if (result != TCL_OK) {
+	        return result;
+	    }
+	    if (listLen & 1) {
+	        Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+                        "list must have an even number of elements", -1);
+		return TCL_ERROR;
+	    }
+	    if (listLen > 0) {
+		for (i = 0;  i < listLen;  i += 2) {
+		    if (Tcl_ObjSetVar2(interp, objv[2], elemPtrs[i],
+			    elemPtrs[i+1], TCL_LEAVE_ERR_MSG) == NULL) {
+			result = TCL_ERROR;
+			break;
+		    }
+		}
+		return result;
+	    }
+  
+	    /*
+	     * The list is empty make sure we have an array, or create
+	     * one if necessary.
+	     */
+	    
+	    if (varPtr != NULL) {
+		if (!TclIsVarUndefined(varPtr) && TclIsVarArray(varPtr)) {
+		    /*
+		     * Already an array, done.
+		     */
+		    
+		    return TCL_OK;
+                }
+		if (TclIsVarArrayElement(varPtr) ||
+			!TclIsVarUndefined(varPtr)) {
+		    /*
+		     * Either an array element, or a scalar: lose!
+		     */
+		    
+		    VarErrMsg(interp, varName, (char *)NULL, "array set",
+                            needArray);
+		    return TCL_ERROR;
+                }
+	    } else {
+		/*
+		 * Create variable for new array.
+		 */
+		
+		varPtr = TclLookupVar(interp, varName, (char *) NULL, 0, 0,
+			/*createPart1*/ 1, /*createPart2*/ 0,
+			&arrayPtr);
+	    }
+	    TclSetVarArray(varPtr);
+	    TclClearVarUndefined(varPtr);
+	    varPtr->value.tablePtr =
+		(Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+	    Tcl_InitHashTable(varPtr->value.tablePtr, TCL_STRING_KEYS);
+	    return TCL_OK;
+	}
+        case ARRAY_SIZE: {
+	    Tcl_HashSearch search;
+	    Var *varPtr2;
+	    int size;
+
+	    if (objc != 3) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
+		return TCL_ERROR;
+	    }
+	    size = 0;
+	    if (!notArray) {
+	        for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, 
+                        &search);
+		     hPtr != NULL;  hPtr = Tcl_NextHashEntry(&search)) {
+		    varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
+		    if (TclIsVarUndefined(varPtr2)) {
+		        continue;
+		    }
+		    size++;
+		}
+	    }
+	    Tcl_SetIntObj(resultPtr, size);
+	    break;
+	}
+        case ARRAY_STARTSEARCH: {
+	    ArraySearch *searchPtr;
+
+	    if (objc != 3) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
+		return TCL_ERROR;
+	    }
+	    if (notArray) {
+	        goto error;
+	    }
+	    searchPtr = (ArraySearch *) ckalloc(sizeof(ArraySearch));
+	    if (varPtr->searchPtr == NULL) {
+	        searchPtr->id = 1;
+		Tcl_AppendStringsToObj(resultPtr, "s-1-", varName,
+		        (char *) NULL);
+	    } else {
+	        char string[20];
+
+		searchPtr->id = varPtr->searchPtr->id + 1;
+		TclFormatInt(string, searchPtr->id);
+		Tcl_AppendStringsToObj(resultPtr, "s-", string, "-", varName,
+			(char *) NULL);
+	    }
+	    searchPtr->varPtr = varPtr;
+	    searchPtr->nextEntry = Tcl_FirstHashEntry(varPtr->value.tablePtr,
+		    &searchPtr->search);
+	    searchPtr->nextPtr = varPtr->searchPtr;
+	    varPtr->searchPtr = searchPtr;
+	    break;
+	}
+    }
+    return TCL_OK;
+
+    error:
+    Tcl_AppendStringsToObj(resultPtr, "\"", varName, "\" isn't an array",
+	    (char *) NULL);
+    return TCL_ERROR;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MakeUpvar --
+ *
+ *	This procedure does all of the work of the "global" and "upvar"
+ *	commands.
+ *
+ * Results:
+ *	A standard Tcl completion code. If an error occurs then an
+ *	error message is left in iPtr->result.
+ *
+ * Side effects:
+ *	The variable given by myName is linked to the variable in framePtr
+ *	given by otherP1 and otherP2, so that references to myName are
+ *	redirected to the other variable like a symbolic link.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+MakeUpvar(iPtr, framePtr, otherP1, otherP2, otherFlags, myName, myFlags)
+    Interp *iPtr;		/* Interpreter containing variables. Used
+				 * for error messages, too. */
+    CallFrame *framePtr;	/* Call frame containing "other" variable.
+				 * NULL means use global :: context. */
+    char *otherP1, *otherP2;	/* Two-part name of variable in framePtr. */
+    int otherFlags;		/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
+				 * indicates scope of "other" variable. */
+    char *myName;		/* Name of variable which will refer to
+				 * otherP1/otherP2. Must be a scalar. */
+    int myFlags;		/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
+				 * indicates scope of myName. */
+{
+    Tcl_HashEntry *hPtr;
+    Var *otherPtr, *varPtr, *arrayPtr;
+    CallFrame *varFramePtr;
+    CallFrame *savedFramePtr = NULL;  /* Init. to avoid compiler warning. */
+    Tcl_HashTable *tablePtr;
+    Namespace *nsPtr, *altNsPtr, *dummyNsPtr;
+    char *tail;
+    int new;
+
+    /*
+     * Find "other" in "framePtr". If not looking up other in just the
+     * current namespace, temporarily replace the current var frame
+     * pointer in the interpreter in order to use TclLookupVar.
+     */
+
+    if (!(otherFlags & TCL_NAMESPACE_ONLY)) {
+	savedFramePtr = iPtr->varFramePtr;
+	iPtr->varFramePtr = framePtr;
+    }
+    otherPtr = TclLookupVar((Tcl_Interp *) iPtr, otherP1, otherP2,
+	    (otherFlags | TCL_LEAVE_ERR_MSG), "access",
+            /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
+    if (!(otherFlags & TCL_NAMESPACE_ONLY)) {
+	iPtr->varFramePtr = savedFramePtr;
+    }
+    if (otherPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Now create a hashtable entry for "myName". Create it as either a
+     * namespace variable or as a local variable in a procedure call
+     * frame. Interpret myName as a namespace variable if:
+     *    1) so requested by a TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY flag,
+     *    2) there is no active frame (we're at the global :: scope),
+     *    3) the active frame was pushed to define the namespace context
+     *       for a "namespace eval" or "namespace inscope" command,
+     *    4) the name has namespace qualifiers ("::"s).
+     * If creating myName in the active procedure, look first in the
+     * frame's array of compiler-allocated local variables, then in its
+     * hashtable for runtime-created local variables. Create that
+     * procedure's local variable hashtable if necessary.
+     */
+
+    varFramePtr = iPtr->varFramePtr;
+    if ((myFlags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
+	    || (varFramePtr == NULL)
+	    || !varFramePtr->isProcCallFrame
+	    || (strstr(myName, "::") != NULL)) {
+	TclGetNamespaceForQualName((Tcl_Interp *) iPtr, myName,
+		(Namespace *) NULL, myFlags, &nsPtr, &altNsPtr, &dummyNsPtr, &tail);
+
+        if (nsPtr == NULL) {
+            nsPtr = altNsPtr;
+        }
+        if (nsPtr == NULL) {
+	    Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"",
+		    myName, "\": unknown namespace", (char *) NULL);
+            return TCL_ERROR;
+        }
+	
+	/*
+	 * Check that we are not trying to create a namespace var linked to
+	 * a local variable in a procedure. If we allowed this, the local
+	 * variable in the shorter-lived procedure frame could go away
+	 * leaving the namespace var's reference invalid.
+	 */
+
+	if ((otherP2 ? arrayPtr->nsPtr : otherPtr->nsPtr) == NULL) {
+	    Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"",
+                    myName, "\": upvar won't create namespace variable that refers to procedure variable",
+		    (char *) NULL);
+            return TCL_ERROR;
+        }
+	
+	hPtr = Tcl_CreateHashEntry(&nsPtr->varTable, tail, &new);
+	if (new) {
+	    varPtr = NewVar();
+	    Tcl_SetHashValue(hPtr, varPtr);
+	    varPtr->hPtr = hPtr;
+            varPtr->nsPtr = nsPtr;
+	} else {
+	    varPtr = (Var *) Tcl_GetHashValue(hPtr);
+	}
+    } else {			/* look in the call frame */
+	Proc *procPtr = varFramePtr->procPtr;
+	int localCt = procPtr->numCompiledLocals;
+	CompiledLocal *localPtr = procPtr->firstLocalPtr;
+	Var *localVarPtr = varFramePtr->compiledLocals;
+	int nameLen = strlen(myName);
+	int i;
+
+	varPtr = NULL;
+	for (i = 0;  i < localCt;  i++) {
+	    if (!TclIsVarTemporary(localPtr)) {
+		char *localName = localVarPtr->name;
+		if ((myName[0] == localName[0])
+		        && (nameLen == localPtr->nameLength)
+		        && (strcmp(myName, localName) == 0)) {
+		    varPtr = localVarPtr;
+		    new = 0;
+		    break;
+		}
+	    }
+	    localVarPtr++;
+	    localPtr = localPtr->nextPtr;
+	}
+	if (varPtr == NULL) {	/* look in frame's local var hashtable */
+	    tablePtr = varFramePtr->varTablePtr;
+	    if (tablePtr == NULL) {
+		tablePtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+		Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS);
+		varFramePtr->varTablePtr = tablePtr;
+	    }
+	    hPtr = Tcl_CreateHashEntry(tablePtr, myName, &new);
+	    if (new) {
+		varPtr = NewVar();
+		Tcl_SetHashValue(hPtr, varPtr);
+		varPtr->hPtr = hPtr;
+                varPtr->nsPtr = varFramePtr->nsPtr;
+	    } else {
+		varPtr = (Var *) Tcl_GetHashValue(hPtr);
+	    }
+	}
+    }
+
+    if (!new) {
+	/*
+	 * The variable already exists. Make sure this variable "varPtr"
+	 * isn't the same as "otherPtr" (avoid circular links). Also, if
+	 * it's not an upvar then it's an error. If it is an upvar, then
+	 * just disconnect it from the thing it currently refers to.
+	 */
+
+	if (varPtr == otherPtr) {
+	    Tcl_SetResult((Tcl_Interp *) iPtr,
+		    "can't upvar from variable to itself", TCL_STATIC);
+	    return TCL_ERROR;
+	}
+	if (TclIsVarLink(varPtr)) {
+	    Var *linkPtr = varPtr->value.linkPtr;
+	    if (linkPtr == otherPtr) {
+		return TCL_OK;
+	    }
+	    linkPtr->refCount--;
+	    if (TclIsVarUndefined(linkPtr)) {
+		CleanupVar(linkPtr, (Var *) NULL);
+	    }
+	} else if (!TclIsVarUndefined(varPtr)) {
+	    Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName,
+		    "\" already exists", (char *) NULL);
+	    return TCL_ERROR;
+	} else if (varPtr->tracePtr != NULL) {
+	    Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName,
+		    "\" has traces: can't use for upvar", (char *) NULL);
+	    return TCL_ERROR;
+	}
+    }
+    TclSetVarLink(varPtr);
+    TclClearVarUndefined(varPtr);
+    varPtr->value.linkPtr = otherPtr;
+    otherPtr->refCount++;
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UpVar --
+ *
+ *	This procedure links one variable to another, just like
+ *	the "upvar" command.
+ *
+ * Results:
+ *	A standard Tcl completion code.  If an error occurs then
+ *	an error message is left in interp->result.
+ *
+ * Side effects:
+ *	The variable in frameName whose name is given by varName becomes
+ *	accessible under the name localName, so that references to
+ *	localName are redirected to the other variable like a symbolic
+ *	link.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_UpVar(interp, frameName, varName, localName, flags)
+    Tcl_Interp *interp;		/* Command interpreter in which varName is
+				 * to be looked up. */
+    char *frameName;		/* Name of the frame containing the source
+				 * variable, such as "1" or "#0". */
+    char *varName;		/* Name of a variable in interp to link to.
+				 * May be either a scalar name or an
+				 * element in an array. */
+    char *localName;		/* Name of link variable. */
+    int flags;			/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
+				 * indicates scope of localName. */
+{
+    int result;
+    CallFrame *framePtr;
+    register char *p;
+
+    result = TclGetFrame(interp, frameName, &framePtr);
+    if (result == -1) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Figure out whether varName is an array reference, then call
+     * MakeUpvar to do all the real work.
+     */
+
+    for (p = varName;  *p != '\0';  p++) {
+	if (*p == '(') {
+	    char *openParen = p;
+	    do {
+		p++;
+	    } while (*p != '\0');
+	    p--;
+	    if (*p != ')') {
+		goto scalar;
+	    }
+	    *openParen = '\0';
+	    *p = '\0';
+	    result = MakeUpvar((Interp *) interp, framePtr, varName,
+		    openParen+1, 0, localName, flags);
+	    *openParen = '(';
+	    *p = ')';
+	    return result;
+	}
+    }
+
+    scalar:
+    return MakeUpvar((Interp *) interp, framePtr, varName, (char *) NULL,
+	    0, localName, flags);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UpVar2 --
+ *
+ *	This procedure links one variable to another, just like
+ *	the "upvar" command.
+ *
+ * Results:
+ *	A standard Tcl completion code.  If an error occurs then
+ *	an error message is left in interp->result.
+ *
+ * Side effects:
+ *	The variable in frameName whose name is given by part1 and
+ *	part2 becomes accessible under the name localName, so that
+ *	references to localName are redirected to the other variable
+ *	like a symbolic link.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_UpVar2(interp, frameName, part1, part2, localName, flags)
+    Tcl_Interp *interp;		/* Interpreter containing variables.  Used
+				 * for error messages too. */
+    char *frameName;		/* Name of the frame containing the source
+				 * variable, such as "1" or "#0". */
+    char *part1, *part2;	/* Two parts of source variable name to
+				 * link to. */
+    char *localName;		/* Name of link variable. */
+    int flags;			/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
+				 * indicates scope of localName. */
+{
+    int result;
+    CallFrame *framePtr;
+
+    result = TclGetFrame(interp, frameName, &framePtr);
+    if (result == -1) {
+	return TCL_ERROR;
+    }
+    return MakeUpvar((Interp *) interp, framePtr, part1, part2, 0,
+	    localName, flags);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetVariableFullName --
+ *
+ *	Given a Tcl_Var token returned by Tcl_FindNamespaceVar, this
+ *	procedure appends to an object the namespace variable's full
+ *	name, qualified by a sequence of parent namespace names.
+ *
+ * Results:
+ *      None.
+ *
+ * Side effects:
+ *      The variable's fully-qualified name is appended to the string
+ *	representation of objPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_GetVariableFullName(interp, variable, objPtr)
+    Tcl_Interp *interp;	        /* Interpreter containing the variable. */
+    Tcl_Var variable;		/* Token for the variable returned by a
+				 * previous call to Tcl_FindNamespaceVar. */
+    Tcl_Obj *objPtr;		/* Points to the object onto which the
+				 * variable's full name is appended. */
+{
+    Interp *iPtr = (Interp *) interp;
+    register Var *varPtr = (Var *) variable;
+    char *name;
+
+    /*
+     * Add the full name of the containing namespace (if any), followed by
+     * the "::" separator, then the variable name.
+     */
+
+    if (varPtr != NULL) {
+	if (!TclIsVarArrayElement(varPtr)) {
+	    if (varPtr->nsPtr != NULL) {
+		Tcl_AppendToObj(objPtr, varPtr->nsPtr->fullName, -1);
+		if (varPtr->nsPtr != iPtr->globalNsPtr) {
+		    Tcl_AppendToObj(objPtr, "::", 2);
+		}
+	    }
+	    if (varPtr->name != NULL) {
+		Tcl_AppendToObj(objPtr, varPtr->name, -1);
+	    } else if (varPtr->hPtr != NULL) {
+		name = Tcl_GetHashKey(varPtr->hPtr->tablePtr, varPtr->hPtr);
+		Tcl_AppendToObj(objPtr, name, -1);
+	    }
+	}
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GlobalObjCmd --
+ *
+ *	This object-based procedure is invoked to process the "global" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl object result value.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GlobalObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Interp *iPtr = (Interp *) interp;
+    register Tcl_Obj *objPtr;
+    char *varName;
+    register char *tail;
+    int result, i;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "varName ?varName ...?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * If we are not executing inside a Tcl procedure, just return.
+     */
+    
+    if ((iPtr->varFramePtr == NULL)
+	    || !iPtr->varFramePtr->isProcCallFrame) {
+	return TCL_OK;
+    }
+
+    for (i = 1;  i < objc;  i++) {
+	/*
+	 * Make a local variable linked to its counterpart in the global ::
+	 * namespace.
+	 */
+	
+	objPtr = objv[i];
+	varName = Tcl_GetStringFromObj(objPtr, (int *) NULL);
+
+	/*
+	 * The variable name might have a scope qualifier, but the name for
+         * the local "link" variable must be the simple name at the tail.
+	 */
+
+	for (tail = varName;  *tail != '\0';  tail++) {
+	    /* empty body */
+	}
+        while ((tail > varName) && ((*tail != ':') || (*(tail-1) != ':'))) {
+            tail--;
+	}
+        if (*tail == ':') {
+            tail++;
+	}
+
+	/*
+	 * Link to the variable "varName" in the global :: namespace.
+	 */
+	
+	result = MakeUpvar(iPtr, (CallFrame *) NULL,
+		varName, (char *) NULL, /*otherFlags*/ TCL_GLOBAL_ONLY,
+	        /*myName*/ tail, /*myFlags*/ 0);
+	if (result != TCL_OK) {
+	    return result;
+	}
+    }
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_VariableObjCmd --
+ *
+ *	Invoked to implement the "variable" command that creates one or more
+ *	global variables. Handles the following syntax:
+ *
+ *	    variable ?name value...? name ?value?
+ *
+ *	One or more variables can be created. The variables are initialized
+ *	with the specified values. The value for the last variable is
+ *	optional.
+ *
+ *	If the variable does not exist, it is created and given the optional
+ *	value. If it already exists, it is simply set to the optional
+ *	value. Normally, "name" is an unqualified name, so it is created in
+ *	the current namespace. If it includes namespace qualifiers, it can
+ *	be created in another namespace.
+ *
+ *	If the variable command is executed inside a Tcl procedure, it
+ *	creates a local variable linked to the newly-created namespace
+ *	variable.
+ *
+ * Results:
+ *	Returns TCL_OK if the variable is found or created. Returns
+ *	TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	If anything goes wrong, this procedure returns an error message
+ *	as the result in the interpreter's result object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_VariableObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Interp *iPtr = (Interp *) interp;
+    char *varName, *tail, *cp;
+    Var *varPtr, *arrayPtr;
+    Tcl_Obj *varValuePtr;
+    int i, result;
+
+    for (i = 1;  i < objc;  i = i+2) {
+	/*
+	 * Look up each variable in the current namespace context, creating
+	 * it if necessary.
+	 */
+	
+	varName = Tcl_GetStringFromObj(objv[i], (int *) NULL);
+	varPtr = TclLookupVar(interp, varName, (char *) NULL,
+                (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "define",
+                /*createPart1*/ 1, /*createPart2*/ 0, &arrayPtr);
+	if (varPtr == NULL) {
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Mark the variable as a namespace variable and increment its 
+	 * reference count so that it will persist until its namespace is
+	 * destroyed or until the variable is unset.
+	 */
+
+	if (!(varPtr->flags & VAR_NAMESPACE_VAR)) {
+	    varPtr->flags |= VAR_NAMESPACE_VAR;
+	    varPtr->refCount++;
+	}
+
+	/*
+	 * If a value was specified, set the variable to that value.
+	 * Otherwise, if the variable is new, leave it undefined.
+	 * (If the variable already exists and no value was specified,
+	 * leave its value unchanged; just create the local link if
+	 * we're in a Tcl procedure).
+	 */
+
+	if (i+1 < objc) {	/* a value was specified */
+	    varValuePtr = Tcl_ObjSetVar2(interp, objv[i], (Tcl_Obj *) NULL,
+		    objv[i+1], (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG));
+	    if (varValuePtr == NULL) {
+		return TCL_ERROR;
+	    }
+	}
+
+	/*
+	 * If we are executing inside a Tcl procedure, create a local
+	 * variable linked to the new namespace variable "varName".
+	 */
+
+	if ((iPtr->varFramePtr != NULL)
+	        && iPtr->varFramePtr->isProcCallFrame) {
+	    /*
+	     * varName might have a scope qualifier, but the name for the
+	     * local "link" variable must be the simple name at the tail.
+	     *
+	     * Locate tail in one pass: drop any prefix after two *or more*
+	     * consecutive ":" characters).
+	     */
+
+	    for (tail = cp = varName;  *cp != '\0'; ) {
+		if (*cp++ == ':') {
+		    while (*cp++ == ':') {
+			tail = cp;
+		    }
+		}
+	    }
+	    
+	    /*
+	     * Create a local link "tail" to the variable "varName" in the
+	     * current namespace.
+	     */
+	    
+	    result = MakeUpvar(iPtr, (CallFrame *) NULL,
+		    /*otherP1*/ varName, /*otherP2*/ (char *) NULL,
+                    /*otherFlags*/ TCL_NAMESPACE_ONLY,
+		    /*myName*/ tail, /*myFlags*/ 0);
+	    if (result != TCL_OK) {
+		return result;
+	    }
+	}
+    }
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UpvarObjCmd --
+ *
+ *	This object-based procedure is invoked to process the "upvar"
+ *	Tcl command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl object result value.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_UpvarObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    register Interp *iPtr = (Interp *) interp;
+    CallFrame *framePtr;
+    char *frameSpec, *otherVarName, *myVarName;
+    register char *p;
+    int result;
+
+    if (objc < 3) {
+	upvarSyntax:
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"?level? otherVar localVar ?otherVar localVar ...?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Find the call frame containing each of the "other variables" to be
+     * linked to. FAILS IF objv[1]'s STRING REP CONTAINS NULLS.
+     */
+
+    frameSpec = Tcl_GetStringFromObj(objv[1], (int *) NULL);
+    result = TclGetFrame(interp, frameSpec, &framePtr);
+    if (result == -1) {
+	return TCL_ERROR;
+    }
+    objc -= result+1;
+    if ((objc & 1) != 0) {
+	goto upvarSyntax;
+    }
+    objv += result+1;
+
+    /*
+     * Iterate over each (other variable, local variable) pair.
+     * Divide the other variable name into two parts, then call
+     * MakeUpvar to do all the work of linking it to the local variable.
+     */
+
+    for ( ;  objc > 0;  objc -= 2, objv += 2) {
+	myVarName = Tcl_GetStringFromObj(objv[1], (int *) NULL);
+	otherVarName = Tcl_GetStringFromObj(objv[0], (int *) NULL);
+	for (p = otherVarName;  *p != 0;  p++) {
+	    if (*p == '(') {
+		char *openParen = p;
+
+		do {
+		    p++;
+		} while (*p != '\0');
+		p--;
+		if (*p != ')') {
+		    goto scalar;
+		}
+		*openParen = '\0';
+		*p = '\0';
+		result = MakeUpvar(iPtr, framePtr,
+		        otherVarName, openParen+1, /*otherFlags*/ 0,
+			myVarName, /*flags*/ 0);
+		*openParen = '(';
+		*p = ')';
+		goto checkResult;
+	    }
+	}
+	scalar:
+	result = MakeUpvar(iPtr, framePtr, otherVarName, (char *) NULL, 0,
+	        myVarName, /*flags*/ 0);
+
+	checkResult:
+	if (result != TCL_OK) {
+	    return TCL_ERROR;
+	}
+    }
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CallTraces --
+ *
+ *	This procedure is invoked to find and invoke relevant
+ *	trace procedures associated with a particular operation on
+ *	a variable. This procedure invokes traces both on the
+ *	variable and on its containing array (where relevant).
+ *
+ * Results:
+ *	The return value is NULL if no trace procedures were invoked, or
+ *	if all the invoked trace procedures returned successfully.
+ *	The return value is non-NULL if a trace procedure returned an
+ *	error (in this case no more trace procedures were invoked after
+ *	the error was returned). In this case the return value is a
+ *	pointer to a static string describing the error.
+ *
+ * Side effects:
+ *	Almost anything can happen, depending on trace; this procedure
+ *	itself doesn't have any side effects.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+CallTraces(iPtr, arrayPtr, varPtr, part1, part2, flags)
+    Interp *iPtr;		/* Interpreter containing variable. */
+    register Var *arrayPtr;	/* Pointer to array variable that contains
+				 * the variable, or NULL if the variable
+				 * isn't an element of an array. */
+    Var *varPtr;		/* Variable whose traces are to be
+				 * invoked. */
+    char *part1, *part2;	/* Variable's two-part name. */
+    int flags;			/* Flags passed to trace procedures:
+				 * indicates what's happening to variable,
+				 * plus other stuff like TCL_GLOBAL_ONLY,
+				 * TCL_NAMESPACE_ONLY, and
+				 * TCL_INTERP_DESTROYED. May also contain
+				 * TCL_PARSE_PART1, which should not be
+				 * passed through to callbacks. */
+{
+    register VarTrace *tracePtr;
+    ActiveVarTrace active;
+    char *result, *openParen, *p;
+    Tcl_DString nameCopy;
+    int copiedName;
+
+    /*
+     * If there are already similar trace procedures active for the
+     * variable, don't call them again.
+     */
+
+    if (varPtr->flags & VAR_TRACE_ACTIVE) {
+	return NULL;
+    }
+    varPtr->flags |= VAR_TRACE_ACTIVE;
+    varPtr->refCount++;
+
+    /*
+     * If the variable name hasn't been parsed into array name and
+     * element, do it here.  If there really is an array element,
+     * make a copy of the original name so that NULLs can be
+     * inserted into it to separate the names (can't modify the name
+     * string in place, because the string might get used by the
+     * callbacks we invoke).
+     */
+
+    copiedName = 0;
+    if (flags & TCL_PARSE_PART1) {
+	for (p = part1; ; p++) {
+	    if (*p == 0) {
+		break;
+	    }
+	    if (*p == '(') {
+		openParen = p;
+		do {
+		    p++;
+		} while (*p != '\0');
+		p--;
+		if (*p == ')') {
+		    Tcl_DStringInit(&nameCopy);
+		    Tcl_DStringAppend(&nameCopy, part1, (p-part1));
+		    part2 = Tcl_DStringValue(&nameCopy)
+			+ (openParen + 1 - part1);
+		    part2[-1] = 0;
+		    part1 = Tcl_DStringValue(&nameCopy);
+		    copiedName = 1;
+		}
+		break;
+	    }
+	}
+    }
+    flags &= ~TCL_PARSE_PART1;
+
+    /*
+     * Invoke traces on the array containing the variable, if relevant.
+     */
+
+    result = NULL;
+    active.nextPtr = iPtr->activeTracePtr;
+    iPtr->activeTracePtr = &active;
+    if (arrayPtr != NULL) {
+	arrayPtr->refCount++;
+	active.varPtr = arrayPtr;
+	for (tracePtr = arrayPtr->tracePtr;  tracePtr != NULL;
+	     tracePtr = active.nextTracePtr) {
+	    active.nextTracePtr = tracePtr->nextPtr;
+	    if (!(tracePtr->flags & flags)) {
+		continue;
+	    }
+	    result = (*tracePtr->traceProc)(tracePtr->clientData,
+		    (Tcl_Interp *) iPtr, part1, part2, flags);
+	    if (result != NULL) {
+		if (flags & TCL_TRACE_UNSETS) {
+		    result = NULL;
+		} else {
+		    goto done;
+		}
+	    }
+	}
+    }
+
+    /*
+     * Invoke traces on the variable itself.
+     */
+
+    if (flags & TCL_TRACE_UNSETS) {
+	flags |= TCL_TRACE_DESTROYED;
+    }
+    active.varPtr = varPtr;
+    for (tracePtr = varPtr->tracePtr; tracePtr != NULL;
+	 tracePtr = active.nextTracePtr) {
+	active.nextTracePtr = tracePtr->nextPtr;
+	if (!(tracePtr->flags & flags)) {
+	    continue;
+	}
+	result = (*tracePtr->traceProc)(tracePtr->clientData,
+		(Tcl_Interp *) iPtr, part1, part2, flags);
+	if (result != NULL) {
+	    if (flags & TCL_TRACE_UNSETS) {
+		result = NULL;
+	    } else {
+		goto done;
+	    }
+	}
+    }
+
+    /*
+     * Restore the variable's flags, remove the record of our active
+     * traces, and then return.
+     */
+
+    done:
+    if (arrayPtr != NULL) {
+	arrayPtr->refCount--;
+    }
+    if (copiedName) {
+	Tcl_DStringFree(&nameCopy);
+    }
+    varPtr->flags &= ~VAR_TRACE_ACTIVE;
+    varPtr->refCount--;
+    iPtr->activeTracePtr = active.nextPtr;
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NewVar --
+ *
+ *	Create a new heap-allocated variable that will eventually be
+ *	entered into a hashtable.
+ *
+ * Results:
+ *	The return value is a pointer to the new variable structure. It is
+ *	marked as a scalar variable (and not a link or array variable). Its
+ *	value initially is NULL. The variable is not part of any hash table
+ *	yet. Since it will be in a hashtable and not in a call frame, its
+ *	name field is set NULL. It is initially marked as undefined.
+ *
+ * Side effects:
+ *	Storage gets allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Var *
+NewVar()
+{
+    register Var *varPtr;
+
+    varPtr = (Var *) ckalloc(sizeof(Var));
+    varPtr->value.objPtr = NULL;
+    varPtr->name = NULL;
+    varPtr->nsPtr = NULL;
+    varPtr->hPtr = NULL;
+    varPtr->refCount = 0;
+    varPtr->tracePtr = NULL;
+    varPtr->searchPtr = NULL;
+    varPtr->flags = (VAR_SCALAR | VAR_UNDEFINED | VAR_IN_HASHTABLE);
+    return varPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParseSearchId --
+ *
+ *	This procedure translates from a string to a pointer to an
+ *	active array search (if there is one that matches the string).
+ *
+ * Results:
+ *	The return value is a pointer to the array search indicated
+ *	by string, or NULL if there isn't one.  If NULL is returned,
+ *	interp->result contains an error message.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ArraySearch *
+ParseSearchId(interp, varPtr, varName, string)
+    Tcl_Interp *interp;		/* Interpreter containing variable. */
+    Var *varPtr;		/* Array variable search is for. */
+    char *varName;		/* Name of array variable that search is
+				 * supposed to be for. */
+    char *string;		/* String containing id of search. Must have
+				 * form "search-num-var" where "num" is a
+				 * decimal number and "var" is a variable
+				 * name. */
+{
+    char *end;
+    int id;
+    ArraySearch *searchPtr;
+
+    /*
+     * Parse the id into the three parts separated by dashes.
+     */
+
+    if ((string[0] != 's') || (string[1] != '-')) {
+	syntax:
+	Tcl_AppendResult(interp, "illegal search identifier \"", string,
+		"\"", (char *) NULL);
+	return NULL;
+    }
+    id = strtoul(string+2, &end, 10);
+    if ((end == (string+2)) || (*end != '-')) {
+	goto syntax;
+    }
+    if (strcmp(end+1, varName) != 0) {
+	Tcl_AppendResult(interp, "search identifier \"", string,
+		"\" isn't for variable \"", varName, "\"", (char *) NULL);
+	return NULL;
+    }
+
+    /*
+     * Search through the list of active searches on the interpreter
+     * to see if the desired one exists.
+     */
+
+    for (searchPtr = varPtr->searchPtr; searchPtr != NULL;
+	 searchPtr = searchPtr->nextPtr) {
+	if (searchPtr->id == id) {
+	    return searchPtr;
+	}
+    }
+    Tcl_AppendResult(interp, "couldn't find search \"", string, "\"",
+	    (char *) NULL);
+    return NULL;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteSearches --
+ *
+ *	This procedure is called to free up all of the searches
+ *	associated with an array variable.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Memory is released to the storage allocator.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteSearches(arrayVarPtr)
+    register Var *arrayVarPtr;		/* Variable whose searches are
+					 * to be deleted. */
+{
+    ArraySearch *searchPtr;
+
+    while (arrayVarPtr->searchPtr != NULL) {
+	searchPtr = arrayVarPtr->searchPtr;
+	arrayVarPtr->searchPtr = searchPtr->nextPtr;
+	ckfree((char *) searchPtr);
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDeleteVars --
+ *
+ *	This procedure is called to recycle all the storage space
+ *	associated with a table of variables. For this procedure
+ *	to work correctly, it must not be possible for any of the
+ *	variables in the table to be accessed from Tcl commands
+ *	(e.g. from trace procedures).
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Variables are deleted and trace procedures are invoked, if
+ *	any are declared.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclDeleteVars(iPtr, tablePtr)
+    Interp *iPtr;		/* Interpreter to which variables belong. */
+    Tcl_HashTable *tablePtr;	/* Hash table containing variables to
+				 * delete. */
+{
+    Tcl_Interp *interp = (Tcl_Interp *) iPtr;
+    Tcl_HashSearch search;
+    Tcl_HashEntry *hPtr;
+    register Var *varPtr;
+    Var *linkPtr;
+    int flags;
+    ActiveVarTrace *activePtr;
+    Tcl_Obj *objPtr;
+    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+
+    /*
+     * Determine what flags to pass to the trace callback procedures.
+     */
+
+    flags = TCL_TRACE_UNSETS;
+    if (tablePtr == &iPtr->globalNsPtr->varTable) {
+	flags |= (TCL_INTERP_DESTROYED | TCL_GLOBAL_ONLY);
+    } else if (tablePtr == &currNsPtr->varTable) {
+	flags |= TCL_NAMESPACE_ONLY;
+    }
+
+    for (hPtr = Tcl_FirstHashEntry(tablePtr, &search);  hPtr != NULL;
+	 hPtr = Tcl_NextHashEntry(&search)) {
+	varPtr = (Var *) Tcl_GetHashValue(hPtr);
+
+	/*
+	 * For global/upvar variables referenced in procedures, decrement
+	 * the reference count on the variable referred to, and free
+	 * the referenced variable if it's no longer needed. Don't delete
+	 * the hash entry for the other variable if it's in the same table
+	 * as us: this will happen automatically later on.
+	 */
+
+	if (TclIsVarLink(varPtr)) {
+	    linkPtr = varPtr->value.linkPtr;
+	    linkPtr->refCount--;
+	    if ((linkPtr->refCount == 0) && TclIsVarUndefined(linkPtr)
+		    && (linkPtr->tracePtr == NULL)
+		    && (linkPtr->flags & VAR_IN_HASHTABLE)) {
+		if (linkPtr->hPtr == NULL) {
+		    ckfree((char *) linkPtr);
+		} else if (linkPtr->hPtr->tablePtr != tablePtr) {
+		    Tcl_DeleteHashEntry(linkPtr->hPtr);
+		    ckfree((char *) linkPtr);
+		}
+	    }
+	}
+
+	/*
+	 * Invoke traces on the variable that is being deleted, then
+	 * free up the variable's space (no need to free the hash entry
+	 * here, unless we're dealing with a global variable: the
+	 * hash entries will be deleted automatically when the whole
+	 * table is deleted). Note that we give CallTraces the variable's
+	 * fully-qualified name so that any called trace procedures can
+	 * refer to these variables being deleted.
+	 */
+
+	if (varPtr->tracePtr != NULL) {
+	    objPtr = Tcl_NewObj();
+	    Tcl_IncrRefCount(objPtr); /* until done with traces */
+	    Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr);
+	    (void) CallTraces(iPtr, (Var *) NULL, varPtr,
+		    Tcl_GetStringFromObj(objPtr, (int *) NULL),
+		    (char *) NULL, flags);
+	    Tcl_DecrRefCount(objPtr); /* free no longer needed obj */
+
+	    while (varPtr->tracePtr != NULL) {
+		VarTrace *tracePtr = varPtr->tracePtr;
+		varPtr->tracePtr = tracePtr->nextPtr;
+		ckfree((char *) tracePtr);
+	    }
+	    for (activePtr = iPtr->activeTracePtr; activePtr != NULL;
+		 activePtr = activePtr->nextPtr) {
+		if (activePtr->varPtr == varPtr) {
+		    activePtr->nextTracePtr = NULL;
+		}
+	    }
+	}
+	    
+	if (TclIsVarArray(varPtr)) {
+	    DeleteArray(iPtr, Tcl_GetHashKey(tablePtr, hPtr), varPtr,
+	            flags);
+	    varPtr->value.tablePtr = NULL;
+	}
+	if (TclIsVarScalar(varPtr) && (varPtr->value.objPtr != NULL)) {
+	    objPtr = varPtr->value.objPtr;
+	    TclDecrRefCount(objPtr);
+	    varPtr->value.objPtr = NULL;
+	}
+	varPtr->hPtr = NULL;
+	varPtr->tracePtr = NULL;
+	TclSetVarUndefined(varPtr);
+	TclSetVarScalar(varPtr);
+
+	/*
+	 * If the variable was a namespace variable, decrement its 
+	 * reference count. We are in the process of destroying its
+	 * namespace so that namespace will no longer "refer" to the
+	 * variable.
+	 */
+
+	if (varPtr->flags & VAR_NAMESPACE_VAR) {
+	    varPtr->flags &= ~VAR_NAMESPACE_VAR;
+	    varPtr->refCount--;
+	}
+
+	/*
+	 * Recycle the variable's memory space if there aren't any upvar's
+	 * pointing to it. If there are upvars to this variable, then the
+	 * variable will get freed when the last upvar goes away.
+	 */
+
+	if (varPtr->refCount == 0) {
+	    ckfree((char *) varPtr); /* this Var must be VAR_IN_HASHTABLE */
+	}
+    }
+    Tcl_DeleteHashTable(tablePtr);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDeleteCompiledLocalVars --
+ *
+ *	This procedure is called to recycle storage space associated with
+ *	the compiler-allocated array of local variables in a procedure call
+ *	frame. This procedure resembles TclDeleteVars above except that each
+ *	variable is stored in a call frame and not a hash table. For this
+ *	procedure to work correctly, it must not be possible for any of the
+ *	variable in the table to be accessed from Tcl commands (e.g. from
+ *	trace procedures).
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Variables are deleted and trace procedures are invoked, if
+ *	any are declared.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclDeleteCompiledLocalVars(iPtr, framePtr)
+    Interp *iPtr;		/* Interpreter to which variables belong. */
+    CallFrame *framePtr;	/* Procedure call frame containing
+				 * compiler-assigned local variables to
+				 * delete. */
+{
+    register Var *varPtr;
+    int flags;			/* Flags passed to trace procedures. */
+    Var *linkPtr;
+    ActiveVarTrace *activePtr;
+    int numLocals, i;
+
+    flags = TCL_TRACE_UNSETS;
+    numLocals = framePtr->numCompiledLocals;
+    varPtr = framePtr->compiledLocals;
+    for (i = 0;  i < numLocals;  i++) {
+	/*
+	 * For global/upvar variables referenced in procedures, decrement
+	 * the reference count on the variable referred to, and free
+	 * the referenced variable if it's no longer needed. Don't delete
+	 * the hash entry for the other variable if it's in the same table
+	 * as us: this will happen automatically later on.
+	 */
+
+	if (TclIsVarLink(varPtr)) {
+	    linkPtr = varPtr->value.linkPtr;
+	    linkPtr->refCount--;
+	    if ((linkPtr->refCount == 0) && TclIsVarUndefined(linkPtr)
+		    && (linkPtr->tracePtr == NULL)
+		    && (linkPtr->flags & VAR_IN_HASHTABLE)) {
+		if (linkPtr->hPtr == NULL) {
+		    ckfree((char *) linkPtr);
+		} else {
+		    Tcl_DeleteHashEntry(linkPtr->hPtr);
+		    ckfree((char *) linkPtr);
+		}
+	    }
+	}
+
+	/*
+	 * Invoke traces on the variable that is being deleted. Then delete
+	 * the variable's trace records.
+	 */
+
+	if (varPtr->tracePtr != NULL) {
+	    (void) CallTraces(iPtr, (Var *) NULL, varPtr,
+		    varPtr->name, (char *) NULL, flags);
+	    while (varPtr->tracePtr != NULL) {
+		VarTrace *tracePtr = varPtr->tracePtr;
+		varPtr->tracePtr = tracePtr->nextPtr;
+		ckfree((char *) tracePtr);
+	    }
+	    for (activePtr = iPtr->activeTracePtr; activePtr != NULL;
+		 activePtr = activePtr->nextPtr) {
+		if (activePtr->varPtr == varPtr) {
+		    activePtr->nextTracePtr = NULL;
+		}
+	    }
+	}
+
+        /*
+	 * Now if the variable is an array, delete its element hash table.
+	 * Otherwise, if it's a scalar variable, decrement the ref count
+	 * of its value.
+	 */
+	    
+	if (TclIsVarArray(varPtr) && (varPtr->value.tablePtr != NULL)) {
+	    DeleteArray(iPtr, varPtr->name, varPtr, flags);
+	}
+	if (TclIsVarScalar(varPtr) && (varPtr->value.objPtr != NULL)) {
+	    TclDecrRefCount(varPtr->value.objPtr);
+	    varPtr->value.objPtr = NULL;
+	}
+	varPtr->hPtr = NULL;
+	varPtr->tracePtr = NULL;
+	TclSetVarUndefined(varPtr);
+	TclSetVarScalar(varPtr);
+	varPtr++;
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteArray --
+ *
+ *	This procedure is called to free up everything in an array
+ *	variable.  It's the caller's responsibility to make sure
+ *	that the array is no longer accessible before this procedure
+ *	is called.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	All storage associated with varPtr's array elements is deleted
+ *	(including the array's hash table). Deletion trace procedures for
+ *	array elements are invoked, then deleted. Any pending traces for
+ *	array elements are also deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteArray(iPtr, arrayName, varPtr, flags)
+    Interp *iPtr;			/* Interpreter containing array. */
+    char *arrayName;			/* Name of array (used for trace
+					 * callbacks). */
+    Var *varPtr;			/* Pointer to variable structure. */
+    int flags;				/* Flags to pass to CallTraces:
+					 * TCL_TRACE_UNSETS and sometimes
+					 * TCL_INTERP_DESTROYED,
+					 * TCL_NAMESPACE_ONLY, or
+					 * TCL_GLOBAL_ONLY. */
+{
+    Tcl_HashSearch search;
+    register Tcl_HashEntry *hPtr;
+    register Var *elPtr;
+    ActiveVarTrace *activePtr;
+    Tcl_Obj *objPtr;
+
+    DeleteSearches(varPtr);
+    for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
+	 hPtr != NULL;  hPtr = Tcl_NextHashEntry(&search)) {
+	elPtr = (Var *) Tcl_GetHashValue(hPtr);
+	if (TclIsVarScalar(elPtr) && (elPtr->value.objPtr != NULL)) {
+	    objPtr = elPtr->value.objPtr;
+	    TclDecrRefCount(objPtr);
+	    elPtr->value.objPtr = NULL;
+	}
+	elPtr->hPtr = NULL;
+	if (elPtr->tracePtr != NULL) {
+	    elPtr->flags &= ~VAR_TRACE_ACTIVE;
+	    (void) CallTraces(iPtr, (Var *) NULL, elPtr, arrayName,
+		    Tcl_GetHashKey(varPtr->value.tablePtr, hPtr), flags);
+	    while (elPtr->tracePtr != NULL) {
+		VarTrace *tracePtr = elPtr->tracePtr;
+		elPtr->tracePtr = tracePtr->nextPtr;
+		ckfree((char *) tracePtr);
+	    }
+	    for (activePtr = iPtr->activeTracePtr; activePtr != NULL;
+		 activePtr = activePtr->nextPtr) {
+		if (activePtr->varPtr == elPtr) {
+		    activePtr->nextTracePtr = NULL;
+		}
+	    }
+	}
+	TclSetVarUndefined(elPtr);
+	TclSetVarScalar(elPtr);
+	if (elPtr->refCount == 0) {
+	    ckfree((char *) elPtr); /* element Vars are VAR_IN_HASHTABLE */
+	}
+    }
+    Tcl_DeleteHashTable(varPtr->value.tablePtr);
+    ckfree((char *) varPtr->value.tablePtr);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CleanupVar --
+ *
+ *	This procedure is called when it looks like it may be OK to free up
+ *	a variable's storage. If the variable is in a hashtable, its Var
+ *	structure and hash table entry will be freed along with those of its
+ *	containing array, if any. This procedure is called, for example,
+ *	when a trace on a variable deletes a variable.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	If the variable (or its containing array) really is dead and in a
+ *	hashtable, then its Var structure, and possibly its hash table
+ *	entry, is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CleanupVar(varPtr, arrayPtr)
+    Var *varPtr;		/* Pointer to variable that may be a
+				 * candidate for being expunged. */
+    Var *arrayPtr;		/* Array that contains the variable, or
+				 * NULL if this variable isn't an array
+				 * element. */
+{
+    if (TclIsVarUndefined(varPtr) && (varPtr->refCount == 0)
+	    && (varPtr->tracePtr == NULL)
+	    && (varPtr->flags & VAR_IN_HASHTABLE)) {
+	if (varPtr->hPtr != NULL) {
+	    Tcl_DeleteHashEntry(varPtr->hPtr);
+	}
+	ckfree((char *) varPtr);
+    }
+    if (arrayPtr != NULL) {
+	if (TclIsVarUndefined(arrayPtr) && (arrayPtr->refCount == 0)
+		&& (arrayPtr->tracePtr == NULL)
+	        && (arrayPtr->flags & VAR_IN_HASHTABLE)) {
+	    if (arrayPtr->hPtr != NULL) {
+		Tcl_DeleteHashEntry(arrayPtr->hPtr);
+	    }
+	    ckfree((char *) arrayPtr);
+	}
+    }
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ * VarErrMsg --
+ *
+ *      Generate a reasonable error message describing why a variable
+ *      operation failed.
+ *
+ * Results:
+ *      None.
+ *
+ * Side effects:
+ *      Interp->result is reset to hold a message identifying the
+ *      variable given by part1 and part2 and describing why the
+ *      variable operation failed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+VarErrMsg(interp, part1, part2, operation, reason)
+    Tcl_Interp *interp;         /* Interpreter in which to record message. */
+    char *part1, *part2;        /* Variable's two-part name. */
+    char *operation;            /* String describing operation that failed,
+                                 * e.g. "read", "set", or "unset". */
+    char *reason;               /* String describing why operation failed. */
+{
+    Tcl_ResetResult(interp);
+    Tcl_AppendResult(interp, "can't ", operation, " \"", part1,
+	    (char *) NULL);
+    if (part2 != NULL) {
+        Tcl_AppendResult(interp, "(", part2, ")", (char *) NULL);
+    }
+    Tcl_AppendResult(interp, "\": ", reason, (char *) NULL);
+}
Index: /trunk/test/AddFriendExample.C
===================================================================
--- /trunk/test/AddFriendExample.C	(revision 2)
+++ /trunk/test/AddFriendExample.C	(revision 2)
@@ -0,0 +1,59 @@
+
+//------------------------------------------------------------------------------
+
+void AnalyseEvents(ExRootTreeReader *treeReader)
+{
+  TClonesArray *branchM1 = treeReader->UseBranch("Match");
+  TClonesArray *branchM2 = treeReader->UseBranch("Matching.Match");
+
+  Long64_t allEntries = treeReader->GetEntries();
+
+  cout << "** Chain contains " << allEntries << " events" << endl;
+
+  ExRootGenMatch *match;
+
+  // Loop over all events
+  for(entry = 0; entry < allEntries; ++entry)
+  {
+    // Load selected branches with data from specified event
+    treeReader->ReadEntry(entry);
+
+    nclus = -1;
+    if(branchM1->GetEntriesFast() > 0)
+    {
+      match = (ExRootGenMatch*) branchM1->At(0);
+      nclus = match->Nclus; 
+    }
+
+    // Analyse missing ET
+    if(nclus != branchM2->GetEntriesFast())
+    {
+      cout << entry << "\t" << nclus << "\t" << branchM2->GetEntriesFast() << endl;
+    }
+  }
+}
+
+//------------------------------------------------------------------------------
+
+void Example()
+{
+  TChain *chain1 = new TChain("Match");
+  TChain *chain2 = new TChain("Matching");
+  chain1->Add("../../eventtree_nclus.root");
+  chain2->Add("MatchingTree.root");
+  chain1->AddFriend(chain2, "Matching");
+
+  ExRootTreeReader *treeReader = new ExRootTreeReader(chain1);
+  ExRootResult *result = new ExRootResult();
+
+  AnalyseEvents(treeReader);
+
+  cout << "** Exiting..." << endl;
+
+  delete treeReader;
+  delete chain1;
+  delete chain2;
+}
+
+//------------------------------------------------------------------------------
+
Index: /trunk/test/ExRootHEPEVTConverter.cpp
===================================================================
--- /trunk/test/ExRootHEPEVTConverter.cpp	(revision 2)
+++ /trunk/test/ExRootHEPEVTConverter.cpp	(revision 2)
@@ -0,0 +1,288 @@
+
+#include <iostream>
+#include <utility>
+#include <deque>
+
+#include "TROOT.h"
+#include "TApplication.h"
+
+#include "TFile.h"
+#include "TTree.h"
+#include "TBranch.h"
+#include "TLeaf.h"
+#include "TString.h"
+#include "TLorentzVector.h"
+
+#include "ExRootAnalysis/ExRootClasses.h"
+
+#include "ExRootAnalysis/ExRootTreeReader.h"
+#include "ExRootAnalysis/ExRootTreeWriter.h"
+#include "ExRootAnalysis/ExRootTreeBranch.h"
+#include "ExRootAnalysis/ExRootUtilities.h"
+
+using namespace std;
+
+//------------------------------------------------------------------------------
+
+struct HEPEvent
+{
+  Int_t           Nevhep;
+  Int_t           Nhep;
+  Int_t           *Idhep;    //[Nhep]
+  Int_t           *Jsmhep;   //[Nhep]
+  Int_t           *Jsdhep;   //[Nhep]
+  Float_t         *Phep;    //[Nhep][5]
+  Float_t         *Vhep;    //[Nhep][4]
+  Int_t           Irun;
+  Int_t           Ievt;
+  Float_t         Weight;
+  Float_t         Xsecn;
+  Int_t           Ifilter;
+  Int_t           Nparam;
+  Float_t         *Param;    //[Nparam]
+};
+
+//------------------------------------------------------------------------------
+
+class HEPTreeReader
+{
+public:
+
+  HEPTreeReader(TTree *tree, HEPEvent *event);
+  ~HEPTreeReader();
+
+  Long64_t GetEntries() const { return fChain ? static_cast<Long64_t>(fChain->GetEntries()) : 0; }
+
+  Bool_t ReadEntry(Long64_t element);
+
+private:
+
+  void Notify();
+
+  TTree *fChain;  // pointer to the analyzed TTree or TChain
+  Int_t fCurrentTree; // current Tree number in a TChain
+
+  HEPEvent *fEvent;
+
+  deque< pair<TString, TBranch*> > fBranches;
+
+};
+
+//------------------------------------------------------------------------------
+
+HEPTreeReader::HEPTreeReader(TTree *tree, HEPEvent *event) : fChain(tree), fCurrentTree(-1), fEvent(event)
+{
+  if(!fChain) return;
+
+  TBranch *branch;
+  TLeaf *leaf;
+  TString name;
+  Int_t i;
+
+  name = "Nhep";
+  branch = fChain->GetBranch(name);
+  branch->SetAddress(&(event->Nhep));
+  fBranches.push_back(make_pair(name, branch));
+
+  TString intNames[3] = {"Idhep", "Jsmhep", "Jsdhep"};
+  Int_t **intData[3] = {&event->Idhep, &event->Jsmhep, &event->Jsdhep};
+
+  for(i = 0; i < 3; ++i)
+  {
+    name = intNames[i];
+    branch = fChain->GetBranch(name);
+    leaf = branch->GetLeaf(name);
+    *intData[i] = new Int_t[leaf->GetNdata()];
+    branch->SetAddress(*intData[i]);
+    fBranches.push_back(make_pair(name, branch));
+  }
+
+  TString floatNames[2] = {"Phep", "Vhep"};
+  Float_t **floatData[2] = {&event->Phep, &event->Vhep};
+
+  for(i = 0; i < 2; ++i)
+  {
+    name = floatNames[i];
+    branch = fChain->GetBranch(name);
+    leaf = branch->GetLeaf(name);
+    *floatData[i] = new Float_t[leaf->GetNdata()];
+    branch->SetAddress(*floatData[i]);
+    fBranches.push_back(make_pair(name, branch));
+  }
+}
+
+//------------------------------------------------------------------------------
+
+HEPTreeReader::~HEPTreeReader()
+{
+  if(!fChain) return;
+
+  delete[] fEvent->Idhep;
+  delete[] fEvent->Jsmhep;
+  delete[] fEvent->Jsdhep;
+  delete[] fEvent->Phep;
+  delete[] fEvent->Vhep;
+}
+
+//------------------------------------------------------------------------------
+
+Bool_t HEPTreeReader::ReadEntry(Long64_t element)
+{
+  if(!fChain) return kFALSE;
+
+  Int_t treeEntry = fChain->LoadTree(element);
+  if(treeEntry < 0) return kFALSE;
+
+  if(fChain->IsA() == TChain::Class())
+  {
+    TChain *chain = static_cast<TChain*>(fChain);
+    if(chain->GetTreeNumber() != fCurrentTree)
+    {
+      fCurrentTree = chain->GetTreeNumber();
+      Notify();
+    }
+  }
+
+  deque< pair<TString, TBranch*> >::iterator it_deque;
+  TBranch *branch;
+
+  for(it_deque = fBranches.begin(); it_deque != fBranches.end(); ++it_deque)
+  {
+    branch = it_deque->second;
+    if(branch)
+    {
+      branch->GetEntry(treeEntry);
+    }
+  }
+
+  return kTRUE;
+}
+
+//------------------------------------------------------------------------------
+
+void HEPTreeReader::Notify()
+{
+  // Called when loading a new file.
+  // Get branch pointers.
+  if(!fChain) return;
+
+  deque< pair<TString, TBranch*> >::iterator it_deque;
+
+  for(it_deque = fBranches.begin(); it_deque != fBranches.end(); ++it_deque)
+  {
+    it_deque->second = fChain->GetBranch(it_deque->first);
+    if(!it_deque->second)
+    {
+      cout << "** WARNING: cannot get branch '" << it_deque->first << "'" << endl;
+    }
+  }
+}
+
+
+//------------------------------------------------------------------------------
+
+int main(int argc, char *argv[])
+{
+  char *appName = "ExRootHEPEVTConverter";
+
+  if(argc != 3)
+  {
+    cout << " Usage: " << appName << " input_file" << " output_file" << endl;
+    cout << " input_file - list of HEPEVT files in ROOT format ('h101' tree)," << endl;
+    cout << " output_file - output file in ROOT format." << endl;
+    return 1;
+  }
+
+  gROOT->SetBatch();
+
+  int appargc = 1;
+  char *appargv[] = {appName};
+  TApplication app(appName, &appargc, appargv);  
+
+  TString inputFileList(argv[1]);
+  TString outputFileName(argv[2]);
+  string buffer;
+
+  TChain *chain = new TChain("h101");
+  if(FillChain(chain, inputFileList))
+  {
+
+    HEPEvent event;
+    HEPTreeReader *treeReader = new HEPTreeReader(chain, &event);
+  
+    TFile *outputFile = TFile::Open(outputFileName, "RECREATE");
+    ExRootTreeWriter *treeWriter = new ExRootTreeWriter(outputFile, "Analysis");
+  
+    ExRootTreeBranch *branchGen = treeWriter->NewBranch("Gen", ExRootGenParticle::Class());
+  
+    Long64_t entry, allEntries = treeReader->GetEntries();
+  
+    cout << "** Chain contains " << allEntries << " events" << endl;
+  
+    Int_t address, particle;
+    Double_t signPz;
+  
+    TLorentzVector momentum;
+  
+    ExRootGenParticle *element;
+  
+    // Loop over all events
+    for(entry = 0; entry < allEntries; ++entry)
+    {
+      // Load selected branches with data from specified event
+      treeReader->ReadEntry(entry);
+      treeWriter->Clear();
+  
+      if((entry % 100) == 0 && entry > 0 )
+      {
+        cout << "** Processing element # " << entry << endl;
+      }
+  
+      for(particle = 0; particle < event.Nhep; ++particle)
+      {
+        element = (ExRootGenParticle*) branchGen->NewEntry();
+  
+        element->PID = event.Idhep[particle];
+        element->Status = event.Jsmhep[particle]/16000000
+                        + event.Jsdhep[particle]/16000000*100;
+        element->M1 = (event.Jsmhep[particle]%16000000)/4000 - 1;
+        element->M2 = event.Jsmhep[particle]%4000 - 1;
+        element->D1 = (event.Jsdhep[particle]%16000000)/4000 - 1;
+        element->D2 = event.Jsdhep[particle]%4000 - 1;
+  
+        address = particle*5;
+        element->E = event.Phep[address + 3];
+        element->Px = event.Phep[address + 0];
+        element->Py = event.Phep[address + 1];
+        element->Pz = event.Phep[address + 2];
+  
+        momentum.SetPxPyPzE(element->Px, element->Py, element->Pz, element->E);
+        element->PT = momentum.Perp();
+        signPz = (element->Pz >= 0.0) ? 1.0 : -1.0;
+        element->Eta = element->PT == 0.0 ? signPz*999.9 : momentum.Eta();
+        element->Phi = momentum.Phi();
+
+        element->Rapidity = element->PT == 0.0 ? signPz*999.9 : momentum.Rapidity();
+
+        address = particle*4;
+        element->T = event.Vhep[address + 3];
+        element->X = event.Vhep[address + 0];
+        element->Y = event.Vhep[address + 1];
+        element->Z = event.Vhep[address + 2];
+      }
+      treeWriter->Fill();
+    }
+  
+    treeWriter->Write();
+  
+    cout << "** Exiting..." << endl;
+  
+    delete treeWriter;
+    delete outputFile;
+    delete treeReader;
+  }
+  delete chain;
+}
+
+
+
Index: /trunk/test/ExRootLHCOlympicsConverter.cpp
===================================================================
--- /trunk/test/ExRootLHCOlympicsConverter.cpp	(revision 2)
+++ /trunk/test/ExRootLHCOlympicsConverter.cpp	(revision 2)
@@ -0,0 +1,476 @@
+
+#include <iostream>
+#include <fstream>
+#include <sstream>
+#include <map>
+
+#include "TROOT.h"
+#include "TApplication.h"
+
+#include "TFile.h"
+#include "TChain.h"
+#include "TString.h"
+
+#include "TH2.h"
+#include "THStack.h"
+#include "TLegend.h"
+#include "TPaveText.h"
+#include "TLorentzVector.h"
+
+#include "ExRootAnalysis/ExRootClasses.h"
+
+#include "ExRootAnalysis/ExRootTreeWriter.h"
+#include "ExRootAnalysis/ExRootTreeBranch.h"
+
+#include "ExRootAnalysis/ExRootUtilities.h"
+#include "ExRootAnalysis/ExRootProgressBar.h"
+
+using namespace std;
+
+/*
+LHC Olympics format discription from http://www.jthaler.net/olympicswiki/doku.php?id=lhc_olympics:data_file_format
+
+    * The first column of each row is just a counter that labels the object.
+    * The event begins with a row labelled "0"; this row contains the event number and the triggering information. The last row of the event is always the missing transverse momentum (MET).
+    * The second column of each row gives the type of object being listed [0, 1, 2, 3, 4, 6 = photon, electron, muon, hadronically-decaying tau, jet, missing transverse energy].
+    * The next three columns give the pseudorapidity, the azimuthal angle, and the transverse momentum of the object.
+    * The sixth column gives the invariant mass of the object.
+    * The seventh column gives the number of tracks associated with the object; in the case of a lepton, this number is multiplied by the charge of the lepton.
+    * The eighth column is 1 or 2 for a jet that has been "tagged" as containing a b-quark (actually a heavy flavor tag that sometimes indicates c-quarks), otherwise it is 0. For muons, the integer part of this number is the identity of the jet (see column 1) that is closest ot this muon in Delta R.
+    * The ninth column is the ratio of the hadronic versus electromagnetic energy deposited in the calorimeter cells associated with the object. For muons to the left of the decimal point is the summed pT in a R=0.4 cone (excluding the muon). To the right of the decimal point is etrat, which is a percentage between .00 and .99. It is the ratio of the transverse energy in a 3x3 grid surrounding the muon to the pT of the muon.
+*/
+
+struct LHCOlympicsObject
+{
+  enum {maxIntParam = 2, maxDblParam = 7};
+
+  Int_t intParam[maxIntParam];
+  Double_t dblParam[maxDblParam];
+};
+
+//------------------------------------------------------------------------------
+
+class LHCOlympicsConverter
+{
+public:
+  LHCOlympicsConverter(const char *outputFileName);
+  ~LHCOlympicsConverter();
+
+  void ProcessObject();
+  void Write();
+
+  Long64_t GetNumberOfObjects(ifstream &inputFileStream);
+  Bool_t ReadObject(ifstream &inputFileStream);
+
+private:
+
+  void AddMissingEvents();
+
+  void AnalyseEvent(ExRootTreeBranch *branch,
+                    Long64_t eventNumber, Int_t triggerWord);
+
+  void AnalysePhoton(ExRootTreeBranch *branch);
+  void AnalyseElectron(ExRootTreeBranch *branch);
+  void AnalyseMuon(ExRootTreeBranch *branch);
+  void AnalyseTau(ExRootTreeBranch *branch);
+  void AnalyseJet(ExRootTreeBranch *branch);
+  void AnalyseMissingET(ExRootTreeBranch *branch);
+
+  istringstream fBufferStream;
+  string fBuffer;
+
+  LHCOlympicsObject fCurrentObject;
+
+  Bool_t fIsFirstEvent, fIsNewEvent, fIsReadyToFill;
+  
+  Long64_t fPreviousObjectNumber, fTriggerWord, fEventNumber, fRecordNumber;
+
+  TFile *fOutputFile;
+  ExRootTreeWriter *fTreeWriter;
+
+  ExRootTreeBranch *fBranchEvent;
+  ExRootTreeBranch *fBranchPhoton;
+  ExRootTreeBranch *fBranchElectron;
+  ExRootTreeBranch *fBranchMuon;
+  ExRootTreeBranch *fBranchTau;
+  ExRootTreeBranch *fBranchJet;
+  ExRootTreeBranch *fBranchMissingET;
+
+};
+
+//------------------------------------------------------------------------------
+
+LHCOlympicsConverter::LHCOlympicsConverter(const char *outputFileName) :
+  fIsFirstEvent(kTRUE), fIsNewEvent(kFALSE), fIsReadyToFill(kFALSE),
+  fPreviousObjectNumber(0), fTriggerWord(0), fEventNumber(1), fRecordNumber(1),
+  fOutputFile(0), fTreeWriter(0)
+{
+  fOutputFile = TFile::Open(outputFileName, "RECREATE");
+  fTreeWriter = new ExRootTreeWriter(fOutputFile, "LHCO");
+
+  // information about reconstructed event
+  fBranchEvent = fTreeWriter->NewBranch("Event", ExRootEvent::Class());
+  // reconstructed photons
+  fBranchPhoton = fTreeWriter->NewBranch("Photon", ExRootPhoton::Class());
+  // reconstructed electrons
+  fBranchElectron = fTreeWriter->NewBranch("Electron", ExRootElectron::Class());
+  // reconstructed muons
+  fBranchMuon = fTreeWriter->NewBranch("Muon", ExRootMuon::Class());
+  // reconstructed hadronically-decaying tau leptons
+  fBranchTau = fTreeWriter->NewBranch("Tau", ExRootTau::Class());
+  // reconstructed jets
+  fBranchJet = fTreeWriter->NewBranch("Jet", ExRootJet::Class());
+  // missing transverse energy
+  fBranchMissingET = fTreeWriter->NewBranch("MissingET", ExRootMissingET::Class());
+}
+
+//------------------------------------------------------------------------------
+
+LHCOlympicsConverter::~LHCOlympicsConverter()
+{
+  if(fTreeWriter) delete fTreeWriter;
+  if(fOutputFile) delete fOutputFile;
+}
+
+//------------------------------------------------------------------------------
+
+Long64_t LHCOlympicsConverter::GetNumberOfObjects(ifstream &inputFileStream)
+{
+  Long64_t counter = 0;
+  Bool_t canReadNumber, canReadFile = kTRUE;
+  Int_t number;
+  int position = inputFileStream.tellg();
+  inputFileStream.seekg(0, std::ios::beg);
+
+  inputFileStream.clear();
+
+  while(canReadFile)
+  {
+    do
+    {
+      getline(inputFileStream, fBuffer);
+  
+      if(!inputFileStream.good())
+      {
+        canReadFile = kFALSE;
+        break;
+      }
+
+      fBufferStream.clear();
+      fBufferStream.str(fBuffer);
+      
+      canReadNumber = (fBufferStream >> number);
+    }
+    while(!canReadNumber);
+
+    ++counter;
+  }
+
+  inputFileStream.clear();
+
+  inputFileStream.seekg(position, std::ios::beg);
+
+  return (counter - 1);
+}
+
+//------------------------------------------------------------------------------
+
+Bool_t LHCOlympicsConverter::ReadObject(ifstream &inputFileStream)
+{
+  Int_t i;
+  Bool_t canReadNumber;
+
+  do
+  {
+    getline(inputFileStream, fBuffer);
+
+    if(!inputFileStream.good()) return kFALSE;
+
+    fBufferStream.clear();
+    fBufferStream.str(fBuffer);
+
+    canReadNumber = kTRUE;
+
+    for(i = 0; canReadNumber && i < LHCOlympicsObject::maxIntParam; ++i)
+    {
+      canReadNumber = (fBufferStream >> fCurrentObject.intParam[i]);
+    }
+    
+    if(canReadNumber && fCurrentObject.intParam[0] == 0)
+    {
+      fEventNumber = fCurrentObject.intParam[1];
+      canReadNumber = (fBufferStream >> fTriggerWord);
+    }
+    else
+    {
+      for(i = 0; canReadNumber && i < LHCOlympicsObject::maxDblParam; ++i)
+      {
+        canReadNumber = (fBufferStream >> fCurrentObject.dblParam[i]);
+      }
+    }
+  }
+  while(!canReadNumber);
+
+  return kTRUE;
+}
+
+//---------------------------------------------------------------------------
+
+void LHCOlympicsConverter::Write()
+{
+  if(fIsReadyToFill && fTreeWriter) fTreeWriter->Fill();
+  if(fTreeWriter) fTreeWriter->Write();
+  fIsReadyToFill = kFALSE;
+}
+
+//---------------------------------------------------------------------------
+// add empty events for missing event numbers
+
+void LHCOlympicsConverter::AddMissingEvents()
+{
+  while(fRecordNumber < fEventNumber)
+  {
+    fTreeWriter->Clear();
+    AnalyseEvent(fBranchEvent, fRecordNumber, 0);
+    fTreeWriter->Fill();
+
+    ++fRecordNumber;
+  }
+
+  fTreeWriter->Clear();
+
+  fIsReadyToFill = kFALSE;
+}
+
+//---------------------------------------------------------------------------
+
+void LHCOlympicsConverter::ProcessObject()
+{
+  fIsNewEvent = (fCurrentObject.intParam[0] <= fPreviousObjectNumber);
+
+  fPreviousObjectNumber = fCurrentObject.intParam[0];
+
+  if(fIsNewEvent && fIsFirstEvent && fTreeWriter)
+  {
+    fIsFirstEvent = kFALSE;
+
+    AddMissingEvents();
+  }
+
+  if(fIsNewEvent && fIsReadyToFill && fTreeWriter)
+  {
+    fIsReadyToFill = kFALSE;
+
+    fTreeWriter->Fill();
+    fTreeWriter->Clear();
+
+    ++fRecordNumber;
+
+    AddMissingEvents();
+  }
+
+  if(fCurrentObject.intParam[0] == 0)
+  {
+    AnalyseEvent(fBranchEvent, fEventNumber, fTriggerWord);
+  }
+  else
+  {
+    switch(fCurrentObject.intParam[1])
+    {
+      case 0: AnalysePhoton(fBranchPhoton); break;
+      case 1: AnalyseElectron(fBranchElectron); break;
+      case 2: AnalyseMuon(fBranchMuon); break;
+      case 3: AnalyseTau(fBranchTau); break;
+      case 4: AnalyseJet(fBranchJet); break;
+      case 6: AnalyseMissingET(fBranchMissingET); break;
+    }
+  }
+
+  fIsReadyToFill = kTRUE;
+}
+
+//---------------------------------------------------------------------------
+
+void LHCOlympicsConverter::AnalyseEvent(ExRootTreeBranch *branch,
+                                        Long64_t eventNumber, Int_t triggerWord)
+{
+  ExRootEvent *element;
+
+  element = static_cast<ExRootEvent*>(branch->NewEntry());
+
+  element->Number = eventNumber;
+  element->Trigger = triggerWord;
+}
+
+//---------------------------------------------------------------------------
+
+void LHCOlympicsConverter::AnalysePhoton(ExRootTreeBranch *branch)
+{
+  ExRootPhoton *element;
+
+  element = static_cast<ExRootPhoton*>(branch->NewEntry());
+
+  element->Eta = fCurrentObject.dblParam[0];
+  element->Phi = fCurrentObject.dblParam[1];
+  element->PT = fCurrentObject.dblParam[2];
+
+  element->EhadOverEem = fCurrentObject.dblParam[6];
+}
+
+//---------------------------------------------------------------------------
+
+void LHCOlympicsConverter::AnalyseElectron(ExRootTreeBranch *branch)
+{
+  ExRootElectron *element;
+
+  element = static_cast<ExRootElectron*>(branch->NewEntry());
+
+  element->Eta = fCurrentObject.dblParam[0];
+  element->Phi = fCurrentObject.dblParam[1];
+  element->PT = fCurrentObject.dblParam[2];
+
+  element->Ntrk = TMath::Abs(fCurrentObject.dblParam[4]);
+
+  element->Charge = fCurrentObject.dblParam[4] < 0.0 ? -1.0 : 1.0;
+
+  element->EhadOverEem = fCurrentObject.dblParam[6];
+}
+
+//---------------------------------------------------------------------------
+
+void LHCOlympicsConverter::AnalyseMuon(ExRootTreeBranch *branch)
+{
+  ExRootMuon *element;
+
+  element = static_cast<ExRootMuon*>(branch->NewEntry());
+
+  element->Eta = fCurrentObject.dblParam[0];
+  element->Phi = fCurrentObject.dblParam[1];
+  element->PT = fCurrentObject.dblParam[2];
+
+  element->Ntrk = TMath::Abs(fCurrentObject.dblParam[4]);
+
+  element->Charge = fCurrentObject.dblParam[4] < 0.0 ? -1.0 : 1.0;
+
+  element->JetIndex = Int_t(fCurrentObject.dblParam[5]);
+
+  element->PTiso = Int_t(fCurrentObject.dblParam[6]);
+  element->ETiso = fCurrentObject.dblParam[6] - element->PTiso;
+}
+
+//---------------------------------------------------------------------------
+
+void LHCOlympicsConverter::AnalyseTau(ExRootTreeBranch *branch)
+{
+  ExRootTau *element;
+
+  element = static_cast<ExRootTau*>(branch->NewEntry());
+
+  element->Eta = fCurrentObject.dblParam[0];
+  element->Phi = fCurrentObject.dblParam[1];
+  element->PT = fCurrentObject.dblParam[2];
+
+  element->Ntrk = TMath::Abs(fCurrentObject.dblParam[4]);
+
+  element->Charge = fCurrentObject.dblParam[4] < 0 ? -1.0 : 1.0;
+
+  element->EhadOverEem = fCurrentObject.dblParam[6];
+}
+
+//---------------------------------------------------------------------------
+
+void LHCOlympicsConverter::AnalyseJet(ExRootTreeBranch *branch)
+{
+  ExRootJet *element;
+
+  element = static_cast<ExRootJet*>(branch->NewEntry());
+
+  element->Eta = fCurrentObject.dblParam[0];
+  element->Phi = fCurrentObject.dblParam[1];
+  element->PT = fCurrentObject.dblParam[2];
+
+  element->Mass = fCurrentObject.dblParam[3];
+
+  element->Ntrk = TMath::Abs(fCurrentObject.dblParam[4]);
+
+  element->BTag = fCurrentObject.dblParam[5];
+
+  element->EhadOverEem = fCurrentObject.dblParam[6];
+
+  element->Index = fCurrentObject.intParam[0];
+
+}
+
+//---------------------------------------------------------------------------
+
+void LHCOlympicsConverter::AnalyseMissingET(ExRootTreeBranch *branch)
+{
+  ExRootMissingET *element;
+
+  element = static_cast<ExRootMissingET*>(branch->NewEntry());
+
+  element->Phi = fCurrentObject.dblParam[1];
+  element->MET = fCurrentObject.dblParam[2];
+}
+
+//---------------------------------------------------------------------------
+
+int main(int argc, char *argv[])
+{
+  char *appName = "ExRootLHEFConverter";
+
+  if(argc != 3)
+  {
+    cout << " Usage: " << appName << " input_file" << " output_file" << endl;
+    cout << " input_file - input file in LHEF format," << endl;
+    cout << " output_file - output file in ROOT format." << endl;
+    return 1;
+  }
+
+  gROOT->SetBatch();
+
+  int appargc = 1;
+  char *appargv[] = {appName};
+  TApplication app(appName, &appargc, appargv);
+
+  // Open a stream connected to an event file:
+  ifstream inputFileStream(argv[1]);
+
+  if(!inputFileStream.is_open())
+  {
+    cerr << "** ERROR: Can't open '" << argv[1] << "' for input" << endl;
+    return 1;
+  }
+
+  // Create LHC Olympics converter:
+  LHCOlympicsConverter *converter = new LHCOlympicsConverter(argv[2]);
+
+  cout << "** Calculating number of objects to process. Please wait..." << endl;
+  Long64_t allEntries = converter->GetNumberOfObjects(inputFileStream);
+  cout << "** Input file contains " << allEntries << " objects" << endl;
+
+  if(allEntries > 0)
+  {
+    ExRootProgressBar progressBar(allEntries);
+
+    // Loop over all objects
+    Long64_t entry = 0;
+    while(converter->ReadObject(inputFileStream))
+    {
+      converter->ProcessObject();
+
+      progressBar.Update(entry);
+      
+      ++entry;
+    }
+    progressBar.Finish();
+
+    converter->Write();
+  }
+
+  cout << "** Exiting..." << endl;
+
+  delete converter;
+}
+
+
Index: /trunk/test/ExRootLHEFConverter.cpp
===================================================================
--- /trunk/test/ExRootLHEFConverter.cpp	(revision 2)
+++ /trunk/test/ExRootLHEFConverter.cpp	(revision 2)
@@ -0,0 +1,164 @@
+
+#include <iostream>
+#include <map>
+
+#include "TROOT.h"
+#include "TApplication.h"
+
+#include "TFile.h"
+#include "TChain.h"
+#include "TString.h"
+
+#include "TH2.h"
+#include "THStack.h"
+#include "TLegend.h"
+#include "TPaveText.h"
+#include "TLorentzVector.h"
+
+#include "LHEF.h"
+
+#include "ExRootAnalysis/ExRootClasses.h"
+
+#include "ExRootAnalysis/ExRootTreeWriter.h"
+#include "ExRootAnalysis/ExRootTreeBranch.h"
+
+#include "ExRootAnalysis/ExRootUtilities.h"
+#include "ExRootAnalysis/ExRootProgressBar.h"
+
+using namespace std;
+
+//---------------------------------------------------------------------------
+
+void AnalyseEvent(LHEF::Reader *reader, ExRootTreeBranch *branch, Long64_t eventNumber)
+{
+  const LHEF::HEPEUP &hepeup = reader->hepeup;
+
+  ExRootLHEFEvent *element;
+
+  element = (ExRootLHEFEvent*) branch->NewEntry();
+
+
+  element->Number = eventNumber;
+  element->Nparticles = hepeup.NUP;
+  element->ProcessID = hepeup.IDPRUP;
+  element->Weight = hepeup.XWGTUP;
+  element->ScalePDF = hepeup.SCALUP;
+  element->CouplingQED = hepeup.AQEDUP;
+  element->CouplingQCD = hepeup.AQCDUP;
+}
+
+//---------------------------------------------------------------------------
+
+void AnalyseParticles(LHEF::Reader *reader, ExRootTreeBranch *branch)
+{
+  const LHEF::HEPEUP &hepeup = reader->hepeup;
+
+  Int_t particle;
+  Double_t signPz;
+
+  TLorentzVector momentum;
+
+  ExRootLHEFParticle *element;
+
+  for(particle = 0; particle < hepeup.NUP; ++particle)
+  {
+    element = (ExRootLHEFParticle*) branch->NewEntry();
+
+    element->PID = hepeup.IDUP[particle];
+    element->Status = hepeup.ISTUP[particle];
+    element->Mother1 = hepeup.MOTHUP[particle].first;
+    element->Mother2 = hepeup.MOTHUP[particle].second;
+    element->ColorLine1 = hepeup.ICOLUP[particle].first;
+    element->ColorLine2 = hepeup.ICOLUP[particle].second;
+    element->Px = hepeup.PUP[particle][0];
+    element->Py = hepeup.PUP[particle][1];
+    element->Pz = hepeup.PUP[particle][2];
+    element->E = hepeup.PUP[particle][3];
+    element->M = hepeup.PUP[particle][4];
+
+    momentum.SetPxPyPzE(element->Px, element->Py, element->Pz, element->E);
+    element->PT = momentum.Perp();
+    signPz = (element->Pz >= 0.0) ? 1.0 : -1.0;
+    element->Eta = element->PT == 0.0 ? signPz*999.9 : momentum.Eta();
+    element->Phi = momentum.Phi();
+
+    element->Rapidity = element->PT == 0.0 ? signPz*999.9 : momentum.Rapidity();
+
+    element->LifeTime = hepeup.VTIMUP[particle];
+    element->Spin = hepeup.SPINUP[particle];
+  }
+}
+
+//------------------------------------------------------------------------------
+
+int main(int argc, char *argv[])
+{
+  char *appName = "ExRootLHEFConverter";
+
+  if(argc != 3)
+  {
+    cout << " Usage: " << appName << " input_file" << " output_file" << endl;
+    cout << " input_file - input file in LHEF format," << endl;
+    cout << " output_file - output file in ROOT format." << endl;
+    return 1;
+  }
+
+  gROOT->SetBatch();
+
+  int appargc = 1;
+  char *appargv[] = {appName};
+  TApplication app(appName, &appargc, appargv);
+
+  // Open a stream connected to an event file:
+  ifstream inputFileStream(argv[1]);
+
+  // Create the Reader object:
+  LHEF::Reader *inputReader = new LHEF::Reader(inputFileStream);
+
+  TFile *outputFile = TFile::Open(argv[2], "RECREATE");
+  ExRootTreeWriter *treeWriter = new ExRootTreeWriter(outputFile, "LHEF");
+
+  // generated event from LHEF
+  ExRootTreeBranch *branchEvent = treeWriter->NewBranch("Event", ExRootLHEFEvent::Class());
+
+  // generated partons from LHEF
+  ExRootTreeBranch *branchParticle = treeWriter->NewBranch("Particle", ExRootLHEFParticle::Class());
+
+  cout << "** Calculating number of events to process. Please wait..." << endl;
+  Long64_t allEntries = inputReader->getNumberOfEvents();
+  cout << "** Input file contains " << allEntries << " events" << endl;
+
+  if(allEntries > 0)
+  {
+    ExRootProgressBar progressBar(allEntries);
+    
+    // Loop over all events
+    Long64_t entry = 0;
+    while(inputReader->readEvent())
+    {
+      treeWriter->Clear();
+
+      AnalyseEvent(inputReader, branchEvent, entry + 1);
+      AnalyseParticles(inputReader, branchParticle);
+
+      treeWriter->Fill();
+
+      progressBar.Update(entry);
+
+      ++entry;
+    }
+
+    progressBar.Finish();
+  }
+
+  treeWriter->Write();
+
+  cout << "** Exiting..." << endl;
+
+  delete treeWriter;
+  delete outputFile;
+  delete inputReader;
+}
+
+
+
Index: /trunk/test/ExRootLHEFGrapher.cpp.backup
===================================================================
--- /trunk/test/ExRootLHEFGrapher.cpp.backup	(revision 2)
+++ /trunk/test/ExRootLHEFGrapher.cpp.backup	(revision 2)
@@ -0,0 +1,279 @@
+
+#include <iostream>
+#include <map>
+
+#include "TChain.h"
+#include "TString.h"
+#include "TApplication.h"
+
+#include "TH2.h"
+#include "THStack.h"
+#include "TLegend.h"
+#include "TPaveText.h"
+#include "TLorentzVector.h"
+
+#include "ExRootAnalysis/ExRootClasses.h"
+
+#include "ExRootAnalysis/ExRootConfReader.h"
+#include "ExRootAnalysis/ExRootTreeReader.h"
+#include "ExRootAnalysis/ExRootTreeWriter.h"
+#include "ExRootAnalysis/ExRootTreeBranch.h"
+#include "ExRootAnalysis/ExRootClassifier.h"
+#include "ExRootAnalysis/ExRootUtilities.h"
+#include "ExRootAnalysis/ExRootFilter.h"
+#include "ExRootAnalysis/ExRootResult.h"
+
+using namespace std;
+
+//------------------------------------------------------------------------------
+
+class TParticleClassifier: public ExRootClassifier
+{
+public:
+  TParticleClassifier() {}
+
+  void AddParticleID(Int_t category, Int_t pid)
+  {
+    fMap[pid] = category;
+  }
+
+  Int_t GetCategory(TObject *object) const
+  {
+    ExRootGenParticle *particle = (ExRootGenParticle*) object;
+    Int_t pid = particle->PID;
+    std::map<Int_t, Int_t>::const_iterator itMap = fMap.find(pid);
+    return itMap != fMap.end() ? itMap->second : -1;
+  }
+
+private:
+  std::map<Int_t, Int_t> fMap;
+};
+
+//------------------------------------------------------------------------------
+
+struct MyPlots
+{
+  TH1 *fParticlePT;
+  TH1 *fJetPT[2];
+  TH1 *fMissingET;
+  TH1 *fElectronPT;
+};
+
+//------------------------------------------------------------------------------
+
+void BookHistograms(ExRootResult *result, MyPlots *plots, Int_t classIndex)
+{
+  THStack *stack;
+  TLegend *legend;
+  TPaveText *comment;
+
+  // book 1 histogram for (PT(track) - PT(particle))/(PT(track) + PT(particle))
+
+  plots->fParticlePT = result->AddHist1D("particle_pt",
+           "particle P_{T}",
+           "particle P_{T}, GeV/c",
+           "number of particles", 50, 0.0, 100.0);
+
+  // book 2 histograms for PT of 1st and 2nd leading jets
+
+  plots->fJetPT[0] = result->AddHist1D("jet_pt_0", "leading jet P_{T}",
+                                       "jet P_{T}, GeV/c", "number of jets",
+                                       50, 0.0, 100.0);
+
+  plots->fJetPT[1] = result->AddHist1D("jet_pt_1", "2nd leading jet P_{T}",
+                                       "jet P_{T}, GeV/c", "number of jets",
+                                       50, 0.0, 100.0);
+
+  plots->fJetPT[0]->SetLineColor(kRed);
+  plots->fJetPT[1]->SetLineColor(kBlue);
+
+  // book 1 stack of 2 histograms
+
+  stack = result->AddHistStack("jet_pt_all", "1st and 2nd jets P_{T}");
+  stack->Add(plots->fJetPT[0]);
+  stack->Add(plots->fJetPT[1]);
+
+  // book legend for stack of 2 histograms
+
+  legend = result->AddLegend(0.72, 0.86, 0.98, 0.98);
+  legend->AddEntry(plots->fJetPT[0], "leading jet", "l");
+  legend->AddEntry(plots->fJetPT[1], "second jet", "l");
+
+  // attach legend to stack (legend will be printed over stack in .eps file)
+
+  result->Attach(stack, legend);
+
+  // book more histograms
+
+  plots->fMissingET = result->AddHist1D("missing_et", "Missing E_{T}",
+                                        "Missing E_{T}, GeV",
+                                        "number of events",
+                                        60, 0.0, 30.0);
+
+  plots->fElectronPT = result->AddHist1D("electron_pt", "electron P_{T}",
+                                         "electron P_{T}, GeV/c",
+                                         "number of electrons",
+                                         50, 0.0, 100.0);
+
+  // book general comment
+
+  comment = result->AddComment(0.54, 0.72, 0.98, 0.98);
+  comment->AddText("demonstration plot");
+  comment->AddText("produced by Example.C");
+
+  // attach comment to single histograms
+
+  result->Attach(plots->fParticlePT, comment);
+  result->Attach(plots->fJetPT[0], comment);
+  result->Attach(plots->fJetPT[1], comment);
+  result->Attach(plots->fMissingET, comment);
+  result->Attach(plots->fElectronPT, comment);
+}
+
+//------------------------------------------------------------------------------
+
+void AnalyseEvents(ExRootTreeReader *treeReader,  TParticleClassifier *classifier,  MyPlots *plots)
+{
+  TClonesArray *branchGenParticle = treeReader->UseBranch("GenParticle");
+
+  ExRootGenParticle *particle;
+
+  ExRootFilter *filterGenParticle = new ExRootFilter(branchGenParticle);
+
+  const TObjArray *particles;
+
+  Long64_t entry;
+  Int_t particleIndex, classIndex;
+
+  // Loop over all events
+  while(treeReader->ReadEntry(entry++))
+  {
+    if(entry % 1000 == 0) cout << "event " << entry << endl;
+
+    filterGenParticle->Reset();
+
+    // Loop over all classes
+    for(classIndex = 0; classIndex < 1; ++classIndex)
+    {
+      particles = filterGenParticle->GetSubArray(classifier, classIndex);
+
+      if(!particles) continue;
+
+      // sort particles by PT
+      ExRootGenParticle::fgCompare = TComparePT<ExRootGenParticle>::Instance();
+      particles->Sort();
+
+      TIter itParticles(particles);
+  
+      // Loop over all generated particles
+      counterParticle = 0;
+      itParticles.Reset();
+      while(particle = (ExRootGenParticle*) itParticles.Next())
+      {
+        ++counterParticle;
+        if(counterParticle > plots->counterMax)
+        {
+          BookHistograms(classIndex);
+        }
+        plots->fParticlePT->Fill(particle->PT);
+      }
+    }
+  }
+
+  delete filterGenParticle;
+}
+
+//------------------------------------------------------------------------------
+
+void PrintHistograms(ExRootResult *result, MyPlots *plots)
+{
+  result->Print();
+}
+
+//------------------------------------------------------------------------------
+
+int main(int argc, char *argv[])
+{
+
+  int appargc = 2;
+  char *appName = "JetsSim";
+  char *appargv[] = {appName, "-b"};
+  TApplication app(appName, &appargc, appargv);
+
+  if(argc != 2)
+  {
+    cout << " Usage: " << argv[0] << " input_file" << endl;
+    cout << " input_file - configuration file in Tcl format." << endl;
+    return 1;
+  }
+
+  TString inputFile(argv[1]);
+  
+  ExRootConfReader *confReader = new ExRootConfReader();
+
+  confReader->ReadFile(inputFile);
+
+  TObjArray *chains = new TObjArray();
+  chains->SetOwner();
+
+  ExRootConfParam param = confReader->GetParam("::InputCollection");
+  TString name;
+  Long_t i, sizeChains, sizeClasses, sizeParticles;
+  TChain *chain, *firstChain;
+  sizeChains = param.GetSize();
+  for(i = 0; i < sizeChains; ++i)
+  {
+    chain = new TChain("", "");
+    chains->Add(chain);
+    name = param[i][0].GetString();
+    chain->SetName(name);
+    FillChain(chain, param[i][1].GetString());
+    if(i == 0)
+    {
+      firstChain = chain;
+    }
+    else
+    {
+      firstChain->AddFriend(chain, name + i);
+    }
+  }
+
+  TParticleClassifier *classifier = new TParticleClassifier();
+
+  param = confReader->GetParam("::ParticleClasses");
+  sizeClasses = param.GetSize();
+  for(i = 0; i < sizeClasses; ++i)
+  {
+    name = param[i][0].GetString();
+
+    sizeParticles = param[i][1].GetSize();
+    for(j = 0; j < sizeParticles; ++j)
+    {
+      pid = param[i][1][j].GetInt();
+      classifierGenParticle->AddParticleID(i, pid);
+    }
+  }
+  
+  ExRootTreeReader *treeReader = new ExRootTreeReader(chain);
+  ExRootResult *result = new ExRootResult();
+
+  MyPlots *plots = new MyPlots();
+
+  BookHistograms(result, plots);
+
+  AnalyseEvents(treeReader, classifier, plots);
+
+  PrintHistograms(result, plots);
+
+  cout << "** Exiting..." << endl;
+
+  delete plots;
+  delete result;
+  delete treeReader;
+  delete classifierGenParticle;
+  delete chains;
+  delete confReader;
+}
+
+//------------------------------------------------------------------------------
+
Index: /trunk/test/ExRootMain.cpp
===================================================================
--- /trunk/test/ExRootMain.cpp	(revision 2)
+++ /trunk/test/ExRootMain.cpp	(revision 2)
@@ -0,0 +1,35 @@
+
+#include "ExRootAnalysis/ExRootAnalysis.h"
+
+#include "TROOT.h"
+#include "TApplication.h"
+
+#include <iostream>
+
+using namespace std;
+
+int main(int argc, char *argv[])
+{
+  char *appName = "ExRootMain";
+
+  if(argc != 2)
+  {
+    cout << " Usage: " << appName << " input_file" << endl;
+    cout << " input_file - configuration file in Tcl format." << endl;
+    return 1;
+  }
+
+  gROOT->SetBatch();
+
+  int appargc = 1;
+  char *appargv[] = {appName};
+  TApplication app(appName, &appargc, appargv);
+  
+  TString inputFile(argv[1]);
+  
+  ExRootAnalysis test;
+  test.SetTclFileName(inputFile);
+  test.InitTask();
+  test.Loop();
+  test.FinishTask();
+}
Index: /trunk/test/ExRootSTDHEPConverter.cpp
===================================================================
--- /trunk/test/ExRootSTDHEPConverter.cpp	(revision 2)
+++ /trunk/test/ExRootSTDHEPConverter.cpp	(revision 2)
@@ -0,0 +1,185 @@
+#include <iostream>
+#include <sstream>
+
+#include <stdlib.h>
+
+#include "stdhep_mcfio.h"
+#include "stdhep_declarations.h"
+
+#include "TROOT.h"
+#include "TApplication.h"
+
+#include "TFile.h"
+#include "TChain.h"
+#include "TString.h"
+
+#include "TH2.h"
+#include "THStack.h"
+#include "TLegend.h"
+#include "TPaveText.h"
+#include "TLorentzVector.h"
+
+#include "LHEF.h"
+
+#include "ExRootAnalysis/ExRootClasses.h"
+
+#include "ExRootAnalysis/ExRootTreeWriter.h"
+#include "ExRootAnalysis/ExRootTreeBranch.h"
+
+#include "ExRootAnalysis/ExRootUtilities.h"
+#include "ExRootAnalysis/ExRootProgressBar.h"
+
+using namespace std;
+
+//---------------------------------------------------------------------------
+
+static void AnalyseEvent(ExRootTreeBranch *branch, Long64_t eventNumber)
+{
+  ExRootGenEvent *element;
+
+  element = static_cast<ExRootGenEvent*>(branch->NewEntry());
+
+  element->Number = eventNumber;
+}
+
+//---------------------------------------------------------------------------
+
+static void AnalyseParticles(ExRootTreeBranch *branch)
+{
+  ExRootGenParticle *element;
+
+  Double_t signPz;
+  TLorentzVector momentum;
+  Int_t number;
+
+  for(number = 0; number < myhepevt.nhep; ++number)
+  {
+
+    element = static_cast<ExRootGenParticle*>(branch->NewEntry());
+
+    element->PID = myhepevt.idhep[number];
+    element->Status = myhepevt.isthep[number];
+    element->M1 = myhepevt.jmohep[number][0] - 1;
+    element->M2 = myhepevt.jmohep[number][1] - 1;
+    element->D1 = myhepevt.jdahep[number][0] - 1;
+    element->D2 = myhepevt.jdahep[number][1] - 1;
+
+    element->E = myhepevt.phep[number][3];
+    element->Px = myhepevt.phep[number][0];
+    element->Py = myhepevt.phep[number][1];
+    element->Pz = myhepevt.phep[number][2];
+
+    momentum.SetPxPyPzE(element->Px, element->Py, element->Pz, element->E);
+    element->PT = momentum.Perp();
+    signPz = (element->Pz >= 0.0) ? 1.0 : -1.0;
+    element->Eta = element->PT == 0.0 ? signPz*999.9 : momentum.Eta();
+    element->Phi = momentum.Phi();
+
+    element->Rapidity = element->PT == 0.0 ? signPz*999.9 : momentum.Rapidity();
+
+    element->T = myhepevt.vhep[number][3];
+    element->X = myhepevt.vhep[number][0];
+    element->Y = myhepevt.vhep[number][1];
+    element->Z = myhepevt.vhep[number][2];
+  }
+}
+
+//---------------------------------------------------------------------------
+
+int main(int argc, char *argv[])
+{
+  int ierr, entryType;
+  int istr = 0;
+  int nevt = 0;
+  char *appName = "ExRootSTDHEPConverter";
+
+  if(argc != 3)
+  {
+    cout << " Usage: " << appName << " input_file" << " output_file" << endl;
+    cout << " input_file - input file in STDHEP format," << endl;
+    cout << " output_file - output file in ROOT format." << endl;
+    return 1;
+  }
+
+  gROOT->SetBatch();
+
+  int appargc = 1;
+  char *appargv[] = {appName};
+  TApplication app(appName, &appargc, appargv);
+
+  // Open a stream connected to an event file:
+  char inputFileName[80];
+  strcpy(inputFileName, argv[1]);
+  ierr = StdHepXdrReadInit(inputFileName, &nevt, istr);
+
+  if(ierr != 0)
+  {
+    cerr << "** ERROR: Can't open '" << argv[1] << "' for input" << endl;
+    return 1;
+  }
+
+  Long64_t allEntries = nevt;
+  cout << "** Input file contains " << allEntries << " entries" << endl;
+
+  TFile *outputFile = TFile::Open(argv[2], "RECREATE");
+  ExRootTreeWriter *treeWriter = new ExRootTreeWriter(outputFile, "STDHEP");
+
+  // information about generated event
+  ExRootTreeBranch *branchGenEvent = treeWriter->NewBranch("Event", ExRootGenEvent::Class());
+  // generated particles from HEPEVT
+  ExRootTreeBranch *branchGenParticle = treeWriter->NewBranch("GenParticle", ExRootGenParticle::Class());
+
+  if(allEntries > 0)
+  {
+    ExRootProgressBar progressBar(allEntries);
+
+    // Loop over all objects
+    Long64_t entry = 0;
+    Long64_t recordNumber = 1;
+    for(entry = 0; entry < allEntries; ++entry)
+    {
+      ierr = StdHepXdrRead(&entryType, istr);
+
+      if(ierr != 0)
+      {
+        cerr << "** ERROR: Unexpected end of file after " << entry << " entries" << endl;
+        break;
+      }
+
+      // analyse only entries with standard HEPEVT common block
+      if(entryType == 1)
+      {
+        // add empty events for missing event numbers
+        while(recordNumber < myhepevt.nevhep)
+        {
+          treeWriter->Clear();
+          AnalyseEvent(branchGenEvent, recordNumber);
+          treeWriter->Fill();
+          ++recordNumber;
+        }
+
+        treeWriter->Clear();
+
+        AnalyseEvent(branchGenEvent, myhepevt.nevhep);
+        AnalyseParticles(branchGenParticle);
+
+        treeWriter->Fill();
+
+        ++recordNumber;
+
+      }
+
+      progressBar.Update(entry);
+    }
+
+    progressBar.Finish();
+  }
+
+  treeWriter->Write();
+
+  cout << "** Exiting..." << endl;
+
+  delete treeWriter;
+  StdHepXdrEnd(istr);
+}
+
Index: /trunk/test/Example.C
===================================================================
--- /trunk/test/Example.C	(revision 2)
+++ /trunk/test/Example.C	(revision 2)
@@ -0,0 +1,165 @@
+//------------------------------------------------------------------------------
+
+struct MyPlots
+{
+  TH1 *fTrackDeltaPT;
+  TH1 *fJetPT[2];
+  TH1 *fMissingET;
+  TH1 *fElectronPT;
+};
+
+//------------------------------------------------------------------------------
+
+void BookHistograms(ExRootResult *result, MyPlots *plots)
+{
+  THStack *stack;
+  TLegend *legend;
+  TPaveText *comment;
+
+  // book 2 histograms for PT of 1st and 2nd leading jets
+
+  plots->fJetPT[0] = result->AddHist1D("jet_pt_0", "leading jet P_{T}",
+                                       "jet P_{T}, GeV/c", "number of jets",
+                                       50, 0.0, 100.0);
+
+  plots->fJetPT[1] = result->AddHist1D("jet_pt_1", "2nd leading jet P_{T}",
+                                       "jet P_{T}, GeV/c", "number of jets",
+                                       50, 0.0, 100.0);
+
+  plots->fJetPT[0]->SetLineColor(kRed);
+  plots->fJetPT[1]->SetLineColor(kBlue);
+
+  // book 1 stack of 2 histograms
+
+  stack = result->AddHistStack("jet_pt_all", "1st and 2nd jets P_{T}");
+  stack->Add(plots->fJetPT[0]);
+  stack->Add(plots->fJetPT[1]);
+
+  // book legend for stack of 2 histograms
+
+  legend = result->AddLegend(0.72, 0.86, 0.98, 0.98);
+  legend->AddEntry(plots->fJetPT[0], "leading jet", "l");
+  legend->AddEntry(plots->fJetPT[1], "second jet", "l");
+
+  // attach legend to stack (legend will be printed over stack in .eps file)
+
+  result->Attach(stack, legend);
+
+  // book more histograms
+
+  plots->fMissingET = result->AddHist1D("missing_et", "Missing E_{T}",
+                                        "Missing E_{T}, GeV",
+                                        "number of events",
+                                        60, 0.0, 30.0);
+
+  plots->fElectronPT = result->AddHist1D("electron_pt", "electron P_{T}",
+                                         "electron P_{T}, GeV/c",
+                                         "number of electrons",
+                                         50, 0.0, 100.0);
+
+  // book general comment
+
+  comment = result->AddComment(0.54, 0.72, 0.98, 0.98);
+  comment->AddText("demonstration plot");
+  comment->AddText("produced by Example.C");
+
+  // attach comment to single histograms
+
+  result->Attach(plots->fJetPT[0], comment);
+  result->Attach(plots->fJetPT[1], comment);
+  result->Attach(plots->fMissingET, comment);
+  result->Attach(plots->fElectronPT, comment);
+}
+
+//------------------------------------------------------------------------------
+
+//------------------------------------------------------------------------------
+
+void AnalyseEvents(ExRootTreeReader *treeReader, MyPlots *plots)
+{
+  TClonesArray *branchJet = treeReader->UseBranch("Jet");
+  TClonesArray *branchElectron = treeReader->UseBranch("Electron");
+  TClonesArray *branchMissingET = treeReader->UseBranch("MissingET");
+
+  Long64_t allEntries = treeReader->GetEntries();
+
+  cout << "** Chain contains " << allEntries << " events" << endl;
+
+  ExRootJet *jet[2];
+  ExRootMissingET *met;
+  ExRootElectron *electron;
+
+  TIter itElectron(branchElectron);
+
+  Long64_t entry;
+
+  // Loop over all events
+  for(entry = 0; entry < allEntries; ++entry)
+  {
+    // Load selected branches with data from specified event
+    treeReader->ReadEntry(entry);
+
+    // Analyse two leading jets
+    if(branchJet->GetEntriesFast() >= 2)
+    {
+      jet[0] = (ExRootJet*) branchJet->At(0);
+      jet[1] = (ExRootJet*) branchJet->At(1);
+
+      plots->fJetPT[0]->Fill(jet[0]->PT);
+      plots->fJetPT[1]->Fill(jet[1]->PT);
+    }
+
+    // Analyse missing ET
+    if(branchMissingET->GetEntriesFast() > 0)
+    {
+      met = (ExRootMissingET*) branchMissingET->At(0);
+      plots->fMissingET->Fill(met->MET);
+    }
+
+    // Loop over all electrons in event
+    itElectron.Reset();
+    while((electron = (ExRootElectron*) itElectron.Next()))
+    {
+      plots->fElectronPT->Fill(electron->PT);
+    }
+  }
+}
+
+//------------------------------------------------------------------------------
+
+void PrintHistograms(ExRootResult *result, MyPlots *plots)
+{
+  result->Print();
+}
+
+//------------------------------------------------------------------------------
+
+void Example(const char *inputFileList)
+{
+  TChain *chain = new TChain("LHCO");
+
+  if(!FillChain(chain, inputFileList)) return;
+
+  ExRootTreeReader *treeReader = new ExRootTreeReader(chain);
+  ExRootResult *result = new ExRootResult();
+
+  MyPlots *plots = new MyPlots;
+
+  BookHistograms(result, plots);
+
+  AnalyseEvents(treeReader, plots);
+
+  PrintHistograms(result, plots);
+
+  result->Write("results.root");
+
+  cout << "** Exiting..." << endl;
+
+  delete plots;
+  delete result;
+  delete treeReader;
+  delete chain;
+}
+
+//------------------------------------------------------------------------------
+
Index: /trunk/test/Example.cpp
===================================================================
--- /trunk/test/Example.cpp	(revision 2)
+++ /trunk/test/Example.cpp	(revision 2)
@@ -0,0 +1,64 @@
+#include <iostream>
+#include <utility>
+#include <vector>
+
+#include "TROOT.h"
+#include "TApplication.h"
+
+#include "TChain.h"
+#include "TString.h"
+
+#include "TH2.h"
+#include "THStack.h"
+#include "TLegend.h"
+#include "TPaveText.h"
+#include "TClonesArray.h"
+#include "TLorentzVector.h"
+
+#include "ExRootAnalysis/ExRootClasses.h"
+
+#include "ExRootAnalysis/ExRootTreeReader.h"
+#include "ExRootAnalysis/ExRootTreeWriter.h"
+#include "ExRootAnalysis/ExRootTreeBranch.h"
+#include "ExRootAnalysis/ExRootResult.h"
+#include "ExRootAnalysis/ExRootUtilities.h"
+
+using namespace std;
+
+//------------------------------------------------------------------------------
+
+// Here you can put your analysis macro
+
+#include "Example.C"
+
+//------------------------------------------------------------------------------
+
+int main(int argc, char *argv[])
+{
+  char *appName = "JetsSim";
+
+  if(argc != 2)
+  {
+    cout << " Usage: " << appName << " input_file_list" << " output_file" << endl;
+    cout << " input_file_list - list of input files in ROOT format ('Analysis' tree)," << endl;
+    return 1;
+  }
+
+  gROOT->SetBatch();
+
+  int appargc = 1;
+  char *appargv[] = {appName};
+  TApplication app(appName, &appargc, appargv);
+
+  TString inputFileList(argv[1]);
+
+//------------------------------------------------------------------------------
+
+// Here you call your macro's main function 
+
+  Example(inputFileList);
+
+//------------------------------------------------------------------------------
+
+}
+
Index: /trunk/test/LHEF.h
===================================================================
--- /trunk/test/LHEF.h	(revision 2)
+++ /trunk/test/LHEF.h	(revision 2)
@@ -0,0 +1,897 @@
+// -*- C++ -*-
+#ifndef THEPEG_LHEF_H
+#define THEPEG_LHEF_H
+//
+// This is the declaration of the Les Houches Event File classes.
+//
+
+
+#include <iostream>
+#include <iomanip>
+#include <sstream>
+#include <fstream>
+#include <string>
+#include <vector>
+#include <utility>
+#include <stdexcept>
+
+namespace LHEF {
+
+/**
+ * The HEPRUP class is a simple container corresponding to the Les Houches
+ * accord (<A HREF="http://arxiv.org/abs/hep-ph/0109068">hep-ph/0109068</A>)
+ * common block with the same name. The members are named in the same
+ * way as in the common block. However, fortran arrays are represented
+ * by vectors, except for the arrays of length two which are
+ * represented by pair objects.
+ */
+class HEPRUP {
+
+public:
+
+  /** @name Standard constructors and destructors. */
+  //@{
+  /**
+   * Default constructor.
+   */
+  HEPRUP()
+    : IDWTUP(0), NPRUP(0) {}
+
+  /**
+   * Copy-constructor.
+   */
+  HEPRUP(const HEPRUP & x)
+    : IDBMUP(x.IDBMUP), EBMUP(x.EBMUP),
+      PDFGUP(x.PDFGUP), PDFSUP(x.PDFSUP), IDWTUP(x.IDWTUP),
+      NPRUP(x.NPRUP), XSECUP(x.XSECUP), XERRUP(x.XERRUP),
+      XMAXUP(x.XMAXUP), LPRUP(x.LPRUP) {}
+
+
+  /**
+   * Assignment operator.
+   */
+  HEPRUP & operator=(const HEPRUP & x) {
+    IDBMUP = x.IDBMUP;
+    EBMUP = x.EBMUP;
+    PDFGUP = x.PDFGUP;
+    PDFSUP = x.PDFSUP;
+    IDWTUP = x.IDWTUP;
+    NPRUP = x.NPRUP;
+    XSECUP = x.XSECUP;
+    XERRUP = x.XERRUP;
+    XMAXUP = x.XMAXUP;
+    LPRUP = x.LPRUP;
+    return *this;
+  }
+
+  /**
+   * Destructor.
+   */
+  ~HEPRUP() {}
+  //@}
+
+public:
+
+  /**
+   * Set the NPRUP variable, corresponding to the number of
+   * sub-processes, to \a nrup, and resize all relevant vectors
+   * accordingly.
+   */
+  void resize(int nrup) {
+    NPRUP = nrup;
+    resize();
+  }
+
+  /**
+   * Assuming the NPRUP variable, corresponding to the number of
+   * sub-processes, is correctly set, resize the relevant vectors
+   * accordingly.
+   */
+  void resize() {
+    XSECUP.resize(NPRUP);
+    XERRUP.resize(NPRUP);
+    XMAXUP.resize(NPRUP);
+    LPRUP.resize(NPRUP);
+  }
+
+public:
+
+  /**
+   * PDG id's of beam particles. (first/second is in +/-z direction).
+   */
+  std::pair<long,long> IDBMUP;
+
+  /**
+   * Energy of beam particles given in GeV.
+   */
+  std::pair<double,double> EBMUP;
+
+  /**
+   * The author group for the PDF used for the beams according to the
+   * PDFLib specification.
+   */
+  std::pair<int,int> PDFGUP;
+
+  /**
+   * The id number the PDF used for the beams according to the
+   * PDFLib specification.
+   */
+  std::pair<int,int> PDFSUP;
+
+  /**
+   * Master switch indicating how the ME generator envisages the
+   * events weights should be interpreted according to the Les Houches
+   * accord.
+   */
+  int IDWTUP;
+
+  /**
+   * The number of different subprocesses in this file.
+   */
+  int NPRUP;
+
+  /**
+   * The cross sections for the different subprocesses in pb.
+   */
+  std::vector<double> XSECUP;
+
+  /**
+   * The statistical error in the cross sections for the different
+   * subprocesses in pb.
+   */
+  std::vector<double> XERRUP;
+
+  /**
+   * The maximum event weights (in HEPEUP::XWGTUP) for different
+   * subprocesses.
+   */
+  std::vector<double> XMAXUP;
+
+  /**
+   * The subprocess code for the different subprocesses.
+   */
+  std::vector<int> LPRUP;
+
+};
+
+
+/**
+ * The HEPEUP class is a simple container corresponding to the Les Houches accord
+ * (<A HREF="http://arxiv.org/abs/hep-ph/0109068">hep-ph/0109068</A>)
+ * common block with the same name. The members are named in the same
+ * way as in the common block. However, fortran arrays are represented
+ * by vectors, except for the arrays of length two which are
+ * represented by pair objects.
+ */
+class HEPEUP {
+
+public:
+
+  /** @name Standard constructors and destructors. */
+  //@{
+  /**
+   * Default constructor.
+   */
+  HEPEUP()
+    : NUP(0), IDPRUP(0), XWGTUP(0.0), XPDWUP(0.0, 0.0),
+      SCALUP(0.0), AQEDUP(0.0), AQCDUP(0.0) {}
+
+  /**
+   * Copy-constructor.
+   */
+  HEPEUP(const HEPEUP & x)
+    : NUP(x.NUP), IDPRUP(x.IDPRUP), XWGTUP(x.XWGTUP), XPDWUP(x.XPDWUP),
+      SCALUP(x.SCALUP), AQEDUP(x.AQEDUP), AQCDUP(x.AQCDUP), IDUP(x.IDUP),
+      ISTUP(x.ISTUP), MOTHUP(x.MOTHUP), ICOLUP(x.ICOLUP),
+      PUP(x.PUP), VTIMUP(x.VTIMUP), SPINUP(x.SPINUP) {}
+  
+  /**
+   * Assignment operator.
+   */
+  HEPEUP & operator=(const HEPEUP & x) {
+    NUP = x.NUP;
+    IDPRUP = x.IDPRUP;
+    XWGTUP = x.XWGTUP;
+    XPDWUP = x.XPDWUP;
+    SCALUP = x.SCALUP;
+    AQEDUP = x.AQEDUP;
+    AQCDUP = x.AQCDUP;
+    IDUP = x.IDUP;
+    ISTUP = x.ISTUP;
+    MOTHUP = x.MOTHUP;
+    ICOLUP = x.ICOLUP;
+    PUP = x.PUP;
+    VTIMUP = x.VTIMUP;
+    SPINUP = x.SPINUP;
+    return *this;
+  }
+
+
+  /**
+   * Destructor.
+   */
+  ~HEPEUP() {};
+  //@}
+
+public:
+
+  /**
+   * Set the NUP variable, corresponding to the number of particles in
+   * the current event, to \a nup, and resize all relevant vectors
+   * accordingly.
+   */
+  void resize(int nup) {
+    NUP = nup;
+    resize();
+  }
+
+  /**
+   * Assuming the NUP variable, corresponding to the number of
+   * particles in the current event, is correctly set, resize the
+   * relevant vectors accordingly.
+   */
+  void resize() {
+    IDUP.resize(NUP);
+    ISTUP.resize(NUP);
+    MOTHUP.resize(NUP);
+    ICOLUP.resize(NUP);
+    PUP.resize(NUP, std::vector<double>(5));
+    VTIMUP.resize(NUP);
+    SPINUP.resize(NUP);
+  }
+
+public:
+
+  /**
+   * The number of particle entries in the current event.
+   */
+  int NUP;
+
+  /**
+   * The subprocess code for this event (as given in LPRUP).
+   */
+  int IDPRUP;
+
+  /**
+   * The weight for this event.
+   */
+  double XWGTUP;
+
+  /**
+   * The PDF weights for the two incoming partons. Note that this
+   * variable is not present in the current LesHouches accord
+   * (<A HREF="http://arxiv.org/abs/hep-ph/0109068">hep-ph/0109068</A>),
+   * hopefully it will be present in a future accord.
+   */
+  std::pair<double,double> XPDWUP;
+
+  /**
+   * The scale in GeV used in the calculation of the PDF's in this
+   * event.
+   */
+  double SCALUP;
+
+  /**
+   * The value of the QED coupling used in this event.
+   */
+  double AQEDUP;
+
+  /**
+   * The value of the QCD coupling used in this event.
+   */
+  double AQCDUP;
+
+  /**
+   * The PDG id's for the particle entries in this event.
+   */
+  std::vector<long> IDUP;
+
+  /**
+   * The status codes for the particle entries in this event.
+   */
+  std::vector<int> ISTUP;
+
+  /**
+   * Indices for the first and last mother for the particle entries in
+   * this event.
+   */
+  std::vector< std::pair<int,int> > MOTHUP;
+
+  /**
+   * The colour-line indices (first(second) is (anti)colour) for the
+   * particle entries in this event.
+   */
+  std::vector< std::pair<int,int> > ICOLUP;
+
+  /**
+   * Lab frame momentum (Px, Py, Pz, E and M in GeV) for the particle
+   * entries in this event.
+   */
+  std::vector< std::vector<double> > PUP;
+
+  /**
+   * Invariant lifetime (c*tau, distance from production to decay in
+   * mm) for the particle entries in this event.
+   */
+  std::vector<double> VTIMUP;
+
+  /**
+   * Spin info for the particle entries in this event given as the
+   * cosine of the angle between the spin vector of a particle and the
+   * 3-momentum of the decaying particle, specified in the lab frame.
+   */
+  std::vector<double> SPINUP;
+
+};
+
+/**
+ * The Reader class is initialized with a stream from which to read a
+ * version 1.0 Les Houches Accord event file. In the constructor of
+ * the Reader object the optional header information is read and then
+ * the mandatory init is read. After this the whole header block
+ * including the enclosing lines with tags are available in the public
+ * headerBlock member variable. Also the information from the init
+ * block is available in the heprup member variable and any additional
+ * comment lines are available in initComments. After each successful
+ * call to the readEvent() function the standard Les Houches Accord
+ * information about the event is available in the hepeup member
+ * variable and any additional comments in the eventComments
+ * variable. A typical reading sequence would look as follows:
+ *
+ *
+ */
+class Reader {
+
+public:
+
+  /**
+   * Initialize the Reader with a stream from which to read an event
+   * file. After the constructor is called the whole header block
+   * including the enclosing lines with tags are available in the
+   * public headerBlock member variable. Also the information from the
+   * init block is available in the heprup member variable and any
+   * additional comment lines are available in initComments.
+   *
+   * @param is the stream to read from.
+   */
+  Reader(std::istream & is)
+    : file(is) {
+    init();
+  }
+
+  /**
+   * Initialize the Reader with a filename from which to read an event
+   * file. After the constructor is called the whole header block
+   * including the enclosing lines with tags are available in the
+   * public headerBlock member variable. Also the information from the
+   * init block is available in the heprup member variable and any
+   * additional comment lines are available in initComments.
+   *
+   * @param filename the name of the file to read from.
+   */
+  Reader(std::string filename)
+    : intstream(filename.c_str()), file(intstream) {
+    init();
+  }
+
+private:
+
+  /**
+   * Used internally in the constructors to read header and init
+   * blocks.
+   */
+  void init() {
+
+    bool readingHeader = false;
+    bool readingInit = false;
+
+    // Make sure we are reading a LHEF file:
+    getline();
+    if ( currentLine.find("<LesHouchesEvents" ) == std::string::npos )
+      throw std::runtime_error
+	("Tried to read a file which does not start with the "
+	 "LesHouchesEvents tag.");
+    if ( currentLine.find("version=\"1.0\"" ) == std::string::npos )
+      throw std::runtime_error
+	("Tried to read a LesHouchesEvents file which is not version 1.0.");
+
+    // Loop over all lines until we hit the </init> tag.
+    while ( getline() && currentLine.find("</init>") == std::string::npos ) {
+      if ( currentLine.find("<header") != std::string::npos ) {
+	// We have hit the header block, so we should dump this all
+	// following lines to headerBlock until we hit the end of it.
+	readingHeader = true;
+	headerBlock = currentLine + "\n";
+      }
+      else if ( currentLine.find("<init") != std::string::npos ) {
+	// We have hit the init block, so we should expect to find the
+	// standard information in the following.
+	readingInit = true;
+
+	// The first line tells us how many lines to read next.
+	getline();
+	std::istringstream iss(currentLine);
+	if ( !( iss >> heprup.IDBMUP.first >> heprup.IDBMUP.second
+		    >> heprup.EBMUP.first >> heprup.EBMUP.second
+	            >> heprup.PDFGUP.first >> heprup.PDFGUP.second
+	            >> heprup.PDFSUP.first >> heprup.PDFSUP.second
+		    >> heprup.IDWTUP >> heprup.NPRUP ) ) {
+	  heprup.NPRUP = -42;
+	  return;
+	}
+	heprup.resize();
+
+	for ( int i = 0; i < heprup.NPRUP; ++i ) {
+	  getline();
+	  std::istringstream iss(currentLine);
+	  if ( !( iss >> heprup.XSECUP[i] >> heprup.XERRUP[i]
+	              >> heprup.XMAXUP[i] >> heprup.LPRUP[i] ) ) {
+	    heprup.NPRUP = -42;
+	    return;
+	  }
+	}
+      }
+      else if ( currentLine.find("</header>") != std::string::npos ) {
+	// The end of the header block. Dump this line as well to the
+	// headerBlock and we're done.
+	readingHeader = false;
+	headerBlock += currentLine + "\n";
+      }
+      else if ( readingHeader ) {
+	// We are in the process of reading the header block. Dump the
+	// line to haderBlock.
+	headerBlock += currentLine + "\n";
+      }
+      else if ( readingInit ) {
+	// Here we found a comment line. Dump it to initComments.
+	initComments += currentLine + "\n";
+      }
+      else {
+	// We found some other stuff outside the standard tags.
+	outsideBlock += currentLine + "\n";
+      }
+    }
+    if ( !file ) heprup.NPRUP = -42;
+  }
+
+public:
+
+  int getNumberOfEvents()
+  {
+    int counter = 0;
+    int position = file.tellg();
+    file.seekg(0, std::ios::beg);
+
+    file.clear();
+
+    while(getline())
+    {
+      if(currentLine.find("<event") != std::string::npos) ++counter;
+    }
+
+    file.clear();
+
+    file.seekg(position, std::ios::beg);
+
+    return counter;
+  }
+
+  /**
+   * Read an event from the file and store it in the hepeup
+   * object. Optional comment lines are stored i the eventComments
+   * member variable.
+   * @return true if the read sas successful.
+   */
+  bool readEvent() {
+
+    // Check if the initialization was successful. Otherwise we will
+    // not read any events.
+    if ( heprup.NPRUP < 0 ) return false;
+    eventComments = "";
+    outsideBlock = "";
+    hepeup.NUP = 0;
+
+    // Keep reading lines until we hit the next event or the end of
+    // the event block. Save any inbetween lines. Exit if we didn't
+    // find an event.
+    while ( getline() && currentLine.find("<event") == std::string::npos )
+      outsideBlock += currentLine + "\n";
+    if ( !getline()  ) return false;
+    
+    // We found an event. The first line determines how many
+    // subsequent particle lines we have.
+    std::istringstream iss(currentLine);
+    if ( !( iss >> hepeup.NUP >> hepeup.IDPRUP >> hepeup.XWGTUP
+	        >> hepeup.SCALUP >> hepeup.AQEDUP >> hepeup.AQCDUP ) )
+      return false;
+    hepeup.resize();
+
+    // Read all particle lines.
+    for ( int i = 0; i < hepeup.NUP; ++i ) {
+      if ( !getline() ) return false;
+      std::istringstream iss(currentLine);
+      if ( !( iss >> hepeup.IDUP[i] >> hepeup.ISTUP[i]
+	          >> hepeup.MOTHUP[i].first >> hepeup.MOTHUP[i].second
+         	  >> hepeup.ICOLUP[i].first >> hepeup.ICOLUP[i].second
+	          >> hepeup.PUP[i][0] >> hepeup.PUP[i][1] >> hepeup.PUP[i][2]
+	          >> hepeup.PUP[i][3] >> hepeup.PUP[i][4]
+        	  >> hepeup.VTIMUP[i] >> hepeup.SPINUP[i] ) )
+	return false;
+    }
+
+    // Now read any additional comments.
+    while ( getline() && currentLine.find("</event>") == std::string::npos )
+      eventComments += currentLine + "\n";
+
+    if ( !file ) return false;
+    return true;
+
+  }
+
+protected:
+
+  /**
+   * Used internally to read a single line from the stream.
+   */
+  bool getline() {
+    return ( std::getline(file, currentLine) );
+  }
+
+protected:
+
+  /**
+   * A local stream which is unused if a stream is supplied from the
+   * outside.
+   */
+  std::ifstream intstream;
+
+  /**
+   * The stream we are reading from. This may be a reference to an
+   * external stream or the internal intstream.
+   */
+  std::istream & file;
+
+  /**
+   * The last line read in from the stream in getline().
+   */
+  std::string currentLine;
+
+public:
+
+  /**
+   * All lines (since the last readEvent()) outside the header, init
+   * and event tags.
+   */
+  std::string outsideBlock;
+
+  /**
+   * All lines from the header block.
+   */
+  std::string headerBlock;
+
+  /**
+   * The standard init information.
+   */
+  HEPRUP heprup;
+
+  /**
+   * Additional comments found in the init block.
+   */
+  std::string initComments;
+
+  /**
+   * The standard information about the last read event.
+   */
+  HEPEUP hepeup;
+
+  /**
+   * Additional comments found with the last read event.
+   */
+  std::string eventComments;
+
+private:
+
+  /**
+   * The default constructor should never be used.
+   */
+  Reader();
+
+  /**
+   * The copy constructor should never be used.
+   */
+  Reader(const Reader &);
+
+  /**
+   * The Reader cannot be assigned to.
+   */
+  Reader & operator=(const Reader &);
+
+};
+
+/**
+ * The Writer class is initialized with a stream to which to write a
+ * version 1.0 Les Houches Accord event file. In the constructor of
+ * the Writer object the main XML tag is written out, with the
+ * corresponding end tag is written in the destructor. After a Writer
+ * object has been created, it is possible to assign standard init
+ * information in the heprup member variable. In addition any XML
+ * formatted information can be added to the headerBlock member
+ * variable (directly or via the addHeader() function). Further
+ * comment line (beginning with a <code>#</code> character) can be
+ * added to the initComments variable (directly or with the
+ * addInitComment() function). After this information is set, it
+ * should be written out to the file with the init() function.
+ *
+ * Before each event is written out with the writeEvent() function,
+ * the standard event information can then be assigned to the hepeup
+ * variable and optional comment lines (beginning with a
+ * <code>#</code> character) may be given to the eventComments
+ * variable (directly or with the addEventComment() function).
+ *
+ */
+class Writer {
+
+public:
+
+  /**
+   * Create a Writer object giving a stream to write to.
+   * @param os the stream where the event file is written.
+   */
+  Writer(std::ostream & os)
+    : file(os) {
+    // Write out the standard XML tag for the event file.
+    file << "<LesHouchesEvents version=\"1.0\">\n";
+  }
+
+  /**
+   * Create a Writer object giving a filename to write to.
+   * @param filename the name of the event file to be written.
+   */
+  Writer(std::string filename)
+    : intstream(filename.c_str()), file(intstream) {
+    // Write out the standard XML tag for the event file.
+    file << "LesHouchesEvents version=\"1.0\">\n";
+  }
+
+  /**
+   * The destructor writes out the final XML end-tag.
+   */
+  ~Writer() {
+    file << "</LesHouchesEvents>" << std::endl;
+  }
+
+  /**
+   * Add header lines consisting of XML code with this stream.
+   */
+  std::ostream & headerBlock() {
+    return headerStream;
+  }
+
+  /**
+   * Add comment lines to the init block with this stream.
+   */
+  std::ostream & initComments() {
+    return initStream;
+  }
+
+  /**
+   * Add comment lines to the next event to be written out with this stream.
+   */
+  std::ostream & eventComments() {
+    return eventStream;
+  }
+
+  /**
+   * Write out an optional header block followed by the standard init
+   * block information together with any comment lines.
+   */
+  void init() {
+
+    file << std::setprecision(8);
+
+    using std::setw;
+
+    std::string headerBlock = headerStream.str();
+    if ( headerBlock.length() ) {
+      if ( headerBlock.find("<header>") == std::string::npos )
+	file << "<header>\n";
+      if ( headerBlock[headerBlock.length() - 1] != '\n' )
+	headerBlock += '\n';
+      file << headerBlock;
+      if ( headerBlock.find("</header>") == std::string::npos )
+	file << "</header>\n";
+    }
+    file << "<init>\n"
+	 << " " << setw(8) << heprup.IDBMUP.first
+	 << " " << setw(8) << heprup.IDBMUP.second
+	 << " " << setw(14) << heprup.EBMUP.first
+	 << " " << setw(14) << heprup.EBMUP.second
+	 << " " << setw(4) << heprup.PDFGUP.first
+	 << " " << setw(4) << heprup.PDFGUP.second
+	 << " " << setw(4) << heprup.PDFSUP.first
+	 << " " << setw(4) << heprup.PDFSUP.second
+	 << " " << setw(4) << heprup.IDWTUP
+	 << " " << setw(4) << heprup.NPRUP << std::endl;
+    heprup.resize();
+    for ( int i = 0; i < heprup.NPRUP; ++i )
+      file << " " << setw(14) << heprup.XSECUP[i]
+	   << " " << setw(14) << heprup.XERRUP[i]
+	   << " " << setw(14) << heprup.XMAXUP[i]
+	   << " " << setw(6) << heprup.LPRUP[i] << std::endl;
+    file << hashline(initStream.str()) << "</init>" << std::endl;
+    eventStream.str("");
+  }
+
+  /**
+   * Write out the event stored in hepeup, followed by optional
+   * comment lines.
+   */
+  bool writeEvent() {
+
+    using std::setw;
+
+    file << "<event>\n";
+    file << " " << setw(4) << hepeup.NUP
+	 << " " << setw(6) << hepeup.IDPRUP
+	 << " " << setw(14) << hepeup.XWGTUP
+	 << " " << setw(14) << hepeup.SCALUP
+	 << " " << setw(14) << hepeup.AQEDUP
+	 << " " << setw(14) << hepeup.AQCDUP << "\n";
+    hepeup.resize();
+
+    for ( int i = 0; i < hepeup.NUP; ++i )
+      file << " " << setw(8) << hepeup.IDUP[i]
+	   << " " << setw(2) << hepeup.ISTUP[i]
+	   << " " << setw(4) << hepeup.MOTHUP[i].first
+	   << " " << setw(4) << hepeup.MOTHUP[i].second
+	   << " " << setw(4) << hepeup.ICOLUP[i].first
+	   << " " << setw(4) << hepeup.ICOLUP[i].second
+	   << " " << setw(14) << hepeup.PUP[i][0]
+	   << " " << setw(14) << hepeup.PUP[i][1]
+	   << " " << setw(14) << hepeup.PUP[i][2]
+	   << " " << setw(14) << hepeup.PUP[i][3]
+	   << " " << setw(14) << hepeup.PUP[i][4]
+	   << " " << setw(1) << hepeup.VTIMUP[i]
+	   << " " << setw(1) << hepeup.SPINUP[i] << std::endl;
+
+    file << hashline(eventStream.str()) << "</event>\n";
+
+    eventStream.str("");
+
+    if ( !file ) return false;
+
+    return true;
+
+  }
+
+protected:
+
+  /**
+   * Make sure that each line in the string \a s starts with a
+   * #-character and that the string ends with a new-line.
+   */
+  std::string hashline(std::string s) {
+    std::string ret;
+    std::istringstream is(s);
+    std::string ss;
+    while ( getline(is, ss) ) {
+      if ( ss.find('#') == std::string::npos ||
+	   ss.find('#') != ss.find_first_not_of(" \t") ) ss = "# " + ss;
+      ret += ss + '\n';
+    }
+    return ret;
+  }
+
+protected:
+
+  /**
+   * A local stream which is unused if a stream is supplied from the
+   * outside.
+   */
+  std::ofstream intstream;
+
+  /**
+   * The stream we are writing to. This may be a reference to an
+   * external stream or the internal intstream.
+   */
+  std::ostream & file;
+
+public:
+
+  /**
+   * Stream to add all lines in the header block.
+   */
+  std::ostringstream headerStream;
+
+  /**
+   * The standard init information.
+   */
+  HEPRUP heprup;
+
+  /**
+   * Stream to add additional comments to be put in the init block.
+   */
+  std::ostringstream initStream;
+
+  /**
+   * The standard information about the event we will write next.
+   */
+  HEPEUP hepeup;
+
+  /**
+   * Stream to add additional comments to be written together the next event.
+   */
+  std::ostringstream eventStream;
+
+private:
+
+  /**
+   * The default constructor should never be used.
+   */
+  Writer();
+
+  /**
+   * The copy constructor should never be used.
+   */
+  Writer(const Writer &);
+
+  /**
+   * The Writer cannot be assigned to.
+   */
+  Writer & operator=(const Writer &);
+
+};
+
+}
+
+/** \example LHEFReadEx.cc An example function which reads from a Les
+    Huches Event File: */
+/** \example LHEFWriteEx.cc An example function which writes out a Les
+    Huches Event File: */
+/** \example LHEFCat.cc This is a main function which simply reads a
+    Les Houches Event File from the standard input and writes it again
+    to the standard output. 
+    This file can be downloaded from
+    <A HREF="http://www.thep.lu.se/~leif/LHEF/LHEFCat.cc">here</A>. 
+    There is also a sample
+    <A HREF="http://www.thep.lu.se/~leif/LHEF/ttbar.lhef">event file</A>
+    to try it on.
+*/
+
+/**\mainpage Les Houches Event File
+
+Why isn't any doxygen output generated by this text?
+
+Here are some example classes for reading and writing Les Houches
+Event Files according to the
+<A HREF="http://www.thep.lu.se/~torbjorn/lhef/lhafile2.pdf">proposal</A>
+by Torbj&ouml;rn Sj&ouml;strand discussed at the
+<A HREF="http://mc4lhc06.web.cern.ch/mc4lhc06/">MC4LHC</A>
+workshop at CERN 2006.
+
+In total there are four classes which are all available in a single
+header file called
+<A HREF="http://www.thep.lu.se/~leif/LHEF/LHEF.h">LHEF.h</A>.
+
+The two classes LHEF::HEPRUP and LHEF::HEPEUP are simple container
+classes which contain the same information as the Les Houches standard
+Fortran common blocks with the same names. The other two classes are
+called LHEF::Reader and LHEF::Writer and are used to read and write
+Les Houches Event Files
+
+Here are a few <A HREF="examples.html">examples</A> of how to use the
+classes:
+
+\namespace LHEF The LHEF namespace contains some example classes for reading and writing Les Houches
+Event Files according to the
+<A HREF="http://www.thep.lu.se/~torbjorn/lhef/lhafile2.pdf">proposal</A>
+by Torbj&ouml;rn Sj&ouml;strand discussed at the
+<A HREF="http://mc4lhc06.web.cern.ch/mc4lhc06/">MC4LHC</A>
+workshop at CERN 2006.
+
+
+
+ */
+
+
+#endif /* THEPEG_LHEF_H */
Index: /trunk/test/MatchingSTDHEPConverter.cpp
===================================================================
--- /trunk/test/MatchingSTDHEPConverter.cpp	(revision 2)
+++ /trunk/test/MatchingSTDHEPConverter.cpp	(revision 2)
@@ -0,0 +1,193 @@
+#include <iostream>
+#include <sstream>
+#include <fstream>
+
+#include <stdlib.h>
+
+#include "stdhep_mcfio.h"
+#include "stdhep_declarations.h"
+
+#include "TROOT.h"
+#include "TApplication.h"
+
+#include "TFile.h"
+#include "TChain.h"
+#include "TString.h"
+
+#include "TH2.h"
+#include "THStack.h"
+#include "TLegend.h"
+#include "TPaveText.h"
+#include "TLorentzVector.h"
+
+#include "LHEF.h"
+
+#include "ExRootAnalysis/ExRootClasses.h"
+
+#include "ExRootAnalysis/ExRootTreeWriter.h"
+#include "ExRootAnalysis/ExRootTreeBranch.h"
+
+#include "ExRootAnalysis/ExRootUtilities.h"
+#include "ExRootAnalysis/ExRootProgressBar.h"
+
+using namespace std;
+
+//---------------------------------------------------------------------------
+
+static void AnalyseEvent(ExRootTreeBranch *branch, Long64_t eventNumber)
+{
+  ExRootGenEvent *element;
+
+  element = static_cast<ExRootGenEvent*>(branch->NewEntry());
+
+  element->Number = eventNumber;
+}
+
+//---------------------------------------------------------------------------
+
+static void AnalyseParticles(ExRootTreeBranch *branch)
+{
+  ExRootGenParticle *element;
+
+  Double_t signPz;
+  TLorentzVector momentum;
+  Int_t number;
+
+  for(number = 0; number < myhepevt.nhep; ++number)
+  {
+
+    element = static_cast<ExRootGenParticle*>(branch->NewEntry());
+
+    element->PID = myhepevt.idhep[number];
+    element->Status = myhepevt.isthep[number];
+    element->M1 = myhepevt.jmohep[number][0] - 1;
+    element->M2 = myhepevt.jmohep[number][1] - 1;
+    element->D1 = myhepevt.jdahep[number][0] - 1;
+    element->D2 = myhepevt.jdahep[number][1] - 1;
+
+    element->E = myhepevt.phep[number][3];
+    element->Px = myhepevt.phep[number][0];
+    element->Py = myhepevt.phep[number][1];
+    element->Pz = myhepevt.phep[number][2];
+
+    momentum.SetPxPyPzE(element->Px, element->Py, element->Pz, element->E);
+    element->PT = momentum.Perp();
+    signPz = (element->Pz >= 0.0) ? 1.0 : -1.0;
+    element->Eta = element->PT == 0.0 ? signPz*999.9 : momentum.Eta();
+    element->Phi = momentum.Phi();
+
+    element->Rapidity = element->PT == 0.0 ? signPz*999.9 : momentum.Rapidity();
+
+    element->T = myhepevt.vhep[number][3];
+    element->X = myhepevt.vhep[number][0];
+    element->Y = myhepevt.vhep[number][1];
+    element->Z = myhepevt.vhep[number][2];
+  }
+}
+
+//---------------------------------------------------------------------------
+
+int main(int argc, char *argv[])
+{
+  int ierr, entryType;
+  int istr = 0;
+  int nevt = 0;
+  char *appName = "ExRootSTDHEPConverter";
+
+  if(argc != 4)
+  {
+    cout << " Usage: " << appName << " input_file";
+    cout << " output_root_file" << " output_text_file" << endl;
+    cout << " input_file - input file in STDHEP format," << endl;
+    cout << " output_root_file - output file in ROOT format." << endl;
+    cout << " output_text_file - output file in TEXT format." << endl;
+    return 1;
+  }
+
+  gROOT->SetBatch();
+
+  int appargc = 1;
+  char *appargv[] = {appName};
+  TApplication app(appName, &appargc, appargv);
+
+  // Open a stream connected to an event file:
+  char inputFileName[80];
+  strcpy(inputFileName, argv[1]);
+  ierr = StdHepXdrReadInit(inputFileName, &nevt, istr);
+
+  if(ierr != 0)
+  {
+    cerr << "** ERROR: Can't open '" << argv[1] << "' for input" << endl;
+    return 1;
+  }
+
+  Long64_t allEntries = nevt;
+  cout << "** Input file contains " << allEntries << " entries" << endl;
+
+  TFile *outputRootFile = TFile::Open(argv[2], "RECREATE");
+  ExRootTreeWriter *treeWriter = new ExRootTreeWriter(outputRootFile, "STDHEP");
+
+  ofstream outputTextFile(argv[3], ios::out);
+
+  if(outputTextFile == 0)
+  {
+    cerr << "** ERROR: Can't open '" << argv[3] << "' for ouput" << endl;
+    return 1;
+  }
+
+  // information about generated event
+  ExRootTreeBranch *branchGenEvent = treeWriter->NewBranch("Event", ExRootGenEvent::Class());
+  // generated particles from HEPEVT
+  ExRootTreeBranch *branchGenParticle = treeWriter->NewBranch("GenParticle", ExRootGenParticle::Class());
+
+  if(allEntries > 0)
+  {
+    ExRootProgressBar progressBar(allEntries);
+
+    // Loop over all objects
+    Long64_t entry = 0;
+    Long64_t recordNumber = 1;
+    for(entry = 0; entry < allEntries; ++entry)
+    {
+      ierr = StdHepXdrRead(&entryType, istr);
+
+      if(ierr != 0)
+      {
+        cerr << "** ERROR: Unexpected end of file after " << entry << " entries" << endl;
+        break;
+      }
+
+      if(entryType == 200)
+      {
+        outputTextFile << "$stdxsec = " << stdcm1_.stdxsec << ";" <<endl;
+      }
+
+      // analyse only entries with standard HEPEVT common block
+      if(entryType == 1)
+      {
+        treeWriter->Clear();
+ 
+        AnalyseEvent(branchGenEvent, myhepevt.nevhep);
+        AnalyseParticles(branchGenParticle);
+
+        treeWriter->Fill();
+
+        ++recordNumber;
+
+      }
+
+      progressBar.Update(entry);
+    }
+
+    progressBar.Finish();
+  }
+
+  treeWriter->Write();
+
+  cout << "** Exiting..." << endl;
+
+  outputTextFile.close();
+  delete treeWriter;
+  StdHepXdrEnd(istr);
+}
+
Index: /trunk/test/MatchingTreeConverter.cpp
===================================================================
--- /trunk/test/MatchingTreeConverter.cpp	(revision 2)
+++ /trunk/test/MatchingTreeConverter.cpp	(revision 2)
@@ -0,0 +1,302 @@
+
+#include <iostream>
+#include <fstream>
+#include <sstream>
+#include <map>
+
+#include "TROOT.h"
+#include "TApplication.h"
+
+#include "TFile.h"
+#include "TChain.h"
+#include "TString.h"
+
+#include "TH2.h"
+#include "THStack.h"
+#include "TLegend.h"
+#include "TPaveText.h"
+#include "TLorentzVector.h"
+
+#include "ExRootAnalysis/ExRootClasses.h"
+
+#include "ExRootAnalysis/ExRootTreeWriter.h"
+#include "ExRootAnalysis/ExRootTreeBranch.h"
+
+#include "ExRootAnalysis/ExRootUtilities.h"
+#include "ExRootAnalysis/ExRootProgressBar.h"
+
+using namespace std;
+
+struct MatchingTreeObject
+{
+  enum {maxDblParam = 58};
+  Double_t dblParam[maxDblParam];
+};
+
+//------------------------------------------------------------------------------
+
+class MatchingTreeConverter
+{
+public:
+  MatchingTreeConverter(const char *outputFileName);
+  ~MatchingTreeConverter();
+
+  void ProcessObject();
+  void Write();
+
+  Long64_t GetNumberOfObjects(ifstream &inputFileStream);
+  Bool_t ReadObject(ifstream &inputFileStream);
+
+private:
+
+  void AnalyseEvent(ExRootTreeBranch *branch);
+
+  istringstream fBufferStream;
+  string fBuffer;
+
+  MatchingTreeObject fCurrentObject;
+
+  TFile *fOutputFile;
+  ExRootTreeWriter *fTreeWriter;
+
+  ExRootTreeBranch *fBranchMatch;
+
+};
+
+//------------------------------------------------------------------------------
+
+MatchingTreeConverter::MatchingTreeConverter(const char *outputFileName) :
+  fOutputFile(0), fTreeWriter(0)
+{
+  fOutputFile = TFile::Open(outputFileName, "RECREATE");
+  fTreeWriter = new ExRootTreeWriter(fOutputFile, "Match");
+
+  // information about reconstructed event
+  fBranchMatch = fTreeWriter->NewBranch("Match", ExRootGenMatch::Class());
+}
+
+//------------------------------------------------------------------------------
+
+MatchingTreeConverter::~MatchingTreeConverter()
+{
+  if(fTreeWriter) delete fTreeWriter;
+  if(fOutputFile) delete fOutputFile;
+}
+
+//------------------------------------------------------------------------------
+
+Long64_t MatchingTreeConverter::GetNumberOfObjects(ifstream &inputFileStream)
+{
+  Long64_t counter = 0;
+  Bool_t canReadNumber, canReadFile = kTRUE;
+  Int_t number;
+  int position = inputFileStream.tellg();
+  inputFileStream.seekg(0, std::ios::beg);
+
+  inputFileStream.clear();
+
+  while(canReadFile)
+  {
+    do
+    {
+      getline(inputFileStream, fBuffer);
+  
+      if(!inputFileStream.good())
+      {
+        canReadFile = kFALSE;
+        break;
+      }
+
+      fBufferStream.clear();
+      fBufferStream.str(fBuffer);
+      
+      canReadNumber = (fBufferStream >> number);
+    }
+    while(!canReadNumber);
+
+    ++counter;
+  }
+
+  inputFileStream.clear();
+
+  inputFileStream.seekg(position, std::ios::beg);
+
+  return (counter - 1);
+}
+
+//------------------------------------------------------------------------------
+
+Bool_t MatchingTreeConverter::ReadObject(ifstream &inputFileStream)
+{
+  Int_t i;
+  Bool_t canReadNumber;
+
+  do
+  {
+    getline(inputFileStream, fBuffer);
+
+    if(!inputFileStream.good()) return kFALSE;
+
+    fBufferStream.clear();
+    fBufferStream.str(fBuffer);
+
+    canReadNumber = kTRUE;
+
+    for(i = 0; canReadNumber && i < MatchingTreeObject::maxDblParam; ++i)
+    {
+      canReadNumber = (fBufferStream >> fCurrentObject.dblParam[i]);
+    }
+  }
+  while(!canReadNumber);
+
+  return kTRUE;
+}
+
+//---------------------------------------------------------------------------
+
+void MatchingTreeConverter::Write()
+{
+  if(fTreeWriter) fTreeWriter->Write();
+}
+
+//---------------------------------------------------------------------------
+
+void MatchingTreeConverter::ProcessObject()
+{
+  fTreeWriter->Clear();
+
+  AnalyseEvent(fBranchMatch);
+
+  fTreeWriter->Fill();
+}
+
+
+//---------------------------------------------------------------------------
+
+void MatchingTreeConverter::AnalyseEvent(ExRootTreeBranch *branch)
+{
+  ExRootGenMatch *element;
+
+  element = static_cast<ExRootGenMatch*>(branch->NewEntry());
+
+  element->Npart = fCurrentObject.dblParam[0];
+  element->Qjet1 = fCurrentObject.dblParam[1];
+  element->Qjet2 = fCurrentObject.dblParam[2];
+  element->Qjet3 = fCurrentObject.dblParam[3];
+  element->Qjet4 = fCurrentObject.dblParam[4];
+  element->Ptcjet1 = fCurrentObject.dblParam[5];
+  element->Ptcjet2 = fCurrentObject.dblParam[6];
+  element->Ptcjet3 = fCurrentObject.dblParam[7];
+  element->Ptcjet4 = fCurrentObject.dblParam[8];
+  element->Etacjet1 = fCurrentObject.dblParam[9];
+  element->Etacjet2 = fCurrentObject.dblParam[10];
+  element->Etacjet3 = fCurrentObject.dblParam[11];
+  element->Etacjet4 = fCurrentObject.dblParam[12];
+  element->Phicjet1 = fCurrentObject.dblParam[13];
+  element->Phicjet2 = fCurrentObject.dblParam[14];
+  element->Phicjet3 = fCurrentObject.dblParam[15];
+  element->Phicjet4 = fCurrentObject.dblParam[16];
+  element->Ptjet1 = fCurrentObject.dblParam[17];
+  element->Ptjet2 = fCurrentObject.dblParam[18];
+  element->Ptjet3 = fCurrentObject.dblParam[19];
+  element->Ptjet4 = fCurrentObject.dblParam[20];
+  element->Etajet1 = fCurrentObject.dblParam[21];
+  element->Etajet2 = fCurrentObject.dblParam[22];
+  element->Etajet3 = fCurrentObject.dblParam[23];
+  element->Etajet4 = fCurrentObject.dblParam[24];
+  element->Phijet1 = fCurrentObject.dblParam[25];
+  element->Phijet2 = fCurrentObject.dblParam[26];
+  element->Phijet3 = fCurrentObject.dblParam[27];
+  element->Phijet4 = fCurrentObject.dblParam[28];
+  element->Idres1 = fCurrentObject.dblParam[29];
+  element->Ptres1 = fCurrentObject.dblParam[30];
+  element->Etares1 = fCurrentObject.dblParam[31];
+  element->Phires1 = fCurrentObject.dblParam[32];
+  element->Idres2 = fCurrentObject.dblParam[33];
+  element->Ptres2 = fCurrentObject.dblParam[34];
+  element->Etares2 = fCurrentObject.dblParam[35];
+  element->Phires2 = fCurrentObject.dblParam[36];
+  element->Ptlep1 = fCurrentObject.dblParam[37];
+  element->Etmiss = fCurrentObject.dblParam[38];
+  element->Htjets = fCurrentObject.dblParam[39];
+  element->Ptb = fCurrentObject.dblParam[40];
+  element->Etab = fCurrentObject.dblParam[41];
+  element->Ptbbar = fCurrentObject.dblParam[42];
+  element->Etabbar = fCurrentObject.dblParam[43];
+  element->Ptbj = fCurrentObject.dblParam[44];
+  element->Etabj = fCurrentObject.dblParam[45];
+  element->Qpar1 = fCurrentObject.dblParam[46];
+  element->Qpar2 = fCurrentObject.dblParam[47];
+  element->Qpar3 = fCurrentObject.dblParam[48];
+  element->Qpar4 = fCurrentObject.dblParam[49];
+  element->Ptpar1 = fCurrentObject.dblParam[50];
+  element->Ptpar2 = fCurrentObject.dblParam[51];
+  element->Ptpar3 = fCurrentObject.dblParam[52];
+  element->Ptpar4 = fCurrentObject.dblParam[53];
+  element->Ncjets = fCurrentObject.dblParam[54];
+  element->Njets = fCurrentObject.dblParam[55];
+  element->Nfile = fCurrentObject.dblParam[56];
+  element->Nclus = fCurrentObject.dblParam[57];
+}
+
+//---------------------------------------------------------------------------
+
+int main(int argc, char *argv[])
+{
+  char *appName = "ExRootLHEFConverter";
+
+  if(argc != 3)
+  {
+    cout << " Usage: " << appName << " input_file" << " output_file" << endl;
+    cout << " input_file - input file in LHEF format," << endl;
+    cout << " output_file - output file in ROOT format." << endl;
+    return 1;
+  }
+
+  gROOT->SetBatch();
+
+  int appargc = 1;
+  char *appargv[] = {appName};
+  TApplication app(appName, &appargc, appargv);
+
+  // Open a stream connected to an event file:
+  ifstream inputFileStream(argv[1]);
+
+  if(!inputFileStream.is_open())
+  {
+    cerr << "** ERROR: Can't open '" << argv[1] << "' for input" << endl;
+    return 1;
+  }
+
+  // Create LHC Olympics converter:
+  MatchingTreeConverter *converter = new MatchingTreeConverter(argv[2]);
+
+  cout << "** Calculating number of objects to process. Please wait..." << endl;
+  Long64_t allEntries = converter->GetNumberOfObjects(inputFileStream);
+  cout << "** Input file contains " << allEntries << " objects" << endl;
+
+  if(allEntries > 0)
+  {
+    ExRootProgressBar progressBar(allEntries);
+
+    // Loop over all objects
+    Long64_t entry = 0;
+    while(converter->ReadObject(inputFileStream))
+    {
+      converter->ProcessObject();
+
+      progressBar.Update(entry);
+      
+      ++entry;
+    }
+    progressBar.Finish();
+
+    converter->Write();
+  }
+
+  cout << "** Exiting..." << endl;
+
+  delete converter;
+}
+
+
Index: /trunk/test/SimpleDraw.C
===================================================================
--- /trunk/test/SimpleDraw.C	(revision 2)
+++ /trunk/test/SimpleDraw.C	(revision 2)
@@ -0,0 +1,16 @@
+// Draw di-electron invariant mass
+
+void SimpleDraw(const char *inputFileList)
+{
+  TChain chain("PGS");
+
+  if(!FillChain(chain, inputFileList)) return;
+
+  ExRootResult result;
+
+  TH1 *mass_hist = result.AddHist1D("mass_hist", "di-electron mass", "di-electron mass, GeV/c^{2}", "number of entries", 70, 60.0, 130.0);
+
+  chain.Draw("sqrt((Electron.E[0]+Electron.E[1])^2 - (Electron.Px[0]+Electron.Px[1])^2 - (Electron.Py[0]+Electron.Py[1])^2 - (Electron.Pz[0]+Electron.Pz[1])^2) >> mass_hist", "Electron_size > 1");
+
+  result.Print(); 
+}
Index: /trunk/test/compare.sh
===================================================================
--- /trunk/test/compare.sh	(revision 2)
+++ /trunk/test/compare.sh	(revision 2)
@@ -0,0 +1,9 @@
+#! /bin/sh
+
+root -l -b <<- EOF
+  gSystem->Load("libEG");
+  gSystem->Load("lib/libExRootAnalysis.so");
+  .X Example.C
+  .q
+EOF
+
Index: /trunk/test/pgs.inc
===================================================================
--- /trunk/test/pgs.inc	(revision 2)
+++ /trunk/test/pgs.inc	(revision 2)
@@ -0,0 +1,264 @@
+c ------------------------------------------------------------------------------------------
+c PGS.INC - include file for PGS package 
+c
+c           Version 3.3
+c ------------------------------------------------------------------------------------------
+c
+c   This include file is to be used with the PGS package.  See
+c   http://www.physics.rutgers.edu/~jconway/soft/pgs/pgs.html
+c   for documentation and details.
+c
+c ------------------------------------------------------------------------------------------
+
+
+c STDHEP common blocks (see L. Garren, STDHEP 4.10, PM0091)  -------------------------------
+
+c generated particle list
+
+      integer    nmxhep
+      parameter (nmxhep=4000)
+
+      integer nevhep,nhep,isthep,idhep,jmohep,jdahep
+
+      double precision phep,vhep
+
+      common /hepevt/ nevhep,           ! event number
+     .                nhep,             ! number of entries in record
+     .                isthep(nmxhep),   ! status code
+     .                idhep(nmxhep),    ! particle ID (PDG standard)
+     .                jmohep(2,nmxhep), ! index to first and second particle mothers
+     .                jdahep(2,nmxhep), ! index to first and last daughter particles
+     .                phep(5,nmxhep),   ! 4-vector and mass
+     .                vhep(4,nmxhep)    ! (x,y,z) of production, and production time (mm/c)
+
+      integer numhep                    ! for symmetry
+      equivalence(numhep,nhep)          ! with other lists
+
+      integer numgen                    ! for symmetry
+      equivalence(numgen,nhep)          ! with other lists
+
+c table of particle properties
+
+      integer    nmxln
+
+      parameter (nmxln=2000)
+
+      integer idt
+      real*4 stmerr,stwerr
+
+      real*8 stmass,stwidth
+
+      character*21 stname
+
+      common /stdtbl/ idt(nmxln),       ! particle ID (PDG standard)
+     .                stmerr(2,nmxln),  ! positive (1) and negative (2) error on mass
+     .                stwerr(2,nmxln),  ! positive (1) and negative (2) error on width
+     .                stmass(nmxln),    ! particle mass (GeV/c^2 for this, and rest)
+     .                stwidth(nmxln),   ! particle width
+     .                stname(nmxln)     ! particle name
+
+
+c STDHEP logical unit numbers and I/O information
+
+      integer lnhwrt,lnhrd,lnhout,lnhdcy,lnhrdm
+
+      common /heplun/ lnhwrt,           ! logical unit number for writing
+     .                lnhrd,            ! logical unit number for reading
+     .                lnhout,           ! logical unit number for output
+     .                lnhdcy,           ! logical unit number for decay table (NYI)
+     .                lnhrdm(15)        ! logical unit number for reading multiple streams
+
+      real stdecom,stdxsec
+      double precision stdseed1,stdseed2
+      integer nevtreq,nevtgen,nevtwrt
+
+      common /stdcm1/ stdecom,  ! center of mass energy
+     .                stdxsec,  ! cross section
+     .                stdseed1, ! random number seed 1
+     .                stdseed2, ! random number seed 2
+     .                nevtreq,  ! events to generate
+     .                nevtgen,  ! actually generated
+     .                nevtwrt   ! written to output file
+      save /stdcm1/
+
+
+c ---------------------------------------------------------------------------------------------
+
+c PGS functions for ET, pt, etc. of generated, reconstructed, clusters and tracks
+
+      real*8 et_gen,pt_gen,p_gen,eta_gen,phi_gen
+      real*8 et_obj,pt_obj,p_obj,eta_obj,phi_obj
+      real*8 et_clu,pt_clu,p_clu,eta_clu,phi_clu
+      real*8 et_trk,pt_trk,p_trk,eta_trk,phi_trk
+
+      real*8 cos_theta,cos_del_phi,del_phi,pgs_cluster_width
+
+      real*8 v4mass,v4mass2,v4et,v4p,v4pt,v4eta,v4phi
+
+      logical pgs_cal_fid_cut
+
+c PGS detector parameters
+
+      integer netacal,nphical
+
+      real*8 deta,dphi,crack_frac,rmax,bfield,sagitta_res
+      real*8 ecal_res,hcal_res,met_res
+      real*8 seed_thresh,shoulder_thresh,conesize
+      real*8 eff_track,eta_max_track,min_track_pt
+
+
+      common /pgspar/ netacal,		! number of eta cells in calorimeter
+     .                nphical,		! number of phi cells in calorimeter
+     .                deta,		! eta width of calorimeter cells
+     .                dphi,		! phi width of calorimeter cells  (2*pi/nphical)
+     .                ecal_res,         ! electromagnetic calorimeter resolution * sqrt(E)
+     .                hcal_res,         ! hadronic calorimeter resolution * sqrt(E)
+     .                met_res,          ! MET resolution
+     .                crack_frac,       ! calorimeter cell edge "crack" fraction
+     .                seed_thresh,      ! calorimeter cluster seed tower threshold
+     .                shoulder_thresh,  ! calorimeter shoulder tower threshold
+     .                conesize,         ! cluster finder cone size
+     .                rmax,             ! outer radius of tracking (m)
+     .                bfield,           ! magnetic field (T)
+     .                sagitta_res,      ! sagitta resolution (m)
+     .                eff_track,	! track finding efficiency
+     .                min_track_pt,     ! minimum track pt (GeV/c)
+     .                eta_max_track     ! maximum tracking coverage in eta
+
+c PGS event header and control information
+
+      integer nevpgs,nprpgs
+
+      character*6 optpgs
+      character*80 pgs_input_file,pgs_output_file,pgs_param_file
+      character*80 pgs_isajet_decay,pgs_isajet_cards,pgs_pythia_cards
+
+      common /pgsevt/ nevpgs,            ! number of events to generate/read
+     .                nprpgs,            ! number of events to print out 
+     .                optpgs,            ! type of run: 'PYTHIA', 'ISAJET', 'FILE', ...
+     .                pgs_input_file,    ! input file
+     .                pgs_output_file,   ! output file
+     .                pgs_param_file,    ! detector parameter file
+     .                pgs_isajet_decay,  ! ISAJET decay table file name
+     .                pgs_isajet_cards,  ! ISAJET card file name
+     .                pgs_pythia_cards   ! PYTHIA card file name
+
+c PGS track list
+
+      integer ntrkmx
+      parameter (ntrkmx=500)
+
+      integer numtrk,dumtrk,indtrk
+
+      real*8 ptrk,qtrk
+
+      common /pgstrk/ numtrk,dumtrk,          ! number of tracks
+     .                indtrk(ntrkmx),         ! index to HEPEVT particle
+     .                ptrk(3,ntrkmx),         ! track 3-vector 
+     .                qtrk(ntrkmx)            ! track charge
+
+
+c PGS calorimeter tower arrays
+
+      real*8 pi
+      parameter(pi=3.141592654)      
+
+      integer nphimax,netamax   
+      parameter (nphimax=600)   
+      parameter (netamax=600)   
+
+      real*8 ecal,hcal,met_cal,phi_met_cal
+
+      common /pgscal/ ecal(netamax,nphimax),  ! electromagnetic energy in each tower
+     .                hcal(netamax,nphimax),  ! hadronic energy in each tower
+     .                met_cal,                ! calorimeter missing ET
+     .                phi_met_cal             ! calorimeter missing ET phi
+
+
+c PGS calorimeter cluster list
+
+      integer nclumx
+
+      parameter (nclumx=50)
+
+      integer cclu,numclu,dumclu,etaclu,phiclu,mulclu
+
+      real*8 pclu,etclu,emclu,ehclu,efclu,widclu
+
+      common /pgsclu/ cclu(netamax,nphimax),  ! map of cluster indices
+     .                numclu,dumclu,          ! number of clusters in list
+     .                pclu(5,nclumx),         ! cluster 4 vector and mass
+     .                etaclu(nclumx),         ! cluster seed tower eta
+     .                phiclu(nclumx),         ! cluster seed tower phi
+     .                emclu(nclumx),          ! cluster electromagnetic energy
+     .                ehclu(nclumx),          ! cluster hadronic energy
+     .                efclu(nclumx),          ! cluster electromagnetic fraction
+     .                widclu(nclumx),         ! cluster width sqrt(deta**2+dphi**2)
+     .                mulclu(nclumx)          ! cluster tower multiplicity
+
+
+c PGS trigger object list
+
+      integer    ntrgmx
+      parameter (ntrgmx=500)
+
+      integer numtrg,dumtrg,indtrg,typtrg
+
+      real*8 vectrg
+
+      common /pgstrg/ numtrg,dumtrg,          ! number of trigger objects
+     .                indtrg(ntrgmx),         ! index to HEPEVT particle (where relevant)
+     .                typtrg(ntrgmx),         ! reconstructed type:  0=photon
+                                              !                      1=electron
+                                              !                      2=muon
+                                              !                      3=tau (hadronic)
+                                              !                      4=jet
+                                              !                      5=detached vertex
+                                              !                      6=MET
+     .                vectrg(10,ntrgmx)       ! trigger object vector: 1 = eta
+                                              !                        2 = phi
+                                              !                        3 = ET of cluster
+                                              !                        4 = cluster #
+                                              !                        5 = pt of track (if any)
+                                              !                        6 = track #
+
+c PGS reconstructed object list
+
+      integer    nobjmx
+      parameter (nobjmx=500)
+
+      integer numobj,dumobj,indobj,typobj
+      real*8 pobj,qobj,vecobj
+
+      common /pgsrec/ numobj,dumobj,          ! number of reconstructed objects
+     .                indobj(nobjmx),         ! index to HEPEVT particle (where relevant)
+     .                typobj(nobjmx),         ! reconstructed type:  0 = photon
+                                              !                      1 = electron
+                                              !                      2 = muon
+                                              !                      3 = tau (hadronic)
+                                              !                      4 = jet
+                                              !                      5 = heavy charged
+     .                pobj(4,nobjmx),         ! four vector of reconstructed object
+     .                qobj(nobjmx),           ! charge of reconstructed object
+     .                vecobj(10,nobjmx)       ! interesting object quantities
+
+c            --------------------------
+c            table of vecobj quantities
+c            --------------------------
+c
+c    -------------------------------------------------------------------------------------
+c     type            1           2          3        4        5        6        7
+c    -------------------------------------------------------------------------------------
+c    0  photon     EM energy  HAD energy  track E   N(trk)   width      -        -
+c    1  electron    "   "      "     "       "        "        -        -        -
+c    2  muon        "   "      "     "       "        "     trk iso E   -        -
+c    3  tau         "   "      "     "       "        "      width    mtau     ptmax
+c    4  jet         "   "      "     "       "        "        "      flavor   c,b tags ->
+c    -------------------------------------------------------------------------------------
+c
+c  b, c tagging: vecobj(7,iobj) non-zero if charm tag (jet prob. alg.)
+c                vecobj(8,iobj) non-zero if b     tag ( "    "    "  )
+c                vecobj(9,iobj) non-zero if b     tag (impact method)
+c
+c    --> all algorithms include rates for gluon, uds, c and b jets
+c
Index: /trunk/test/test.f
===================================================================
--- /trunk/test/test.f	(revision 2)
+++ /trunk/test/test.f	(revision 2)
@@ -0,0 +1,32 @@
+      program pgs
+      implicit none
+
+c generated particle list
+      include 'pgs.inc'
+
+      nevhep = 12
+      jmohep(1,2) = 11
+      phep(1,1) = 15.123456789E10
+      
+      numtrk = 5
+      ptrk(2,1) = 1.23456789e15
+
+      hcal(2,1) = 2.34567890e15
+      met_cal = pi
+
+      pclu(2,1) = 3.456789012e15
+      mulclu(2) = 123
+
+      vectrg(9,2) = 4.567890123e15
+      indtrg(2) = 234
+
+      vecobj(10,3) = 5.678901234e15
+      indobj(3) = 345
+
+      call test_cpp(10)
+      
+      call pgs2root_ini
+      call pgs2root_evt
+      call pgs2root_end
+      
+      end
Index: /trunk/test/test.list
===================================================================
--- /trunk/test/test.list	(revision 2)
+++ /trunk/test/test.list	(revision 2)
@@ -0,0 +1,1 @@
+../pgs_events.root
Index: /trunk/test/test.sh
===================================================================
--- /trunk/test/test.sh	(revision 2)
+++ /trunk/test/test.sh	(revision 2)
@@ -0,0 +1,8 @@
+#! /bin/sh
+
+root -l -b <<- EOF
+  gSystem->Load("../lib/libExRootAnalysis.so");
+  .X Example.C("test.list");
+  .q
+EOF
+