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 / dmpwrld.c < prev    next >
C/C++ Source or Header  |  2000-12-05  |  5KB  |  242 lines
  1. /* -*-C-*-
  2.  
  3. $Id: dmpwrld.c,v 9.40 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 a primitive to dump an executable version of Scheme.
  23.    It uses unexec.c from GNU Emacs.
  24.    Look at unexec.c for more information. */
  25.  
  26. #include "scheme.h"
  27. #include "prims.h"
  28.  
  29. #ifndef __unix__
  30. #include "Error: dumpworld.c does not work on non-unix machines."
  31. #endif
  32.  
  33. #include "ux.h"
  34. #include "osfs.h"
  35. #include <sys/file.h>
  36.  
  37. /* Compatibility definitions for GNU Emacs's unexec.c.
  38.    Taken from the various m-*.h and s-*.h files for GNU Emacs.
  39. */
  40.  
  41. #define CANNOT_UNEXEC
  42.  
  43. #if defined (vax)
  44. #undef CANNOT_UNEXEC
  45. #endif
  46.  
  47. #if defined (hp9000s300) || defined (__hp9000s300)
  48. #undef CANNOT_UNEXEC
  49. #define ADJUST_EXEC_HEADER                           \
  50.   hdr.a_magic = ((ohdr.a_magic.file_type == OLDMAGIC.file_type) ?    \
  51.          NEWMAGIC : ohdr.a_magic);
  52. #endif
  53.  
  54. #if defined (hp9000s800) || defined (__hp9000s800)
  55. #undef CANNOT_UNEXEC
  56. #endif
  57.  
  58. #if defined (sun3)
  59. #undef CANNOT_UNEXEC
  60. #define SEGMENT_MASK        (SEGSIZ - 1)
  61. #define A_TEXT_OFFSET(HDR)    sizeof (HDR)
  62. #define TEXT_START        (PAGSIZ + (sizeof(struct exec)))
  63. #endif
  64.  
  65. /* I haven't tried any below this point. */
  66.  
  67. #if defined (umax)
  68. #undef CANNOT_UNEXEC
  69. #define HAVE_GETPAGESIZE
  70. #define COFF
  71. #define UMAX
  72. #define SECTION_ALIGNMENT    pagemask
  73. #define SEGMENT_MASK        (64 * 1024 - 1)
  74. #endif
  75.  
  76. #if defined (celerity)
  77. #undef CANNOT_UNEXEC
  78. #endif
  79.  
  80. #if defined (sun2)
  81. #undef CANNOT_UNEXEC
  82. #define SEGMENT_MASK        (SEGSIZ - 1)
  83. #endif
  84.  
  85. #if defined (pyr)
  86. #undef CANNOT_UNEXEC
  87. #define SEGMENT_MASK (2048-1)    /* ZMAGIC format */
  88.                 /* man a.out for info */
  89. #endif
  90.  
  91. #ifdef CANNOT_UNEXEC
  92. #include "Error: dmpwrld.c only works on a few machines."
  93. #endif
  94.  
  95. #ifndef TEXT_START
  96. #define TEXT_START    0
  97. #endif
  98.  
  99. #ifndef SEGMENT_MASK
  100. #define DATA_START    (&etext)
  101. #else
  102. #define DATA_START    \
  103. (((((unsigned) &etext) - 1) & ~SEGMENT_MASK) + (SEGMENT_MASK + 1))
  104. #endif
  105.  
  106. #if defined (__HPUX__)
  107. #define USG
  108. #define HPUX
  109. #endif
  110.  
  111. /* More compatibility definitions for unexec. */
  112.  
  113. extern int end, etext, edata;
  114.  
  115. char
  116. *start_of_text()
  117. {
  118.   return ((char *) TEXT_START);
  119. }
  120.  
  121. char
  122. *start_of_data()
  123. {
  124.   return ((char *) DATA_START);
  125. }
  126.  
  127. #if defined (USG) || defined (NO_BZERO)
  128.  
  129. #define bzero(b,len)    (memset((b), 0, (len)))
  130.  
  131. #else
  132.  
  133. extern void bzero();
  134.  
  135. #endif
  136.  
  137. #define static
  138.  
  139. #if defined (hp9000s800) || defined (__hp9000s800)
  140. #include "unexhp9k800.c"
  141. #else
  142. #include "unexec.c"
  143. #endif
  144.  
  145. #undef static
  146.  
  147. void
  148. DEFUN (unix_find_pathname, (program_name, target),
  149.        CONST char * program_name AND char * target)
  150. {
  151.   int length;
  152.   char
  153.     * path,
  154.     * next;
  155.   extern char *
  156.     EXFUN (index, (char * path AND char srchr));
  157.   extern void
  158.     EXFUN (strcpy, (char * target AND CONST char * source));
  159.  
  160.   /* Attempt first in the connected directory */
  161.  
  162.   if (((program_name[0]) == '/')
  163.       || (OS_file_access (program_name, X_OK))
  164.       || ((path = ((char *) (getenv ("PATH")))) == ((char *) NULL)))
  165.   {
  166.     strcpy (target, program_name);
  167.     return;
  168.   }
  169.   for (next = (index (path, ':'));
  170.        path != ((char *)  NULL);
  171.        path = (next + 1),
  172.        next = (index (path, ':')))
  173.   {
  174.     length = ((next == ((char *) NULL))
  175.           ? (strlen (path))
  176.           : (next-path));
  177.     strncpy (target, path, length);
  178.     target[length] = '/';
  179.     target[length + 1] = '\0';
  180.     strcpy ((target + (length + 1)), program_name);
  181.     if (OS_file_access (target, X_OK))
  182.     {
  183.       return;
  184.     }
  185.   }
  186.   strcpy (target, program_name);
  187.   return;
  188. }
  189.  
  190. /* The primitive visible from Scheme. */
  191.  
  192. extern Boolean scheme_dumped_p;
  193.  
  194. DEFINE_PRIMITIVE ("DUMP-WORLD", Prim_dump_world, 1, 1, 0)
  195. {
  196.   int result;
  197.   SCHEME_OBJECT arg;
  198.   Boolean saved_dumped_p;
  199.   char
  200.     * fname,
  201.     path_buffer[FILE_NAME_LENGTH];
  202.   PRIMITIVE_HEADER (1);
  203.  
  204.   PRIMITIVE_CANONICALIZE_CONTEXT();
  205.  
  206.   arg = (ARG_REF (1));
  207.   fname = (STRING_ARG (1));
  208.  
  209.   /* Set up for restore */
  210.  
  211.   saved_dumped_p = scheme_dumped_p;
  212.  
  213.   scheme_dumped_p = true;
  214.   Val = SHARP_T;
  215.   POP_PRIMITIVE_FRAME (1);
  216.  
  217.   /* Dump! */
  218.  
  219.   unix_find_pathname (scheme_program_name, path_buffer);
  220.   result = (unexec (fname,
  221.             path_buffer,
  222.             ((unsigned) 0),        /* default */
  223.             ((unsigned) 0),        /* default */
  224.             ((unsigned) start_of_text())));
  225.  
  226.   /* Restore State */
  227.  
  228.   Val = SHARP_F;
  229.   scheme_dumped_p = saved_dumped_p;
  230.  
  231.   /* IO: Restoring cached input for this job. */
  232.  
  233.   if (result != 0)
  234.   {
  235.     STACK_PUSH (arg);
  236.     error_external_return ();
  237.   }
  238.  
  239.   PRIMITIVE_ABORT (PRIM_POP_RETURN);
  240.   /*NOTREACHED*/
  241. }
  242.