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 / load.c < prev    next >
C/C++ Source or Header  |  1999-01-02  |  10KB  |  316 lines
  1. /* -*-C-*-
  2.  
  3. $Id: load.c,v 9.39 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 reading internal
  23.    format binary files. */
  24.  
  25. #include "fasl.h"
  26.  
  27. #define FASL_FILE_FINE            0
  28. #define FASL_FILE_TOO_SHORT        1
  29. #define FASL_FILE_NOT_FASL        2
  30. #define FASL_FILE_BAD_MACHINE        3
  31. #define FASL_FILE_BAD_VERSION        4
  32. #define FASL_FILE_BAD_SUBVERSION    5
  33. #define FASL_FILE_BAD_PROCESSOR        6
  34. #define FASL_FILE_BAD_INTERFACE        7
  35.  
  36. #ifndef BYTE_INVERSION
  37.  
  38. #define NORMALIZE_HEADER(header, size, base, count)
  39. #define NORMALIZE_REGION(region, size)
  40.  
  41. #else /* BYTE_INVERSION */
  42.  
  43. void
  44.   EXFUN (Byte_Invert_Region, (long *, long)),
  45.   EXFUN (Byte_Invert_Header, (long *, long, long, long));
  46.  
  47. #define NORMALIZE_HEADER Byte_Invert_Header
  48. #define NORMALIZE_REGION Byte_Invert_Region
  49.  
  50. #endif /* BYTE_INVERSION */
  51.  
  52. /* Static storage for some shared variables */
  53.  
  54. static Boolean
  55.   band_p;
  56.  
  57. static long
  58.   Machine_Type, Version, Sub_Version,
  59.   Dumped_Object, Dumped_Stack_Top,
  60.   Heap_Base, Heap_Count,
  61.   Const_Base, Const_Count,
  62.   Dumped_Heap_Top, Dumped_Constant_Top,
  63.   Primitive_Table_Size, Primitive_Table_Length,
  64.   C_Code_Table_Size, C_Code_Table_Length,
  65.   dumped_processor_type, dumped_interface_version,
  66.   dumped_memory_base;
  67.  
  68. static unsigned long
  69.   dumped_checksum, computed_checksum;
  70.  
  71. static SCHEME_OBJECT
  72.   Ext_Prim_Vector,
  73.   dumped_utilities;
  74.  
  75. void
  76. DEFUN_VOID (print_fasl_information)
  77. {
  78.   printf ("FASL File Information:\n\n");
  79.   printf ("Machine = %ld; Version = %ld; Subversion = %ld\n",
  80.       Machine_Type, Version, Sub_Version);
  81.   if ((dumped_processor_type != 0) || (dumped_interface_version != 0))
  82.     printf ("Compiled code interface version = %ld; Processor type = %ld\n",
  83.         dumped_interface_version, dumped_processor_type);
  84.   if (band_p)
  85.     printf ("The file contains a dumped image (band).\n");
  86.  
  87.   printf ("\nRelocation Information:\n\n");
  88.   printf ("Heap Count = %ld; Heap Base = 0x%lx; Heap Top = 0x%lx\n",
  89.       Heap_Count, Heap_Base, Dumped_Heap_Top);
  90.   printf ("Const Count = %ld; Const Base = 0x%lx; Const Top = 0x%lx\n",
  91.       Const_Count, Const_Base, Dumped_Constant_Top);
  92.   printf ("Stack Top = 0x%lx\n", Dumped_Stack_Top);
  93.  
  94.   printf ("\nDumped Objects:\n\n");
  95.   printf ("Dumped object at 0x%lx (as read from file)\n", Dumped_Object);
  96.   printf ("Compiled code utilities vector = 0x%lx\n", dumped_utilities);
  97.   if (Ext_Prim_Vector != SHARP_F)
  98.     printf ("External primitives vector = 0x%lx\n", Ext_Prim_Vector);
  99.   else
  100.     printf ("Length of primitive table = %ld\n", Primitive_Table_Length);
  101.   printf ("Length of C table = %ld\n", C_Code_Table_Length);
  102.   printf ("Checksum = 0x%lx\n", dumped_checksum);
  103.   return;
  104. }
  105.  
  106. long
  107. DEFUN (initialize_variables_from_fasl_header, (buffer),
  108.        SCHEME_OBJECT * buffer)
  109. {
  110.   SCHEME_OBJECT Pointer_Heap_Base, Pointer_Const_Base;
  111.  
  112.   if (buffer[FASL_Offset_Marker] != FASL_FILE_MARKER)
  113.     return (FASL_FILE_NOT_FASL);
  114.  
  115.   NORMALIZE_HEADER (buffer,
  116.             (sizeof(buffer) / sizeof(SCHEME_OBJECT)),
  117.             buffer[FASL_Offset_Heap_Base],
  118.             buffer[FASL_Offset_Heap_Count]);
  119.   Heap_Count = OBJECT_DATUM (buffer[FASL_Offset_Heap_Count]);
  120.   Pointer_Heap_Base = buffer[FASL_Offset_Heap_Base];
  121.   Heap_Base = OBJECT_DATUM (Pointer_Heap_Base);
  122.   Dumped_Object = OBJECT_DATUM (buffer[FASL_Offset_Dumped_Obj]);
  123.   Const_Count = OBJECT_DATUM (buffer[FASL_Offset_Const_Count]);
  124.   Pointer_Const_Base = buffer[FASL_Offset_Const_Base];
  125.   Const_Base = OBJECT_DATUM (Pointer_Const_Base);
  126.   Version = The_Version(buffer[FASL_Offset_Version]);
  127.   Sub_Version = The_Sub_Version(buffer[FASL_Offset_Version]);
  128.   Machine_Type = The_Machine_Type(buffer[FASL_Offset_Version]);
  129.   Dumped_Stack_Top = OBJECT_DATUM (buffer[FASL_Offset_Stack_Top]);
  130.   Dumped_Heap_Top =
  131.     ADDRESS_TO_DATUM (MEMORY_LOC (Pointer_Heap_Base, Heap_Count));
  132.   Dumped_Constant_Top =
  133.     ADDRESS_TO_DATUM (MEMORY_LOC (Pointer_Const_Base, Const_Count));
  134.  
  135.   if (Version == FASL_FORMAT_ADDED_STACK && Sub_Version < FASL_MERGED_PRIMITIVES)
  136.   {
  137.     Primitive_Table_Length = 0;
  138.     Primitive_Table_Size = 0;
  139.     Ext_Prim_Vector =
  140.       (OBJECT_NEW_TYPE (TC_CELL, (buffer [FASL_Offset_Ext_Loc])));
  141.   }
  142.   else
  143.   {
  144.     Primitive_Table_Length = (OBJECT_DATUM (buffer[FASL_Offset_Prim_Length]));
  145.     Primitive_Table_Size = (OBJECT_DATUM (buffer[FASL_Offset_Prim_Size]));
  146.     Ext_Prim_Vector = SHARP_F;
  147.   }
  148.  
  149.   if (Version == FASL_FORMAT_ADDED_STACK && Sub_Version < FASL_INTERFACE_VERSION)
  150.   {
  151.     /* This may be all wrong, but... */
  152.     band_p = false;
  153.     dumped_processor_type = 0;
  154.     dumped_interface_version = 0;
  155.     dumped_utilities = SHARP_F;
  156.   }
  157.   else
  158.   {
  159.     SCHEME_OBJECT temp = buffer[FASL_Offset_Ci_Version];
  160.  
  161.     band_p = (CI_BAND_P (temp));
  162.     dumped_processor_type = (CI_PROCESSOR (temp));
  163.     dumped_interface_version = (CI_VERSION (temp));
  164.     dumped_utilities = buffer[FASL_Offset_Ut_Base];
  165.   }
  166.  
  167.   if (Version == FASL_FORMAT_ADDED_STACK && Sub_Version < FASL_C_CODE)
  168.   {
  169.     C_Code_Table_Length = 0;
  170.     C_Code_Table_Size = 0;
  171.   }
  172.   else
  173.   {
  174.     C_Code_Table_Length = (OBJECT_DATUM (buffer[FASL_Offset_C_Length]));
  175.     C_Code_Table_Size = (OBJECT_DATUM (buffer[FASL_Offset_C_Size]));
  176.   }
  177.   dumped_memory_base = ((long) buffer[FASL_Offset_Mem_Base]);
  178.  
  179. #ifndef INHIBIT_FASL_VERSION_CHECK
  180.   /* The error messages here should be handled by the runtime system! */
  181.  
  182.   if ((Version != FASL_READ_VERSION) ||
  183. #ifndef BYTE_INVERSION
  184.       (Machine_Type != FASL_INTERNAL_FORMAT) ||
  185. #endif
  186.       (Sub_Version < FASL_READ_SUBVERSION) ||
  187.       (Sub_Version > FASL_SUBVERSION))
  188.   {
  189.     outf_error ("\nread_file:\n");
  190.     outf_error ("FASL File: Version %4d Subversion %4d Machine Type %4d.\n",
  191.         Version, Sub_Version , Machine_Type);
  192.     outf_error ("Expected:  Version %4d Subversion %4d Machine Type %4d.\n",
  193.         FASL_READ_VERSION, FASL_READ_SUBVERSION, FASL_INTERNAL_FORMAT);
  194.  
  195.     return ((Machine_Type != FASL_INTERNAL_FORMAT)    ?
  196.         FASL_FILE_BAD_MACHINE            :
  197.         ((Version != FASL_READ_VERSION)        ?
  198.          FASL_FILE_BAD_VERSION            :
  199.          FASL_FILE_BAD_SUBVERSION));
  200.   }
  201.  
  202. #endif /* INHIBIT_FASL_VERSION_CHECK */
  203.  
  204. #ifndef INHIBIT_COMPILED_VERSION_CHECK
  205.  
  206.   /* Is the compiled code "loadable" here? */
  207.  
  208.   {
  209.     extern long compiler_processor_type, compiler_interface_version;
  210.  
  211.     if (((dumped_processor_type != 0) &&
  212.     (dumped_processor_type != compiler_processor_type)) ||
  213.     ((dumped_interface_version != 0) &&
  214.      (dumped_interface_version != compiler_interface_version)))
  215.     {
  216.       outf_error ("\nread_file:\n");
  217.       outf_error ("FASL File: compiled code interface %4d; processor %4d.\n",
  218.           dumped_interface_version, dumped_processor_type);
  219.       outf_error ("Expected:  compiled code interface %4d; processor %4d.\n",
  220.           compiler_interface_version, compiler_processor_type);
  221.       return (((dumped_processor_type != 0) &&
  222.            (dumped_processor_type != compiler_processor_type))    ?
  223.           FASL_FILE_BAD_PROCESSOR                    :
  224.           FASL_FILE_BAD_INTERFACE);
  225.     }
  226.   }
  227.  
  228. #endif /* INHIBIT_COMPILED_VERSION_CHECK */
  229.  
  230.   dumped_checksum = (buffer [FASL_Offset_Check_Sum]);
  231.  
  232. #ifndef INHIBIT_CHECKSUMS
  233.  
  234.   {
  235.     extern unsigned long
  236.       EXFUN (checksum_area, (unsigned long *, long, unsigned long));
  237.  
  238.     computed_checksum =
  239.       (checksum_area (((unsigned long *) &buffer[0]),
  240.               ((long) (FASL_HEADER_LENGTH)),
  241.               ((unsigned long) 0)));
  242.   }
  243.  
  244. #endif /* INHIBIT_CHECKSUMS */
  245.  
  246.   return (FASL_FILE_FINE);
  247. }
  248.  
  249. long
  250. DEFUN_VOID (Read_Header)
  251. {
  252.   SCHEME_OBJECT header[FASL_HEADER_LENGTH];
  253.  
  254.   if ((Load_Data (FASL_HEADER_LENGTH, header)) !=
  255.       FASL_HEADER_LENGTH)
  256.     return (FASL_FILE_TOO_SHORT);
  257.   return (initialize_variables_from_fasl_header (&header[0]));
  258. }
  259.  
  260. #ifdef HEAP_IN_LOW_MEMORY
  261.  
  262. #define SCHEME_ADDR_TO_OLD_DATUM(addr)                    \
  263.   (ADDRESS_TO_DATUM (SCHEME_ADDR_TO_ADDR ((SCHEME_OBJECT *) (addr))))
  264.  
  265. #else /* not HEAP_IN_LOW_MEMORY */
  266.  
  267. #define SCHEME_ADDR_TO_OLD_DATUM(addr)                    \
  268.   (((SCHEME_OBJECT *) (addr)) - ((SCHEME_OBJECT *) dumped_memory_base))
  269.  
  270. #endif /* HEAP_IN_LOW_MEMORY */
  271.  
  272. #ifdef BYTE_INVERSION
  273.  
  274. static Boolean Byte_Invert_Fasl_Files;
  275.  
  276. void
  277. DEFUN (Byte_Invert_Header, (Header, Headsize, Test1, Test2),
  278.        long * Header
  279.        AND long Headsize
  280.        AND long Test1
  281.        AND long Test2)
  282. {
  283.   Byte_Invert_Fasl_Files = false;
  284.  
  285.   if ((Test1 & 0xff) == TC_BROKEN_HEART &&
  286.       (Test2 & 0xff) == TC_BROKEN_HEART &&
  287.       (OBJECT_TYPE (Test1) != TC_BROKEN_HEART ||
  288.        OBJECT_TYPE (Test2) != TC_BROKEN_HEART))
  289.   {
  290.     Byte_Invert_Fasl_Files = true;
  291.     Byte_Invert_Region(Header, Headsize);
  292.   }
  293.   return;
  294. }
  295.  
  296. void
  297. DEFUN (Byte_Invert_Region, (Region, Size),
  298.        long * Region
  299.        AND long Size)
  300. {
  301.   register long word, size;
  302.  
  303.   if (Byte_Invert_Fasl_Files)
  304.   {
  305.     for (size = Size; size > 0; size--, Region++)
  306.     {
  307.       word = (*Region);
  308.       *Region = (((word>>24)&0xff) | ((word>>8)&0xff00) |
  309.          ((word<<8)&0xff0000) | ((word<<24)&0xff000000));
  310.     }
  311.   }
  312.   return;
  313. }
  314.  
  315. #endif /* BYTE_INVERSION */
  316.