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 / dump.c < prev    next >
C/C++ Source or Header  |  1999-01-02  |  8KB  |  233 lines
  1. /* -*-C-*-
  2.  
  3. $Id: dump.c,v 9.40 1999/01/02 06:11:34 cph Exp $
  4.  
  5. Copyright (c) 1987-1999 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 common code for dumping internal format binary files. */
  23.  
  24. #ifndef PSBMAP_H_INCLUDED
  25. extern long
  26.   compiler_interface_version,
  27.   compiler_processor_type;
  28.  
  29. extern SCHEME_OBJECT
  30.   compiler_utilities;
  31. #endif /* PSBMAP_H_INCLUDED */
  32.  
  33. void
  34. DEFUN (prepare_dump_header, (Buffer, Dumped_Object,
  35.                  Heap_Count, Heap_Relocation,
  36.                  Constant_Count, Constant_Relocation,
  37.                  prim_table_length, prim_table_size,
  38.                  c_table_length, c_table_size,
  39.                  cc_code_p, band_p),
  40.        SCHEME_OBJECT * Buffer
  41.        AND SCHEME_OBJECT * Dumped_Object
  42.        AND long Heap_Count
  43.        AND SCHEME_OBJECT * Heap_Relocation
  44.        AND long Constant_Count
  45.        AND SCHEME_OBJECT * Constant_Relocation
  46.        AND long prim_table_length
  47.        AND long prim_table_size
  48.        AND long c_table_length
  49.        AND long c_table_size
  50.        AND Boolean cc_code_p
  51.        AND Boolean band_p)
  52. {
  53.   long i;
  54.  
  55. #ifdef DEBUG
  56.  
  57. #ifndef HEAP_IN_LOW_MEMORY
  58.   fprintf(stderr, "\nmemory_base = 0x%lx\n", ((long) memory_base));
  59. #endif /* HEAP_IN_LOW_MEMORY */
  60.  
  61.   fprintf(stderr, "\nHeap_Relocation=0x%lx, dumped as 0x%lx\n",
  62.       ((long) Heap_Relocation),
  63.       ((long) (MAKE_POINTER_OBJECT (TC_BROKEN_HEART, Heap_Relocation))));
  64.   fprintf(stderr, "\nDumped object=0x%lx, dumped as 0x%lx\n",
  65.       ((long) Dumped_Object),
  66.       ((long) (MAKE_POINTER_OBJECT (TC_BROKEN_HEART, Dumped_Object))));
  67. #endif /* DEBUG */
  68.  
  69.   Buffer[FASL_Offset_Marker] = FASL_FILE_MARKER;
  70.   Buffer[FASL_Offset_Heap_Count] =
  71.     MAKE_OBJECT (TC_BROKEN_HEART, Heap_Count);
  72.   Buffer[FASL_Offset_Heap_Base] =
  73.     MAKE_POINTER_OBJECT (TC_BROKEN_HEART, Heap_Relocation);
  74.   Buffer[FASL_Offset_Dumped_Obj] =
  75.     MAKE_POINTER_OBJECT (TC_BROKEN_HEART, Dumped_Object);
  76.   Buffer[FASL_Offset_Const_Count] =
  77.     MAKE_OBJECT (TC_BROKEN_HEART, Constant_Count);
  78.   Buffer[FASL_Offset_Const_Base] =
  79.     MAKE_POINTER_OBJECT (TC_BROKEN_HEART, Constant_Relocation);
  80.   Buffer[FASL_Offset_Version] =
  81.     Make_Version(FASL_FORMAT_VERSION,
  82.          FASL_SUBVERSION, FASL_INTERNAL_FORMAT);
  83.   Buffer[FASL_Offset_Stack_Top] =
  84. #ifdef USE_STACKLETS
  85.     MAKE_OBJECT (TC_BROKEN_HEART, 0);    /* Nothing in stack area */
  86. #else
  87.     MAKE_POINTER_OBJECT (TC_BROKEN_HEART, Stack_Top);
  88. #endif /* USE_STACKLETS */
  89.  
  90.   Buffer[FASL_Offset_Prim_Length] =
  91.     MAKE_OBJECT (TC_BROKEN_HEART, prim_table_length);
  92.   Buffer[FASL_Offset_Prim_Size] =
  93.     MAKE_OBJECT (TC_BROKEN_HEART, prim_table_size);
  94.  
  95.   if (cc_code_p)
  96.   {
  97.     Buffer[FASL_Offset_Ci_Version] =
  98.       MAKE_CI_VERSION(band_p,
  99.               compiler_interface_version,
  100.               compiler_processor_type);
  101.     Buffer[FASL_Offset_Ut_Base] = compiler_utilities;
  102.   }
  103.   else
  104.   {
  105.     /* If there is no compiled code in the file,
  106.        flag it as if dumped without compiler support, so
  107.        it can be loaded anywhere.
  108.      */
  109.     Buffer[FASL_Offset_Ci_Version] = (MAKE_CI_VERSION (band_p, 0, 0));
  110.     Buffer[FASL_Offset_Ut_Base] = SHARP_F;
  111.   }
  112.  
  113.   Buffer[FASL_Offset_C_Length] =
  114.     MAKE_OBJECT (TC_BROKEN_HEART, c_table_length);
  115.   Buffer[FASL_Offset_C_Size] =
  116.     MAKE_OBJECT (TC_BROKEN_HEART, c_table_size);
  117.  
  118. #ifdef HEAP_IN_LOW_MEMORY
  119.   Buffer[FASL_Offset_Mem_Base] = ((SCHEME_OBJECT) 0);
  120. #else /* not HEAP_IN_LOW_MEMORY */
  121.   Buffer[FASL_Offset_Mem_Base] = ((SCHEME_OBJECT) memory_base);
  122. #endif /* HEAP_IN_LOW_MEMORY */
  123.  
  124.   Buffer[FASL_Offset_Check_Sum] = SHARP_F;
  125.   for (i = FASL_Offset_First_Free; i < FASL_HEADER_LENGTH; i++)
  126.     Buffer[i] = SHARP_F;
  127.   return;
  128. }
  129.  
  130. extern unsigned long
  131.   EXFUN (checksum_area, (unsigned long *, long, unsigned long));
  132.  
  133. Boolean
  134. DEFUN (Write_File, (Dumped_Object, Heap_Count, Heap_Relocation,
  135.             Constant_Count, Constant_Relocation,
  136.             prim_table_start, prim_table_length, prim_table_size,
  137.             c_table_start, c_table_length, c_table_size,
  138.             cc_code_p, band_p),
  139.        SCHEME_OBJECT * Dumped_Object
  140.        AND long Heap_Count
  141.        AND SCHEME_OBJECT * Heap_Relocation
  142.        AND long Constant_Count
  143.        AND SCHEME_OBJECT * Constant_Relocation
  144.        AND SCHEME_OBJECT * prim_table_start
  145.        AND long prim_table_length
  146.        AND long prim_table_size
  147.        AND SCHEME_OBJECT * c_table_start
  148.        AND long c_table_length
  149.        AND long c_table_size
  150.        AND Boolean cc_code_p
  151.        AND Boolean band_p)
  152. {
  153.   SCHEME_OBJECT Buffer[FASL_HEADER_LENGTH];
  154.   unsigned long checksum;
  155.  
  156.   prepare_dump_header (Buffer, Dumped_Object,
  157.                Heap_Count, Heap_Relocation,
  158.                Constant_Count, Constant_Relocation,
  159.                prim_table_length, prim_table_size,
  160.                c_table_length, c_table_size,
  161.                cc_code_p, band_p);
  162.  
  163.   /* This is not done in prepare_dump_header because it doesn't
  164.      work when prepare_dump_header is invoked from bchdmp.
  165.      The areas don't really have these values.
  166.      For the time being, bchdmp does not dump checksums.
  167.    */
  168.  
  169.   checksum = (checksum_area (((unsigned long *) (&Buffer[0])),
  170.                  ((long) FASL_Offset_Check_Sum),
  171.                  ((unsigned long) 0L)));
  172.   checksum = (checksum_area (((unsigned long *)
  173.                   (&Buffer[FASL_Offset_Check_Sum + 1])),
  174.                  ((long) ((FASL_HEADER_LENGTH - 1) -
  175.                       FASL_Offset_Check_Sum)),
  176.                  checksum));
  177.   checksum = (checksum_area (((unsigned long *) Heap_Relocation),
  178.                  Heap_Count,
  179.                  checksum));
  180.   checksum = (checksum_area (((unsigned long *) Constant_Relocation),
  181.                  Constant_Count,
  182.                  checksum));
  183.   checksum = (checksum_area (((unsigned long *) prim_table_start),
  184.                  prim_table_size,
  185.                  checksum));
  186.   checksum = (checksum_area (((unsigned long *) c_table_start),
  187.                  c_table_size,
  188.                  checksum));
  189.  
  190.   Buffer[FASL_Offset_Check_Sum] = checksum;
  191.  
  192.   if ((Write_Data (FASL_HEADER_LENGTH, Buffer))
  193.       != FASL_HEADER_LENGTH)
  194.     return (false);
  195.  
  196.   if ((Heap_Count != 0)
  197.       && ((Write_Data (Heap_Count, Heap_Relocation))
  198.       != Heap_Count))
  199.     return (false);
  200.  
  201.   if ((Constant_Count != 0)
  202.       && ((Write_Data (Constant_Count, Constant_Relocation))
  203.       != Constant_Count))
  204.     return (false);
  205.  
  206.   if ((prim_table_size != 0)
  207.       && ((Write_Data (prim_table_size, prim_table_start))
  208.       != prim_table_size))
  209.       return (false);
  210.  
  211.   if ((c_table_size != 0)
  212.       && ((Write_Data (c_table_size, c_table_start))
  213.       != c_table_size))
  214.       return (false);
  215.  
  216.   return (true);
  217. }
  218.  
  219. unsigned long
  220. DEFUN (checksum_area, (start, count, initial_value),
  221.        register unsigned long * start
  222.        AND register long count
  223.        AND unsigned long initial_value)
  224. {
  225.   register unsigned long value;
  226.  
  227.   value = initial_value;
  228.   while ((--count) >= 0)
  229.     value = (value ^ (*start++));
  230.   return (value);
  231. }
  232.  
  233.