[comp.lang.scheme] sources.shar

hartzell@boulder.colorado.edu (George Hartzell) (12/05/89)

Here is the shar file of the changes to the src files needed to get
ELK running on the MIPS.  There are three other postings: a
README.MIPS and two patches[12].shar.

--------------------------------cut here---------------------------------
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#	README.MIPS
#	alloca.s.mips
#	dumpmips.c
#	loadmips.c
#	stabmips.c
#	stack.s.mips
# This archive created: Mon Dec  4 11:12:33 1989
export PATH; PATH=/bin:$PATH
echo shar: extracting "'README.MIPS'" '(6112 characters)'
if test -f 'README.MIPS'
then
	echo shar: will not over-write existing file "'README.MIPS'"
else
sed 's/^	X//' << \SHAR_EOF > 'README.MIPS'
	X
	XHere are the changes necessary to get ELK to run on MIPS systems.
	XThis work was done in the bsd43 environment under RISCos 4.01 on a
	XMIPS M-2000.  You *must* use the 2.10 compiler release (I used a beta
	Xcopy) because previous releases don't support a stack-extending alloca
	X(see below).  One should be able to build it with gcc, but I haven't
	Xtried it yet.  This stuff should also be a good starting point for ELK
	Xon the DECstation (I think that DEC is just about to release the 2.00
	Xcompilers, so you'll have to use gcc or wait a bit longer for the 2.10
	Xsuite).
	X
	XThe following features work:
	X	- the basic interpreter.
	X	- dumping preloaded executables.
	X	- dynamically loading object files (see below).
	X	- The xlib interface (if you have -G 0 compiled version of the
	X	  X libraries.  I made one from the X11R3 source.  I haven't
	X	  tested this very thoroughly yet...
	X	
	XI don't know about:
	X	- the Xt interface.  We don't have the HP widget set (yet), so
	X	  I couldn't test it.  The Xt stuff seems to have compiled
	X	  correctly (see alloca changes below).
	X
	XThere are several types of changes that I had to make:
	X	- wrote the MIPS specific version of stack.s and created an
	X	  empty alloca.s.mips to satisfy the Makefile.
	X
	X	- rewrote the routines that need to work with MIPS' unique
	X	  symbol table format.  These changes were substantial enough
	X	  that I just created a new file for the MIPS version, rather
	X	  than try to #ifdef it into the original one.  Elk's author
	X	  may or may not stick with this scheme.  The new files are
	X	  dumpmips.c, stabmips.c, and loadmips.c.  The Makefile in the
	X	  src directory is modified by the SRC_PATCHES to use the mips
	X	  version of these files.  The file dumpmips.c explicitly
	X	  calls "ld2.10".  If/when the compilers are installed as the
	X	  default, this should be changed to "/bsd43/bin/ld".
	X
	X	- Change stuff to work with the 2.10 builtin alloca().  Any
	X	  file that wants to use the builtin alloca needs to include
	X	  the file <alloca.h>.  I put this in the MIPS section of
	X	  config.h, since it is included by scheme.h.  I also had to 
	X	  work around the crippled nature of the alloca in the 2.10
	X	  compiler suite. While it is a "true" stack extending alloca,
	X	  it is implemented as an operator, and  only works with
	X	  "integral_types".  For instance, this is legal:
	X		int size;
	X		foo = alloca(size);
	X	  but this is not:
	X		int size;
	X		foo = alloca(size+1);
	X	  I went through all of the sources and replaced every
	X	  occurrence calls like:
	X		int size;
	X		...
	X		foo = alloca(size+1);
	X	  with something similar to:
	X		int size;
	X		...
	X		#ifdef MIPS_ALLOCA
	X		foo = alloca(size+1);
	X		#else
	X		{
	X		  int mips_alloca_size = size + 1;
	X		  foo = alloca(mips_alloca_size);
	X		}
	X		#endif
	X	  I dislike declaring variables in local blocks like this, but
	X	  it seemed like the cleanest way to get things to work.
	X
	X[begin editorial comment]
	X	  The comment in the alloca header file implies that the
	X	  builtin alloca was implemented this way for efficiency...
	X	  It seems to me that forcing me to go through all of the
	X	  source code and make these changes is not the most efficient
	X	  way to make it work.  If there is really a neat/fast way to
	X	  do the builtin alloca for "integral_types" (and it seems to
	X	  me that there would be) then why not make the compiler
	X	  smart enough to use it when appropriate, and handle the
	X	  other cases as needed?  Maybe the compiler people are
	X	  planning this?
	X[end editorial comment]
	X
	X	  The compiler becomes very unhappy (one of the ucode stages
	X	  dumps core and dies) if you don't assign the pointer
	X	  returned by the builtin alloca to something.  For example,
	X	  there are two places in scheme's main routine that do this:
	X		(void)alloca(something);
	X	  These were changed to assign the returned value to a scratch
	X	  variable.  I don't know if this is a bug or a side effect of
	X	  implementing the builtin alloca as an operator.  One of the
	X	  programs for testing stack.s also has this problem. 
	X
	X	- Any object file that will be fast loaded (dynamically
	X	  loaded) needs to be compiled and linked with the -G 0 and
	X	  without the -x flag.  The interpreter doesn't need this, and
	X	  should run more efficiently without it, so I changed the
	X	  root Makefile to use a different set of compile and load
	X	  flags when working on the src directory and all of the others.
	X
	X	- All of the source file modifications are inside #ifdef's,
	X	  using the following two identifiers:
	X		"MIPS_ALLOCA" for code that handles MIPS' alloca
	X		"mips" for two places (src/bignum.c and lib/xlib/font.c)
	X		   where the code tickles some compiler bug.  In both
	X		   cases, breaking out the complicated expression
	X		   fixed things.
	X	
	X	- The modifications to the root Makefile, the
	X	  lib/xlib/Makefile and the lib/xt/Makefile just comment out
	X	  the original lines.  The modifications to the src Makefile
	X	  replace dump.c with dumpmips.c, etc... because I was worried
	X	  about putting a comment line inside the long set of "\"
	X	  continued lines.  It should be easy enough to change it
	X	  back.  A cleaner way to do this would be to define DUMP_SRC
	X	  (etc...) at the top of the Makefile.  I'll leave that to
	X	  ELK's author for the next release.
	X
	X
	XThree shar files (posted separately) contain the changes:
	X	sources.shar
	X	   README.MIPS (this file)
	X	   alloca.s.mips
	X	   dumpmips.c
	X	   loadmips.c
	X	   stabmips.c
	X	   stack.s.mips
	X
	X	patches1.shar
	X	   LIB_PATCHES
	X	   LIB_UTIL_PATCHES
	X	   LIB_XLIB_PATCHES
	X	   LIB_XT_PATCHES
	X
	X	patches2.shar
	X	   ROOT_PATCHES
	X	   SRC_PATCHES
	X   
	XAll of the files from the sources.shar file should be put in the src
	Xdirectory.  I recommend making a MIPS directory in the root directory
	Xand unpacking the patches there.  Then just invoke patch as:
	X	patch -d .. < ROOT_PATCHES
	X	patch -d ../src < SRC_PATCHES
	X	patch -d ../lib < LIB_PATCHES
	X	patch -d ../lib/util < LIB_UTIL_PATCHES
	X	patch -d ../lib/xlib < LIB_XLIB_PATCHES
	X	patch -d ../lib/xt < LIB_XT_PATCHES
	X
	XGeorge Hartzell			                  (303) 492-4535
	X MCD Biology, University of Colorado-Boulder, Boulder, CO 80309
	Xhartzell@Boulder.Colorado.EDU  ..!{ncar,nbires}!boulder!hartzell
SHAR_EOF
if test 6112 -ne "`wc -c < 'README.MIPS'`"
then
	echo shar: error transmitting "'README.MIPS'" '(should have been 6112 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'alloca.s.mips'" '(0 character)'
if test -f 'alloca.s.mips'
then
	echo shar: will not over-write existing file "'alloca.s.mips'"
else
sed 's/^	X//' << \SHAR_EOF > 'alloca.s.mips'
SHAR_EOF
if test 0 -ne "`wc -c < 'alloca.s.mips'`"
then
	echo shar: error transmitting "'alloca.s.mips'" '(should have been 0 character)'
fi
fi # end of overwriting check
echo shar: extracting "'dumpmips.c'" '(7965 characters)'
if test -f 'dumpmips.c'
then
	echo shar: will not over-write existing file "'dumpmips.c'"
else
sed 's/^	X//' << \SHAR_EOF > 'dumpmips.c'
	X/* Create a.out from running interpreter
	X *
	X * For MIPS ecoff format.  Some parts cribbed from unexmips.c from 
	X * GNU emacs.
	X * George Hartzell --- Mon Nov 13 09:55:01 1989
	X *
	X */
	X
	X#include <signal.h>
	X#include "scheme.h"
	X
	X#include <sys/types.h>
	X#include <sys/stat.h>
	X#include <sys/file.h>
	X#include <filehdr.h>
	X#include <aouthdr.h>
	X#include <scnhdr.h>
	X#include <sym.h>
	X
	X#define BADAOUT(x) {close(newfd);close(aout_fd);Primitive_Error(x);}
	X
	X#define BADWRITE(x) {Saved_Errno = errno;\
	X  close(newfd);\
	X  close(aout_fd);\
	X  Primitive_Error(x);}
	X
	X#define CHECK_SCNHDR(ptr, name, flags) { \
	X  if (strcmp(hdr.section[i].s_name, name) == 0) { \
	X    if (hdr.section[i].s_flags != flags) { \
	X    Primitive_Error("dump: %x flags where %x were expected in %s section.\n", \
	X		      hdr.section[i].s_flags, flags, name); \
	X    } \
	X    ptr = hdr.section + i; \
	X    i += 1; \
	X  } \
	X  else { \
	X    ptr = NULL; \
	X  } \
	X}
	X
	X#define READ(_fd, _buffer, _size, _error_message, _error_arg) \
	X	errno = EEOF; \
	X	if (read(_fd, _buffer, _size) != _size) \
	X	  Primitive_Error(_error_message, _error_arg);
	X
	X#define WRITE(_fd, _buffer, _size, _error_message) \
	X	if (write(_fd, _buffer, _size) != _size) \
	X	  Primitive_Error(_error_message);
	X
	X#define SEEK(_fd, _position, _error_message, _error_arg) \
	X	if (lseek(_fd, _position, L_SET) != _position) \
	X	  Primitive_Error(_error_message, _error_arg);
	X
	X#define BUFSIZE 8192
	X
	Xstatic struct scnhdr *text_section;
	Xstatic struct scnhdr *init_section;
	Xstatic struct scnhdr *rdata_section;
	Xstatic struct scnhdr *data_section;
	Xstatic struct scnhdr *lit8_section;
	Xstatic struct scnhdr *lit4_section;
	Xstatic struct scnhdr *sdata_section;
	Xstatic struct scnhdr *sbss_section;
	Xstatic struct scnhdr *bss_section;
	X
	Xstruct headers {
	X    struct filehdr fhdr;
	X    struct aouthdr aout;
	X    struct scnhdr section[10];
	X};
	X
	XObject Dump_Control_Point;
	X
	XInit_Dump () {
	X  Global_GC_Link (Dump_Control_Point);
	X}
	X
	XObject P_Dump (newfile)
	X     Object newfile;
	X{
	X
	X  Object port;			/* the port for the new exectable */
	X  Object ret;			/* the object from saveenv */
	X  char buf[BUFSIZE];
	X  int i;			/* a simple counter */
	X  int newsyms;
	X  int symrel;
	X  int nread;			/* number of bytes read */
	X  int newfd;
	X  int aout_fd;
	X  int pagesize;			/* page size */
	X  int scnptr;			/* the section being worked on */
	X  int size;			/* size of stack */
	X  int vaddr;
	X  struct stat st;
	X  unsigned data_end;
	X  unsigned start_of_data;
	X  static struct headers hdr;
	X  GC_Node;
	X  
	X  /* 
	X   * make sure that stdin and out aren't redirected.
	X   * flush and close them.
	X   */
	X  if (!EQ (Curr_Input_Port, Standard_Input_Port) ||
	X      !EQ (Curr_Output_Port, Standard_Output_Port))
	X    Primitive_Error ("cannot dump with current ports redirected");
	X  Flush_Output (Curr_Output_Port);
	X  Close_All_Files ();
	X
	X  /* 
	X   * make a point to jmpenv to.
	X   */
	X  GC_Link (newfile);
	X  size = stksize ();
	X  Dump_Control_Point = Make_Control_Point (size);
	X  SETFAST(ret,saveenv (CONTROL(Dump_Control_Point)->stack));
	X  if (TYPE(ret) != T_Special) {
	X    Enable_Interrupts;
	X    return ret;
	X  }
	X  GC_Unlink;
	X
	X  /* 
	X   * open the new executable file (newfile)
	X   */
	X  Disable_Interrupts;
	X  port = General_Open_File (newfile, 0, Null);
	X  newfd = dup (fileno (PORT(port)->file));
	X  P_Close_Port (port);
	X  if (newfd < 0)
	X    Primitive_Error ("out of file descriptors");
	X  
	X  /* 
	X   * open the executable file (the one that contains our code.
	X   */
	X  if ((aout_fd = open (myname, 0)) == -1) {
	X    Saved_Errno = errno;
	X    close (newfd);
	X    Primitive_Error ("cannot open a.out file: ~E");
	X  }
	X
	X  hdr = *((struct headers *) TEXT_START);
	X  
	X  if (hdr.fhdr.f_magic != MIPSELMAGIC && hdr.fhdr.f_magic != MIPSEBMAGIC)
	X    BADAOUT("dump: input file has bad magic number!\n");
	X
	X  if (hdr.fhdr.f_opthdr != sizeof(hdr.aout))
	X    BADAOUT("dump: input file's a.out header is the wrong size!\n");
	X  
	X  if (hdr.aout.magic != ZMAGIC)
	X    BADAOUT("dump: input file is not a ZMAGIC file\n");
	X
	X  i = 0;
	X  CHECK_SCNHDR(text_section,  _TEXT,  STYP_TEXT);
	X  CHECK_SCNHDR(init_section,  _INIT,  STYP_INIT);
	X  CHECK_SCNHDR(rdata_section, _RDATA, STYP_RDATA);
	X  CHECK_SCNHDR(data_section,  _DATA,  STYP_DATA);
	X#ifdef _LIT8
	X  CHECK_SCNHDR(lit8_section,  _LIT8,  STYP_LIT8);
	X  CHECK_SCNHDR(lit4_section,  _LIT4,  STYP_LIT4);
	X#endif /* _LIT8 */
	X  CHECK_SCNHDR(sdata_section, _SDATA, STYP_SDATA);
	X  CHECK_SCNHDR(sbss_section,  _SBSS,  STYP_SBSS);
	X  CHECK_SCNHDR(bss_section,   _BSS,   STYP_BSS);
	X  if (i != hdr.fhdr.f_nscns)
	X    Primitive_Error("dump: %d sections expected, %d found.\n",
	X		    hdr.fhdr.f_nscns, i);
	X
	X  dumped = 1;
	X
	X  pagesize = getpagesize();
	X  data_end = ((unsigned)sbrk (0) + pagesize - 1) & (-pagesize);
	X  hdr.aout.dsize = data_end - DATA_START;
	X  hdr.aout.bsize =0;
	X  
	X  { extern __start();
	X    hdr.aout.entry = (unsigned)__start;
	X  }
	X
	X  hdr.aout.bss_start = hdr.aout.data_start + hdr.aout.dsize;
	X
	X  data_section->s_vaddr = DATA_START + rdata_section->s_size;
	X  data_section->s_paddr = DATA_START + rdata_section->s_size;
	X
	X  data_section->s_size = data_end - DATA_START;
	X  data_section->s_scnptr = rdata_section->s_scnptr + rdata_section->s_size;
	X
	X  vaddr = data_section->s_vaddr + data_section->s_size;
	X  scnptr = data_section->s_scnptr + data_section->s_size;
	X  if (lit8_section != NULL) 
	X    {
	X      lit8_section->s_vaddr = data_section->s_vaddr + data_section->s_size;
	X      lit8_section->s_paddr = data_section->s_paddr + data_section->s_size;
	X      lit8_section->s_scnptr = data_section->s_scnptr + data_section->s_size;
	X    }
	X  if (sdata_section != NULL)
	X    {
	X      sdata_section->s_vaddr = lit8_section->s_vaddr + lit8_section->s_size;
	X      sdata_section->s_paddr = lit8_section->s_paddr + lit8_section->s_size;
	X      sdata_section->s_scnptr = lit8_section->s_scnptr + lit8_section->s_size;
	X    }
	X  if (sbss_section != NULL)
	X    {
	X      sbss_section->s_vaddr = sdata_section->s_vaddr + sdata_section->s_size;
	X      sbss_section->s_paddr = sdata_section->s_paddr + sdata_section->s_size;
	X      sbss_section->s_scnptr = sdata_section->s_scnptr + sdata_section->s_size;
	X    }
	X  if (bss_section != NULL)
	X    {
	X      bss_section->s_vaddr = sbss_section->s_vaddr + sbss_section->s_size;
	X      bss_section->s_paddr = sbss_section->s_paddr + sbss_section->s_size;
	X      bss_section->s_scnptr = sbss_section->s_scnptr + sbss_section->s_size;
	X    }
	X
	X  WRITE(newfd, TEXT_START, hdr.aout.tsize,
	X	"dump: problem writing text section to output file");
	X
	X  WRITE(newfd, DATA_START, hdr.aout.dsize,
	X	"dump: problem writing text section to output file");
	X  
	X  /* 
	X   * set up and copy the symbol table to the new executable.
	X   * 
	X   */
	X  SEEK(aout_fd, hdr.fhdr.f_symptr,
	X       "seeking to start of symbols in %s", myname);
	X
	X  nread = read(aout_fd, buf, BUFSIZE);
	X  if (nread < sizeof(HDRR))
	X    Primitive_Error("dump: problem reading symbols from %s", myname);
	X
	X#define symhdr ((pHDRR)buf)
	X  newsyms = hdr.aout.tsize + hdr.aout.dsize;
	X  symrel = newsyms - hdr.fhdr.f_symptr;
	X  hdr.fhdr.f_symptr = newsyms;
	X  symhdr->cbLineOffset += symrel;
	X  symhdr->cbDnOffset += symrel;
	X  symhdr->cbPdOffset += symrel;
	X  symhdr->cbSymOffset += symrel;
	X  symhdr->cbOptOffset += symrel;
	X  symhdr->cbAuxOffset += symrel;
	X  symhdr->cbSsOffset += symrel;
	X  symhdr->cbSsExtOffset += symrel;
	X  symhdr->cbFdOffset += symrel;
	X  symhdr->cbRfdOffset += symrel;
	X  symhdr->cbExtOffset += symrel;
	X#undef symhdr
	X
	X  do
	X    {
	X      if (write(newfd, buf, nread) != nread)
	X	Primitive_Error("dump: writing symbols to output file");
	X      nread = read(aout_fd, buf, BUFSIZE);
	X      if (nread < 0)
	X	Primitive_Error("dump: reading symbols from %s", myname);
	X    } while (nread != 0);
	X
	X  SEEK(newfd, 0, "dump: problem seeking to start of header in %s", myname);
	X
	X  WRITE(newfd, &hdr, sizeof(hdr),
	X	"dump: problem writing header of output file");
	X
	X  close (aout_fd);
	X
	X  if (fstat (newfd, &st) != -1) {
	X    int omask = umask (0);
	X    (void)umask (omask);
	X    (void)fchmod (newfd, st.st_mode & 0777 | 0111 & ~omask);
	X  }
	X
	X  close (newfd);
	X  Enable_Interrupts;
	X
	X  return False;
	X}
SHAR_EOF
if test 7965 -ne "`wc -c < 'dumpmips.c'`"
then
	echo shar: error transmitting "'dumpmips.c'" '(should have been 7965 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'loadmips.c'" '(4506 characters)'
if test -f 'loadmips.c'
then
	echo shar: will not over-write existing file "'loadmips.c'"
else
sed 's/^	X//' << \SHAR_EOF > 'loadmips.c'
	X/* Loading of source and object files
	X * Modified for MIPS ecoff format.
	X * George Hartzell --- Mon Dec  4 10:58:59 1989
	X */
	X
	X#include <signal.h>
	X#include "scheme.h"
	X
	X#include <filehdr.h>
	X#include <aouthdr.h>
	X#include <scnhdr.h>
	X#include <syms.h>
	X
	Xstatic Object V_Load_Path, V_Load_Noisilyp, V_Load_Libraries;
	X
	X#ifdef gcc
	X#  define Default_Load_Libraries "/usr/new/ghs/lib/libc.a"
	X#else
	X#  define Default_Load_Libraries "-lc_G0"
	X#endif
	X
	Xchar Loader_Input[20];
	Xstatic char Loader_Output[20];
	X
	XInit_Load () {
	X    Define_Variable (&V_Load_Path, "load-path",
	X	Cons (Make_String (".", 1),
	X	Cons (Make_String (DEF_LOAD_DIR, sizeof (DEF_LOAD_DIR) - 1), Null)));
	X    Define_Variable (&V_Load_Noisilyp, "load-noisily?", False);
	X    Define_Variable (&V_Load_Libraries, "load-libraries", 
	X	Make_String (Default_Load_Libraries, sizeof Default_Load_Libraries-1));
	X}
	X
	XObject General_Load (name, env) Object name, env; {
	X    register char *p;
	X    register struct S_String *str;
	X    Object oldenv, port;
	X    GC_Node2;
	X
	X    Check_Type (env, T_Environment);
	X    oldenv = The_Environment;
	X    GC_Link2 (env, oldenv);
	X    port = General_Open_File (name, P_INPUT, Val (V_Load_Path));
	X    str = STRING(PORT(port)->name);
	X    Switch_Environment (env);
	X    p = str->data + str->size;
	X    if (str->size >= 2 && *--p == 'o' && *--p == '.') {
	X	Load_Object (port, str);
	X    } else
	X	Load_Source (port);
	X    Switch_Environment (oldenv);
	X    GC_Unlink;
	X    return Void;
	X}
	X
	XObject P_Load (argc, argv) register argc; register Object *argv; {
	X    return General_Load (argv[0], argc == 1 ? The_Environment : argv[1]);
	X}
	X
	XLoad_Source (port) Object port; {
	X    Object val;
	X    GC_Node;
	X
	X    GC_Link (port);
	X    while (1) {
	X	val = General_Read (port);
	X	if (TYPE(val) == T_End_Of_File)
	X	    break;
	X	val = Eval (val);
	X	if (Truep (Val (V_Load_Noisilyp))) {
	X	    Print (val);
	X	    P_Newline (0);
	X	}
	X    }
	X    P_Close_Port (port);
	X    GC_Unlink;
	X}
	X
	Xstruct headers {
	X    struct filehdr fhdr;
	X    struct aouthdr aout;
	X    struct scnhdr section[3];    
	X};
	X
	XLoad_Object (port, fn) Object port; register struct S_String *fn; {
	X    struct headers hdr;
	X    register char *brk, *obrk, *buf, *lp, *li;
	X    register n, f;
	X    Object libs;
	X    FILE *fp;
	X    int mipshit;
	X
	X    n = fread ((char *)&hdr, sizeof (hdr), 1, PORT(port)->file);
	X    P_Close_Port (port);
	X    if (n == 0 || hdr.fhdr.f_magic != XLMAGIC)
	X	Primitive_Error ("not a valid object file");
	X
	X    strcpy (Loader_Output, "/tmp/ldXXXXXX");
	X    mktemp (Loader_Output);
	X    mipshit = fn->size + strlen (myname) + 500;
	X    buf = alloca (mipshit);
	X    obrk = brk = sbrk (0);
	X    brk = (char *)((int)brk + 7 & ~7);
	X    libs = Val (V_Load_Libraries);
	X    if (TYPE(libs) == T_String) {
	X        if ((n = STRING(libs)->size) > 400)
	X	    Primitive_Error ("too many load libraries");
	X	lp = STRING(libs)->data;
	X    } else {
	X	lp = "-lc"; n = 3;
	X    }
	X    li = Loader_Input;
	X    if (li[0] == 0)
	X	li = myname;
	X#ifdef XFLAG_BROKEN
	X    sprintf (buf, "ld2.10 -systype bsd43 -N -A %s -T %x %.*s -o %s %.*s",
	X#else
	X    sprintf (buf, "/bin/ld -x -N -A %s -T %x %.*s -o %s %.*s",
	X#endif
	X	     li, brk, fn->size, fn->data, Loader_Output, n, lp);
	X    if (system (buf) != 0) {
	X	(void)unlink (Loader_Output);
	X	Primitive_Error ("system linker failed");
	X    }
	X    Disable_Interrupts;               /* To ensure that f gets closed */
	X    if ((f = open (Loader_Output, 0)) == -1) {
	X	(void)unlink (Loader_Output);
	X	Primitive_Error ("cannot open tempfile");
	X    }
	X    if (Loader_Input[0])
	X	(void)unlink(Loader_Input);
	X    strcpy (Loader_Input, Loader_Output);
	X    if (read (f, (char *)&hdr, sizeof (hdr)) != sizeof (hdr)) {
	Xerr:
	X	close (f);
	X	Primitive_Error ("corrupt tempfile (/bin/ld is broken)");
	X    }
	X    n = hdr.aout.tsize + hdr.aout.dsize + hdr.aout.bsize;
	X    n += brk - obrk;
	X    if (sbrk (n) == (char *)-1) {
	X	close (f);
	X	Primitive_Error ("not enough memory to load object file");
	X    }
	X    bzero (obrk, n);
	X    n -= hdr.aout.bsize;
	X
	X    if (lseek(f, hdr.section[0].s_scnptr, 0) == -1) {
	X	close (f);
	X	Primitive_Error ("failed to lseek.\n");
	X    }
	X
	X    if (read (f, brk, n) != n) {
	X	close (f);
	X	Primitive_Error ("failed to read text and data segs.\n");
	X    }
	X
	X    if ((fp = fdopen (f, "r")) == NULL) {
	X	close (f);
	X	Primitive_Error ("cannot fdopen object file");
	X    }
	X
	X    if (The_Symbols)
	X	Free_Symbols (The_Symbols);
	X    The_Symbols = Snarf_Symbols (fp, &hdr);
	X
	X    fclose (fp);
	X    Call_Initializers (The_Symbols, brk);
	X    Enable_Interrupts;
	X}
	X
	XFinit_Load () {
	X    if (Loader_Input[0])
	X	(void)unlink (Loader_Input);
	X}
SHAR_EOF
if test 4506 -ne "`wc -c < 'loadmips.c'`"
then
	echo shar: error transmitting "'loadmips.c'" '(should have been 4506 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'stabmips.c'" '(4492 characters)'
if test -f 'stabmips.c'
then
	echo shar: will not over-write existing file "'stabmips.c'"
else
sed 's/^	X//' << \SHAR_EOF > 'stabmips.c'
	X/* Read and manage symbol tables from object modules
	X * Modified for MIPS ecoff format.
	X * George Hartzell --- Mon Dec  4 10:59:23 1989
	X */
	X
	X#include "scheme.h"
	X
	X#include <filehdr.h>
	X#include <aouthdr.h>
	X#include <sys/file.h>
	X#include <syms.h>
	X
	X#define READ(_fd, _buffer, _size, _error_message) \
	X	if (read(_fd, _buffer, _size) != _size) \
	X	  Primitive_Error(_error_message);
	X
	X#define WRITE(_fd, _buffer, _size, _error_message) \
	X	if (write(_fd, _buffer, _size) != _size) \
	X	  Primitive_Error(_error_message);
	X
	X#define SEEK(_fd, _position, _error_message) \
	X	if (lseek(_fd, _position, L_SET) != _position) \
	X	  Primitive_Error(_error_message);
	X
	Xchar *Safe_Malloc (size) {
	X    char *ret;
	X
	X    if ((ret = malloc (size)) == 0)
	X	Primitive_Error ("not enough memory to allocate ~s bytes",
	X	    Make_Fixnum (size));
	X    return ret;
	X}
	X
	XSYMTAB *Snarf_Symbols (fp)
	X     FILE *fp;
	X{
	X  int fd;			/* a file descriptor */
	X  long fdi;			/* a counter for the file desc table */
	X  pFDR file_desc;		/* pointer to the filedesc table */
	X  struct filehdr file_hdr;	/* pointer to the file header */
	X  long sbase;
	X  char *strbase;
	X  char *strings;
	X  HDRR sym_hdr;			/* pointer to symbolic header */
	X  long symi;			/* a counter for the local symbol table */
	X  pSYMR symbol;			/* pointer to symbol table */
	X
	X
	X  SYMTAB *tab;
	X  char *p;
	X  SYM *sp, **nextp;
	X
	X  fd = fileno(fp);
	X
	X  /* rewind the object file, since who knows what it's status is... */
	X  SEEK(fd, 0, "Unable to rewind object file.\n");
	X
	X  /* read in the file header */
	X  READ(fd, &file_hdr, sizeof(file_hdr), "Unable to read file header.\n");
	X
	X  /* seek to the start of the symbolic header */
	X  SEEK(fd, file_hdr.f_symptr, "Unable to seek to symbolic header.\n");
	X
	X  /* read in the symbolic header */
	X  READ(fd, &sym_hdr, sizeof(sym_hdr), "Unable to read symbolic header\n");
	X
	X  tab = (SYMTAB *)Safe_Malloc (sizeof (SYMTAB));
	X  tab->first = 0;
	X  tab->strings = 0;
	X  nextp = &tab->first;
	X
	X  SEEK(fd, sym_hdr.cbSymOffset, "Unable to seek to symbol table.\n");
	X  if ((symbol = (pSYMR)malloc(sym_hdr.isymMax * sizeof (SYMR))) == (pSYMR)NULL)
	X    Primitive_Error("Unable to allocate memory for symbol table.\n");
	X  READ(fd, symbol, (sym_hdr.isymMax * sizeof(SYMR)),
	X       "Unable to read symbol tables.\n");
	X
	X  SEEK(fd, sym_hdr.cbSsOffset, "Unable to seek to string space.\n");
	X  if ((strings = malloc(sym_hdr.issMax)) == NULL)
	X    Primitive_Error("Unable to allocate memory for string space.\n");
	X  READ(fd, strings, sym_hdr.issMax, "Unable to read symbol tables.\n");
	X
	X  SEEK(fd, sym_hdr.cbFdOffset, "Unable to seek to file descriptors.\n");
	X  if((file_desc = (pFDR)malloc(sym_hdr.ifdMax * sizeof(FDR))) == (pFDR)NULL)
	X    Primitive_Error("Unable to allocate memory for fd's.\n");
	X  READ(fd, file_desc, (sym_hdr.ifdMax * sizeof(FDR)),
	X       "Unable to read file descriptor tables.\n");
	X
	X
	X  /* foreach file in
	X   * the file descriptor table
	X   * do:
	X   */
	X  for(fdi = 0; fdi < sym_hdr.ifdMax; fdi++) {
	X    strbase = strings + file_desc[fdi].issBase;
	X    for(symi=file_desc[fdi].isymBase;
	X	symi < file_desc[fdi].csym + file_desc[fdi].isymBase;
	X	symi++) {
	X      if (symbol[symi].st == stProc && symbol[symi].sc == scText) {
	X	p = symbol[symi].iss + strbase;
	X	
	X	/* allocate another node in the symbol table list */
	X	sp = (SYM *)Safe_Malloc (sizeof (SYM));
	X	sp->name = Safe_Malloc (strlen (p) + 1);
	X	
	X	/* set the new nodes values */
	X	strcpy (sp->name, p);
	X	sp->type = symbol[symi].st;
	X	sp->value = symbol[symi].value;
	X	
	X	/* link the node into the linked list */
	X	*nextp = sp;
	X	nextp = &sp->next;
	X	*nextp = 0;
	X      }				/* end of if(symbol... */
	X    }				/* end of for(symi=0... */
	X  }				/* end of for(fdi=0... */
	X  return tab;
	X}				/* end of Snarf_Symbols() */
	X
	X
	XSYMTAB *Open_File_And_Snarf_Symbols (name)
	X     char *name;
	X{
	X  FILE *fp;
	X  SYMTAB *tab;
	X  
	X  if ((fp = fopen (name, "r")) == (FILE *)NULL)
	X    Primitive_Error ("cannot open a.out file:");
	X  
	X  tab = Snarf_Symbols (fp);
	X  
	X  close (fp);
	X  return tab;
	X}
	X
	XFree_Symbols (tab) SYMTAB *tab; {
	X    register SYM *sp;
	X
	X    for (sp = tab->first; sp; sp = sp->next) {
	X	free (sp->name);
	X	free ((char *)sp);
	X    }
	X    if (tab->strings)
	X	free (tab->strings);
	X}
	X
	XCall_Initializers (tab, addr)
	X     SYMTAB *tab;
	X     char *addr;
	X{
	X  register SYM *sp;
	X  
	X  /* procedure names don't have leading underscores... */
	X  for (sp = tab->first; sp; sp = sp->next) {
	X    if (((bcmp (sp->name, "init_", 5) == 0) ||
	X	 (bcmp (sp->name, "_STI", 4) == 0))
	X	&& (char *)sp->value >= addr)
	X      ((int (*)())sp->value)(); 
	X  }
	X}
	X
SHAR_EOF
if test 4492 -ne "`wc -c < 'stabmips.c'`"
then
	echo shar: error transmitting "'stabmips.c'" '(should have been 4492 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'stack.s.mips'" '(2714 characters)'
if test -f 'stack.s.mips'
then
	echo shar: will not over-write existing file "'stack.s.mips'"
else
sed 's/^	X//' << \SHAR_EOF > 'stack.s.mips'
	X	# 
	X	# stack manipulation routines for elk on the MIPS chip.
	X	# George Hartzell --- Sat Dec  2 15:02:43 1989
	X	#
	X	# declare externals
	X	.extern	stkbase 4
	X	# declare Special 
	X	.extern	Special 4
	X
	X	################################################################
	X	# int stksize();
	X	################################################################
	X	.text	
	X	.align	2
	X	.globl	stksize
	X	.ent	stksize
	Xstksize:
	X	# set up the frame pointer
	X	.frame	$sp, 0, $31
	X	# put the value of stkbase into register 8
	X	lw	$8, stkbase
	X	# register 8 = stackbase - stackpointer
	X	subu	$8, $8, $sp
	X	# give ourselves a safety margin (Don't seem to need this!!! gh.)
	X	#	addu	$8, $8, 100
	X	# move the size to register 2, where MIPS C expects the return value
	X	move	$2, $8
	X	# return.  return address is in $31
	X	j	$31
	X	.end	stksize
	X
	X	################################################################
	X	# int saveenv(char *buf)
	X	################################################################
	X	.text
	X	.align	2
	X	.globl	saveenv
	X	.ent	saveenv
	Xsaveenv:
	X	# set up the frame pointer
	X	.frame	$sp, 0, $31
	X	# buf is in register 4.
	X
	X	# copy the registers that seem to need to be saved :)
	X	sw	$28, 4($4)
	X	sw	$sp, 8($4)
	X	sw	$31, 12($4)
	X	sw	$fp, 16($4)
	X
	X	# $9 points into buffer
	X	# $10 contains the stack base
	X	# $11 points into the stack.
	X	addu	$9, $4, 20
	X	lw	$10, stkbase
	X	move	$11, $sp
	Xrep1:
	X	# get a value from the stack and stuff it into the buffer
	X	# increment the pointers into the stack and the buffer
	X	# stop when you've copied the word at stkbase
	X	#      e.g. when $11 has gone beyond stkbase
	X	lw	$12, 0($11)
	X	sw	$12, 0($9)
	X	addu	$11, $11, 4
	X	addu	$9, $9, 4
	X	bltu	$11, $10, rep1
	X
	X	# calculate the "relocation offset"
	X	subu	$15, $9, $10
	X	sw	$15, 0($4)
	X	# set up to return value of Special
	X	lw	$2, Special
	X	# return.  return address is in register 31.
	X	j	$31
	X	.end	saveenv
	X
	X
	X	################################################################
	X	# dead jmpenv(const char *buf, int retcode);
	X	################################################################
	X	.text	
	X	.align	2
	X	.globl	jmpenv
	X	.ent	jmpenv 2
	Xjmpenv:
	X	.frame	$sp, 0, $31
	X	# copy the registers that seem to need to be saved :)
	X	lw	$28, 4($4)
	X	lw	$sp, 8($4)
	X	lw	$31, 12($4)
	X	lw	$fp, 16($4)
	X
	X	# $9 points into buffer
	X	# $10 contains the stack base
	X	# $11 points into the stack.
	X	addu	$9, $4, 20
	X	lw	$10, stkbase
	X	move	$11, $sp
	Xrep2:
	X	# get a value from the buffer and stuff it into the stack
	X	# increment the pointers into the stack and the buffer
	X	# stop when you've copied the word at stkbase
	X	#      e.g. when $11 has gone beyond stkbase
	X	lw	$12, 0($9)
	X	sw	$12, 0($11)
	X	addu	$11, $11, 4
	X	addu	$9, $9, 4
	X	bltu	$11, $10, rep2
	X
	X	# set up the return code
	X	move	$2, $5
	X	# and return
	X	j	$31
	X	.end	jmpenv
	X
	X
	X
SHAR_EOF
if test 2714 -ne "`wc -c < 'stack.s.mips'`"
then
	echo shar: error transmitting "'stack.s.mips'" '(should have been 2714 characters)'
fi
fi # end of overwriting check
#	End of shell archive
exit 0

George Hartzell			                  (303) 492-4535
 MCD Biology, University of Colorado-Boulder, Boulder, CO 80309
hartzell@Boulder.Colorado.EDU  ..!{ncar,nbires}!boulder!hartzell