X-Git-Url: https://git.distorted.org.uk/~mdw/runlisp/blobdiff_plain/6af30eee998dbe438466db9096ba5b966a605c0e..75a6ea6025a65db5c444ce18ad0b68511d603de6:/dump-runlisp-image.c

diff --git a/dump-runlisp-image.c b/dump-runlisp-image.c
index 7a88be5..9ed578d 100644
--- a/dump-runlisp-image.c
+++ b/dump-runlisp-image.c
@@ -547,6 +547,7 @@ static void notice_filename(const char *p, size_t sz)
   if (!node) {
     node = xmalloc(sizeof(*node));
     treap_insert(&good, &path, node, p, sz);
+    if (verbose >= 3) moan("noticed non-junk file `%.*s'", (int)sz, p);
   }
 }
 
@@ -702,7 +703,10 @@ static void add_job(unsigned f, struct config_section *sect)
   config_subst_split_var(&config, sect, runvar, &av_version);
   if (!av_version.n)
     lose("empty `run-script' command for Lisp implementation `%s'", name);
-  argv_append(&av_version, xstrdup("?(lisp-implementation-version)"));
+  argv_append(&av_version,
+	      config_subst_string_alloc
+		(&config, sect, "<internal>",
+		 "?${lisp-version?(lisp-implementation-version)}"));
   config_subst_split_var(&config, sect, dumpvar, &av_dump);
   if (!av_dump.n)
     lose("empty `dump-image' command for Lisp implementation `%s'", name);
@@ -915,7 +919,7 @@ static void finish_job(struct job *job)
 	    job->exit);
 
   /* What happens next depends on the state of the job.  This is the main
-   * place which advanced the job state machine.
+   * place which advances the job state machine.
    */
   if (ok) switch (job->st) {
 
@@ -982,6 +986,9 @@ static void finish_job(struct job *job)
        * job, because the chances are good that it failed to produce the
        * image properly.
        */
+      if (verbose >= 3)
+	moan("rename completed Lisp `%s' image `%s' to `%s'",
+	     JOB_NAME(job), job->imgnew, job->imghash);
       if (rename(job->imgnew, job->imghash)) {
 	fprintf(job->log, "%-13s > failed to rename Lisp `%s' "
 			  "output image `%s' to `%s': %s",
@@ -990,6 +997,12 @@ static void finish_job(struct job *job)
 	ok = 0; break;
       }
 
+      /* Notice the image so that it doesn't get junked. */
+      if (flags&AF_JUNK) {
+	p = strrchr(job->imghash, '/'); if (p) p++; else p = job->imghash;
+	notice_filename(p, strlen(p));
+      }
+
       /* Determine the basename of the final image. */
       p = strrchr(job->imghash, '/'); if (p) p++; else p = job->imghash;
 
@@ -1001,6 +1014,9 @@ static void finish_job(struct job *job)
 	    JOB_NAME(job), job->imgnewlink, strerror(errno));
 	break;
       }
+      if (verbose >= 3)
+	moan("establish Lisp `%s' image link `%s' referring to `%s'",
+	     JOB_NAME(job), job->imglink, job->imghash);
       if (symlink(p, job->imgnewlink)) {
 	bad("failed to create Lisp `%s' image link `%s': %s",
 	    JOB_NAME(job), job->imgnewlink, strerror(errno));
@@ -1011,11 +1027,15 @@ static void finish_job(struct job *job)
 	    JOB_NAME(job), job->imgnewlink, job->imglink, strerror(errno));
 	break;
       }
-      if (job->oldimg && STRCMP(job->oldimg, !=, job->imghash) &&
-	  unlink(job->oldimg) && errno != ENOENT) {
-	if (verbose >= 1)
-	  moan("failed to delete old Lisp `%s' image `%s': %s",
-	       JOB_NAME(job), job->oldimg, strerror(errno));
+      if (job->oldimg && STRCMP(job->oldimg, !=, job->imghash)) {
+	if (verbose >= 3)
+	  moan("remove old Lisp `%s' image `%s'",
+	       JOB_NAME(job), job->oldimg);
+	if (unlink(job->oldimg) && errno != ENOENT) {
+	  if (verbose >= 1)
+	    moan("failed to delete old Lisp `%s' image `%s': %s",
+		 JOB_NAME(job), job->oldimg, strerror(errno));
+	}
       }
 
       /* I think we're all done. */