Merge branch 'eqfl' of github.com:mflatt/ChezScheme

original commit: 8b36396eacb139e0fff70efcd2c9dc842815324f

LOG

@@ -1027,6 +1027,21 @@
     cpnanopass.ss, x86_64.ss, x86.ss, foreign2.c, foreign.ms
 - added initialization of seginfo sorted and trigger_ephemerons fields.
     segment.c
+- redirecting output of first two checkboot runs to /dev/null so the
+  ignored exception, if any, does not show up in the make output.
+    s/Mf-base
+- fixed 7.ms to specify the relative path of testfile.boot
+    7.ms
+- profile counts are now maintained even for code that has been
+  reclaimed by the collector and must be released explicitly by the
+  programmer via (profile-release-counters).
+    pdhtml.ss, primdata.ss,
+    globals.h, externs.h, fasl.c, prim5.c, prim.c, alloc.c, scheme.c,
+    misc.ms,
+    release_notes.stex, system.stex
+- clarified required use of scheme-start to start an application
+  packaged as a boot file and added a short "myecho" example.
+    use.stex
 - add ordered guardians through a new optional argument to make-guardian
     prims.ss, primdata.ss, cp0.ss, cpnanopass.ss,
     cmacros.ss, mkheader.ss, gc.c, segment.c, types.h,
@@ -1072,4 +1087,3 @@
     5_4.ss, 5_4.ms
 - added enable-arithmetic-left-associative
     cp0.ss, compile.ss, primdata.ss, front.ss, cp0.ms, system.stex
-

c/alloc.c

@@ -930,6 +930,14 @@ ptr S_relocation_table(n) iptr n; {
     return p;
 }
 
+ptr S_weak_cons(ptr car, ptr cdr) {
+  ptr p;
+  tc_mutex_acquire();
+  p = S_cons_in(space_weakpair, 0, car, cdr);
+  tc_mutex_release();
+  return p;
+}
+
 ptr S_phantom_bytevector(sz) uptr sz; {
     ptr tc = get_thread_context();
     ptr p;

c/externs.h

@@ -90,6 +90,7 @@ extern ptr S_string PROTO((const char *s, iptr n));
 extern ptr S_bignum PROTO((iptr n, IBOOL sign));
 extern ptr S_code PROTO((ptr tc, iptr type, iptr n));
 extern ptr S_relocation_table PROTO((iptr n));
+extern ptr S_weak_cons PROTO((ptr car, ptr cdr));
 extern ptr S_phantom_bytevector PROTO((uptr sz));
 extern void S_phantom_bytevector_adjust PROTO((ptr ph, uptr new_sz));
 

c/fasl.c

@@ -887,7 +887,7 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) {
             return;
         case fasl_type_code: {
             iptr n, m, a; INT flags; iptr free;
-            ptr co, reloc, name;
+            ptr co, reloc, name, pinfos;
             flags = bytein(f);
             free = uptrin(f);
             n = uptrin(f) /* length in bytes of code */;
@@ -898,7 +898,11 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) {
             CODENAME(co) = name;
             faslin(tc, &CODEARITYMASK(co), t, pstrbuf, f);
             faslin(tc, &CODEINFO(co), t, pstrbuf, f);
-            faslin(tc, &CODEPINFOS(co), t, pstrbuf, f);
+            faslin(tc, &pinfos, t, pstrbuf, f);
+            CODEPINFOS(co) = pinfos;
+            if (pinfos != Snil) {
+              S_G.profile_counters = Scons(S_weak_cons(co, pinfos), S_G.profile_counters);
+            }
             bytesin((octet *)&CODEIT(co, 0), n, f);
             m = uptrin(f);
             CODERELOC(co) = reloc = S_relocation_table(m);

c/gc.c

@@ -144,6 +144,40 @@ uptr list_length(ptr ls) {
   return i;
 }
 
+#ifdef PRESERVE_FLONUM_EQ
+
+static void flonum_set_forwarded(ptr p, seginfo *si) {
+  uptr delta = (uptr)UNTYPE(p, type_flonum) - (uptr)build_ptr(si->number, 0);
+  delta >>= log2_ptr_bytes;
+  if (!si->forwarded_flonums) {
+    ptr ff;
+    uptr sz = (bytes_per_segment) >> (3 + log2_ptr_bytes);
+    find_room(space_data, 0, typemod, ptr_align(sz), ff);
+    memset(ff, 0, sz);
+    si->forwarded_flonums = ff;
+  }
+  si->forwarded_flonums[delta >> 3] |= (1 << (delta & 0x7));
+}
+
+static int flonum_is_forwarded_p(ptr p, seginfo *si) {
+  if (!si->forwarded_flonums)
+    return 0;
+  else {
+    uptr delta = (uptr)UNTYPE(p, type_flonum) - (uptr)build_ptr(si->number, 0);
+    delta >>= log2_ptr_bytes;
+    return si->forwarded_flonums[delta >> 3] & (1 << (delta & 0x7));
+  }
+}
+
+# define FLONUM_FWDADDRESS(p) *(ptr*)(UNTYPE(p, type_flonum))
+
+# define FORWARDEDP(p, si) ((TYPEBITS(p) == type_flonum) ? flonum_is_forwarded_p(p, si) : (FWDMARKER(p) == forward_marker))
+# define GET_FWDADDRESS(p) ((TYPEBITS(p) == type_flonum) ? FLONUM_FWDADDRESS(p) : FWDADDRESS(p))
+#else
+# define FORWARDEDP(p, si) (FWDMARKER(p) == forward_marker && TYPEBITS(p) != type_flonum)
+# define GET_FWDADDRESS(p) FWDADDRESS(p)
+#endif
+
 #define relocate(ppp) {\
     ptr PP;\
     PP = *ppp;\
@@ -176,9 +210,9 @@ uptr list_length(ptr ls) {
     relocate_help_help(ppp, pp, SI)\
 }
 
-#define relocate_help_help(ppp, pp, si) {\
+#define relocate_help_help(ppp, pp, si) {       \
-  if (FWDMARKER(pp) == forward_marker && TYPEBITS(pp) != type_flonum)\
+  if (FORWARDEDP(pp, si)) \
-    *ppp = FWDADDRESS(pp);\
+    *ppp = GET_FWDADDRESS(pp); \
   else\
     *ppp = copy(pp, si);\
 }
@@ -430,8 +464,24 @@ static ptr copy(pp, si) ptr pp; seginfo *si; {
           find_room(space_data, tg,
                       type_typed_object, size_inexactnum, p);
           INEXACTNUM_TYPE(p) = type_inexactnum;
+# ifdef PRESERVE_FLONUM_EQ
+          {
+            ptr pt;
+            pt = TYPE(&INEXACTNUM_REAL_PART(pp), type_flonum);
+            if (flonum_is_forwarded_p(pt, si))
+              INEXACTNUM_REAL_PART(p) = FLODAT(FLONUM_FWDADDRESS(pt));
+            else
+              INEXACTNUM_REAL_PART(p) = INEXACTNUM_REAL_PART(pp);
+            pt = TYPE(&INEXACTNUM_IMAG_PART(pp), type_flonum);
+            if (flonum_is_forwarded_p(pt, si))
+              INEXACTNUM_IMAG_PART(p) = FLODAT(FLONUM_FWDADDRESS(pt));
+            else
+              INEXACTNUM_IMAG_PART(p) = INEXACTNUM_IMAG_PART(pp);
+          }
+# else
           INEXACTNUM_REAL_PART(p) = INEXACTNUM_REAL_PART(pp);
           INEXACTNUM_IMAG_PART(p) = INEXACTNUM_IMAG_PART(pp);
+# endif
       } else if (TYPEP(tf, mask_bignum, type_bignum)) {
           iptr n;
           n = size_bignum(BIGLEN(pp));
@@ -601,7 +651,12 @@ static ptr copy(pp, si) ptr pp; seginfo *si; {
 #endif /* ENABLE_OBJECT_COUNTS */
         find_room(space_data, tg, type_flonum, size_flonum, p);
         FLODAT(p) = FLODAT(pp);
+# ifdef PRESERVE_FLONUM_EQ
+        flonum_set_forwarded(pp, si);
+        FLONUM_FWDADDRESS(pp) = p;
+# else
       /* no room for forwarding address, so let 'em be duplicated */
+# endif
         return p;
     } else {
       S_error_abort("copy(gc): illegal type");
@@ -857,8 +912,8 @@ static ptr copy_stack(old, length, clength) ptr old; iptr *length, clength; {
       if (!(si->space & space_old) || locked(obj)) { \
         INITGUARDIANNEXT(ls) = pend_hold_ls; \
         pend_hold_ls = ls; \
-      } else if (FWDMARKER(obj) == forward_marker && TYPEBITS(obj) != type_flonum) { \
+      } else if (FORWARDEDP(obj, si)) { \
-        INITGUARDIANOBJ(ls) = FWDADDRESS(obj); \
+        INITGUARDIANOBJ(ls) = GET_FWDADDRESS(obj); \
         INITGUARDIANNEXT(ls) = pend_hold_ls; \
         pend_hold_ls = ls; \
       } else { \
@@ -1145,7 +1200,7 @@ void GCENTRY(ptr tc, IGEN mcg, IGEN tg) {
                      representative can't itself be a tconc, so we
                      won't discover any new tconcs at that point. */
                   ptr obj = GUARDIANOBJ(ls);
-                  if (FWDMARKER(obj) == forward_marker && TYPEBITS(obj) != type_flonum) {
+                  if (FORWARDEDP(obj, SegInfo(ptr_get_segment(obj)))) {
                     /* Object is reachable, so we might as well move
                        this one to the hold list --- via pend_hold_ls, which
                        leads to a copy to move to hold_ls */
@@ -1226,7 +1281,7 @@ void GCENTRY(ptr tc, IGEN mcg, IGEN tg) {
               for (; ls != Snil; ls = next) {
                 ptr obj = GUARDIANOBJ(ls);
                 next = GUARDIANNEXT(ls);
-                if (FWDMARKER(obj) == forward_marker && TYPEBITS(obj) != type_flonum) {
+                if (FORWARDEDP(obj, SegInfo(ptr_get_segment(obj)))) {
                   /* Will defintely move to hold_ls, but the entry
                      must be copied to move from pend_hold_ls to
                      hold_ls: */
@@ -1446,6 +1501,10 @@ void GCENTRY(ptr tc, IGEN mcg, IGEN tg) {
         if (g == static_generation) S_G.number_of_nonstatic_segments -= 1;
         si->next = S_G.occupied_segments[s][g];
         S_G.occupied_segments[s][g] = si;
+#ifdef PRESERVE_FLONUM_EQ
+        /* any flonums forwarded won't be reference anymore */
+        si->forwarded_flonums = NULL;
+#endif
       } else {
         chunkinfo *chunk = si->chunk;
         if (si->generation != static_generation) S_G.number_of_nonstatic_segments -= 1;
@@ -1549,8 +1608,8 @@ static void forward_or_bwp(pp, p) ptr *pp; ptr p; {
   seginfo *si;
  /* adapted from relocate */
   if (!IMMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL && si->space & space_old && !locked(p)) {
-    if (FWDMARKER(p) == forward_marker && TYPEBITS(p) != type_flonum) {
+    if (FORWARDEDP(p, si)) {
-      *pp = FWDADDRESS(p);
+      *pp = GET_FWDADDRESS(p);
     } else {
       *pp = Sbwp_object;
     }
@@ -2355,7 +2414,7 @@ static void resweep_dirty_weak_pairs() {
                 if (si->space & space_old) {
                   if (locked(p)) {
                     youngest = tg;
-                  } else if (FWDMARKER(p) == forward_marker && TYPEBITS(p) != type_flonum) {
+                  } else if (FORWARDEDP(p, si)) {
                     *pp = FWDADDRESS(p);
                     youngest = tg;
                   } else {
@@ -2445,7 +2504,7 @@ static void check_ephemeron(ptr pe, int add_to_trigger) {
 
   p = Scar(pe);
   if (!IMMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL && si->space & space_old && !locked(p)) {
-    if (FWDMARKER(p) == forward_marker && TYPEBITS(p) != type_flonum) {
+    if (FORWARDEDP(p, si)) {
       INITCAR(pe) = FWDADDRESS(p);
       relocate(&INITCDR(pe))
       if (!add_to_trigger)
@@ -2499,8 +2558,8 @@ static int check_dirty_ephemeron(ptr pe, int tg, int youngest) {
   p = Scar(pe);
   if (!IMMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL) {
     if (si->space & space_old && !locked(p)) {
-      if (FWDMARKER(p) == forward_marker && TYPEBITS(p) != type_flonum) {
+      if (FORWARDEDP(p, si)) {
-        INITCAR(pe) = FWDADDRESS(p);
+        INITCAR(pe) = GET_FWDADDRESS(p);
         relocate(&INITCDR(pe))
         youngest = tg;
       } else {

c/globals.h

@@ -78,6 +78,7 @@ EXTERN struct {
     ptr scheme_version_id;
     ptr make_load_binary_id;
     ptr load_binary;
+    ptr profile_counters;
 
   /* foreign.c */
     ptr foreign_static;

c/prim.c

@@ -195,6 +195,7 @@ static void s_instantiate_code_object() {
     ptr tc = get_thread_context();
     ptr old, cookie, proc;
     ptr new, oldreloc, newreloc;
+    ptr pinfos;
     uptr a, m, n;
     iptr i, size;
 
@@ -217,7 +218,10 @@ static void s_instantiate_code_object() {
     CODEARITYMASK(new) = CODEARITYMASK(old);
     CODEFREE(new) = CODEFREE(old);
     CODEINFO(new) = CODEINFO(old);
-    CODEPINFOS(new) = CODEPINFOS(old);
+    CODEPINFOS(new) = pinfos = CODEPINFOS(old);
+    if (pinfos != Snil) {
+      S_G.profile_counters = Scons(S_weak_cons(new, pinfos), S_G.profile_counters);
+    }
 
     for (i = 0; i < CODELEN(old); i++) CODEIT(new,i) = CODEIT(old,i);
 

c/prim5.c

@@ -32,7 +32,6 @@ static iptr s_fxmul PROTO((iptr x, iptr y));
 static iptr s_fxdiv PROTO((iptr x, iptr y));
 static ptr s_trunc_rem PROTO((ptr x, ptr y));
 static ptr s_fltofx PROTO((ptr x));
-static ptr s_weak_cons PROTO((ptr car, ptr cdr));
 static ptr s_weak_pairp PROTO((ptr p));
 static ptr s_ephemeron_cons PROTO((ptr car, ptr cdr));
 static ptr s_ephemeron_pairp PROTO((ptr p));
@@ -86,7 +85,6 @@ static IBOOL s_fd_regularp PROTO((INT fd));
 static void s_nanosleep PROTO((ptr sec, ptr nsec));
 static ptr s_set_collect_trip_bytes PROTO((ptr n));
 static void c_exit PROTO((I32 status));
-static ptr find_pcode PROTO((void));
 static ptr s_get_reloc PROTO((ptr co));
 #ifdef PTHREADS
 static s_thread_rv_t s_backdoor_thread_start PROTO((void *p));
@@ -117,6 +115,8 @@ static ptr s_iconv_to_string PROTO((uptr cd, ptr in, uptr i, uptr iend, ptr out,
 static ptr s_multibytetowidechar PROTO((unsigned cp, ptr inbv));
 static ptr s_widechartomultibyte PROTO((unsigned cp, ptr inbv));
 #endif
+static ptr s_profile_counters PROTO((void));
+static void s_set_profile_counters PROTO((ptr counters));
 
 #define require(test,who,msg,arg) if (!(test)) S_error1(who, msg, arg)
 
@@ -174,15 +174,6 @@ static ptr s_fltofx(x) ptr x; {
     return FIX((iptr)FLODAT(x));
 }
 
-static ptr s_weak_cons(car, cdr) ptr car, cdr; {
-  ptr p;
-
-  tc_mutex_acquire()
-  p = S_cons_in(space_weakpair, 0, car, cdr);
-  tc_mutex_release()
-  return p;
-}
-
 static ptr s_weak_pairp(p) ptr p; {
   seginfo *si;
   return Spairp(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL && (si->space & ~space_locked) == space_weakpair ? Strue : Sfalse;
@@ -893,6 +884,9 @@ static ptr s_make_code(flags, free, name, arity_mark, n, info, pinfos)
     CODEARITYMASK(co) = arity_mark;
     CODEINFO(co) = info;
     CODEPINFOS(co) = pinfos;
+    if (pinfos != Snil) {
+      S_G.profile_counters = Scons(S_weak_cons(co, pinfos), S_G.profile_counters);
+    }
     return co;
 }
 
@@ -1452,6 +1446,14 @@ static void s_condition_signal(s_thread_cond_t *c) {
 }
 #endif
 
+static ptr s_profile_counters(void) {
+  return S_G.profile_counters;
+}
+
+static void s_set_profile_counters(ptr counters) {
+  S_G.profile_counters = counters;
+}
+
 void S_dump_tc(ptr tc) {
   INT i;
 
@@ -1492,7 +1494,7 @@ void S_prim5_init() {
     Sforeign_symbol("(cs)s_ptr_in_heap", (void *)s_ptr_in_heap);
     Sforeign_symbol("(cs)generation", (void *)s_generation);
     Sforeign_symbol("(cs)s_fltofx", (void *)s_fltofx);
-    Sforeign_symbol("(cs)s_weak_cons", (void *)s_weak_cons);
+    Sforeign_symbol("(cs)s_weak_cons", (void *)S_weak_cons);
     Sforeign_symbol("(cs)s_weak_pairp", (void *)s_weak_pairp);
     Sforeign_symbol("(cs)s_ephemeron_cons", (void *)s_ephemeron_cons);
     Sforeign_symbol("(cs)s_ephemeron_pairp", (void *)s_ephemeron_pairp);
@@ -1647,7 +1649,6 @@ void S_prim5_init() {
     Sforeign_symbol("(cs)log1p", (void *)s_log1p);
 #endif /* LOG1P */
 
-    Sforeign_symbol("(cs)find_pcode", (void *)find_pcode);
     Sforeign_symbol("(cs)s_get_reloc", (void *)s_get_reloc);
     Sforeign_symbol("(cs)getenv", (void *)s_getenv);
     Sforeign_symbol("(cs)putenv", (void *)s_putenv);
@@ -1677,27 +1678,8 @@ void S_prim5_init() {
     Sforeign_symbol("(cs)s_multibytetowidechar", (void *)s_multibytetowidechar);
     Sforeign_symbol("(cs)s_widechartomultibyte", (void *)s_widechartomultibyte);
 #endif
-}
+    Sforeign_symbol("(cs)s_profile_counters", (void *)s_profile_counters);
-
+    Sforeign_symbol("(cs)s_set_profile_counters", (void *)s_set_profile_counters);
-static ptr find_pcode() {
-   ptr ls, p, *pp, *nl;
-   IGEN g;
-
-   ls = Snil;
-   for (g = 0; g <= static_generation; g++) {
-      pp = (ptr *)S_G.first_loc[space_code][g];
-      nl = (ptr *)S_G.next_loc[space_code][g];
-      while (pp != nl) {
-         if (*pp == forward_marker)
-            pp = (ptr *)*(pp + 1);
-         else {
-            p = TYPE((ptr)pp, type_typed_object);
-            if (CODEPINFOS(p) != Snil) ls = Scons(p, ls);
-            pp += size_code(CODELEN(p)) / sizeof(ptr);
-         }
-      }
-   }
-   return ls;
 }
 
 static ptr s_get_reloc(co) ptr co; {

c/print.c

@@ -34,6 +34,7 @@ static void pvec PROTO((ptr x));
 static void pfxvector PROTO((ptr x));
 static void pbytevector PROTO((ptr x));
 static void pflonum PROTO((ptr x));
+static void pflodat PROTO((double x));
 static void pfixnum PROTO((ptr x));
 static void pbignum PROTO((ptr x));
 static void wrint PROTO((ptr x));
@@ -113,9 +114,9 @@ static void pfile(UNUSED ptr x) {
 }
 
 static void pinexactnum(x) ptr x; {
-    S_prin1(TYPE(&INEXACTNUM_REAL_PART(x),type_flonum));
+    pflodat(INEXACTNUM_REAL_PART(x));
     if (INEXACTNUM_IMAG_PART(x) >= 0.0) putchar('+');
-    S_prin1(TYPE(&INEXACTNUM_IMAG_PART(x),type_flonum));
+    pflodat(INEXACTNUM_IMAG_PART(x));
     putchar('i');
 }
 
@@ -246,10 +247,14 @@ static void pbytevector(x) ptr x; {
 }
 
 static void pflonum(x) ptr x; {
+  pflodat(FLODAT(x));
+}
+
+static void pflodat(x) double x; {
   char buf[256], *s;
 
  /* use snprintf to get it in a string */
-  (void) snprintf(buf, 256, "%.16g",FLODAT(x));
+  (void) snprintf(buf, 256, "%.16g", x);
 
  /* print the silly thing */
   printf("%s", buf);

c/scheme.c

@@ -80,6 +80,9 @@ static void main_init() {
 
     if (!S_boot_time) return;
 
+    S_protect(&S_G.profile_counters);
+    S_G.profile_counters = Snil;
+
     FXLENGTHBV(tc) = p = S_bytevector(256);
     for (i = 0; i < 256; i += 1) {
       BVIT(p, i) =

c/segment.c

@@ -239,6 +239,9 @@ static void initialize_seginfo(seginfo *si, ISPC s, IGEN g) {
   si->has_triggers = 0;
   si->trigger_ephemerons = 0;
   si->trigger_guardians = 0;
+#ifdef PRESERVE_FLONUM_EQ
+  si->forwarded_flonums = NULL;
+#endif
 }
 
 iptr S_find_segments(s, g, n) ISPC s; IGEN g; iptr n; {

c/types.h

@@ -103,6 +103,10 @@ typedef int IFASLCODE;      /* fasl type codes */
   }\
 }
 
+#ifndef NO_PRESERVE_FLONUM_EQ
+# define PRESERVE_FLONUM_EQ
+#endif
+
 /* size of protected array used to store roots for the garbage collector */
 #define max_protected 100
 
@@ -130,6 +134,9 @@ typedef struct _seginfo {
   struct _seginfo *dirty_next;              /* pointer to the next seginfo on the DirtySegments list */
   ptr trigger_ephemerons;                   /* ephemerons to re-check if object in segment is copied out */
   ptr trigger_guardians;                    /* guardians to re-check if object in segment is copied out */
+#ifdef PRESERVE_FLONUM_EQ
+  octet *forwarded_flonums;                 /* bitmap of flonums whose payload is a forwarding pointer */
+#endif
   octet dirty_bytes[cards_per_segment];     /* one dirty byte per card */
 } seginfo;
 

csug/system.stex

@@ -3186,6 +3186,16 @@ The code generated when \scheme{compile-profile} is non-false is
 larger and less efficient, so this parameter should be set only
 when profile information is needed.
 
+The profile counters for code compiled when profile instrumentation
+is enabled are retained indefinitely, even if the code with which
+they are associated is reclaimed by the garbage collector.
+This results in more complete and accurate profile data but can lead
+to space leaks in programs that dynamically generate or load code.
+Such programs can avoid the potential space leak by releasing the
+counters explicitly via the procedure
+\index{\scheme{profile-release-counters}}\scheme{profile-release-counters}.
+
+
 \entryheader
 \formdef{profile}{\categorysyntax}{(profile \var{source-object})}
 \returns unspecified
@@ -3226,6 +3236,17 @@ that should be profiled.
 Calling this procedure causes profile information to be cleared, i.e.,
 the counts associated with each section of code are set to zero.
 
+%----------------------------------------------------------------------------
+\entryheader
+\formdef{profile-release-counters}{\categoryprocedure}{(profile-release-counters)}
+\returns unspecified
+\listlibraries
+\endentryheader
+
+\noindent
+Calling this procedure causes profile information associated with reclaimed
+code objects to be dropped.
+
 %----------------------------------------------------------------------------
 \entryheader
 \formdef{profile-dump}{\categoryprocedure}{(profile-dump)}

csug/use.stex

@@ -1590,8 +1590,19 @@ application's name and spare your users from supplying any command-line
 arguments or running a separate script to load the application code.
 \end{itemize}
 
-A boot file is simply an object file, possibly containing the code for
+\index{\scheme{scheme-start}}%
-more than one source file, prefixed by a boot header.
+When an application is packaged into a boot file, the source code
+that is compiled and converted into a boot file should set
+\scheme{scheme-start} to a procedure that starts the application,
+as shown in the example above.
+The application should not be started directly from the boot file,
+because boot files are loaded before final initialization of the
+Scheme system.
+The value of \scheme{scheme-start} is invoked automatically after
+final initialization.
+
+A boot file is simply an object file containing the code for
+one or more source files, prefixed by a boot header.
 The boot header identifies a base boot file upon which the application
 directly depends, or possibly two or more alternatives upon which the
 application can be run.
@@ -1630,7 +1641,7 @@ This would allow your application to run on top of the full
 {\ChezScheme} if present, otherwise {\PetiteChezScheme}.
 
 In most cases, you can construct your application
-so it does not depend upon features of {\ChezScheme} (specifically,
+so it does not depend upon features of scheme.boot (specifically,
 the compiler) by specifying only \scheme{"petite"} in the call to
 \scheme{make-boot-file}.
 If your application calls \scheme{eval}, however, and you wish to
@@ -1639,6 +1650,28 @@ advantage of the faster execution speed of compiled code, then specifying
 both \scheme{"scheme"} and \scheme{"petite"}
 is appropriate.
 
+Here is how we might create and run a simple ``echo'' application
+from a Linux shell:
+
+\schemedisplay
+echo '(suppress-greeting #t)' > myecho.ss
+echo '(scheme-start (lambda fns (printf "~{~a~^ ~}\n" fns)))' >> myecho.ss
+echo '(compile-file "myecho.ss") \
+      (make-boot-file "myecho.boot" (quote ("petite")) "myecho.so")' \
+     | scheme -q
+scheme -b myecho.boot hello world
+\endschemedisplay
+
+If we take the extra step of installing a copy of the {\PetiteChezScheme}
+executable as \scheme{myecho} and copying \scheme{myecho.boot} into
+the same directory as \scheme{petite.boot} (or set SCHEMEHEAPDIRS to
+include the directory containing myecho.boot), we can simply invoke
+\scheme{myecho} to run our echo application:
+
+\schemedisplay
+myecho hello world
+\endschemedisplay
+
 \parheader{Distributing the Application}
 Distributing an application involves can be as simple as creating a
 distribution package that includes the following items:

mats/7.ms

@@ -925,7 +925,7 @@
           "testfile-5.ss"))
       (let-values ([(to-stdin from-stdout from-stderr pid)
                     (open-process-ports
-                      (format "~a -b testfile.boot -q" (patch-exec-path *scheme*))
+                      (format "~a -b ./testfile.boot -q" (patch-exec-path *scheme*))
                       (buffer-mode block)
                       (native-transcoder))])
         (close-output-port to-stdin)
@@ -946,7 +946,7 @@
         (make-boot-file "testfile.boot" '("petite") "testfile-libs.so"))
       (let-values ([(to-stdin from-stdout from-stderr pid)
                     (open-process-ports
-                      (format "~a -b testfile.boot -q" (patch-exec-path *scheme*))
+                      (format "~a -b ./testfile.boot -q" (patch-exec-path *scheme*))
                       (buffer-mode block)
                       (native-transcoder))])
         (pretty-print '(let () (import (B)) (printf "~s\n" b)) to-stdin)
@@ -973,7 +973,7 @@
           "testfile-5.so"))
       (let-values ([(to-stdin from-stdout from-stderr pid)
                     (open-process-ports
-                      (format "~a -b testfile.boot -q" (patch-exec-path *scheme*))
+                      (format "~a -b ./testfile.boot -q" (patch-exec-path *scheme*))
                       (buffer-mode block)
                       (native-transcoder))])
         (close-output-port to-stdin)

mats/misc.ms

@@ -1895,13 +1895,8 @@
   (eqv?
     ($frumble (make-list 100 5))
     9860761315262647567646607066034827870915080438862787559628486633300781)
-  (andmap
-    ; if counts for define and lambda on the first two lines are available (haven't
-    ; been tossed by the collector), check that they are 1
-    (lambda (x) (= (car x) 1))
-    (filter (lambda (x) (and (equal? (cadr x) "testfile-cp1.ss") (<= (list-ref x 4) 2))) (profile-dump-list)))
   (equal?
-    (filter (lambda (x) (and (equal? (cadr x) "testfile-cp1.ss") (>= (list-ref x 4) 3))) (profile-dump-list))
+    (filter (lambda (x) (equal? (cadr x) "testfile-cp1.ss")) (profile-dump-list))
     '((101 "testfile-cp1.ss" 36 258 3 5)
       (101 "testfile-cp1.ss" 40 50 3 9)
       (101 "testfile-cp1.ss" 41 46 3 10)
@@ -1927,6 +1922,8 @@
       (100 "testfile-cp1.ss" 247 248 9 24)
       (100 "testfile-cp1.ss" 249 250 9 26)
       (100 "testfile-cp1.ss" 251 252 9 28)
+      (1 "testfile-cp1.ss" 0 260 1 1)
+      (1 "testfile-cp1.ss" 19 259 2 3)
       (1 "testfile-cp1.ss" 59 60 4 9)
       (0 "testfile-cp1.ss" 128 178 7 15)
       (0 "testfile-cp1.ss" 129 136 7 16)
@@ -1943,11 +1940,8 @@
         (let ([ans ($frumble (append (make-list 50 5) (list 0) (make-list 50 7)))])
           ($return ans))))
     0)
-  (andmap
-    (lambda (x) (= (car x) 1))
-    (filter (lambda (x) (and (equal? (cadr x) "testfile-cp1.ss") (<= (list-ref x 4) 2))) (profile-dump-list)))
   (equal?
-    (filter (lambda (x) (and (equal? (cadr x) "testfile-cp1.ss") (>= (list-ref x 4) 3))) (profile-dump-list))
+    (filter (lambda (x) (equal? (cadr x) "testfile-cp1.ss")) (profile-dump-list))
     '((152 "testfile-cp1.ss" 36 258 3 5)
       (152 "testfile-cp1.ss" 40 50 3 9)
       (152 "testfile-cp1.ss" 41 46 3 10)
@@ -1973,6 +1967,8 @@
       (100 "testfile-cp1.ss" 247 248 9 24)
       (100 "testfile-cp1.ss" 249 250 9 26)
       (100 "testfile-cp1.ss" 251 252 9 28)
+      (1 "testfile-cp1.ss" 0 260 1 1)
+      (1 "testfile-cp1.ss" 19 259 2 3)
       (1 "testfile-cp1.ss" 59 60 4 9)
       (1 "testfile-cp1.ss" 128 178 7 15)
       (1 "testfile-cp1.ss" 129 136 7 16)
@@ -1988,11 +1984,50 @@
         (set! $return k)
         ($retry 1)))
     111022302462515654042363166809082031)
-  (andmap
-    (lambda (x) (= (car x) 1))
-    (filter (lambda (x) (and (equal? (cadr x) "testfile-cp1.ss") (<= (list-ref x 4) 2))) (profile-dump-list)))
   (equal?
-    (filter (lambda (x) (and (equal? (cadr x) "testfile-cp1.ss") (>= (list-ref x 4) 3))) (profile-dump-list))
+    (filter (lambda (x) (equal? (cadr x) "testfile-cp1.ss")) (profile-dump-list))
+    '((152 "testfile-cp1.ss" 36 258 3 5)
+      (152 "testfile-cp1.ss" 40 50 3 9)
+      (152 "testfile-cp1.ss" 41 46 3 10)
+      (152 "testfile-cp1.ss" 47 49 3 16)
+      (151 "testfile-cp1.ss" 69 257 5 9)
+      (151 "testfile-cp1.ss" 78 86 5 18)
+      (151 "testfile-cp1.ss" 79 82 5 19)
+      (151 "testfile-cp1.ss" 83 85 5 23)
+      (151 "testfile-cp1.ss" 99 256 6 11)
+      (151 "testfile-cp1.ss" 103 113 6 15)
+      (151 "testfile-cp1.ss" 104 108 6 16)
+      (151 "testfile-cp1.ss" 109 110 6 21)
+      (151 "testfile-cp1.ss" 111 112 6 23)
+      (150 "testfile-cp1.ss" 193 255 8 15)
+      (150 "testfile-cp1.ss" 202 221 8 24)
+      (150 "testfile-cp1.ss" 203 211 8 25)
+      (150 "testfile-cp1.ss" 212 220 8 34)
+      (150 "testfile-cp1.ss" 213 216 8 35)
+      (150 "testfile-cp1.ss" 217 219 8 39)
+      (150 "testfile-cp1.ss" 240 254 9 17)
+      (150 "testfile-cp1.ss" 241 245 9 18)
+      (150 "testfile-cp1.ss" 246 253 9 23)
+      (150 "testfile-cp1.ss" 247 248 9 24)
+      (150 "testfile-cp1.ss" 249 250 9 26)
+      (150 "testfile-cp1.ss" 251 252 9 28)
+      (1 "testfile-cp1.ss" 0 260 1 1)
+      (1 "testfile-cp1.ss" 19 259 2 3)
+      (1 "testfile-cp1.ss" 59 60 4 9)
+      (1 "testfile-cp1.ss" 128 178 7 15)
+      (1 "testfile-cp1.ss" 129 136 7 16)
+      (1 "testfile-cp1.ss" 137 177 7 24)
+      (1 "testfile-cp1.ss" 149 164 7 36)
+      (1 "testfile-cp1.ss" 162 163 7 49)
+      (1 "testfile-cp1.ss" 165 176 7 52)
+      (1 "testfile-cp1.ss" 166 173 7 53)
+      (1 "testfile-cp1.ss" 174 175 7 61)))
+  (begin
+    (collect (collect-maximum-generation)) ; drop code object for the define and lambda
+    (profile-release-counters) ; drop proile information for the dropped code object
+    #t)
+  (equal?
+    (filter (lambda (x) (equal? (cadr x) "testfile-cp1.ss")) (profile-dump-list))
     '((152 "testfile-cp1.ss" 36 258 3 5)
       (152 "testfile-cp1.ss" 40 50 3 9)
       (152 "testfile-cp1.ss" 41 46 3 10)
@@ -2027,6 +2062,88 @@
       (1 "testfile-cp1.ss" 165 176 7 52)
       (1 "testfile-cp1.ss" 166 173 7 53)
       (1 "testfile-cp1.ss" 174 175 7 61)))
+  ; test profiling with compiled files
+  (begin
+    (with-output-to-file "testfile-cp2.ss"
+      (lambda ()
+        (display-string "\
+(define cp2-fib
+  (rec fib
+    (lambda (n)
+      (cond
+        [(fx= n 0) 1]
+        [(fx= n 1) 1]
+        [else (+ (fib (- n 1)) (fib (- n 2)))]))))
+"))
+      'replace)
+    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f] [optimize-level 2] [compile-profile #t])
+      (compile-file "testfile-cp2"))
+    (profile-clear)
+    (load "testfile-cp2.so")
+    #t)
+  (eqv? (cp2-fib 10) 89)
+  (equal?
+    (filter (lambda (x) (equal? (cadr x) "testfile-cp2.ss")) (profile-dump-list))
+    '((177 "testfile-cp2.ss" 49 146 4 7)
+      (177 "testfile-cp2.ss" 64 73 5 10)
+      (177 "testfile-cp2.ss" 65 68 5 11)
+      (177 "testfile-cp2.ss" 69 70 5 15)
+      (177 "testfile-cp2.ss" 71 72 5 17)
+      (143 "testfile-cp2.ss" 86 95 6 10)
+      (143 "testfile-cp2.ss" 87 90 6 11)
+      (143 "testfile-cp2.ss" 91 92 6 15)
+      (143 "testfile-cp2.ss" 93 94 6 17)
+      (88 "testfile-cp2.ss" 113 144 7 15)
+      (88 "testfile-cp2.ss" 114 115 7 16)
+      (88 "testfile-cp2.ss" 116 129 7 18)
+      (88 "testfile-cp2.ss" 117 120 7 19)
+      (88 "testfile-cp2.ss" 121 128 7 23)
+      (88 "testfile-cp2.ss" 122 123 7 24)
+      (88 "testfile-cp2.ss" 124 125 7 26)
+      (88 "testfile-cp2.ss" 126 127 7 28)
+      (88 "testfile-cp2.ss" 130 143 7 32)
+      (88 "testfile-cp2.ss" 131 134 7 33)
+      (88 "testfile-cp2.ss" 135 142 7 37)
+      (88 "testfile-cp2.ss" 136 137 7 38)
+      (88 "testfile-cp2.ss" 138 139 7 40)
+      (88 "testfile-cp2.ss" 140 141 7 42)
+      (55 "testfile-cp2.ss" 96 97 6 20)
+      (34 "testfile-cp2.ss" 74 75 5 20)
+      (1 "testfile-cp2.ss" 0 149 1 1)
+      (1 "testfile-cp2.ss" 18 148 2 3)
+      (1 "testfile-cp2.ss" 23 26 2 8)
+      (1 "testfile-cp2.ss" 31 147 3 5)))
+  (begin
+    (collect (collect-maximum-generation)) ; drop code object for the define and lambda
+    (profile-release-counters) ; drop proile information for the dropped code object
+    #t)
+  (equal?
+    (filter (lambda (x) (equal? (cadr x) "testfile-cp2.ss")) (profile-dump-list))
+    '((177 "testfile-cp2.ss" 49 146 4 7)
+      (177 "testfile-cp2.ss" 64 73 5 10)
+      (177 "testfile-cp2.ss" 65 68 5 11)
+      (177 "testfile-cp2.ss" 69 70 5 15)
+      (177 "testfile-cp2.ss" 71 72 5 17)
+      (143 "testfile-cp2.ss" 86 95 6 10)
+      (143 "testfile-cp2.ss" 87 90 6 11)
+      (143 "testfile-cp2.ss" 91 92 6 15)
+      (143 "testfile-cp2.ss" 93 94 6 17)
+      (88 "testfile-cp2.ss" 113 144 7 15)
+      (88 "testfile-cp2.ss" 114 115 7 16)
+      (88 "testfile-cp2.ss" 116 129 7 18)
+      (88 "testfile-cp2.ss" 117 120 7 19)
+      (88 "testfile-cp2.ss" 121 128 7 23)
+      (88 "testfile-cp2.ss" 122 123 7 24)
+      (88 "testfile-cp2.ss" 124 125 7 26)
+      (88 "testfile-cp2.ss" 126 127 7 28)
+      (88 "testfile-cp2.ss" 130 143 7 32)
+      (88 "testfile-cp2.ss" 131 134 7 33)
+      (88 "testfile-cp2.ss" 135 142 7 37)
+      (88 "testfile-cp2.ss" 136 137 7 38)
+      (88 "testfile-cp2.ss" 138 139 7 40)
+      (88 "testfile-cp2.ss" 140 141 7 42)
+      (55 "testfile-cp2.ss" 96 97 6 20)
+      (34 "testfile-cp2.ss" 74 75 5 20)))
   (eqv? (profile-clear) (void))
   (begin
     (with-output-to-file "testfile.ss"
@@ -2034,7 +2151,7 @@
         (pretty-print
           '(define f (lambda () 0))))
       'replace)
-    (parameterize ([compile-profile #t]) (load "testfile.ss"))
+    (parameterize ([compile-profile #t]) (load "testfile.ss" compile))
     #t)
   (begin
     (with-output-to-file "testfile.ss"

release_notes/release_notes.stex

@@ -2,8 +2,8 @@
 
 \thisversion{Version 9.5.1}
 \thatversion{Version 8.4}
-\pubmonth{August}
+\pubmonth{January}
-\pubyear{2018}
+\pubyear{2019}
 
 \begin{document}
 
@@ -112,6 +112,19 @@ unordered by default. An ordered guardian's objects are classified as
 inaccessible only when they are not reachable from the represetative
 of any inaccessible object in any other guardian.
 
+\subsection{Profile data retained for reclaimed code (9.5.1)}
+
+Profile data is now retained indefinitely even for code objects
+that have been reclaimed by the garbage collector.
+Previously, the counters holding the data were reclaimed by the
+collector along with the code objects.
+This makes profile output more complete and accurate, but it does
+represent a potential space leak in programs that create or load
+and release code dynamically.
+Such programs can avoid the potential space leak by releasing the
+counters explicitly via the new procedure
+\scheme{profile-release-counters}.
+
 \subsection{Procedure source location without inspector information (9.5.1)}
 
 When \scheme{generate-inspector-information} is set to \scheme{#f} and

s/Mf-base

@@ -162,10 +162,10 @@ all: bootall ${Cheader} ${Cequates}
 # same as the last, i.e., the system is properly bootstrapped.
 allx: prettyclean saveboot
 	$(MAKE) all
-	if $(MAKE) checkboot; then echo fine ; else\
+	if $(MAKE) checkboot > /dev/null 2>&1; then echo fine ; else\
           $(MAKE) prettyclean saveboot &&\
           $(MAKE) all &&\
-          if $(MAKE) checkboot; then echo fine ; else\
+          if $(MAKE) checkboot > /dev/null 2>&1; then echo fine ; else\
             $(MAKE) prettyclean saveboot &&\
             $(MAKE) all &&\
             $(MAKE) checkboot ;\

s/pdhtml.ss

@@ -60,14 +60,14 @@
   (include "types.ss")
   (define op+ car)
   (define op- cdr)
-  (define find-pcode
+  (define get-counter-list (foreign-procedure "(cs)s_profile_counters" () ptr))
-    (foreign-procedure "(cs)find_pcode" () scheme-object))
+  (define set-counter-list! (foreign-procedure "(cs)s_set_profile_counters" (ptr) void))
-  (define find-pinfo
+  (set-who! profile-release-counters
-    (lambda (x who)
+    (lambda ()
-      (cond
+      (set-counter-list!
-        [(procedure? x) ($code-pinfo* ($closure-code x))]
+        (remp
-        [($code? x) ($code-pinfo* x)]
+          (lambda (x) (bwp-object? (car x)))
-        [else ($oops who "could not find profiling info in ~s" x)])))
+          (get-counter-list)))))
   (set-who! profile-clear
     (lambda ()
       (define clear-links
@@ -80,8 +80,8 @@
       (for-each
         (lambda (x)
           (for-each (lambda (node) (clear-links (rblock-op node)))
-            (find-pinfo x who)))
+            (cdr x)))
-        (find-pcode))))
+        (get-counter-list))))
   (set-who! profile-dump
     (lambda ()
       (define rblock-count
@@ -94,7 +94,7 @@
                 (- (#3%apply + (#3%map sum (op+ op)))
                    (#3%apply + (#3%map sum (op- op))))))))
       (fold-left
-        (lambda (r code)
+        (lambda (r x)
           (fold-left
             (lambda (r rblock)
               (fold-left
@@ -102,8 +102,8 @@
                   (lambda (r inst)
                     (cons (cons inst count) r)))
                 r (rblock-srecs rblock)))
-            r (find-pinfo code who)))
+            r (cdr x)))
-        '() (find-pcode)))))
+        '() (get-counter-list)))))
 
 (let ()
   (include "types.ss")

s/primdata.ss

@@ -1540,6 +1540,7 @@
   (profile-dump-data [sig [(pathname) (pathname sub-list) -> (void)]] [flags true])
   (profile-dump-list [sig [() (ptr) (ptr sub-list) -> (list)]] [flags discard true])
   (profile-dump-html [sig [() (pathname) (pathname sub-list) -> (void)]] [flags true])
+  (profile-release-counters [sig [() -> (void)]] [flags true])
   (property-list [sig [(symbol) -> (list)]] [flags discard true safeongoodargs])
   (put-bytevector-some [sig [(binary-output-port bytevector) (binary-output-port bytevector length) (binary-output-port bytevector length length) -> (uint)]] [flags true])
   (put-hash-table! [sig [(old-hash-table ptr ptr) -> (void)]] [flags true])