Index: api.scm
==================================================================
--- api.scm
+++ api.scm
@@ -129,10 +129,11 @@
 	    ((delete-old-deleted-test-records) (apply db:delete-old-deleted-test-records dbstruct params))
 	    ((test-set-status-state)           (apply db:test-set-status-state dbstruct params))
 	    ((test-set-top-process-pid)        (apply db:test-set-top-process-pid dbstruct params))
 	    ((roll-up-pass-fail-counts)        (apply db:roll-up-pass-fail-counts dbstruct params))
 	    ((update-fail-pass-counts)         (apply db:general-call dbstruct 'update-pass-fail-counts params))
+	    ((test-set-archive-block-id)       (apply db:test-set-archive-block-id dbstruct params))
 
 	    ;; RUNS
 	    ((register-run)                 (apply db:register-run dbstruct params))
 	    ((set-tests-state-status)       (apply db:set-tests-state-status dbstruct params))
 	    ((delete-run)                   (apply db:delete-run dbstruct params))

Index: db.scm
==================================================================
--- db.scm
+++ db.scm
@@ -1027,11 +1027,23 @@
 	(begin
 	  (sqlite3:execute db "INSERT OR REPLACE INTO archive_blocks (archive_disk_id,disk_path,last_du)
                                                         VALUES (?,?,?);"
 			   bdisk-id archive-path (or du 0))
 	  (db:archive-register-block-name dbstruct bdisk-id archive-path du: du)))))
-       
+
+
+;; The "archived" field in tests is overloaded; 0 = not archived, > 0 archived in block with given id
+;;
+(define (db:test-set-archive-block-id dbstruct run-id test-id archive-block-id)
+  (db:with-db
+   dbstruct
+   run-id
+   #f
+   (lambda (db)
+     (sqlite3:execute db "UPDATE tests SET archived=? WHERE id=?;"
+		      pid test-id))))
+ 
 
 ;; (define (db:archive-allocate-testsuite/area-to-block block-id testsuite-name areakey)
 ;;   (let* ((dbdat        (db:get-db dbstruct #f)) ;; archive tables are in main.db
 ;; 	 (db           (db:dbdat-get-db dbdat))
 ;; 	 (res          '())

Index: rmt.scm
==================================================================
--- rmt.scm
+++ rmt.scm
@@ -667,5 +667,8 @@
 (define (rmt:archive-allocate-testsuite/area-to-block block-id testsuite-name areakey)
   (rmt:send-receive 'archive-allocate-test-to-block #f (list  block-id testsuite-name areakey)))
 
 (define (rmt:archive-register-disk bdisk-name bdisk-path df)
   (rmt:send-receive 'archive-register-disk #f (list bdisk-name bdisk-path df)))
+
+(define (rmt:test-set-archive-block-id run-id test-id archive-block-id)
+  (rmt:send-receive 'test-set-archive-block-id run-id (list run-id test-id archive-block-id)))