 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; gtm (genetic turing machine) instructions
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Instructions for moving GTM control from tape to tape. There is always an "active"
-;; tape, to which some instructions refer implicitly. 
-
-(define-registered ;; set active to tape0
-  gtm_tape0
-  ^{:stack-types [:gtm]}
-  (fn [state]
-    (if (:gtm state)
-      (trace 'gtm_tape0
-             (-> state
-                 (assoc-in [:gtm :active] 0)))
-      state)))
-
-(define-registered ;; set active to tape1
-  gtm_tape1
-  ^{:stack-types [:gtm]}
-  (fn [state]
-    (if (:gtm state)
-      (trace 'gtm_tape1
-             (-> state
-                 (assoc-in [:gtm :active] 1)))
-      state)))
-
-(define-registered ;; set active to tape2
-  gtm_tape2
-  ^{:stack-types [:gtm]}
-  (fn [state]
-    (if (:gtm state)
-      (trace 'gtm_tape2
-             (-> state
-                 (assoc-in [:gtm :active] 2)))
-      state)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Instructions for moving the read/write head on the primary tape.
-
-(define-registered ;; move head on active tape to the left
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Instructions for moving the read/write head.
+
+(define-registered ;; move head to the left
   gtm_left
   ^{:stack-types [:gtm]}
   (fn [state]
     (if (:gtm state)
       (trace 'gtm_left
-             (update-in state [:gtm :tapes (:active (:gtm state)) :position] dec))
-      state)))
-
-(define-registered ;; move head on active tape to the right
+             (update-in state [:gtm :position] dec))
+      state)))
+
+(define-registered ;; move head to the right
   gtm_right
   ^{:stack-types [:gtm]}
   (fn [state]
     (if (:gtm state)
       (trace 'gtm_right
-             (update-in state [:gtm :tapes (:active (:gtm state)) :position] inc))
-      state)))
-
+             (update-in state [:gtm :position] inc))
+      state)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Instructions for moving the offset.
+
+(define-registered ;; move offset to the left
+  gtm_offset_left
+  ^{:stack-types [:gtm]}
+  (fn [state]
+    (if (:gtm state)
+      (trace 'gtm_offset_left
+             (update-in state [:gtm :offset] dec))
+      state)))
+
+(define-registered ;; move offset to the right
+  gtm_offset_right
+  ^{:stack-types [:gtm]}
+  (fn [state]
+    (if (:gtm state)
+      (trace 'gtm_offset_right
+             (update-in state [:gtm :offset] inc))
+      state)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Instructions for swapping genes between tapes.
+
+(define-registered ;; swap genes at current position between tapes 0 and 1
+  gtm_swap_all
+  ^{:stack-types [:gtm]}
+  (fn [state]
+    (if (:gtm state)
+      (trace 'gtm_swap_all
+             (let [pos (:position (:gtm state))
+                   offset (:offset (:gtm state))]
+               (-> state
+                   (assoc-in [:gtm :tapes 0 pos]
+                             (get-in state [:gtm :tapes 1 (+ pos offset)]))
+                   (assoc-in [:gtm :tapes 1 (+ pos offset)]
+                             (get-in state [:gtm :tapes 0 pos])))))
+      state)))
+
+(define-registered ;; swap instructions at current position between tapes 0 and 1
+  gtm_swap_instruction
+  ^{:stack-types [:gtm]}
+  (fn [state]
+    (if (:gtm state)
+      (trace 'gtm_swap_instruction
+             (let [pos (:position (:gtm state))
+                   offset (:offset (:gtm state))]
+               (-> state
+                   (assoc-in [:gtm :tapes 0 pos :instruction]
+                             (get-in state [:gtm :tapes 1 (+ pos offset) :instruction]))
+                   (assoc-in [:gtm :tapes 1 (+ pos offset) :instruction]
+                             (get-in state [:gtm :tapes 0 pos :instruction])))))
+      state)))
+
+(define-registered ;; swap silent markers at current position between tapes 0 and 1
+  gtm_swap_silent
+  ^{:stack-types [:gtm]}
+  (fn [state]
+    (if (:gtm state)
+      (trace 'gtm_swap_silent
+             (let [pos (:position (:gtm state))
+                   offset (:offset (:gtm state))]
+               (-> state
+                   (assoc-in [:gtm :tapes 0 pos :silent]
+                             (get-in state [:gtm :tapes 1 (+ pos offset) :silent]))
+                   (assoc-in [:gtm :tapes 1 (+ pos offset) :silent]
+                             (get-in state [:gtm :tapes 0 pos :silent])))))
+      state)))
+
+(define-registered ;; swap close markers at current position between tapes 0 and 1
+  gtm_swap_close
+  ^{:stack-types [:gtm]}
+  (fn [state]
+    (if (:gtm state)
+      (trace 'gtm_swap_close
+             (let [pos (:position (:gtm state))
+                   offset (:offset (:gtm state))]
+               (-> state
+                   (assoc-in [:gtm :tapes 0 pos :close]
+                             (get-in state [:gtm :tapes 1 (+ pos offset) :close]))
+                   (assoc-in [:gtm :tapes 1 (+ pos offset) :close]
+                             (get-in state [:gtm :tapes 0 pos :close])))))
+      state)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Instructions for reading/writing to tapes.
 
-(define-registered ;; copy from active to tape 0
-  gtm_copy
-  ^{:stack-types [:gtm]}
-  (fn [state]
-    (if (and (:gtm state)
-             (not (zero? (:active (:gtm state)))))
-      (let [destination-tape (get (:tapes (:gtm state)) 0)
-            destination-position (:position destination-tape)
-            source (:active (:gtm state))
-            source-tape (get (:tapes (:gtm state)) source)
-            source-position (:position source-tape)
-            source-instr-map (get (:contents source-tape) source-position)]
-        (if source-instr-map
-          (trace 'gtm_copy
-                 (-> state
-                     (assoc-in [:gtm :tapes 0 :contents destination-position] 
-                               source-instr-map)
-                     (update-in [:gtm :tapes 0 :position] inc)
-                     (update-in [:gtm :tapes source :position] inc)))
-          state))
-      state)))
-
-(define-registered ;; push boolean indicating whether active tape is blank at current position
+(define-registered ;; push boolean indicating whether tape is blank at current position
   gtm_blank
   ^{:stack-types [:gtm :boolean]}
   (fn [state]
     (if (:gtm state)
-      (let [active (:active (:gtm state))
-            active-tape (get (:tapes (:gtm state)) active)]
-        (trace 'gtm_blank
-               (update-in
-                 (push-item (if (get (:contents active-tape) (:position active-tape))
-                              false
-                              true)
-                            :boolean 
-                            state)
-                 [:gtm :tapes active :position]
-                 inc)))
-      state)))
-
-(define-registered ;; make tape 0 blank at current position
+      (trace 'gtm_blank
+             (let [pos (:position (:gtm state))]
+               (push-item (if (get-in state [:gtm :tapes 0 pos])
+                            false
+                            true)
+                          :boolean 
+                          state)))
+      state)))
+
+(define-registered ;; make blank at current position
   gtm_erase
   ^{:stack-types [:gtm]}
   (fn [state]
+    (if (:gtm state)
+      (trace 'gtm_erase
+             (let [pos (:position (:gtm state))]
+               (assoc-in state
+                         [:gtm :tapes 0]
+                         (dissoc (get-in state [:gtm :tapes 0]) pos))))
+      state)))
+
+(define-registered ;; push all components to stacks
+  gtm_read_all
+  ^{:stack-types [:gtm :code :boolean :integer]}
+  (fn [state]
+    (if (:gtm state)
+      (let [pos (:position (:gtm state))
+            instr-map (get-in state [:gtm :tapes 0 pos])]
+        (if instr-map
+          (trace 'gtm_read_all
+                 (push-item (:instruction instr-map) :code state)
+                 (push-item (:silent instr-map) :boolean state)
+                 (push-item (:close instr-map) :integer state))
+          state))
+      state)))
+
+(define-registered ;; set all components from stacks
+  gtm_write_all
+  ^{:stack-types [:gtm :code :boolean :integer]}
+  (fn [state]
     (if (and (:gtm state)
-             (not (zero? (:active (:gtm state)))))
-      (let [write-tape (get (:tapes (:gtm state)) 0)
-            write-position (:position write-tape)]
-        (trace 'gtm_erase
-               (-> state
-                   (assoc-in [:gtm :tapes 0 :contents]
-                             (dissoc (:contents write-tape) write-position))
-                   (update-in [:gtm :tapes 0 :position] inc))))
-      state)))
-
-(define-registered ;; push active tape's instruction to code stack
-  gtm_instruction
+             (not (empty? (:code state)))
+             (not (empty? (ensure-list (stack-ref :code 0 state))))
+             (not (empty? (:boolean state)))
+             (not (empty? (:integer state))))
+      (let [pos (:position (:gtm state))
+            write-instr-map (ensure-instruction-map 
+                              (get-in state [:gtm :tapes 0 pos]))
+            new-instr (first (flatten (ensure-list (stack-ref :code 0 state))))
+            new-silent (stack-ref :boolean 0 state)
+            new-close (math/abs (stack-ref :integer 0 state))]
+        (trace 'gtm_write_all
+               (-> (pop-item :code state)
+                   (pop-item :boolean state)
+                   (pop-item :integer state)
+                   (assoc-in [:gtm :tapes 0 pos]
+                             (-> write-instr-map
+                                 (assoc :instruction new-instr)
+                                 (assoc :silent new-silent)
+                                 (assoc :close new-close))))))
+      state)))
+
+(define-registered ;; push instruction to code stack
+  gtm_read_instruction
   ^{:stack-types [:gtm :code]}
   (fn [state]
     (if (:gtm state)
-      (let [active (:active (:gtm state))
-            active-tape (get (:tapes (:gtm state)) active)
-            instr-map (get (:contents active-tape) (:position active-tape))]
+      (let [pos (:position (:gtm state))
+            instr-map (get-in state [:gtm :tapes 0 pos])]
         (if instr-map
-          (trace 'gtm_instruction
-                 (update-in
-                   (push-item (:instruction instr-map) :code state)
-                   [:gtm :tapes active :position]
-                   inc))
+          (trace 'gtm_read_instruction
+                 (push-item (:instruction instr-map) :code state))
           state))
       state)))
 
 (define-registered ;; set instruction to first of flattened top of code stack
-  gtm_set_instruction
+  gtm_write_instruction
   ^{:stack-types [:gtm :code]}
   (fn [state]
     (if (and (:gtm state)
              (not (empty? (:code state)))
              (not (empty? (ensure-list (stack-ref :code 0 state)))))
-      (let [write-tape (get (:tapes (:gtm state)) 0)
-            write-position (:position write-tape)
-            write-contents (:contents write-tape)
+      (let [pos (:position (:gtm state))
             write-instr-map (ensure-instruction-map 
-                              (get write-contents write-position))
+                              (get-in state [:gtm :tapes 0 pos]))
             new-instr (first (flatten (ensure-list (stack-ref :code 0 state))))]
-        (trace 'gtm_set_instruction
+        (trace 'gtm_write_instruction
                (-> (pop-item :code state)
-                   (assoc-in [:gtm :tapes 0 :contents write-position]
-                             (assoc write-instr-map :instruction new-instr))
-                   (update-in [:gtm :tapes 0 :position] inc))))
-      state)))
-
-(define-registered ;; push active tape's silent marker to boolean stack
-  gtm_silent
+                   (assoc-in [:gtm :tapes 0 pos]
+                             (assoc write-instr-map :instruction new-instr)))))
+      state)))
+
+(define-registered ;; push silent marker to boolean stack
+  gtm_read_silent
   ^{:stack-types [:gtm :boolean]}
   (fn [state]
     (if (:gtm state)
-      (let [active (:active (:gtm state))
-            active-tape (get (:tapes (:gtm state)) active)
-            instr-map (get (:contents active-tape) (:position active-tape))]
+      (let [pos (:position (:gtm state))
+            instr-map (get-in state [:gtm :tapes 0 pos])]
         (if instr-map
-          (trace 'gtm_silent
-                 (update-in
-                   (push-item (:silent instr-map) :boolean state)
-                   [:gtm :tapes active :position]
-                   inc))
+          (trace 'gtm_read_silent
+                 (push-item (:silent instr-map) :boolean state))
           state))
       state)))
 
-(define-registered ;; set silent to top of boolean stack
-  gtm_set_silent
+(define-registered ;; set silent marker to top of boolean stack
+  gtm_write_silent
   ^{:stack-types [:gtm :boolean]}
   (fn [state]
     (if (and (:gtm state)
              (not (empty? (:boolean state))))
-      (let [write-tape (get (:tapes (:gtm state)) 0)
-            write-position (:position write-tape)
-            write-contents (:contents write-tape)
+      (let [pos (:position (:gtm state))
             write-instr-map (ensure-instruction-map 
-                              (get write-contents write-position))
+                              (get-in state [:gtm :tapes 0 pos]))
             new-silent (stack-ref :boolean 0 state)]
-        (trace 'gtm_set_silent
+        (trace 'gtm_write_silent
                (-> (pop-item :boolean state)
-                   (assoc-in [:gtm :tapes 0 :contents write-position]
-                             (assoc write-instr-map :silent new-silent))
-                   (update-in [:gtm :tapes 0 :position] inc))))
-      state)))
-
-(define-registered ;; push active tape's close marker to integer stack
-  gtm_close
+                   (assoc-in [:gtm :tapes 0 pos]
+                             (assoc write-instr-map :silent new-silent)))))
+      state)))
+
+(define-registered ;; push close marker to integer stack
+  gtm_read_close
   ^{:stack-types [:gtm :integer]}
   (fn [state]
     (if (:gtm state)
-      (let [active (:active (:gtm state))
-            active-tape (get (:tapes (:gtm state)) active)
-            instr-map (get (:contents active-tape) (:position active-tape))]
+      (let [pos (:position (:gtm state))
+            instr-map (get-in state [:gtm :tapes 0 pos])]
         (if instr-map
-          (trace 'gtm_close
-                 (update-in
-                   (push-item (:close instr-map) :integer state)
-                   [:gtm :tapes active :position]
-                   inc))
+          (trace 'gtm_read_close
+                 (push-item (:close instr-map) :integer state))
           state))
       state)))
 
-(define-registered ;; set close to abs value of top of integer stack
-  gtm_set_close
+(define-registered ;; set close marker to abs value of top of integer stack
+  gtm_write_close
   ^{:stack-types [:gtm :integer]}
   (fn [state]
     (if (and (:gtm state)
              (not (empty? (:integer state))))
-      (let [write-tape (get (:tapes (:gtm state)) 0)
-            write-position (:position write-tape)
-            write-contents (:contents write-tape)
+      (let [pos (:position (:gtm state))
             write-instr-map (ensure-instruction-map 
-                              (get write-contents write-position))
+                              (get-in state [:gtm :tapes 0 pos]))
             new-close (math/abs (stack-ref :integer 0 state))]
-        (trace 'gtm_set_close
+        (trace 'gtm_write_close
                (-> (pop-item :integer state)
-                   (assoc-in [:gtm :tapes 0 :contents write-position]
-                             (assoc write-instr-map :close new-close))
-                   (update-in [:gtm :tapes 0 :position] inc))))
+                   (assoc-in [:gtm :tapes 0 pos]
+                             (assoc write-instr-map :close new-close)))))
       state)))
 
 ;; some tests

(defn dump-tape
  "Returns the genome recorded on the specified tape in the GTM of the provided Push state."
  [push-state tape-index]
  (vec (vals (:contents (get (:tapes (:gtm push-state)) tape-index)))))

(defn trace
  "Returns push-state with trace-info added to the trace recorded in its GTM."

  to contain the provided genome."
  [push-state tape-index genome]
  (assoc-in push-state
            [:gtm :tapes tape-index]
            (into (sorted-map)
                  (zipmap (iterate inc 0)
                          (map ensure-instruction-map genome)))))
