From 926074468eaec6c6b508ca00d391e6c0a539e963 Mon Sep 17 00:00:00 2001
From: Leigh B Stoller <stoller@flux.utah.edu>
Date: Mon, 14 Mar 2016 14:01:12 -0600
Subject: [PATCH] Add NS syntax for setting the packing strategy:

	tb-set-packing-strategy pack|balance

defaults to null, which means no strategy (whatever assign does).
---
 db/VirtExperiment.pm.in        |  1 +
 tbsetup/mapper.in              |  2 ++
 tbsetup/ns2ir/parse.tcl.in     |  5 ++++-
 tbsetup/ns2ir/sim.tcl.in       |  7 ++++++-
 tbsetup/ns2ir/tb_compat.tcl.in | 16 +++++++++++++++-
 5 files changed, 28 insertions(+), 3 deletions(-)

diff --git a/db/VirtExperiment.pm.in b/db/VirtExperiment.pm.in
index ca176013b..3b8090a7f 100644
--- a/db/VirtExperiment.pm.in
+++ b/db/VirtExperiment.pm.in
@@ -112,6 +112,7 @@ my $debug	      = 0;
 # be updated.
 #
 %experiment_fields = ("multiplex_factor"	=> 1,
+		      "packing_strategy"        => 1,
 		      "forcelinkdelays"		=> 1,
 		      "uselinkdelays"		=> 1,
 		      "usewatunnels"		=> 1,
diff --git a/tbsetup/mapper.in b/tbsetup/mapper.in
index 450575d01..05620c190 100644
--- a/tbsetup/mapper.in
+++ b/tbsetup/mapper.in
@@ -288,6 +288,8 @@ my $real_user = User->RealUser();
 # multiplex_factor default.
 $mfactor = $experiment->multiplex_factor()
     if (!defined($mfactor) && defined($experiment->multiplex_factor()));
+$packoption = $experiment->packing_strategy()
+    if (!defined($packoption) && defined($experiment->packing_strategy()));
 # NS file can say to run the prepass.
 my $useprepass = $experiment->useprepass();
 
diff --git a/tbsetup/ns2ir/parse.tcl.in b/tbsetup/ns2ir/parse.tcl.in
index 5e4910428..7625f7c69 100644
--- a/tbsetup/ns2ir/parse.tcl.in
+++ b/tbsetup/ns2ir/parse.tcl.in
@@ -1,7 +1,7 @@
 #!/usr/local/bin/otclsh
 
 #
-# Copyright (c) 2000-2014 University of Utah and the Flux Group.
+# Copyright (c) 2000-2016 University of Utah and the Flux Group.
 # 
 # {{{EMULAB-LICENSE
 # 
@@ -227,6 +227,9 @@ namespace eval GLOBALS {
     # Control multiplex_factor for the experiment. Crude.
     variable multiplex_factor {}
 
+    # Control packing strategy for the experiment. pack or balance.
+    variable packing_strategy {}
+
     # The name of the sync_server
     variable sync_server {}
 
diff --git a/tbsetup/ns2ir/sim.tcl.in b/tbsetup/ns2ir/sim.tcl.in
index a52c34708..5ef7d4fb0 100644
--- a/tbsetup/ns2ir/sim.tcl.in
+++ b/tbsetup/ns2ir/sim.tcl.in
@@ -1,6 +1,6 @@
 # -*- tcl -*-
 #
-# Copyright (c) 2000-2015 University of Utah and the Flux Group.
+# Copyright (c) 2000-2016 University of Utah and the Flux Group.
 # 
 # {{{EMULAB-LICENSE
 # 
@@ -501,6 +501,7 @@ Simulator instproc run {} {
     var_import ::GLOBALS::uselinkdelays
     var_import ::GLOBALS::forcelinkdelays
     var_import ::GLOBALS::multiplex_factor
+    var_import ::GLOBALS::packing_strategy
     var_import ::GLOBALS::sync_server
     var_import ::GLOBALS::use_ipassign
     var_import ::GLOBALS::ipassign_args
@@ -742,6 +743,10 @@ Simulator instproc run {} {
 	lappend fields "multiplex_factor"
 	lappend values $multiplex_factor
     }
+    if { $packing_strategy != {} } {
+	lappend fields "packing_strategy"
+	lappend values $packing_strategy
+    }
     
     if { $sync_server != {} } {
 	lappend fields "sync_server"
diff --git a/tbsetup/ns2ir/tb_compat.tcl.in b/tbsetup/ns2ir/tb_compat.tcl.in
index de25585eb..17cabb70b 100644
--- a/tbsetup/ns2ir/tb_compat.tcl.in
+++ b/tbsetup/ns2ir/tb_compat.tcl.in
@@ -1,6 +1,6 @@
 # -*- tcl -*-
 #
-# Copyright (c) 2000-2014 University of Utah and the Flux Group.
+# Copyright (c) 2000-2016 University of Utah and the Flux Group.
 # 
 # {{{EMULAB-LICENSE
 # 
@@ -1541,6 +1541,20 @@ proc tb-set-colocate-factor {factor} {
     set multiplex_factor $factor
 }
 
+#
+# Set the packing strategy assign uses.
+#
+proc tb-set-packing-strategy {strategy} {
+    var_import ::GLOBALS::packing_strategy
+
+    if {$strategy != "pack" && $strategy != "balance"} {
+	perror "\[tb-set-packing-strategy] strategy must be pack|balance"
+	return
+    }
+
+    set packing_strategy $strategy
+}
+
 #
 # Set the sync server for the experiment. Must a vnode name that has been
 # allocated.
-- 
GitLab