home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mitsch75.zip / scheme-7_5_17-src.zip / scheme-7.5.17 / src / microcode / fasdump.c < prev    next >
C/C++ Source or Header  |  2000-12-05  |  17KB  |  605 lines
  1. /* -*-C-*-
  2.  
  3. $Id: fasdump.c,v 9.64 2000/12/05 21:23:44 cph Exp $
  4.  
  5. Copyright (c) 1987-2000 Massachusetts Institute of Technology
  6.  
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or (at
  10. your option) any later version.
  11.  
  12. This program is distributed in the hope that it will be useful, but
  13. WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with this program; if not, write to the Free Software
  19. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. */
  21.  
  22. /* This file contains code for fasdump and dump-band. */
  23.  
  24. #include "scheme.h"
  25. #include "prims.h"
  26. #include "osscheme.h"
  27. #include "osio.h"
  28. #include "osfile.h"
  29. #include "osfs.h"
  30. #define In_Fasdump
  31. #include "gccode.h"
  32. #include "trap.h"
  33. #include "lookup.h"
  34. #include "fasl.h"
  35.  
  36. static Tchannel dump_channel;
  37.  
  38. #define Write_Data(size, buffer)                    \
  39.   ((long)                                \
  40.    ((OS_channel_write_dump_file                        \
  41.      (dump_channel,                            \
  42.       ((char *) (buffer)),                        \
  43.       ((size) * (sizeof (SCHEME_OBJECT)))))                \
  44.     / (sizeof (SCHEME_OBJECT))))
  45.  
  46. #include "dump.c"
  47.  
  48. extern SCHEME_OBJECT
  49.   EXFUN (dump_renumber_primitive, (SCHEME_OBJECT)),
  50.   * EXFUN (initialize_primitive_table, (SCHEME_OBJECT *, SCHEME_OBJECT *)),
  51.   * EXFUN (cons_primitive_table, (SCHEME_OBJECT *, SCHEME_OBJECT *, long *)),
  52.   * EXFUN (cons_whole_primitive_table,
  53.        (SCHEME_OBJECT *, SCHEME_OBJECT *, long *)),
  54.   * EXFUN (cons_c_code_table, (SCHEME_OBJECT *, SCHEME_OBJECT *, long *));
  55.  
  56. /* Some statics used freely in this file */
  57.  
  58. static SCHEME_OBJECT *NewFree, *NewMemTop, *Fixup;
  59. static Boolean compiled_code_present_p;
  60. static CONST char * dump_file_name = ((char *) 0);
  61.  
  62. /* FASDUMP:
  63.  
  64.    Hair squared! ... in order to dump an object it must be traced (as
  65.    in a garbage collection), but with some significant differences.
  66.    First, the copy must have the global value cell of symbols set to
  67.    UNBOUND and variables uncompiled.  Second, and worse, all the
  68.    broken hearts created during the process must be restored to their
  69.    original values.  This last is done by growing the copy of the
  70.    object in the bottom of spare heap, keeping track of the locations
  71.    of broken hearts and original contents at the top of the spare
  72.    heap.
  73.  
  74.    FASDUMP is called with three arguments:
  75.    Argument 1: Object to dump.
  76.    Argument 2: File name.
  77.    Argument 3: Flag.
  78.    Currently, flag is ignored.
  79. */
  80.  
  81. /*
  82.    Copy of GCLoop, except (a) copies out of constant space into the
  83.    object to be dumped; (b) changes symbols and variables as
  84.    described; (c) keeps track of broken hearts and their original
  85.    contents (e) To_Pointer is now NewFree.
  86. */
  87.  
  88. #define Setup_Pointer_for_Dump(Extra_Code)                \
  89.   Dump_Pointer (Fasdump_Setup_Pointer (Extra_Code,            \
  90.                        Normal_BH (false, continue)))
  91.  
  92. #define Dump_Pointer(Code)                        \
  93.   Old = (OBJECT_ADDRESS (Temp));                    \
  94.   Code
  95.  
  96. #define DUMP_RAW_POINTER(Code)                        \
  97.   Old = (SCHEME_ADDR_TO_ADDR (Temp));                    \
  98.   Code
  99.  
  100. /* This depends on the fact that the last word in a compiled code block
  101.    contains the environment, and that To will be pointing to the word
  102.    immediately after that!
  103.  */
  104.  
  105. #define Fasdump_Transport_Compiled()                    \
  106. {                                    \
  107.   Transport_Compiled ();                        \
  108.   if ((mode == 2) && ((OBJECT_TYPE (*(To - 1))) == TC_ENVIRONMENT))    \
  109.     *(To - 1) = SHARP_F;                        \
  110. }
  111.  
  112. #define FASDUMP_TRANSPORT_RAW_COMPILED()                \
  113. {                                    \
  114.   TRANSPORT_RAW_COMPILED ();                        \
  115.   if ((mode == 2) && ((OBJECT_TYPE (*(To - 1))) == TC_ENVIRONMENT))    \
  116.     *(To - 1) = SHARP_F;                        \
  117. }
  118.  
  119. #define Dump_Compiled_Entry(label)                    \
  120. {                                    \
  121.   Dump_Pointer                                \
  122.     (Fasdump_Setup_Aligned (Fasdump_Transport_Compiled (),        \
  123.                 Compiled_BH (false, goto label)));        \
  124. }
  125.  
  126. #define DUMP_RAW_COMPILED_ENTRY(label)                    \
  127. {                                    \
  128.   DUMP_RAW_POINTER                            \
  129.     (Fasdump_Setup_Aligned (FASDUMP_TRANSPORT_RAW_COMPILED (),        \
  130.                 RAW_COMPILED_BH (false,            \
  131.                          goto label)));        \
  132. }
  133.  
  134. /* Should be big enough for the largest fixed size object (a Quad)
  135.    and 2 for the Fixup.
  136.  */
  137.  
  138. #define FASDUMP_FIX_BUFFER 10
  139.  
  140. long
  141. DEFUN (DumpLoop, (Scan, mode), fast SCHEME_OBJECT * Scan AND int mode)
  142. {
  143.   fast SCHEME_OBJECT *To, *Old, Temp, New_Address, *Fixes;
  144.   long result;
  145. #ifdef ENABLE_GC_DEBUGGING_TOOLS
  146.   SCHEME_OBJECT object_referencing;
  147. #endif
  148.  
  149.   To = NewFree;
  150.   Fixes = Fixup;
  151.  
  152.   for ( ; Scan != To; Scan++)
  153.   {
  154.     Temp = *Scan;
  155. #ifdef ENABLE_GC_DEBUGGING_TOOLS
  156.     object_referencing = Temp;
  157. #endif
  158.  
  159.     Switch_by_GC_Type (Temp)
  160.     {
  161.       case TC_PRIMITIVE:
  162.       case TC_PCOMB0:
  163.         * Scan = (dump_renumber_primitive (* Scan));
  164.     break;
  165.  
  166.       case TC_BROKEN_HEART:
  167.         if ((OBJECT_DATUM (Temp)) != 0)
  168.     {
  169.       sprintf (gc_death_message_buffer,
  170.            "dumploop: broken heart (0x%lx) in scan",
  171.            ((long) Temp));
  172.       gc_death (TERM_BROKEN_HEART, gc_death_message_buffer, Scan, To);
  173.       /*NOTREACHED*/
  174.     }
  175.     break;
  176.  
  177.       case TC_MANIFEST_NM_VECTOR:
  178.       case TC_MANIFEST_SPECIAL_NM_VECTOR:
  179.     Scan += (OBJECT_DATUM (Temp));
  180.     break;
  181.  
  182.       /* Compiled code relocation. */
  183.  
  184.       case_compiled_entry_point:
  185.     compiled_code_present_p = true;
  186.     Dump_Compiled_Entry (after_entry);
  187.       after_entry:
  188.     * Scan = Temp;
  189.     break;
  190.  
  191.       case TC_MANIFEST_CLOSURE:
  192.       {
  193.     fast long count;
  194.     fast char * word_ptr;
  195.     SCHEME_OBJECT * area_end;
  196.  
  197.     compiled_code_present_p = true;
  198.     START_CLOSURE_RELOCATION (Scan);
  199.     Scan += 1;
  200.     count = (MANIFEST_CLOSURE_COUNT (Scan));
  201.     word_ptr = (FIRST_MANIFEST_CLOSURE_ENTRY (Scan));
  202.     area_end = (MANIFEST_CLOSURE_END (Scan, count));
  203.  
  204.     while ((--count) >= 0)
  205.     {
  206.       Scan = ((SCHEME_OBJECT *) (word_ptr));
  207.       word_ptr = (NEXT_MANIFEST_CLOSURE_ENTRY (word_ptr));
  208.       EXTRACT_CLOSURE_ENTRY_ADDRESS (Temp, Scan);
  209.       DUMP_RAW_COMPILED_ENTRY (after_closure);
  210.     after_closure:
  211.       STORE_CLOSURE_ENTRY_ADDRESS (Temp, Scan);
  212.     }
  213.     Scan = area_end;
  214.     END_CLOSURE_RELOCATION (Scan);
  215.     break;
  216.       }
  217.  
  218.       case TC_LINKAGE_SECTION:
  219.       {
  220.     compiled_code_present_p = true;
  221.     switch (READ_LINKAGE_KIND (Temp))
  222.     {
  223.       case REFERENCE_LINKAGE_KIND:
  224.       case ASSIGNMENT_LINKAGE_KIND:
  225.       {
  226.         /* Assumes that all others are objects of type TC_QUAD without
  227.            their type codes.
  228.          */
  229.  
  230.         fast long count;
  231.  
  232.         Scan++;
  233.         for (count = (READ_CACHE_LINKAGE_COUNT (Temp));
  234.          --count >= 0;
  235.          Scan += 1)
  236.         {
  237.           Temp = (* Scan);
  238.           DUMP_RAW_POINTER (Fasdump_Setup_Pointer
  239.                 (TRANSPORT_RAW_QUADRUPLE (),
  240.                  RAW_BH (false, continue)));
  241.         }
  242.         Scan -= 1;
  243.         break;
  244.       }
  245.  
  246.       case OPERATOR_LINKAGE_KIND:
  247.       case GLOBAL_OPERATOR_LINKAGE_KIND:
  248.       {
  249.         fast long count;
  250.         fast char * word_ptr;
  251.         SCHEME_OBJECT * end_scan;
  252.  
  253.         START_OPERATOR_RELOCATION (Scan);
  254.         count = (READ_OPERATOR_LINKAGE_COUNT (Temp));
  255.         word_ptr = (FIRST_OPERATOR_LINKAGE_ENTRY (Scan));
  256.         end_scan = (END_OPERATOR_LINKAGE_AREA (Scan, count));
  257.  
  258.         while (--count >= 0)
  259.         {
  260.           Scan = ((SCHEME_OBJECT *) (word_ptr));
  261.           word_ptr = (NEXT_LINKAGE_OPERATOR_ENTRY (word_ptr));
  262.           EXTRACT_OPERATOR_LINKAGE_ADDRESS (Temp, Scan);
  263.           DUMP_RAW_COMPILED_ENTRY (after_operator);
  264.         after_operator:
  265.           STORE_OPERATOR_LINKAGE_ADDRESS (Temp, Scan);
  266.         }
  267.         Scan = end_scan;
  268.         END_OPERATOR_RELOCATION (Scan);
  269.         break;
  270.       }
  271.  
  272.       case CLOSURE_PATTERN_LINKAGE_KIND:
  273.         Scan += (READ_CACHE_LINKAGE_COUNT (Temp));
  274.         break;
  275.  
  276.       default:
  277.       {
  278.         gc_death (TERM_EXIT,
  279.               "fasdump: Unknown compiler linkage kind.",
  280.               Scan, Free);
  281.         /*NOTREACHED*/
  282.       }
  283.     }
  284.     break;
  285.       }
  286.  
  287.       case_Cell:
  288.     Setup_Pointer_for_Dump (Transport_Cell ());
  289.     break;
  290.  
  291.       case TC_REFERENCE_TRAP:
  292.     if ((OBJECT_DATUM (Temp)) <= TRAP_MAX_IMMEDIATE)
  293.     {
  294.       /* It is a non pointer. */
  295.       break;
  296.     }
  297.     /* Fall through. */
  298.  
  299.       case TC_WEAK_CONS:
  300.       case_Fasdump_Pair:
  301.     Setup_Pointer_for_Dump (Transport_Pair ());
  302.     break;
  303.  
  304.       case TC_INTERNED_SYMBOL:
  305.     Setup_Pointer_for_Dump (Fasdump_Symbol (BROKEN_HEART_ZERO));
  306.     break;
  307.  
  308.       case TC_UNINTERNED_SYMBOL:
  309.     Setup_Pointer_for_Dump (Fasdump_Symbol (UNBOUND_OBJECT));
  310.     break;
  311.  
  312.       case_Triple:
  313.     Setup_Pointer_for_Dump (Transport_Triple ());
  314.     break;
  315.  
  316.       case TC_VARIABLE:
  317.     Setup_Pointer_for_Dump (Fasdump_Variable ());
  318.     break;
  319.  
  320.       case_Quadruple:
  321.     Setup_Pointer_for_Dump (Transport_Quadruple ());
  322.     break;
  323.  
  324.       case_Aligned_Vector:
  325.     Dump_Pointer (Fasdump_Setup_Aligned (goto Move_Vector,
  326.                          Normal_BH (false, continue)));
  327.     break;
  328.  
  329.       case_Purify_Vector:
  330.       process_vector:
  331.     Setup_Pointer_for_Dump (Transport_Vector ());
  332.     break;
  333.  
  334.       case TC_ENVIRONMENT:
  335.     if (mode == 1)
  336.       goto process_vector;
  337.     /* Make fasdump fail */
  338.     result = ERR_FASDUMP_ENVIRONMENT;
  339.     goto exit_dumploop;
  340.  
  341.       case TC_FUTURE:
  342.     Setup_Pointer_for_Dump (Transport_Future ());
  343.     break;
  344.  
  345.       default:
  346.     GC_BAD_TYPE ("dumploop", Temp);
  347.     /* Fall Through */
  348.  
  349.       case TC_STACK_ENVIRONMENT:
  350.       case_Fasload_Non_Pointer:
  351.     break;
  352.       }
  353.   }
  354.   result = PRIM_DONE;
  355.  
  356. exit_dumploop:
  357.   NewFree = To;
  358.   Fixup = Fixes;
  359.   return (result);
  360. }
  361.  
  362. #define DUMPLOOP(obj, mode)                        \
  363. {                                    \
  364.   long value;                                \
  365.                                     \
  366.   value = (DumpLoop (obj, mode));                    \
  367.   if (value != PRIM_DONE)                        \
  368.   {                                    \
  369.     PRIMITIVE_RETURN (Fasdump_Exit (value, false));            \
  370.   }                                    \
  371. }
  372.  
  373. #define FASDUMP_INTERRUPT()                        \
  374. {                                    \
  375.   PRIMITIVE_RETURN (Fasdump_Exit (PRIM_INTERRUPT, false));        \
  376. }
  377.  
  378. SCHEME_OBJECT
  379. DEFUN (Fasdump_Exit, (code, close_p), long code AND Boolean close_p)
  380. {
  381.   Boolean result;
  382.   fast SCHEME_OBJECT *Fixes;
  383.  
  384.   Fixes = Fixup;
  385.   if (close_p)
  386.     OS_channel_close_noerror (dump_channel);
  387.  
  388.   result = true;
  389.   while (Fixes != NewMemTop)
  390.   {
  391.     fast SCHEME_OBJECT *Fix_Address;
  392.  
  393.     Fix_Address = (OBJECT_ADDRESS (*Fixes++)); /* Where it goes. */
  394.     *Fix_Address = *Fixes++;             /* Put it there. */
  395.   }
  396.   Fixup = Fixes;
  397.   if ((close_p) && ((!result) || (code != PRIM_DONE)))
  398.     OS_file_remove (dump_file_name);
  399.  
  400.   dump_file_name = ((char *) 0);
  401.   Fasdump_Exit_Hook ();
  402.   if (!result)
  403.   {
  404.     signal_error_from_primitive (ERR_IO_ERROR);
  405.     /*NOTREACHED*/
  406.     return (0);
  407.   }
  408.   if (code == PRIM_DONE)
  409.     return (SHARP_T);
  410.   else if (code == PRIM_INTERRUPT)
  411.     return (SHARP_F);
  412.   else
  413.   {
  414.     signal_error_from_primitive (code);
  415.     /*NOTREACHED*/
  416.     return (0);
  417.   }
  418. }
  419.  
  420. /* (PRIMITIVE-FASDUMP object-to-dump filename-or-channel flag)
  421.  
  422.    Dump an object into a file so that it can be loaded using
  423.    BINARY-FASLOAD.  A spare heap is required for this operation.  The
  424.    first argument is the object to be dumped.  The second is the
  425.    filename or channel.  The primitive returns #T or #F indicating
  426.    whether it successfully dumped the object (it can fail on an object
  427.    that is too large).  It should signal an error rather than return
  428.    false, but ... some other time.
  429.  
  430.    The third argument, FLAG, specifies how to handle the dumping of
  431.    environment objects:
  432.    - SHARP_F means that it is an error to dump an object containing
  433.    environment objects.
  434.    - SHARP_T means that they should be dumped as if they were ordinary
  435.    objects.
  436.    - anything else means that the environment objects pointed at by
  437.    compiled code blocks should be eliminated on the dumped copy,
  438.    but other environments are not allowed.
  439. */
  440.  
  441. DEFINE_PRIMITIVE ("PRIMITIVE-FASDUMP", Prim_prim_fasdump, 3, 3, 0)
  442. {
  443.   Tchannel channel = NO_CHANNEL;
  444.   Boolean arg_string_p;
  445.   SCHEME_OBJECT Object, *New_Object, arg2, flag;
  446.   SCHEME_OBJECT * prim_table_start, * prim_table_end;
  447.   long Length, prim_table_length;
  448.   Boolean result;
  449.   PRIMITIVE_HEADER (3);
  450.  
  451.   Object = (ARG_REF (1));
  452.   arg2 = (ARG_REF (2));
  453.   arg_string_p = (STRING_P (arg2));
  454.   if (!arg_string_p)
  455.     channel = (arg_channel (2));
  456.   flag = (ARG_REF (3));
  457.  
  458.   compiled_code_present_p = false;
  459.  
  460.   prim_table_end = &Free[(Space_Before_GC ())];
  461.   prim_table_start = (initialize_primitive_table (Free, prim_table_end));
  462.   if (prim_table_start >= prim_table_end)
  463.     Primitive_GC (prim_table_start - Free);
  464.  
  465.   Fasdump_Free_Calc (NewFree, NewMemTop);
  466.   Fixup = NewMemTop;
  467.   ALIGN_FLOAT (NewFree);
  468.   New_Object = NewFree;
  469.   *NewFree++ = Object;
  470.  
  471.   if (arg_string_p)
  472.   {
  473.     /* This needs to be done before Fasdump_Exit is called.
  474.        DUMPLOOP may do that.
  475.        It should not be done if the primitive will not call
  476.        Fasdump_Exit on its way out (ie. Primitive_GC above).
  477.      */
  478.     dump_file_name = ((CONST char *) (STRING_LOC (arg2, 0)));
  479.   }
  480.  
  481.   DUMPLOOP (New_Object,
  482.         ((flag == SHARP_F) ? 0 : ((flag == SHARP_T) ? 1 : 2)));
  483.   Length = (NewFree - New_Object);
  484.   prim_table_start = NewFree;
  485.   prim_table_end = (cons_primitive_table (NewFree, Fixup, &prim_table_length));
  486.   if (prim_table_end >= Fixup)
  487.     FASDUMP_INTERRUPT ();
  488.  
  489. #ifdef NATIVE_CODE_IS_C
  490.  
  491.   /* Cannot dump C compiled code. */
  492.  
  493.   if (compiled_code_present_p)
  494.     PRIMITIVE_RETURN (Fasdump_Exit (ERR_COMPILED_CODE_ERROR, false));
  495.  
  496. #endif /* NATIVE_CODE_IS_C */
  497.  
  498.   if (arg_string_p)
  499.   {
  500.     channel = (OS_open_dump_file (dump_file_name));
  501.     if (channel == NO_CHANNEL)
  502.       PRIMITIVE_RETURN (Fasdump_Exit (ERR_ARG_2_BAD_RANGE, false));
  503.   }
  504.  
  505.   dump_channel = channel;
  506.   result = (Write_File (New_Object,
  507.             Length, New_Object,
  508.             0, Constant_Space,
  509.             prim_table_start, prim_table_length,
  510.             ((long) (prim_table_end - prim_table_start)),
  511.             prim_table_end, 0, 0,
  512.             compiled_code_present_p, false));
  513.  
  514.   PRIMITIVE_RETURN (Fasdump_Exit ((result ? PRIM_DONE : PRIM_INTERRUPT),
  515.                   arg_string_p));
  516. }
  517.  
  518. /* (DUMP-BAND PROCEDURE FILE-NAME)
  519.    Saves all of the heap and pure space on FILE-NAME.  When the
  520.    file is loaded back using BAND_LOAD, PROCEDURE is called with an
  521.    argument of #F.
  522. */
  523.  
  524. DEFINE_PRIMITIVE ("DUMP-BAND", Prim_band_dump, 2, 2, 0)
  525. {
  526.   SCHEME_OBJECT
  527.     Combination, * saved_free,
  528.     * prim_table_start, * prim_table_end,
  529.     * c_table_start, * c_table_end;
  530.   long
  531.     prim_table_length,
  532.     c_table_length;
  533.   Boolean result = false;
  534.   PRIMITIVE_HEADER (2);
  535.  
  536.   Band_Dump_Permitted ();
  537.   CHECK_ARG (1, INTERPRETER_APPLICABLE_P);
  538.   CHECK_ARG (2, STRING_P);
  539.   if (Unused_Heap_Bottom < Heap_Bottom)
  540.     /* Cause the image to be in the low heap, to increase
  541.        the probability that no relocation is needed on reload. */
  542.     Primitive_GC (0);
  543.   Primitive_GC_If_Needed (5);
  544.   saved_free = Free;
  545.   Combination = (MAKE_POINTER_OBJECT (TC_COMBINATION_1, Free));
  546.   Free[COMB_1_FN] = (ARG_REF (1));
  547.   Free[COMB_1_ARG_1] = SHARP_F;
  548.   Free += 2;
  549.   (* Free++) = Combination;
  550.   (* Free++) = compiler_utilities;
  551.   (* Free) = (MAKE_POINTER_OBJECT (TC_LIST, (Free - 2)));
  552.   Free ++;  /* Some compilers are TOO clever about this and increment Free
  553.           before calculating Free-2! */
  554.   prim_table_start = Free;
  555.   prim_table_end = (cons_whole_primitive_table (prim_table_start,
  556.                         Heap_Top,
  557.                         &prim_table_length));
  558.   if (prim_table_end >= Heap_Top)
  559.     goto done;
  560.  
  561.   c_table_start = prim_table_end;
  562.   c_table_end = (cons_c_code_table (c_table_start, Heap_Top, &c_table_length));
  563.   if (c_table_end >= Heap_Top)
  564.     goto done;
  565.  
  566.   {
  567.     SCHEME_OBJECT * faligned_heap, * faligned_constant;
  568.     CONST char * filename = ((CONST char *) (STRING_LOC ((ARG_REF (2)), 0)));
  569.  
  570.     OS_file_remove_link (filename);
  571.     dump_channel = (OS_open_dump_file (filename));
  572.     if (dump_channel == NO_CHANNEL)
  573.       error_bad_range_arg (2);
  574.  
  575.     for (faligned_heap = Heap_Bottom;
  576.      (! (FLOATING_ALIGNED_P (faligned_heap)));
  577.      faligned_heap += 1)
  578.       ;
  579.     
  580.     for (faligned_constant = Constant_Space;
  581.      (! (FLOATING_ALIGNED_P (faligned_constant)));
  582.      faligned_constant += 1)
  583.       ;
  584.  
  585.     result = (Write_File ((Free - 1),
  586.               ((long) (Free - faligned_heap)),
  587.               faligned_heap,
  588.               ((long) (Free_Constant - faligned_constant)),
  589.               faligned_constant,
  590.               prim_table_start, prim_table_length,
  591.               ((long) (prim_table_end - prim_table_start)),
  592.               c_table_start, c_table_length,
  593.               ((long) (c_table_end - c_table_start)),
  594.               (compiler_utilities != SHARP_F), true));
  595.     OS_channel_close_noerror (dump_channel);
  596.     if (! result)
  597.       OS_file_remove (filename);
  598.   }
  599.  
  600. done:
  601.   Band_Dump_Exit_Hook ();
  602.   Free = saved_free;
  603.   PRIMITIVE_RETURN (BOOLEAN_TO_OBJECT (result));
  604. }
  605.