diff -crN schemetoc.NeXT/00README.FIRST schemetoc/00README.FIRST
*** schemetoc.NeXT/00README.FIRST	Mon Jun 17 20:01:48 1991
--- schemetoc/00README.FIRST
***************
*** 1,23 ****
- How to install
- ==============
- 
-      1. Edit the top level makefile (./makefile) to fix up the
-         definition of SRCDIR at a minimum.  You may also want to change
-         the various *DIR, *BIN, and *LIB macros that are appropriate for
-         your environment.
- 
-      2. Run a "make for<ARCH>" command, where ARCH is one of APOLLO, I386,
-         MIPS, NeXT, PRISM, SPARC, SUN3, TITAN, or VAX.  This will create
-         the $(CPUDIR) directory, if it does not exist.  It will then
-         create a tree of symbolic links to all the directories and
-         necessary files in the distribution.
- 
-         [ If you can accept the values for CPUDIR that already exist in
-         the makefile, you can just say "make for<ARCH> SRCDIR=$PWD"
-         where $PWD has a valid pathname to the currect directory]
- 
-      3. cd into $(CPUDIR).
- 
-      4. Do a "make port"
- 
-      5. Verify the build as in step #4 in the README file.
--- 0 ----
diff -crN schemetoc.NeXT/APOLLO schemetoc/APOLLO
*** schemetoc.NeXT/APOLLO	Sun Apr 14 20:44:17 1991
--- schemetoc/APOLLO
***************
*** 1,36 ****
- #
- # This is the header file for constructing make files for Apollo 3000
- # series processors (DN3000, DN3500, DN4000, DN4500).
- #
- 
- .SUFFIXES:
- .SUFFIXES:	.o .c .sc .s .asm .bin
- 
- # Processor name:
- 
- cpu = APOLLO
- 
- # Default flags to use when invoking the C compiler.
- 
- OPT = -O
- CFLAGS = $(OPT) -A cpu,3000 -A sys,bsd4.3
- CC = cc
- 
- # Assembly language object files.
- 
- Aruntime = apollo.o 
- 
- # The assembler does not normally come with Domain/OS.  If you don't have the 
- # assembler, then you can just use the apollo.o file that is supplied.
- ASM = /usr/apollo/bin/asm
- AFLAGS = -nl -dba
- 
- # Profiled library
- 
- Plib = # libsc_p.a
- 
- # Heap size in megabytes for the compiler.
- 
- scheapmb = 8 -scl 40
- 
- # End of APOLLO header.
--- 0 ----
diff -crN schemetoc.NeXT/I386 schemetoc/I386
*** schemetoc.NeXT/I386	Sun Apr 14 20:44:19 1991
--- schemetoc/I386
***************
*** 1,29 ****
- #
- # This is the header file for constructing make files for I386 processors.
- #
- 
- .SUFFIXES:
- .SUFFIXES:	.o .c .sc .s .u
- 
- # Processor name:
- 
- cpu = I386
- 
- # Default flags to use when invoking the C compiler.
- 
- CFLAGS = -O -DSYSV
- CC = gcc
- 
- # Assembly language object files.
- 
- Aruntime = i386.o 
- 
- # Profiled library
- 
- Plib =
- 
- # Heap size in megabytes for the compiler.
- 
- scheapmb = 4 -scl 40
- 
- # End of I386 header.
--- 0 ----
diff -crN schemetoc.NeXT/NeXT schemetoc/NeXT
*** schemetoc.NeXT/NeXT	Sat Jun 15 09:48:02 1991
--- schemetoc/NeXT
***************
*** 1,29 ****
- #
- # This is the header file for constructing make files for the NeXT
- #
- 
- .SUFFIXES:
- .SUFFIXES:	.o .c .sc .s
- 
- # Processor name:
- 
- cpu = NeXT
- 
- # Default flags to use when invoking the C compiler.
- 
- CFLAGS = -O -g
- CC = cc
- 
- # Assembly language object files.
- 
- Aruntime = next.o 
- 
- # Profiled library
- 
- Plib =
- 
- # Heap size in megabytes for the compiler.
- 
- scheapmb = 8 -scl 40
- 
- # End of NeXT header.
--- 0 ----
diff -crN schemetoc.NeXT/PRISM schemetoc/PRISM
*** schemetoc.NeXT/PRISM	Sun Apr 14 20:44:20 1991
--- schemetoc/PRISM
***************
*** 1,36 ****
- #
- # This is the header file for constructing make files for Apollo 10000
- # series processors.
- #
- 
- .SUFFIXES:
- .SUFFIXES:	.o .c .sc .s .asm .bin
- 
- # Processor name:
- 
- cpu = PRISM
- 
- # Default flags to use when invoking the C compiler.
- 
- OPT = -O
- CFLAGS = $(OPT) -A cpu,a88k -A sys,bsd4.3
- CC = cc
- 
- # Assembly language object files.
- 
- Aruntime = prism.o 
- 
- # The assembler does not normally come with Domain/OS.  If you don't have the 
- # assembler, then you can just use the prism.o file that is supplied.
- ASM = /sr/apollo/bin/asm
- AFLAGS = -dba
- 
- # Profiled library
- 
- Plib =
- 
- # Heap size in megabytes for the compiler.
- 
- scheapmb = 8 -scl 40
- 
- # End of PRISM header.
--- 0 ----
diff -crN schemetoc.NeXT/SPARC schemetoc/SPARC
*** schemetoc.NeXT/SPARC	Sun Apr 14 20:44:20 1991
--- schemetoc/SPARC
***************
*** 1,29 ****
- #
- # This is the header file for constructing make files for SPARC processors.
- #
- 
- .SUFFIXES:
- .SUFFIXES:	.o .c .sc .s .u
- 
- # Processor name:
- 
- cpu = SPARC
- 
- # Default flags to use when invoking the C compiler.
- 
- CFLAGS = -g
- CC = cc
- 
- # Assembly language object files.
- 
- Aruntime = sparc.o 
- 
- # Profiled library
- 
- Plib =
- 
- # Heap size in megabytes for the compiler.
- 
- scheapmb = 8 -scl 40
- 
- # End of SPARC header.
--- 0 ----
diff -crN schemetoc.NeXT/SUN3 schemetoc/SUN3
*** schemetoc.NeXT/SUN3	Sun Apr 14 20:44:20 1991
--- schemetoc/SUN3
***************
*** 1,29 ****
- #
- # This is the header file for constructing make files for the Sun3
- #
- 
- .SUFFIXES:
- .SUFFIXES:	.o .c .sc .s
- 
- # Processor name:
- 
- cpu = SUN3
- 
- # Default flags to use when invoking the C compiler.
- 
- CFLAGS = -O
- CC = cc
- 
- # Assembly language object files.
- 
- Aruntime = sun3.o 
- 
- # Profiled library
- 
- Plib =
- 
- # Heap size in megabytes for the compiler.
- 
- scheapmb = 8 -scl 40
- 
- # End of Sun3 header.
--- 0 ----
diff -crN schemetoc.NeXT/makefile schemetoc/makefile
*** schemetoc.NeXT/makefile	Mon Jun 17 19:48:03 1991
--- schemetoc/makefile	Tue Apr 10 15:48:28 1990
***************
*** 2,13 ****
  # This file is used to make the Scheme->C system for multiple processor types.
  #
  
! SRCDIR = /usr/local/src/schemetoc
  
- NeXTDIR = ${SRCDIR}/next
- NeXTBIN = /usr/local/bin
- NeXTLIB = /usr/local/lib
- 
  MIPSDIR = /wrl/pmax/src/schemetoc
  MIPSBIN = /wrl/pmax/bin
  MIPSLIB = /wrl/pmax/lib
--- 2,9 ----
  # This file is used to make the Scheme->C system for multiple processor types.
  #
  
! SRCDIR = /wrl/Gen/src/schemetoc
  
  MIPSDIR = /wrl/pmax/src/schemetoc
  MIPSBIN = /wrl/pmax/bin
  MIPSLIB = /wrl/pmax/lib
***************
*** 20,56 ****
  VAXBIN = /wrl/vax/bin
  VAXLIB = /wrl/vax/lib
  
- APOLLODIR = $(SRCDIR)/apollo
- APOLLOBIN = $(SRCDIR)/bin.apollo
- APOLLOLIB = $(SRCDIR)/lib.apollo
- 
- PRISMDIR = $(SRCDIR)/prism
- PRISMBIN = $(SRCDIR)/bin.prism
- PRISMLIB = $(SRCDIR)/lib.prism
- 
- SPARCDIR = ${SRCDIR}/sparc
- SPARCBIN = ${SRCDIR}/bin.sparc
- SPARCLIB = ${SRCDIR}/lib.sparc
- 
- SUN3DIR = ${SRCDIR}/sun3
- SUN3BIN = ${SRCDIR}/bin.sun3
- SUN3LIB = ${SRCDIR}/lib.sun3
- 
- I386DIR = ${SRCDIR}/i386
- I386BIN = ${SRCDIR}/bin.i386
- I386LIB = ${SRCDIR}/lib.i386
- 
- # This is a list of the machines/architectures that are currently supported. 
- # These are also the names of the necessary makefile fragements.
- MACHINES = APOLLO I386 MIPS NeXT PRISM SPARC SUN3 TITAN VAX
  
  # Architecture specific directories and links to the source files are
  # constructed by the following commands which follow:
  
- no-target:
- 	@echo 'Use "make for<target>", where <target> is one of:'
- 	@echo '    $(MACHINES)'
- 
  forCPU:
  	-mkdir ${CPUDIR}
  	cp ${CPU} ${CPUDIR}
--- 16,25 ----
***************
*** 95,215 ****
  	-cd ${CPUDIR}/test; make srclinks
  
  forMIPS:
! 	$(MAKE) "CPU = MIPS" "CPUDIR = ${MIPSDIR}" "SRCDIR = ${SRCDIR}" \
  	     "BINDIR = ${MIPSBIN}" "LIBDIR = ${MIPSLIB}" forCPU
  
  forTITAN:
! 	$(MAKE) "CPU = TITAN" "CPUDIR = ${TITANDIR}" "SRCDIR = ${SRCDIR}"  \
  	     "BINDIR = ${TITANBIN}" "LIBDIR = ${TITANLIB}" forCPU
  
  forVAX:
! 	$(MAKE) "CPU = VAX" "CPUDIR = ${VAXDIR}" "SRCDIR = ${SRCDIR}"  \
  	     "BINDIR = ${VAXBIN}" "LIBDIR = ${VAXLIB}" forCPU
  
- forAPOLLO:
- 	$(MAKE) "CPU = APOLLO" "CPUDIR = ${APOLLODIR}" "SRCDIR = ${SRCDIR}" \
- 	     "BINDIR = ${APOLLOBIN}" "LIBDIR = ${APOLLOLIB}" forCPU
- 	cd $(APOLLODIR)/scrt; ln -s $(SRCDIR)/mul-fix.perl mul-fix.perl
- 
- forPRISM:
- 	$(MAKE) "CPU = PRISM" "CPUDIR = ${PRISMDIR}" "SRCDIR = ${SRCDIR}" \
- 	     "BINDIR = ${PRISMBIN}" "LIBDIR = ${PRISMLIB}" forCPU
- 
- forSPARC:
- 	$(MAKE) "CPU = SPARC" "CPUDIR = ${SPARCDIR}" "SRCDIR = ${SRCDIR}" \
- 	     "BINDIR = ${SPARCBIN}" "LIBDIR = ${SPARCLIB}" forCPU
- 
- 
- forSUN3:
- 	$(MAKE) "CPU = SUN3" "CPUDIR = ${SUN3DIR}" "SRCDIR = ${SRCDIR}" \
- 	     "BINDIR=${SUN3BIN}" "LIBDIR=${SUN3LIB}" forCPU
- 
- forI386:
- 	$(MAKE) "CPU = I386" "CPUDIR = ${I386DIR}" "SRCDIR = ${SRCDIR}" \
- 	     "BINDIR = ${I386BIN}" "LIBDIR = ${I386LIB}" forCPU
- 
- forNeXT:
- 	$(MAKE) "CPU = NeXT" "CPUDIR = ${NeXTDIR}" "SRCDIR = ${SRCDIR}" \
- 	     "BINDIR = ${NeXTBIN}" "LIBDIR = ${NeXTLIB}" forCPU
- 
  # The Scheme->C system is initially compiled from the C sources by the
  # following:
  
  port:
! 	cd scrt; $(MAKE) port
! 	cd scsc; $(MAKE) port
  
  # A "private" working copy of the current compiler, libary, and interpreter
  # is installed in a directory by the following command:
  
  install-private:
! 	cd scrt; $(MAKE) "destdir = ${destdir}" install-private
! 	cd scsc; $(MAKE) "destdir = ${destdir}" install-private
  
  # Clean out working files.
  
  clean:
  	rm -f *.BAK *.CKP SC-TO-C*
! 	cd doc; $(MAKE) clean
! 	cd scrt; $(MAKE) clean
! 	cd scsc; $(MAKE) clean
! 	cd test; $(MAKE) clean
  
  # Clean up C source files generated from Scheme source.
  
  clean-sc-to-c:
! 	cd scrt; $(MAKE) clean-sc-to-c
! 	cd scsc; $(MAKE) clean-sc-to-c
! 	cd test; $(MAKE) clean-sc-to-c
  
  # Delete programs and libraries.
  
  noprogs:
! 	cd scrt; $(MAKE) noprogs
! 	cd scsc; $(MAKE) noprogs
! 	cd test; $(MAKE) noprogs
  
  # All binaries and documentation files are installed by the following command
  # for access by all users.
  
  install:
! 	cd scrt; $(MAKE) "BINDIR = ${BINDIR}" "LIBDIR = ${LIBDIR}" install
! 	cd scsc; $(MAKE) "BINDIR = ${BINDIR}" "LIBDIR = ${LIBDIR}" install
! #	cd doc; $(MAKE) "BINDIR = ${BINDIR}" "LIBDIR = ${LIBDIR}" install
  
  # All files which must be constructed are made by the following command:
  
  all:
! 	cd scrt; $(MAKE) all
! 	cd scsc; $(MAKE) all
  
  # Distribute "source" files required to make the Scheme->C system.
  
  srcdist:
! 	rdist -c $(MACHINES) README makefile ${destdir}
! 	cd doc; $(MAKE) "destdir = ${destdir}/doc" srcdist
! 	-cd scbenchmark; $(MAKE) "destdir = ${destdir}/scbenchmark" srcdist
! 	cd scrt; $(MAKE) "destdir = ${destdir}/scrt" srcdist
! 	cd scsc; $(MAKE) "destdir = ${destdir}/scsc" srcdist
! 	-cd test; $(MAKE) "destdir = ${destdir}/test" srcdist
! 	-cd tools; $(MAKE) "destdir = ${destdir}/tools" srcdist
  
  # Distribute "binary" files so that they may be installed on some other
  # system.
  
  bindist:
! 	rdist -c $(MACHINES) README makefile ${destdir}
! 	cd doc; $(MAKE) "destdir = ${destdir}/doc" bindist
! 	cd scrt; $(MAKE) "destdir = ${destdir}/scrt" bindist
! 	cd scsc; $(MAKE) "destdir = ${destdir}/scsc" bindist
  
  # Write the tar tape for distribution.
  
! TARFILES = CHANGES README $(MACHINES) makefile \
  	   doc/[a-z]*.mss doc/[a-z]*.psf doc/[a-z]*.l doc/makefile \
  	   gnuemacs/README gnuemacs/[a-z]* \
  	   scrt/[a-z]*.sc scrt/[a-z]*.[chs] scrt/makefile-tail \
- 	   scrt/[a-z]*.asm \
  	   scsc/[a-z]*.sc scsc/[a-z]*.c scsc/[a-z]*.sch scsc/makefile-tail \
  	   test/[a-z]*.sc test/test54c.c test/makefile-tail \
  	   cdecl/README cdecl/[a-z]* \
--- 64,157 ----
  	-cd ${CPUDIR}/test; make srclinks
  
  forMIPS:
! 	make "CPU = MIPS" "CPUDIR = ${MIPSDIR}" \
  	     "BINDIR = ${MIPSBIN}" "LIBDIR = ${MIPSLIB}" forCPU
  
  forTITAN:
! 	make "CPU = TITAN" "CPUDIR = ${TITANDIR}" \
  	     "BINDIR = ${TITANBIN}" "LIBDIR = ${TITANLIB}" forCPU
  
  forVAX:
! 	make "CPU = VAX" "CPUDIR = ${VAXDIR}" \
  	     "BINDIR = ${VAXBIN}" "LIBDIR = ${VAXLIB}" forCPU
  
  # The Scheme->C system is initially compiled from the C sources by the
  # following:
  
  port:
! 	cd scrt; make port
! 	cd scsc; make port
  
  # A "private" working copy of the current compiler, libary, and interpreter
  # is installed in a directory by the following command:
  
  install-private:
! 	cd scrt; make "destdir = ${destdir}" install-private
! 	cd scsc; make "destdir = ${destdir}" install-private
  
  # Clean out working files.
  
  clean:
  	rm -f *.BAK *.CKP SC-TO-C*
! 	cd doc; make clean
! 	cd scrt; make clean
! 	cd scsc; make clean
! 	cd test; make clean
  
  # Clean up C source files generated from Scheme source.
  
  clean-sc-to-c:
! 	cd scrt; make clean-sc-to-c
! 	cd scsc; make clean-sc-to-c
! 	cd test; make clean-sc-to-c
  
  # Delete programs and libraries.
  
  noprogs:
! 	cd scrt; make noprogs
! 	cd scsc; make noprogs
! 	cd test; make noprogs
  
  # All binaries and documentation files are installed by the following command
  # for access by all users.
  
  install:
! 	cd doc; make "BINDIR = ${BINDIR}" "LIBDIR = ${LIBDIR}" install
! 	cd scrt; make "BINDIR = ${BINDIR}" "LIBDIR = ${LIBDIR}" install
! 	cd scsc; make "BINDIR = ${BINDIR}" "LIBDIR = ${LIBDIR}" install
  
  # All files which must be constructed are made by the following command:
  
  all:
! 	cd scrt; make all
! 	cd scsc; make all
  
  # Distribute "source" files required to make the Scheme->C system.
  
  srcdist:
! 	rdist -c MIPS README TITAN VAX makefile ${destdir}
! 	cd doc; make "destdir = ${destdir}/doc" srcdist
! 	-cd scbenchmark; make "destdir = ${destdir}/scbenchmark" srcdist
! 	cd scrt; make "destdir = ${destdir}/scrt" srcdist
! 	cd scsc; make "destdir = ${destdir}/scsc" srcdist
! 	-cd test; make "destdir = ${destdir}/test" srcdist
! 	-cd tools; make "destdir = ${destdir}/tools" srcdist
  
  # Distribute "binary" files so that they may be installed on some other
  # system.
  
  bindist:
! 	rdist -c MIPS README TITAN VAX makefile ${destdir}
! 	cd doc; make "destdir = ${destdir}/doc" bindist
! 	cd scrt; make "destdir = ${destdir}/scrt" bindist
! 	cd scsc; make "destdir = ${destdir}/scsc" bindist
  
  # Write the tar tape for distribution.
  
! TARFILES = CHANGES MIPS README VAX makefile \
  	   doc/[a-z]*.mss doc/[a-z]*.psf doc/[a-z]*.l doc/makefile \
  	   gnuemacs/README gnuemacs/[a-z]* \
  	   scrt/[a-z]*.sc scrt/[a-z]*.[chs] scrt/makefile-tail \
  	   scsc/[a-z]*.sc scsc/[a-z]*.c scsc/[a-z]*.sch scsc/makefile-tail \
  	   test/[a-z]*.sc test/test54c.c test/makefile-tail \
  	   cdecl/README cdecl/[a-z]* \
diff -crN schemetoc.NeXT/scrt/apollo.asm schemetoc/scrt/apollo.asm
*** schemetoc.NeXT/scrt/apollo.asm	Sun Apr 14 20:44:21 1991
--- schemetoc/scrt/apollo.asm
***************
*** 1,229 ****
- * apollo.asm - Apollo specific module for DEC's Scheme->C
- *
- * This file implements the assembly language part of the Apollo port,
- * specifically for the DN3000 and DN4000 series, that is, depending on
- * the M68020 CPU and M68881 FPP.
- *
- * Included are all the necessary math routines to catch integer overflow.
- *
- * This file is written for PIC (Position Independent Code), to build
- * a shared library.
- *
- * Ray Lischner (uunet!mntgfx!lisch)
- * 26 April 1990
- 
- 	module	sc_apollo
- 	cpu	68020,68881
- 	sri	68020
- 
- 	entry	sc_setregs
- 	entry	sc_regs
- 	entry	sc_iplus
- 	entry	sc_idifference
- 	entry	sc_inegate
- 	entry	sc_itimes
- 
- 	data
- 
- * set up jump tables for calling PIC routines
- data_start	equ	*
- 
- sc_iplus	lea	data_start,a0
- 		jmp.l	sc$iplus
- sc_idifference	lea	data_start,a0
- 		jmp.l	sc$idifference
- sc_inegate	lea	data_start,a0
- 		jmp.l	sc$inegate
- sc_itimes	lea	data_start,a0
- 		jmp.l	sc$itimes
- 
- * set up transfer address for external PIC routines
- 	extern	sc_makefloat64
- sc$makefloat64	ac	sc_makefloat64
- 
- 	text
- 
- ***********************************************************************
- * void sc_setregs(int* a6, int* a7)
- * Apollo's longjmp() checks to see if the jump is backwards in the stack.
- * If not, it assumes that something is wrong and ungracefully terminates
- * the program.  Since we don't want this to happen, we need to fake
- * out Domain/OS.  This is done by setting the stack pointer (a7) and
- * frame pointer (a6) to the destination frame, thus circumventing
- * longjmp's checks.
- *
- * To accomplish this takes some clever tricks.  First, we need to know
- * how the stack is layed out:
- *
- * (lower addresses)
- *       +----------------------------+
- *    A7 |  local storage ...         |
- *       +----------------------------+
- *    A6 | link to previous frame     |
- *       +----------------------------+
- *       | return address             |
- *       +----------------------------+
- *       | arguments pushed by caller |
- *       +----------------------------+
- * (higher addresses)
- * Note that we are ignoring floating point control blocks.
- *
- * The caller pushes the desired values for A7 and A6.  On entry to sc_setregs(),
- * A6 points to the caller's frame, and A7 points to the return address.
- * We can retrieve the caller's arguments by dereferencing a7: the second
- * argument is in 8(a7), and the first is in 4(a7).  We can just copy
- * them into the registers we want, but first we need to save the return
- * address before we lose the pointer to it.  It is saved in A0, at the
- * same time we load A6 and A7.  Clever, isn't it?  After getting the new
- * register values, we know that the caller will try to pop the
- * arguments off the stack by adding 8 to A7.  We circumvent this by
- * subtracting 8 now.
- 
- sc_setregs	procedure "sc_setregs",nocode
- 	movem.l	(a7),a0/a6-a7
- 	subq.l	#8,a7
- 	jmp	(a0)
- 
- ***********************************************************************
- * void sc_regs(int regs[12])
- * sc_regs returns the values of a1-a4, d0-d7 in the caller supplied buffer.
- * These are the "callee" save registers that need to be examined during
- * garbage collection.
- 
- sc_regs	procedure	"sc_regs",#-4
- 	move.l	8(a6),a0		* a0 := &regs[0]
- 	movem.l	d0-d7/a1-a4,(a0)	* save the interesting registers
- 	return	sc_regs
- 
- ***********************************************************************
- * The following routines are for doing arithmetic on tagged numbers.
- * The input arguments are tagged integers, that is, integers shifted
- * left by two bits.  (Except for sc_itimes, where only the second
- * argument, b, is shifted.)  This makes it easier to check for overflow,
- * but we must unshift the values before calling sc_makefloat64().
- *
- * When the result of any operation overflows, the operands are converted
- * to floating point, and the operation is repeated.  The floating point
- * result is then passed to sc_makefloat64() to produce a float object
- * to return.
- 
- * int sc_iplus(int a, int b)
- *	returns the integer sum, a + b, where a and b are the two 
- *	integer arguments, unless integer overflow occurs, then returns
- *	(unsigned int) sc_makefloat64( (double)a + (double)b ) instead.
- 
- sc$iplus	procedure	"sc_iplus",#0,a5
- 	move.l	a0,a5
- * add the arguments
- 	move.l	8(a6),d0
- 	move.l	12(a6),d1
- 	add.l	d1,d0
- * if the operation overflows, we know to use floating point
- 	bvc	1$
- 	
- * otherwise, convert to floating point and add
- 	move.l	8(a6),d0
- 	asr.l	#2,d0
- 	fmove.l	d0,fp0
- * note that d1 still contains "b"
- 	asr.l	#2,d1
- 	fmove.l	d1,fp1
- 	fadd	fp1,fp0
- * pass the floating point sum to sc_makefloat64
- 	fmove.d	fp0,-(sp)
- 	move.l	sc$makefloat64,a0
- 	jsr	(a0)
- 	addq.l	#8,sp
- 
- 1$	return	sc$iplus
- 
- 
- * int sc_idifference(int a, int b)
- *	returns integer difference, a - b, where a and b are the two 
- *	integer arguments, unless integer overflow occurs, then returns
- *	(unsigned int) sc_makefloat64( (double)a - (double)b ) instead.
- *
- 
- sc$idifference	procedure	"sc_idifference",#0,a5
- 	move.l	a0,a5
- * subtract the arguments
- 	move.l	8(a6),d0
- 	move.l	12(a6),d1
- 	sub.l	d1,d0
- * if the operation overflows, we know to use floating point
- 	bvc	1$
- 
- * otherwise, convert to floating point and subtract
- 	move.l	8(a6),d0
- 	asr.l	#2,d0
- 	fmove.l	d0,fp0
- * note that d1 still contains "b"
- 	asr.l	#2,d1
- 	fmove.l	d1,fp1
- 	fsub	fp1,fp0
- * pass the floating point sum to sc_makefloat64
- 	fmove.d	fp0,-(sp)
- 	move.l	sc$makefloat64,a0
- 	jsr	(a0)
- 	addq.l	#8,sp
- 
- 1$	return	sc$idifference
- 
- * int sc_inegate(int a)
- *	returns integer negation, -a, where a is the integer
- *	argument, unless integer overflow occurs, then returns
- *	(unsigned int) sc_makefloat64( -(double)a) instead.
- *
- 
- sc$inegate procedure	"sc_inegate",#0,a5
- 	move.l	a0,a5
- * negate the argument
- 	move.l	8(a6),d0
- 	move.l	d0,d1
- 	neg.l	d0
- * if the operation overflows, we know to use floating point
- 	bvc	1$
- 
- * otherwise, convert to floating point and negate
- 	asr.l	#2,d1
- 	fmove.l	d1,fp1
- 	fneg	fp1,fp0
- * pass the floating point sum to sc_makefloat64
- 	fmove.d	fp0,-(sp)
- 	move.l	sc$makefloat64,a0
- 	jsr	(a0)
- 	addq.l	#8,sp
- 
- 1$	return	sc$inegate
- 	
- * sc_itimes(int a, int b)
- *	returns integer procuct, a * b, where a and b are the two 
- *	integer arguments, unless integer overflow occurs, then returns
- *	(unsigned int) sc_makefloat64( (double)a * (double)b ) instead.
- * Unlike the previous arithmetic functions, only "b" has been shifted.
- 
- sc$itimes	procedure	"sc_itimes",#0,a5
- 	move.l	a0,a5
- * multiply the arguments
- 	move.l	8(a6),d0
- 	move.l	12(a6),d1
- 	muls.l	d1,d0
- 
- * if the operation overflows, we know to use floating point
- 	bvc	1$
- 
- * otherwise, convert to floating point and multiply
- 	fmove.l	8(a6),fp0
- * note that d1 still contains "b"
- 	asr.l	#2,d1
- 	fmove.l	d1,fp1
- 	fmul	fp1,fp0
- * pass the floating point sum to sc_makefloat64
- 	fmove.d	fp0,-(sp)
- 	move.l	sc$makefloat64,a0
- 	jsr	(a0)
- 	addq.l	#8,sp
- 
- 1$	return	sc$itimes
- 
- 	end
--- 0 ----
diff -crN schemetoc.NeXT/scrt/apollo.o.uu schemetoc/scrt/apollo.o.uu
*** schemetoc.NeXT/scrt/apollo.o.uu	Sun Apr 14 20:44:22 1991
--- schemetoc/scrt/apollo.o.uu
***************
*** 1,69 ****
- begin 444 apollo.o
- M 9< "28WDLH   DT    '0 L@ X  0 !   #)    "P             @   
- M 0     (?@               "YT97AT      "!J   @:@   $$   !J   
- M               @ " N=6YW:6YD    @JP  (*L    >    JP   B*    
- M   '       @+F1A=&$      0    $      "P                     
- M(   @"YB;&]C:W,   $ +  ! "P   '@   #)   "-        0    #   N
- M;&EN97,    ! @P  0(,    D@  !00                  P  +G-Y;6)O
- M;',  0*>  $"G@   I8   66                  ,  "YR=V1I      $%
- M-  !!30    X   (+   "/@       8    !   N;6ER                
- M    &@  "&0                   ( +G-R:0                    P 
- M  A^                   " $S7P0!1CT[03E;__"!N  A(T![_3EY.=4Y6
- M   O#2I(("X ""(N  S0@6@  "(@+@ (Y(#R $  Y('R 4" \@ $(O(G=  @
- M;0 H3I!0CRIN__Q.7DYU3E8  "\-*D@@+@ ((BX #)"!:   (B N  CD@/( 
- M0 #D@?(!0(#R  0H\B=T "!M "A.D%"/*F[__$Y>3G5.5@  +PTJ2" N  @B
- M $2 :   &.2!\@% @/( !!KR)W0 (&T *$Z04(\J;O_\3EY.=4Y6   O#2I(
- M("X ""(N  Q, 0@ :   'O(N0   ".2!\@% @/( !"/R)W0 (&T *$Z04(\J
- M;O_\3EY.=0    "!J  ! @0   !X        @:@   @#           @    
- M        @;   ! !     /____P  ('    ^ 2    #____\  "!_@  /@$@
- M    _____   @CP  #(!(    /____P  ()N   \ 2    #____\ 0 ! @  
- M  4 !P   #H    :    +@   > "   $  $"#  ! IX  (&H  $   ,   %*
- M"O-,   !*@0                  5P  @   /   0   "P !        0  
- M   $  ("    *         $^  (       $    (  ,       $    0!  "
- M @   "@        !(0 "    *  !    $  #    "  !    ' 0  @(    H
- M         0$  @   %   0   #X  P   !@  0   "H$  ("    *       
- M  #B  (   !X  $    ^  ,   !6  $   !%!  " @   "@         R0 "
- M    H  !    ,@ #    E  !    8 0  @(              *P  @   ,@ 
- M 0   #P  P   ,8  0   '@;     (@O+VIE;&QI;W1T+VQO8V%L7W5S97(O
- M9VYU+G-R8RYP<F]J+V1E8RUS8VAE;64O<V-R="]A<&]L;&\N87-M '-C7V%P
- M;VQL;P!S8U]S971R96=S '-C7W)E9W, <V-?:7!L=7, <V-?:61I9F9E<F5N
- M8V4 <V-?:6YE9V%T90!S8U]I=&EM97, @0 0 !\ $A,2$Q(3$D./ H$ $ !2
- MB  0$A&/ 8$ $ != (@ $A*)$H\"@0 0 ', B  3(1(2(3(2$2(1$B(2$A&)
- M(8\$@0 0 ), B  3(1(2(3(2$2(1$B(2$A&)(8\$@0 0 +( B  3(1(1(3(1
- M$B(2$A&)(8\$@0 0 ,T B  3(1(2,C(C$1(B$A(1B2&/!( 7        $ !2
- M !  514        0 %(      3X  @       1@ %P       !  70 0 & 5
- M        $ !=      $A  (    H  $8 !<        0 ', $ "*%0      
- M !  <P     ! 0 "    4  !&  7        $ "3 !  JA4        0 ), 
- M     .(  @   '@  1@ %P       !  L@ 0 ,45        $ "R      #)
- M  (   "@  $8 !<        0 ,T $ #C%0       !  S0      K  "    
- MR  !&  7        $  ! !  XQ8    !$  0 !T  R $           6    
- M 04 $  ?  ,@!           %@    #X !  (0 #( 0    *     !8     
- M\0 0 ",  R $    %      6     .8 $  E  ,@!    !X     %@    #:
- M !  *@ #( 0    H     !8     TP 0 %(  R #           6     ,@ 
- M$ !=  ,@ P    @     %@    "Z !  <P #( ,    8     !8     K0 0
- M ),  R #    5@     6     *8 $ "R  ,@ P   )0     %@    "; !  
- MS0 #( ,   #&     !@ &P    "(9&%T85]S=&%R= !S8U]I<&QU<P!S8U]I
- M9&EF9F5R96YC90!S8U]I;F5G871E '-C7VET:6UE<P!S8R1M86ME9FQO870V
- M- !S8U]S971R96=S '-C7W)E9W, <V,D:7!L=7, <V,D:61I9F9E<F5N8V4 
- M<V,D:6YE9V%T90!S8R1I=&EM97,       $      "Q!^O_^3OD  (' 0?K_
- M]$[Y  "!_D'Z_^I.^0  @CQ!^O_@3OD  ()N       #     @ !  X)"B*%
- MYP8    $  ( "     @    !  $ !     0  (*L    !@ &  ""O     8 
- M!@  @M0    &  8  (+D    !@ &  ""]     8 !@  @P0    &  8  (,4
- M    !@ &  $ 2@    X !@ ! $X    0  8  0!2    !@ &  $ 5@    H 
- M!@ !!38    *  8  05$    !@ &  $%3@    8 !@ !!5@    &  8  05B
- M    !@ &  $%9@   !P !BYF:6QE        &/_^  !G 6%P;VQL;RYA<VT 
- M                   2  "!J  ! "0" 0         (             '-C
- M7W)E9W,   "!L  ! "0" 0         0             "YT97AT      "!
- MJ  !   # 0   00                  "YU;G=I;F0   ""K  "   # 0  
- M '@ !P               "YD871A      $    #   # 0   "P         
- M         "YB;&]C:W,   $ +  $   # 0   >  !                "YL
- M:6YE<P    $"#  %   # 0   )(                  "YS>6UB;VQS  $"
- MG@ &   # 0   I8                  "YR=V1I      $%-  '   # 0  
- M #@ !@               "YM:7(            (   # 0   !H         
- M         "YS<FD            )   # 0    P                  '-C
- M7VEP;'5S  $    #  0"           =  $ "@ #  0"           L  $ 
- M%  #  0"           W  $ '@ #  0"          !!           "    
- M %!!4TT <V-?87!O;&QO '-C7W-E=')E9W, <V-?:61I9F9E<F5N8V4 <V-?
- A:6YE9V%T90!S8U]I=&EM97, <V-?;6%K969L;V%T-C0 
-  
- end
--- 0 ----
diff -crN schemetoc.NeXT/scrt/apply.h schemetoc/scrt/apply.h
*** schemetoc.NeXT/scrt/apply.h	Sun Apr 14 20:44:12 1991
--- schemetoc/scrt/apply.h	Fri Sep 21 14:51:11 1990
***************
*** 44,49 ****
--- 44,57 ----
     by the compiler to call unknown functions.
  */
  
+ #ifdef MIPS
+ #define MAXARGS 25	/* Maximum number of required arguments permitted.
+ 			   Note that this does not preclude an optional
+ 			   argument list as an additional argument.  This
+ 			   number is typically determined by the ability
+ 			   of one's C compiler.  */
+ #endif
+ 
  #ifdef TITAN
  #define MAXARGS 16	/* Maximum number of required arguments permitted.
  			   Note that this does not preclude an optional
***************
*** 50,56 ****
  			   argument list as an additional argument.  This
  			   number is typically determined by the ability
  			   of one's C compiler.  */
! #else
  #define MAXARGS 25	/* Maximum number of required arguments permitted.
  			   Note that this does not preclude an optional
  			   argument list as an additional argument.  This
--- 58,66 ----
  			   argument list as an additional argument.  This
  			   number is typically determined by the ability
  			   of one's C compiler.  */
! #endif
! 
! #ifdef VAX
  #define MAXARGS 25	/* Maximum number of required arguments permitted.
  			   Note that this does not preclude an optional
  			   argument list as an additional argument.  This
diff -crN schemetoc.NeXT/scrt/callcc.c schemetoc/scrt/callcc.c
*** schemetoc.NeXT/scrt/callcc.c	Sun Apr 14 20:44:12 1991
--- schemetoc/scrt/callcc.c	Fri Sep 21 14:51:55 1990
***************
*** 57,74 ****
  #include "callcc.h"
  #include "apply.h"
  #include "signal.h"
- 
- #ifdef SPARC
- extern	sc_setjmp();
- /* This is really tacky, but it appears to be necessary because of the */
- /* compiler on the DECStation 5100.  That beast does not seem to be able to */
- /* grok the #pragma directive. The one I tried appeared to be */
- /* Ultrix T3.1D-0 (Rev. 45) Worksystem X2.2.  */
- #include "sparc-pragma.h"
- #define setjmp( x )	sc_setjmp( x )
- #define longjmp( x, y )	sc_longjmp( x, y )
- #endif
- 
  #ifdef MIPS
  extern  sc_setsp();
  #endif
--- 57,62 ----
***************
*** 78,92 ****
  #define  setjmp( x )		sc_setjmp( x )
  #endif
  
- #ifdef APOLLO
- extern sc_setregs(int a6, int a7);
- #endif
- 
- #ifdef PRISM
- #define longjmp(x, y)		sc_longjmp(x, y)
- #define setjmp(x)		sc_setjmp(x)
- #endif
- 
  TSCP  sc_clink;		/* Pointer to inner most continuation on stack. */
  
  /* Static declarations for data structures internal to the module.  These
--- 66,71 ----
***************
*** 118,127 ****
             it will restore the stack.  */
  #ifdef MIPS
  	sc_setsp( (T_U(callcccp))->continuation.address );
- #endif
- #ifdef APOLLO
- 	sc_setregs( (T_U(callcccp))->continuation.savedstate[3],
- 		   (T_U(callcccp))->continuation.savedstate[2]);
  #endif
  	longjmp( (T_U(callcccp))->continuation.savedstate, 1 );
  }
--- 97,102 ----
diff -crN schemetoc.NeXT/scrt/cio.c schemetoc/scrt/cio.c
*** schemetoc.NeXT/scrt/cio.c	Sun Apr 14 20:44:12 1991
--- schemetoc/scrt/cio.c	Fri Sep 21 14:52:03 1990
***************
*** 46,64 ****
  #include <sys/time.h>
  #include "objects.h"
  
- /* This really does not need to be dependant on ISC386IX, just the lack of */
- /* a rename function.  This is just a dirty hack. */
- #ifdef ISC386IX
- #include <stropts.h>
- #include <poll.h>
- int rename(old, new) char *old, *new;
- {
-   if (link(old, new) == 0 && unlink(old) == 0)
-     return 0;
-   return -1;
- }
- #endif
- 
  int  sc_libc_eof = EOF;
  
  /*  feof(stream)  */
--- 46,51 ----
***************
*** 97,124 ****
     input characters ready, and 0 when none are available.
  */
  
- /* The changes here are probably generic Sys5 changes, but what the heck */
  int sc_inputchars( stream )
  	FILE *stream;
  {
  	int  readfds, nfound;
- #ifndef ISC386IX
  	struct  timeval  timeout;
- #else
- 	struct pollfd pollfd;
- #endif
  	
  	if  (((stream)->_cnt) <= 0)  {
- #ifndef ISC386IX
  	   readfds = 1<<(fileno( stream ));
  	   timeout.tv_sec = 0;
  	   timeout.tv_usec = 0;
  	   nfound = select( fileno( stream )+1, &readfds, 0, 0, &timeout );
- #else
- 	   pollfd.fd = fileno( stream );
- 	   pollfd.events = POLLIN;
- 	   nfound = poll(&pollfd, 1, 0);
- #endif
  	   if  (nfound == 0)  return( 0 );
  	}
  	return( 1 );
--- 84,100 ----
diff -crN schemetoc.NeXT/scrt/heap.c schemetoc/scrt/heap.c
*** schemetoc.NeXT/scrt/heap.c	Sun Apr 14 21:31:25 1991
--- schemetoc/scrt/heap.c	Fri Sep 21 14:54:45 1990
***************
*** 59,70 ****
  #ifdef VAX
  extern  sc_r2tor11();
  #endif
- #ifdef APOLLO
- extern sc_regs();
- #endif
- #if defined(SUN3) || defined(NeXT)
- extern	sc_a2to5d2to7();
- #endif
  
  /* Forward declarations */
  
--- 59,64 ----
***************
*** 106,116 ****
  
  int	sc_gcinfo;		/* controls logging */
  
- #ifndef SYSV
  static struct rusage gcru,	/* resource consumption during collection */
  	             startru,
  	      	     stopru;
- #endif
  
  int	*sc_stackbase;		/* pointer to base of the stack */
  
--- 100,108 ----
***************
*** 119,125 ****
  
  TSCP	sc_after_2dcollect_v;	/* Collection status callback */
  
- #ifndef SYSV
  /* The following function converts a rusage structure into an 18 word Scheme
     vector composed of the same items.
  */
--- 111,116 ----
***************
*** 250,260 ****
  	return( rusagevector( &gcru ) );
  }
  
- #else
- #define	getrusage(x,y)	/* no operation */
- #define updategcru()	/* no operation */
- #endif		/* SYSV-BSD dependency */
- 
  /* Errors detected during garbage collection are logged by the following
     procedure.  If any errors occur, the program will abort after logging
     them.  More than 30 errors will result in the program being aborted at
--- 241,246 ----
***************
*** 362,368 ****
  	pp = STACKPTR;
  	while  (pp != sc_stackbase)  move_continuation_ptr( *pp++ );
  }
! #endif /* TITAN */
  
  #ifdef VAX
  /* The following code is used to read the stack pointer.  The register
--- 348,354 ----
  	pp = STACKPTR;
  	while  (pp != sc_stackbase)  move_continuation_ptr( *pp++ );
  }
! #endif TITAN
  
  #ifdef VAX
  /* The following code is used to read the stack pointer.  The register
***************
*** 388,394 ****
  	pp = STACKPTR;
  	while  (pp != sc_stackbase)  move_continuation_ptr( *pp++ );
  }
! #endif /* VAX */
  
  #ifdef MIPS
  /* The following code is used to read the stack pointer.  The register
--- 374,380 ----
  	pp = STACKPTR;
  	while  (pp != sc_stackbase)  move_continuation_ptr( *pp++ );
  }
! #endif VAX
  
  #ifdef MIPS
  /* The following code is used to read the stack pointer.  The register
***************
*** 414,530 ****
  	pp = STACKPTR;
  	while  (pp != sc_stackbase)  move_continuation_ptr( *pp++ );
  }
! #endif /* MIPS */
! 
! #ifdef APOLLO
! /* The following code is used to read the stack pointer.  The register
!    number is passed in to force an argument to be on the stack, which in
!    turn can be used to find the address of the top of stack.
! */
! 
! int  *sc_processor_register( reg )
! 	int  reg;
! {
! 	return( &reg );
! }
! 
! /* All processor registers that might contain pointers are traced by the
!    following procedure.
! */
! 
! static  trace_stack_and_registers()
! {
! 	int  i, a1toa4_d0tod7[12], *pp;
! 
! 	sc_regs( a1toa4_d0tod7 );
! 	pp = STACKPTR;
! 	while  (pp != sc_stackbase)  move_continuation_ptr( *pp++ );
! }
! #endif /* APOLLO */
! 
! #ifdef PRISM
! /* All processor registers that might contain pointers are traced by the
!    following procedure.
! */
! 
! static  trace_stack_and_registers()
! {
! 	int  i, regs[12], *pp;
! 
! 	sc_regs( regs );
! 	pp = STACKPTR;
! 	while  (pp != sc_stackbase)  move_continuation_ptr( *pp++ );
! }
! #endif /* PRISM */
! 
! #ifdef SPARC
! /* All processor registers which might contain pointers are traced by the
!    following procedure.
! */
! 
! static  trace_stack_and_registers()
! {
! 	int  i, *pp;
! 	jmp_buf tmp;
! 
! 	pp = STACKPTR;
! 	while  (pp != sc_stackbase)  move_continuation_ptr( *pp++ );
! }
! #endif SPARC
! 
! #if defined(SUN3) || defined(NeXT)
! /* The following code is used to read the stack pointer.  The register
!    number is passed in to force an argument to be on the stack, which in
!    turn can be used to find the address of the top of stack.
! */
! 
! int  *sc_processor_register( reg )
! 	int  reg;
! {
! 	return( &reg+1 );
! }
! 
! /* All processor registers which might contain pointers are traced by the
!    following procedure.
! */
! 
! static  trace_stack_and_registers()
! {
! 	int  i, a2to5d2to7[10], *pp;
! 
! 	sc_a2to5d2to7( a2to5d2to7 );
! 	pp = STACKPTR;
! 	while  (pp != sc_stackbase)  move_continuation_ptr( *pp++ );
! }
! #endif /* SUN3 or NeXT */
! 
! 
! #ifdef I386
! /* The following code is used to read the stack pointer.  The register
!    number is passed in to force an argument to be on the stack, which in
!    turn can be used to find the address of the top of stack.
! */
! 
! int  *sc_processor_register( reg )
! 	int  reg;
! {
! 	return( &reg );
! }
! 
! /* All processor registers which might contain pointers are traced by the
!    following procedure.
! */
! 
! static  trace_stack_and_registers()
! {
! 	int  i, *pp;
! 	jmp_buf tmp;
! 
! 	setjmp(tmp);
! 	pp = STACKPTR;
! 	while  (pp != sc_stackbase)  move_continuation_ptr( *pp++ );
! }
! #endif I386
  
  
  /* The size of an extended object in words is returned by the following
--- 400,406 ----
  	pp = STACKPTR;
  	while  (pp != sc_stackbase)  move_continuation_ptr( *pp++ );
  }
! #endif MIPS
  
  
  /* The size of an extended object in words is returned by the following
***************
*** 1545,1551 ****
  	getrusage( 0, &stopru );
  	updategcru();
  	if  (sc_gcinfo)  { 
- #ifndef SYSV
  	   fprintf( stderr,
  	            "              %d%% locked  %d%% retained  %d user ms",
  		    (sc_lockcnt*100)/sc_heappages,
--- 1421,1426 ----
***************
*** 1555,1566 ****
  	   	    "  %d system ms  %d page faults\n",
  		    stopru.ru_stime.tv_sec*1000+stopru.ru_stime.tv_usec/1000,
  		    stopru.ru_majflt );
- #else
- 	   fprintf( stderr,
- 	            "              %d%% locked  %d%% retained\n",
- 		    (sc_lockcnt*100)/sc_heappages,
- 	            (sc_generationpages*100)/sc_heappages);
- #endif
  	}
  	if  (sc_gcinfo == 2)  {
  	   /* Perform additional consistency checks */
--- 1430,1435 ----
***************
*** 1794,1805 ****
     the Scheme object with that value.
  */
  
- #ifdef PRISM
- TSCP sc_makefloat32( float value )
- #else
  TSCP sc_makefloat32( value )
  	float  value;
- #endif
  {
  	SCP  pp;
  
--- 1663,1670 ----
***************
*** 1808,1815 ****
  	   pp = sc_extobjp;
  	   sc_extobjp = (SCP)(((int*)sc_extobjp)+FLOAT32SIZE);
  	   sc_extobjwords = sc_extobjwords-FLOAT32SIZE;
! 	   pp->float32.tag = FLOAT32TAG;
! 	   pp->float32.rest = 0;
  	}
  	else
  	   pp = sc_allocateheap( FLOAT32SIZE, FLOAT32TAG, 0 );
--- 1673,1679 ----
  	   pp = sc_extobjp;
  	   sc_extobjp = (SCP)(((int*)sc_extobjp)+FLOAT32SIZE);
  	   sc_extobjwords = sc_extobjwords-FLOAT32SIZE;
! 	   pp->unsi.gned = FLOAT32TAG;
  	}
  	else
  	   pp = sc_allocateheap( FLOAT32SIZE, FLOAT32TAG, 0 );
***************
*** 1821,1840 ****
  /* 64-bit floating point numbers are constructed by the following function.  It
     is called with a 64-bit floating point value and it returns a pointer to
     the Scheme object with that value.
- 
-    On the Apollo Prism, it is vital that we use a function prototype,
-    so the compiler knows that the function's argument is being passed
-    in a register.  Without the prototype, the argument is read from
-    the stack.  See prism.asm for examples where it is simpler to pass
-    the argument in a register.  Also see objects.h for the declaration.
  */
  
- #ifdef PRISM
- TSCP sc_makefloat64( double value )
- #else
  TSCP sc_makefloat64( value )
  	double  value;
- #endif
  {
  	SCP  pp;
  
--- 1685,1694 ----
***************
*** 1844,1851 ****
  	   pp = sc_extobjp;
  	   sc_extobjp = (SCP)(((int*)sc_extobjp)+FLOAT64SIZE);
  	   sc_extobjwords = sc_extobjwords-FLOAT64SIZE;
! 	   pp->float64.tag = FLOAT64TAG;
! 	   pp->float64.rest = 0;
  	}
  	else
  	   pp = sc_allocateheap( FLOAT64SIZE, FLOAT64TAG, 0 );
--- 1698,1704 ----
  	   pp = sc_extobjp;
  	   sc_extobjp = (SCP)(((int*)sc_extobjp)+FLOAT64SIZE);
  	   sc_extobjwords = sc_extobjwords-FLOAT64SIZE;
! 	   pp->unsi.gned = FLOAT64TAG;
  	}
  	else
  	   pp = sc_allocateheap( FLOAT64SIZE, FLOAT64TAG, 0 );
diff -crN schemetoc.NeXT/scrt/heap.h schemetoc/scrt/heap.h
*** schemetoc.NeXT/scrt/heap.h	Sun Apr 14 21:33:47 1991
--- schemetoc/scrt/heap.h	Fri Sep 21 14:54:58 1990
***************
*** 42,74 ****
  /* Import definitions */
  
  #ifndef rusage
- 
- #ifdef apollo
- #include <sys/time.h>
- #else
- #ifdef SPARC
- #include <sys/time.h>
- #else
- #ifdef SUN3
- #include <sys/time.h>
- #else
- #ifdef NeXT
- #include <sys/time.h>
- #else
- #ifndef SYSV
  #include <time.h>
- #endif
- #endif
- #endif
- #endif
- #endif
- 
- #ifndef SYSV
  #include <sys/resource.h>
  #endif
  
- #endif
- 
  /* This module implements the object storage storage system for SCHEME->C.
  
     Unlike most Lisp systems, it is not intended that SCHEME->C provide a
--- 42,51 ----
***************
*** 341,371 ****
  
  #ifdef VAX
  #define STACKPTR sc_processor_register( 14 )
- #endif
- 
- #ifdef APOLLO
- #define STACKPTR sc_processor_register( 7 )
- #endif
- 
- #ifdef PRISM
- extern int* prism_stack_frame(void);
- #define STACKPTR prism_stack_frame()
- #endif
- 
- #ifdef I386
- #define STACKPTR sc_processor_register( 4 )
- #endif
- 
- #ifdef SPARC
- #define STACKPTR sc_processor_register( 0 )
- #endif
- 
- #ifdef SUN3
- #define STACKPTR sc_processor_register( 15 )
- #endif
- 
- #ifdef NeXT
- #define STACKPTR sc_processor_register( 15 )
  #endif
  
  /* Some objects require cleanup actions when they are freed.  For example,
--- 318,323 ----
diff -crN schemetoc.NeXT/scrt/makefile-tail schemetoc/scrt/makefile-tail
*** schemetoc.NeXT/scrt/makefile-tail	Wed Apr 17 14:22:06 1991
--- schemetoc/scrt/makefile-tail	Fri Sep 21 14:54:59 1990
***************
*** 34,42 ****
              scqquote.sc screp.sc \
              scrt1.sc scrt2.sc scrt3.sc scrt4.sc scrt5.sc scrt6.sc scrt7.sc
  
! Smisc = GGC.c GGC.h GGCprivate.h apollo.asm prism.asm mips.s predef.sc \
! 	repdef.sc sci.sc sci.c vax.s sparc.s i386.s sun3.s sparc-pragma.h \
! 	next.s
  
  ${Sruntimec} sci.c:	${predef.sc} ${objects.h}
  
--- 34,40 ----
              scqquote.sc screp.sc \
              scrt1.sc scrt2.sc scrt3.sc scrt4.sc scrt5.sc scrt6.sc scrt7.sc
  
! Smisc = GGC.c GGC.h GGCprivate.h mips.s predef.sc repdef.sc sci.sc sci.c vax.s
  
  ${Sruntimec} sci.c:	${predef.sc} ${objects.h}
  
***************
*** 51,61 ****
  .c.u:
  	${CC} -j -D${cpu} -I. $*.c
  
- # Apollo assembler
- .asm.o:
- 	$(ASM) $* $(AFLAGS)
- 	-mv $*.bin $*.o
- 
  .s.o:
  	${CC} -c $*.s
  
--- 49,54 ----
***************
*** 76,82 ****
  	      -lm
  
  GGCi:		${Sruntimec} ${Sruntime} ${Aruntime} GGC.o sci.c sci.o
! 	$(MAKE) "CFLAGS = -DGGC ${CFLAGS}" GGCheap.o GGCscinit.o
  	${CC} -o GGCi ${CFLAGS} ${Sruntime} ${GGCCruntime} ${Aruntime} sci.o \
  	      -lXaw -lXt -lX11 -lm
  
--- 69,75 ----
  	      -lm
  
  GGCi:		${Sruntimec} ${Sruntime} ${Aruntime} GGC.o sci.c sci.o
! 	make "CFLAGS = -DGGC ${CFLAGS}" GGCheap.o GGCscinit.o
  	${CC} -o GGCi ${CFLAGS} ${Sruntime} ${GGCCruntime} ${Aruntime} sci.o \
  	      -lXaw -lXt -lX11 -lm
  
***************
*** 85,91 ****
  	mv Xlibsc.a libsc.a
  	
  port:
! 	$(MAKE) "CC = ${CC}" "CFLAGS = ${CFLAGS}" "sccomp = echo" \
  	     Xlibsc.a Xsci Xmv ${Plib}
  
  libsc_p.a:	libsc.a
--- 78,84 ----
  	mv Xlibsc.a libsc.a
  	
  port:
! 	make "CC = ${CC}" "CFLAGS = ${CFLAGS}" "sccomp = echo" \
  	     Xlibsc.a Xsci Xmv ${Plib}
  
  libsc_p.a:	libsc.a
***************
*** 92,98 ****
  	mkdir saveobj
  	mv ${Sruntime} ${Cruntime} ${Aruntime} saveobj
  	rm -f libsc_p.a
! 	$(MAKE) "CC = ${CC}" "CFLAGS = ${CFLAGS} -pg" ${Sruntime} ${Cruntime} \
  	     ${Aruntime}
  	ar q libsc_p.a ${Cruntime} ${Sruntime} ${Aruntime}
  	ranlib libsc_p.a
--- 85,91 ----
  	mkdir saveobj
  	mv ${Sruntime} ${Cruntime} ${Aruntime} saveobj
  	rm -f libsc_p.a
! 	make "CC = ${CC}" "CFLAGS = ${CFLAGS} -pg" ${Sruntime} ${Cruntime} \
  	     ${Aruntime}
  	ar q libsc_p.a ${Cruntime} ${Sruntime} ${Aruntime}
  	ranlib libsc_p.a
***************
*** 134,140 ****
  	rm -f sci libsc.a libsc_p.a
  
  srcdist:
! 	rdist -c README *.c *.h *.s *.sc *.asm makefile-tail ${destdir}
  
  bindist:
  	rdist -c README makefile makefile-tail predef.sc objects.h \
--- 127,133 ----
  	rm -f sci libsc.a libsc_p.a
  
  srcdist:
! 	rdist -c README *.c *.h *.s *.sc makefile-tail ${destdir}
  
  bindist:
  	rdist -c README makefile makefile-tail predef.sc objects.h \
***************
*** 141,147 ****
  	      libsc.a ${Plib} sci ${destdir}
  
  all:
! 	$(MAKE) "CC = ${CC}" "CFLAGS = ${CFLAGS}" "sccomp = ${sccomp}" \
  	     Xlibsc.a Xsci Xmv ${Plib}
  
  srclinks:
--- 134,140 ----
  	      libsc.a ${Plib} sci ${destdir}
  
  all:
! 	make "CC = ${CC}" "CFLAGS = ${CFLAGS}" "sccomp = ${sccomp}" \
  	     Xlibsc.a Xsci Xmv ${Plib}
  
  srclinks:
diff -crN schemetoc.NeXT/scrt/next.s schemetoc/scrt/next.s
*** schemetoc.NeXT/scrt/next.s	Sun Apr 14 21:26:48 1991
--- schemetoc/scrt/next.s
***************
*** 1,69 ****
- |
- | SCHEME->C
- |
- | NeXT assembly code.
- |
- 
- |
- |              Copyright 1989 Digital Equipment Corporation
- |                         All Rights Reserved
- |
- | Permission to use, copy, and modify this software and its documentation is
- | hereby granted only under the following terms and conditions.  Both the
- | above copyright notice and this permission notice must appear in all copies
- | of the software, derivative works or modified versions, and any portions
- | thereof, and both notices must appear in supporting documentation.
- |
- | Users of this software agree to the terms and conditions set forth herein,
- | and hereby grant back to Digital a non-exclusive, unrestricted, royalty-free
- | right and license under any changes, enhancements or extensions made to the
- | core functions of the software, including but not limited to those affording
- | compatibility with other hardware or software environments, but excluding
- | applications which incorporate this software.  Users further agree to use
- | their best efforts to return to Digital any such changes, enhancements or
- | extensions that they make and inform Digital of noteworthy uses of this
- | software.  Correspondence should be provided to Digital at:
- | 
- |                       Director of Licensing
- |                       Western Research Laboratory
- |                       Digital Equipment Corporation
- |                       100 Hamilton Avenue
- |                       Palo Alto, California  94301  
- | 
- | This software may be distributed (but not offered for sale or transferred
- | for compensation) to third parties, provided such third parties agree to
- | abide by the terms and conditions of this notice.  
- | 
- | THE SOFTWARE IS PROVIDED "AS IS" AND DIGITAL EQUIPMENT CORP. DISCLAIMS ALL
- | WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF
- | MERCHANTABILITY AND FITNESS.   IN NO EVENT SHALL DIGITAL EQUIPMENT
- | CORPORATION BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL
- | DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR
- | PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS
- | ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
- | SOFTWARE.
- |
- 
- |
- | sc_a2to5d2to7
- |
- |   sc_a2to5d2to7( a )
- | will return the contents of A2, ..., A5, D2, ..., D7 starting at address 'a'.
- |
- |
- 	.text
- 	.globl	_sc_a2to5d2to7
- 	.even
- _sc_a2to5d2to7:
- 	movl	sp@(4),a0
- 	movl	a2,a0@(0)
- 	movl	a3,a0@(4)
- 	movl	a4,a0@(8)
- 	movl	a5,a0@(12)
- 	movl	d2,a0@(16)
- 	movl	d3,a0@(20)
- 	movl	d4,a0@(24)
- 	movl	d5,a0@(28)
- 	movl	d6,a0@(32)
- 	movl	d7,a0@(36)
- 	rts
--- 0 ----
diff -crN schemetoc.NeXT/scrt/objects.c schemetoc/scrt/objects.c
*** schemetoc.NeXT/scrt/objects.c	Sun Apr 14 20:44:13 1991
--- schemetoc/scrt/objects.c	Fri Sep 21 14:55:56 1990
***************
*** 482,488 ****
  		break;
  	   case EXTENDEDTAG:
  	        if  (TX_U( p )->extendedobj.tag == FLOATTAG)
! 		   return ROUND( FLOAT_VALUE( p ) );
  		break;
  	}
  	sc_error( "TSCP_INT", "Argument cannot be converted to C int", 0 );
--- 482,488 ----
  		break;
  	   case EXTENDEDTAG:
  	        if  (TX_U( p )->extendedobj.tag == FLOATTAG)
! 		   return( (int)( TX_U( p )->FLOATUTYPE.value ) );
  		break;
  	}
  	sc_error( "TSCP_INT", "Argument cannot be converted to C int", 0 );
***************
*** 506,514 ****
  	        if  (TX_U( p )->extendedobj.tag == FLOATTAG)  {
  		   v = TX_U( p )->FLOATUTYPE.value;
  		   if  (v <= (double)(0x7fffffff))
! 		      return( (unsigned)ROUND( v ) );
  		   else
! 		      return( (unsigned)ROUND( v-((double)(0x40000000))*2.0 ) |
  		   	      0x80000000 );
  		}
  		break;
--- 506,514 ----
  	        if  (TX_U( p )->extendedobj.tag == FLOATTAG)  {
  		   v = TX_U( p )->FLOATUTYPE.value;
  		   if  (v <= (double)(0x7fffffff))
! 		      return( (unsigned)( v ) );
  		   else
! 		      return( (unsigned)( v-((double)(0x40000000))*2.0 ) |
  		   	      0x80000000 );
  		}
  		break;
***************
*** 543,551 ****
  		   case FLOATTAG:
  		      v = TX_U( p )->FLOATUTYPE.value;
  		      if  (v <= (double)(0x7fffffff))
! 		         return( (unsigned int)( v ) );
  		      else
! 		         return( (unsigned int)( v-((double)(0x40000000))*2.0 ) |
  		   	         0x80000000 );
  		      break;
  		}
--- 543,551 ----
  		   case FLOATTAG:
  		      v = TX_U( p )->FLOATUTYPE.value;
  		      if  (v <= (double)(0x7fffffff))
! 		         return( (unsigned)( v ) );
  		      else
! 		         return( (unsigned)( v-((double)(0x40000000))*2.0 ) |
  		   	         0x80000000 );
  		      break;
  		}
diff -crN schemetoc.NeXT/scrt/objects.h schemetoc/scrt/objects.h
*** schemetoc.NeXT/scrt/objects.h	Sun Apr 14 21:38:43 1991
--- schemetoc/scrt/objects.h	Fri Sep 21 14:56:06 1990
***************
*** 43,57 ****
  */
  
  /* Default the value of CPUTYPE if not currently defined. */
  #ifndef MIPS
  #ifndef TITAN
  #ifndef VAX
- #ifndef SPARC
- #ifndef SUN3
- #ifndef I386
- #ifndef APOLLO
- #ifndef PRISM
- 
  #ifdef mips
  #define MIPS 1
  #endif
--- 43,52 ----
  */
  
  /* Default the value of CPUTYPE if not currently defined. */
+ 
  #ifndef MIPS
  #ifndef TITAN
  #ifndef VAX
  #ifdef mips
  #define MIPS 1
  #endif
***************
*** 61,94 ****
  #ifdef vax
  #define VAX 1
  #endif
! #ifdef sun
! #  ifdef sparc
! #    define SPARC 1
! #  else
! #    ifdef mc68000
! #      define SUN3 1
! #    endif
! #  endif
! #endif
! #ifdef i386
! #define I386 1
! #endif
! #ifdef apollo
! #  ifdef _ISP_A88K
! #    define PRISM 1
! #  else
! #    define APOLLO 1
! #  endif
! #endif
! 
! #endif /* PRISM */
! #endif /* APOLLO */
! #endif /* I386 */
! #endif /* SUN3 */
! #endif /* SPARC */
! #endif /* VAX */
! #endif /* TITAN */
! #endif /* MIPS */
  
  /* The Scheme->C installer may elect to have arithmetic overflow handled
     gracefully on either the MIPS or the VAX implementations.  The default
--- 56,64 ----
  #ifdef vax
  #define VAX 1
  #endif
! #endif
! #endif
! #endif
  
  /* The Scheme->C installer may elect to have arithmetic overflow handled
     gracefully on either the MIPS or the VAX implementations.  The default
***************
*** 110,116 ****
  #ifdef TITAN
  #include <setjmp.h>
  #define CPUTYPE TITAN
- #undef MATHTRAPS
  #endif
  
  #ifdef VAX
--- 80,85 ----
***************
*** 127,182 ****
  #define CPUTYPE VAX
  #endif
  
- #ifdef APOLLO
- #include <setjmp.h>
- #define CPUTYPE APOLLO
- #define BIG_ENDIAN
- #endif
- 
- #ifdef PRISM
- /* Use our own setjmp/longjmp so we can make sure all the registers
-    are saved that need to be saved, namely, .10 through .23,
-    plus the signal mask, return PC, and PSWs.
- 
-    The layout of these registers in the array is described in prism.asm.
- */
- typedef int jmp_buf[18];
- #define CPUTYPE PRISM
- #define BIG_ENDIAN
- #endif
- 
- #ifdef SPARC
- typedef int jmp_buf[2+7+8+8+1];
- #define DOUBLE_ALIGN 1
- #define CPUTYPE SPARC
- #define BIG_ENDIAN
- #undef MATHTRAPS
- #define MATHTRAPS 0
- #endif
- 
- #ifdef SUN3
- #include <setjmp.h>
- #define CPUTYPE SUN3
- #define BIG_ENDIAN
- #undef MATHTRAPS
- #define MATHTRAPS 0
- #endif
- 
- #ifdef NeXT
- #include <setjmp.h>
- #define CPUTYPE NeXT
- #define BIG_ENDIAN
- #undef MATHTRAPS
- #define MATHTRAPS 0
- #endif
- 
- #ifdef I386
- #include <setjmp.h>
- #define CPUTYPE I386
- #undef MATHTRAPS
- #define MATHTRAPS 0
- #endif
- 
  /* The data encoding scheme is similar to that used by Vax NIL and T, where
     all objects are represented by 32-bit pointers, with a "low tag" encoded
     in the two least significant bits encoding the type.  All objects are
--- 96,101 ----
***************
*** 204,227 ****
  
  struct  STACKTRACE;
  
- /*
-   Ugly, but machine independent way to declare and use bit fields:
-   Bit fields are declared using F?(...), where the least significant
-   fields are listed first (in honor of the original implementations).
-   Similarly, static objects are created with the U?(...) macros.
-  */
- #ifdef BIG_ENDIAN
- #define	F2(a,b)		b;a
- #define F3(a,b,c)	c;b;a
- #define U2(a,b)		(b),(a)
- #define	U3(a,b,c)	(c),(b),(a)
- #else
- #define F2(a,b)		a;b
- #define F3(a,b,c)	a;b;c
- #define U2(a,b)		(a),(b)
- #define U3(a,b,c)	(a),(b),(c)
- #endif
- 
  typedef char *TSCP;
  
  typedef union SCOBJ {		/* SCHEME to C OBJECT */
--- 123,128 ----
***************
*** 229,240 ****
  	      unsigned  gned;
  	   }  unsi;
  	   struct {	/* EXTENDEDOBJ */
! 	      F2(unsigned  tag:8,
! 	      unsigned  rest:24);
  	   }  extendedobj;
  	   struct {	/* SYMBOL */
! 	      F2(unsigned  tag:8,
! 	      unsigned  rest:24);
  	      TSCP  name;
  	      TSCP  *ptrtovalue;
  	      TSCP  value;
--- 130,141 ----
  	      unsigned  gned;
  	   }  unsi;
  	   struct {	/* EXTENDEDOBJ */
! 	      unsigned  tag:8;
! 	      unsigned  rest:24;
  	   }  extendedobj;
  	   struct {	/* SYMBOL */
! 	      unsigned  tag:8;
! 	      unsigned  rest:24;
  	      TSCP  name;
  	      TSCP  *ptrtovalue;
  	      TSCP  value;
***************
*** 241,271 ****
  	      TSCP  propertylist;
  	   }  symbol;
  	   struct {	/* STRING */
! 	      F2(unsigned  tag:8,
! 	      unsigned  length:24);
  	      char  char0;
  	   }  string;
  	   struct {	/* VECTOR */
! 	      F2(unsigned  tag:8,
! 	      unsigned  length:24);
  	      TSCP  element0;
  	   }  vector;
  	   struct {	/* PROCEDURE */
! 	      F3(unsigned  tag:8,
! 	      unsigned  required:8,
! 	      unsigned  optional:16);
  	      TSCP  (*code)();
  	      TSCP  closure;
  	   }  procedure;
  	   struct {	/* CLOSURE */
! 	      F2(unsigned  tag:8,
! 	      unsigned  length:24);
  	      TSCP  closure;
  	      TSCP  var0;
  	   }  closure;
  	   struct {	/* CONTINUATION */
! 	      F2(unsigned  tag:8,
! 	      unsigned  length:24);
  	      TSCP  continuation;
  	      jmp_buf  savedstate;
  	      int  *address;
--- 142,172 ----
  	      TSCP  propertylist;
  	   }  symbol;
  	   struct {	/* STRING */
! 	      unsigned  tag:8;
! 	      unsigned  length:24;
  	      char  char0;
  	   }  string;
  	   struct {	/* VECTOR */
! 	      unsigned  tag:8;
! 	      unsigned  length:24;
  	      TSCP  element0;
  	   }  vector;
  	   struct {	/* PROCEDURE */
! 	      unsigned  tag:8;
! 	      unsigned  required:8;
! 	      unsigned  optional:16;
  	      TSCP  (*code)();
  	      TSCP  closure;
  	   }  procedure;
  	   struct {	/* CLOSURE */
! 	      unsigned  tag:8;
! 	      unsigned  length:24;
  	      TSCP  closure;
  	      TSCP  var0;
  	   }  closure;
  	   struct {	/* CONTINUATION */
! 	      unsigned  tag:8;
! 	      unsigned  length:24;
  	      TSCP  continuation;
  	      jmp_buf  savedstate;
  	      int  *address;
***************
*** 273,295 ****
  	      int  word0;
  	   }  continuation;
  	   struct {	/* FLOAT32 */
! 	      F2(unsigned  tag:8,
! 	      unsigned  rest:24);
  	      float  value;
  	   }  float32;
  	   struct {	/* FLOAT64 */
! 	      F2(unsigned  tag:8,
! 	      unsigned  rest:24);
  	      double  value;
  	   }  float64;
  	   struct {	/* FORWARD */
! 	      F2(unsigned  tag:8,
! 	      unsigned  length:24);
  	      TSCP  forward;
  	   } forward;
  	   struct {	/* WORDALIGN */
! 	      F2(unsigned  tag:8,
! 	      unsigned  length:24);
  	   }  wordalign;
  	   struct {	/* PAIR */
  	      TSCP  car;
--- 174,196 ----
  	      int  word0;
  	   }  continuation;
  	   struct {	/* FLOAT32 */
! 	      unsigned  tag:8;
! 	      unsigned  rest:24;
  	      float  value;
  	   }  float32;
  	   struct {	/* FLOAT64 */
! 	      unsigned  tag:8;
! 	      unsigned  rest:24;
  	      double  value;
  	   }  float64;
  	   struct {	/* FORWARD */
! 	      unsigned  tag:8;
! 	      unsigned  length:24;
  	      TSCP  forward;
  	   } forward;
  	   struct {	/* WORDALIGN */
! 	      unsigned  tag:8;
! 	      unsigned  length:24;
  	   }  wordalign;
  	   struct {	/* PAIR */
  	      TSCP  car;
***************
*** 319,344 ****
  #define  TX_U( tscp ) ((SCP)((char*)tscp-EXTENDEDTAG))
  #define  TP_U( tscp ) ((SCP)((char*)tscp-PAIRTAG))
  #endif
- #ifdef apollo
- #define  TX_U( tscp ) ((SCP)((char*)tscp-EXTENDEDTAG))
- #define  TP_U( tscp ) ((SCP)((char*)tscp-PAIRTAG))
- #endif
- #ifdef SPARC
- #define  TX_U( tscp ) ((SCP)((char*)tscp-EXTENDEDTAG))
- #define  TP_U( tscp ) ((SCP)((char*)tscp-PAIRTAG))
- #endif
- #ifdef SUN3
- #define  TX_U( tscp ) ((SCP)((char*)tscp-EXTENDEDTAG))
- #define  TP_U( tscp ) ((SCP)((char*)tscp-PAIRTAG))
- #endif
- #ifdef NeXT
- #define  TX_U( tscp ) ((SCP)((char*)tscp-EXTENDEDTAG))
- #define  TP_U( tscp ) ((SCP)((char*)tscp-PAIRTAG))
- #endif
- #ifdef I386
- #define  TX_U( tscp ) ((SCP)((char*)tscp-EXTENDEDTAG))
- #define  TP_U( tscp ) ((SCP)((char*)tscp-PAIRTAG))
- #endif
  
  /* Fixed point numbers are encoded in the address portion of the pointer.  The
     value is obtained by arithmetically shifting the pointer value two bits to
--- 220,225 ----
***************
*** 745,780 ****
     When the procedure is exited, sc_stacktrace is restored.  In order to assure
     that sc_stacktrace always points to a valid entry, the list is maintained
     by subroutines (compilers want to optimize it out!).
- 
-    In dobacktrace(), the stack is traced by calling C-UNSIGNED-REF
-    to get the prevstacktrace pointer.  The problem with this is that
-    C-UNSIGNED-REF (aka scrt4_c_2dunsigned_2dref) uses MUNSIGNED, which
-    uses T_U, which masks out the least significant two bits of the pointer.
-    The trick is to get an implementation independent method of aligning
-    the stacktrace structure.  Most compilers at least align the structure
-    with an even address, but only some will align it on a four-byte boundary.
- 
-    The macro ALIGN4(t,x) declares "x" to be a pointer to "t", aligned on
-    a 4-byte boundary.  If nothing special needs to be done, then the default
-    definition can be used.
- */
- 
- #ifdef APOLLO
- /* On an Apollo, things are usually aligned properly on the stack,
-    but after an interrupt, things can get screwy, and even doubles
-    can end up non-longword aligned.  To be safe, we need to align
-    everything on a longword boundary ourselves.
  */
- #define IDENT(a)	a
- #define CAT(a,b)	IDENT(a)b
- #define ALIGN4(t,x)	char CAT(x,buf)[sizeof(t) + sizeof(long)];\
-     t& x = * (t*) ((unsigned)CAT(x,buf) & ~(sizeof(long)-1))
- #endif
  
- /* the rest of the world does not need to worry about such matters */
- #ifndef ALIGN4
- #define ALIGN4(t,x)	t x
- #endif
  struct  STACKTRACE {			/* Stack trace back record */
  	struct STACKTRACE*  prevstacktrace;	
  	TSCP  procname;
--- 626,633 ----
***************
*** 783,789 ****
  
  extern  struct STACKTRACE  *sc_stacktrace;
  
! #define  PUSHSTACKTRACE( procedure )	ALIGN4(struct  STACKTRACE,  st); \
  					sc_pushtrace( &st, (procedure) )
  
  #define  POPSTACKTRACE( exp )		return( sc_poptrace( &st, (exp) ) )
--- 636,642 ----
  
  extern  struct STACKTRACE  *sc_stacktrace;
  
! #define  PUSHSTACKTRACE( procedure )	struct  STACKTRACE  st; \
  					sc_pushtrace( &st, (procedure) )
  
  #define  POPSTACKTRACE( exp )		return( sc_poptrace( &st, (exp) ) )
***************
*** 882,902 ****
  #ifdef VAX
  #define VECTOR_ELEMENT( tscp, n ) (*((PATSCP)(((char*)( tscp ))+3+((int)n))))
  #endif
- #ifdef apollo
- #define VECTOR_ELEMENT( tscp, n ) (*((PATSCP)(((char*)( tscp ))+3+((int)n))))
- #endif
- #ifdef SPARC
- #define VECTOR_ELEMENT( tscp, n ) (*((PATSCP)(((char*)( tscp ))+3+((int)n))))
- #endif
- #ifdef I386
- #define VECTOR_ELEMENT( tscp, n ) (*((PATSCP)(((char*)( tscp ))+3+((int)n))))
- #endif
- #ifdef SUN3
- #define VECTOR_ELEMENT( tscp, n ) (*((PATSCP)(((char*)( tscp ))+3+((int)n))))
- #endif
- #ifdef NeXT
- #define VECTOR_ELEMENT( tscp, n ) (*((PATSCP)(((char*)( tscp ))+3+((int)n))))
- #endif
  
  #define PROCEDURE_REQUIRED( tscp )  (TX_U( tscp )->procedure.required)
  #define PROCEDURE_OPTIONAL( tscp )  (TX_U( tscp )->procedure.optional)
--- 735,740 ----
***************
*** 915,930 ****
  /* C declarations */
  
  #define DEFSTRING( name, chars, len ) \
! 	static struct { F2(unsigned tag:8, \
! 		        unsigned length:24); \
  		        char char0[len+(4-(len % 4))]; } \
! 	name = { U2(STRINGTAG, len), chars }
  
  #define DEFFLOAT( name, value ) \
! 	static struct { F2(unsigned tag:8, \
! 		        unsigned length: 24); \
  		        FLOATTYPE f; } \
! 	name = { U2(FLOATTAG, 0), value }
  
  #define DEFTSCP( name ) TSCP  name
  
--- 753,768 ----
  /* C declarations */
  
  #define DEFSTRING( name, chars, len ) \
! 	static struct { unsigned tag:8; \
! 		        unsigned length:24; \
  		        char char0[len+(4-(len % 4))]; } \
! 	name = { STRINGTAG, len, chars }
  
  #define DEFFLOAT( name, value ) \
! 	static struct { unsigned tag:8; \
! 		        unsigned length: 24; \
  		        FLOATTYPE f; } \
! 	name = { FLOATTAG, 0, value }
  
  #define DEFTSCP( name ) TSCP  name
  
***************
*** 1019,1032 ****
  
  /* C operators that detect integer overflow in some implementations */
  
! #if (MATHTRAPS == 0 || CPUTYPE == TITAN)
  #define IPLUS( a, b )		(a + b)
  #define IDIFFERENCE( a, b )	(a - b)
  #define INEGATE( a )		(- a)
  #define ITIMES( a, b )		(a * b)
! 
! #else
  
  #define IPLUS( a, b )		sc_iplus( a, b )
  #define IDIFFERENCE( a, b )	sc_idifference( a, b )
  #define ITIMES( a, b )		sc_itimes( a, b )
--- 857,870 ----
  
  /* C operators that detect integer overflow in some implementations */
  
! #if (MATHTRAPS == 0  ||  CPUTYPE == TITAN)
  #define IPLUS( a, b )		(a + b)
  #define IDIFFERENCE( a, b )	(a - b)
  #define INEGATE( a )		(- a)
  #define ITIMES( a, b )		(a * b)
! #endif
  
+ #if  (MATHTRAPS  &&  (CPUTYPE == MIPS || CPUTYPE == VAX))
  #define IPLUS( a, b )		sc_iplus( a, b )
  #define IDIFFERENCE( a, b )	sc_idifference( a, b )
  #define ITIMES( a, b )		sc_itimes( a, b )
***************
*** 1057,1088 ****
     significant 8 bits of the extended object header.
  */
  
! #define UNKNOWNCALL( proc, argc ) \
!     (sc_unknownargc = argc, sc_unknownproc[ 1 ] = proc, \
!     sc_unknownproc[(PROCEDURE_REQUIRED(sc_unknownproc[ TSCPTAG(proc) ]) == argc\
! 		    && ! PROCEDURE_OPTIONAL(sc_unknownproc[ TSCPTAG( proc )]))])
! /* UNSI_GNED(sc_unknownproc[ TSCPTAG( proc ) ] ) \
! 		    == (argc*256+PROCEDURETAG)) ])
! */
  
  /* Inline type conversions */
  
! /* round a floating point number to the nearest integer */
! #ifdef apollo
! #include <math.h>
! /* Apollo SR10.2, with cc 6.7: rint() returns a bogus value (e.g., 0.9
!    is "rounded" to 0.899902).
!    If Apollo does not fix rint() soon, then we should write our own.
! */
! #define rint(x)		floor((x) + 0.5)
! #define ROUND(x)	((int) rint(x))
! #endif
! 
! #ifndef ROUND
! #define ROUND(x)	((int) (x))
! #endif
! 
! #define FLT_FIX( flt )   C_FIXED( ROUND(FLOAT_VALUE( flt )) )
  #define FIX_FLT( fix )   MAKEFLOAT( (FLOATTYPE)(FIXED_C( fix )) )
  #define FIX_FLTV( fix )  ((FLOATTYPE)(FIXED_C( fix )))
  #define FLTV_FLT( flt )	 MAKEFLOAT( flt )
--- 895,910 ----
     significant 8 bits of the extended object header.
  */
  
! #define UNKNOWNCALL( proc, argc ) (sc_unknownargc = argc, \
! 				   sc_unknownproc[ 1 ] = proc, \
! 				   sc_unknownproc[ \
! 				     (UNSI_GNED( \
! 				         sc_unknownproc[ TSCPTAG( proc ) ] ) \
! 				      == (argc*256+PROCEDURETAG)) ])
  
  /* Inline type conversions */
  
! #define FLT_FIX( flt )   C_FIXED( (int)(FLOAT_VALUE( flt )) )
  #define FIX_FLT( fix )   MAKEFLOAT( (FLOATTYPE)(FIXED_C( fix )) )
  #define FIX_FLTV( fix )  ((FLOATTYPE)(FIXED_C( fix )))
  #define FLTV_FLT( flt )	 MAKEFLOAT( flt )
***************
*** 1131,1147 ****
     definitions needed by a SCHEME->C program.
  */
  
- #ifdef PRISM
- /* As explained in heap.c, it is important to declare the function prototype,
-    so the compiler passes the floating point argument in a register, rather
-    than on the stack.
- */
- extern  TSCP  sc_makefloat32(float);
- extern  TSCP  sc_makefloat64(double);
- #else
  extern  TSCP  sc_makefloat32();
  extern  TSCP  sc_makefloat64();
- #endif
  extern  TSCP  sc_cons();
  extern  int  sc_unknownargc;
  extern  TSCP  sc_unknownproc[ 4 ];
--- 953,960 ----
diff -crN schemetoc.NeXT/scrt/prism.asm schemetoc/scrt/prism.asm
*** schemetoc.NeXT/scrt/prism.asm	Sun Apr 14 20:44:22 1991
--- schemetoc/scrt/prism.asm
***************
*** 1,387 ****
- * prism.asm - Apollo Prism (DN10000) specific module for DEC's Scheme->C
- *
- * This file implements the assembly language part of the Prism port,
- * specifically for the DN10000.
- *
- * Included are all the necessary math routines to catch integer overflow.
- *
- * NOTE: Don't even try to read this file if you do not understand
- * how an Apollo Prism (also called an AT, for Advanced Technology;
- * perhaps Apollo thinks the Prism is as good as an IBM PC AT :-) works.
- * I have tried to optimize the parallel operations, such as branch and
- * call shadows, and combining integer and floating point operations.
- * (The former are common; the latter are rare in this file.)
- *
- * The sematics of b.sa are completely different from b.sn, and the
- * subtle differences are too lengthy to discuss here.  Read the
- * various Apollo manuals, such as the AT Assembler Reference and
- * the AT Technical Reference.
- *
- * Apollo's setjmp/longjmp do not permit jumps to random locations in the
- * stack, so we must write our own.  On the DN3000 (M68K), we can get away
- * with simply altering the stack and frame pointers (A6 and A7) before
- * calling longjmp, but on the Prism this does not work because longjmp
- * only jumps to a valid stack frame.  I tried modifying call/cc to
- * restore the stack and registers before calling longjmp(), but this
- * does not work because it changes the data base register, which messes
- * up the call to longjmp.  The simplest solution is to reimplemen]t
- * setjmp and longjmp.
- *
- * Another reason to write our own setjmp/longjmp is to make sure all
- * the registers are saved properly.  The standard jmp_buf does not have
- * enough room to save all the needed registers.
- *
- * Ray Lischner (uunet!mntgfx!lisch)
- * 1 May 1990
- 
- 	module	sc_prism
- 
- 	export.f	prism_stack_frame
- 	export.p	sc_longjmp
- 	export.f	sc_setjmp
- 	export.p	sc_regs
- 	export.f	sc_iplus
- 	export.f	sc_idifference
- 	export.f	sc_inegate
- 	export.f	sc_itimes
- 
- 	import.f	sc_makefloat64
- 	import.f	sigblock
- 	import.f	sigsetmask
- 
- 	data
- 
- * set up ECBs for all the functions that need one
- data_frame	equ	*
- 
- sc_setjmp	procedure	ok
- 	.0 = sc$setjmp		; get the relocatable address of the routine
- 	.1 = .sf		; save the old stack frame
- 	.2 = #data_frame	; get the relocatable data frame
- 	b.sa [.0]		; branch to the real routine
- 	[--.sf,#16] = .1	; push the old .SF onto the stack
- 
- sc_longjmp	procedure	ok
- 	.0 = sc$longjmp		; get the relocatable address of the routine
- 	.1 = .sf		; save the old stack frame
- 	.2 = #data_frame	; get the relocatable data frame
- 	b.sa [.0]		; branch to the real routine
- 	[--.sf,#16] = .1	; push the old .SF onto the stack
- 
- sc_idifference	procedure	ok
- 	.0 = sc$idifference	; get the relocatable address of the routine
- 	.1 = .sf		; save the old stack frame
- 	.2 = #data_frame	; get the relocatable data frame
- 	b.sa [.0]		; branch to the real routine
- 	[--.sf,#16] = .1	; push the old .SF onto the stack
- 
- sc_inegate	procedure	ok
- 	.0 = sc$inegate		; get the relocatable address of the routine
- 	.1 = .sf		; save the old stack frame
- 	.2 = #data_frame	; get the relocatable data frame
- 	b.sa [.0]		; branch to the real routine
- 	[--.sf,#16] = .1	; push the old .SF onto the stack
- 
- sc_iplus	procedure	ok
- 	.0 = sc$iplus		; get the relocatable address of the routine
- 	.1 = .sf		; save the old stack frame
- 	.2 = #data_frame	; get the relocatable data frame
- 	b.sa [.0]		; branch to the real routine
- 	[--.sf,#16] = .1	; push the old .SF onto the stack
- 
- sc_itimes	procedure	ok
- 	.0 = sc$itimes		; get the relocatable address of the routine
- 	.1 = .sf		; save the old stack frame
- 	.2 = #data_frame	; get the relocatable data frame
- 	b.sa [.0]		; branch to the real routine
- 	[--.sf,#16] = .1	; push the old .SF onto the stack
- 
- * jump table for the ECBs
- sc$setjmp	data.l	sc$$setjmp
- sc$longjmp	data.l	sc$$longjmp
- sc$idifference	data.l	sc$$idifference
- sc$inegate	data.l	sc$$inegate
- sc$iplus	data.l	sc$$iplus
- sc$itimes	data.l	sc$$itimes
- 
- * relocation table for the external functions
- sc$makefloat64	data.l	sc_makefloat64
- sig$setmask	data.l	sigsetmask
- sig$block	data.l	sigblock
- 	proc
- 
- ***********************************************************************
- * int prism_stack_frame(void)
- * Return the caller's stack frame pointer.  See the STACKPTR macro
- * in heap.h for how this is called.
- 
- prism_stack_frame	procedure ok
- 	b.sa [.return]
- 	.0 = .sf
- 
- 
- ***********************************************************************
- * int sc_setjmp(jmp_buf buf)
- * Save the current signal mask, processor status words, and preserved
- * registers in the caller-supplied buffer, and return zero.
- 
- sc$$setjmp	procedure name="sc_setjmp",return=save,stack=(),save=1$
- 	[.sf,4] = .4
- 	[.sf,8] = .return
- 	[.sf,12] = .10
- 	.10 = .2
- 	using .10, data_frame
- 1$	.0 = .ipsw		; and the processor status words
- 	[.4++] = .0
- 	.0 = .fppsw
- 	[.4++] = .0
- 	.0 = [.sf,12]	; old value of .10
- 	[.4++] = .0
- 	[.4++] = .11
- 	[.4++] = .12
- 	[.4++] = .13
- 	[.4++] = .14
- 	[.4++] = .15
- 	[.4++] = .16
- 	[.4++] = .17
- 	[.4++] = .18
- 	[.4++] = .19
- 	[.4++] = .20
- 	[.4++] = .21
- 	[.4++] = .return
- 	.0 = [.sf]
- 	[.4++] = .0
- 
- 	.3 = sig$block		; and the current signal mask
- 	.return = call.sa [.3]	; sigblock(0)
- 	.4 = .null
- 	.4 = [.sf,4]
- 	[.4++] = .0
- 
- 	.10 = [.sf,12]		; restore the saved registers
- 	.return = [.sf,8]
- 	.0 = .null
- 	b.sa [.return]		; return(0)
- 	.sf = [.sf]
- 
- 	drop .10
- 	endp
- 
- * void longjmp(jmp_buf buf, int rtn)
- * Jump to the location saved by a previous call to setjmp(), such that
- * it looks to the caller of setjmp() as though setjmp returned "rtn".
- * If "rtn" is zero, one is returned.
- 
- sc$$longjmp	procedure name="sc_longjmp",return=save,stack=(),save=1$
- 	[.sf,8] = .return
- 	using .2, data_frame
- 1$	.cc = .5
- 	.0 = [.4++]
- 	bnz.sf 2$	; make sure the return value is non-zero
- 	.5 = #1
- 2$	.ipsw = .0
- 	.0 = [.4++]
- 	.fppsw = .0
- 	.10 = [.4++]
- 	.11 = [.4++]
- 	.12 = [.4++]
- 	.13 = [.4++]
- 	.14 = [.4++]
- 	.15 = [.4++]
- 	.16 = [.4++]
- 	.17 = [.4++]
- 	.18 = [.4++]
- 	.19 = [.4++]
- 	.20 = [.4++]
- 	.21 = [.4++]
- 	.0 = [.4++]
- 	[.sf,8] = .0		; save the return PC
- 	.0 = [.4++]
- 	[.sf] = .0		; save .sf
- 	[.sf,4] = .5		; save return value
- 
- 	.3 = sig$setmask	; restore the signal mask
- 	.return = call.sa [.3]
- 	.4 = [.4]
- 
- 	.0 = [.sf,4]		; return the user-supplied "rtn"
- 	.return = [.sf,8]
- 	b.sa [.return]
- 	.sf = [.sf]
- 	endp
- 
- ***********************************************************************
- * void sc_regs(int regs[12])
- * sc_regs stores the values of .10 - .21 in the caller supplied buffer.
- * These are the "callee" save registers that need to be examined during
- * garbage collection.
- 
- sc_regs	procedure ok
- 	[.4++] = .10
- 	[.4++] = .11
- 	[.4++] = .12
- 	[.4++] = .13
- 	[.4++] = .14
- 	[.4++] = .15
- 	[.4++] = .16
- 	[.4++] = .17
- 	[.4++] = .18
- 	[.4++] = .19
- 	[.4++] = .20
- 	b.sa [.return]
- 	[.4] = .21
- 	endp
- 
- ***********************************************************************
- * The following routines are for doing arithmetic on tagged numbers.
- * The input arguments are tagged integers, that is, integers shifted
- * left by two bits.  (Except for sc_itimes, where only the second
- * argument, b, is shifted.)  This makes it easier to check for overflow,
- * but we must unshift the values before calling sc_makefloat64().
- *
- * When the result of any operation overflows, the operands are converted
- * to floating point, and the operation is repeated.  The floating point
- * result is then passed to sc_makefloat64() to produce a float object
- * to return.
- 
- 
- * int sc_iplus(int a, int b)
- *	returns the integer sum, a + b, where a and b are the two 
- *	integer arguments, unless integer overflow occurs, then returns
- *	(unsigned int) sc_makefloat64( (double)a + (double)b ) instead.
- 
- sc$$iplus	procedure	name="sc_iplus",return=save,stack=(),save=1$
- 	[.sf,8] = .return
- * add the arguments
- 1$	.0.cc = .4 + .5		; try adding the arguments as integers
- 	.4 = .4 SHRA #2		; wait 1 cycle until CCs set
- 	bnv.sf 2$		; return if the integer operation worked
- 	.5 = .5 SHRA #2		; otherwise keep working
- 	.fs0.i = .5		; convert the integers to floating point
- 	.fs1.i = .4
- 	.fd8 = float(.fs1.i)
- 	.fd0 = float(.fs0.i)
- * get ready to call makefloat64, while adding the operands
- 	.3 = sc$makefloat64, .fd8 += .fd0
- 	.return = call.sn [.3]	; call sc_makefloat64()
- 	nop
- 	.return = [.sf,8]	; pop the return PC
- 
- 2$	b.sa [.return]		; return
- 	.sf = [.sf]		; restore the old .SF
- 	endp
- 
- 
- * int sc_idifference(int a, int b)
- *	returns integer difference, a - b, where a and b are the two 
- *	integer arguments, unless integer overflow occurs, then returns
- *	(unsigned int) sc_makefloat64( (double)a - (double)b ) instead.
- 
- sc$$idifference	procedure	ok,name="sc_idifference"
- 	[.sf,8] = .return
- * subtract the arguments
- 1$	.0.cc = .4 - .5		; try subtracting the arguments as integers
- 	.4 = .4 SHRA #2		; wait 1 cycle until CCs set
- 	bnv.sf 2$		; return if the integer operation worked
- 	.5 = .5 SHRA #2		; otherwise keep working
- 	.fs0.i = .5		; convert the integers to floating point
- 	.fs1.i = .4
- 	.fd8 = float(.fs1.i)
- 	.fd0 = float(.fs0.i)
- * get ready to call makefloat64, while subtracting the operands
- 	.3 = sc$makefloat64, .fd8 -= .fd0
- 	.return = call.sn [.3]	; call sc_makefloat64()
- 	nop
- 	.return = [.sf,8]	; pop the return PC
- 
- 2$	b.sa [.return]		; return
- 	.sf = [.sf]		; restore the old .SF
- 	endp
- 
- * int sc_inegate(int a)
- *	returns integer negation, -a, where a is the integer
- *	argument, unless integer overflow occurs, then returns
- *	(unsigned int) sc_makefloat64( -(double)a) instead.
- 
- sc$$inegate procedure	ok,name="sc_inegate"
- 	[.sf,8] = .return
- * negate the argument
- 1$	.0.cc = -.4		; try negating the argument as an integer
- 	.4 = .4 SHRA #2		; wait 1 cycle until CCs set
- 	bnv.sf 2$		; return if the integer operation worked
- 	.fs0.i = .4		; otherwise keep working
- 	.fd8 = float(.fs0.i)	; convert the argument to floating point
- * get ready to call makefloat64, while negating the argument
- 	.3 = sc$makefloat64, .fd8 = -.fd8
- 	.return = call.sn [.3]	; call sc_makefloat64()
- 	nop
- 	.return = [.sf,8]	; pop the return PC
- 
- 2$	b.sa [.return]		; return
- 	.sf = [.sf]		; restore the old .SF
- 	endp
- 	
- * sc_itimes(int a, int b)
- *	returns integer procuct, a * b, where a and b are the two 
- *	integer arguments, unless integer overflow occurs, then returns
- *	(unsigned int) sc_makefloat64( (double)a * (double)b ) instead.
- *	Unlike the previous arithmetic functions, only "b" has been shifted.
- *
- * 	This is a pain on a Prism because we need to use the floating
- *	point unit for the integer multiply, and that means we cannot
- *	set the integer condition codes.  Instead, we do a normal
- *	floating point multiply and explicitly check the result to see
- *	if it fits into an integer.  If not, we divide by 4 to get the
- *	true result.  Note that this does not affect the precision
- *	of the result.
- 
- sc$$itimes	procedure	name="sc_itimes",return=save,stack=(),save=1$
- 	[.sf,8] = .return
- 1$	.fs0.i = .4		; load floating point registers for the
- 	.fs1.i = .5		; multiplication
- 	.fd8 = float(.fs0.i)
- 	.fd2 = float(.fs1.i)
- * do the multiply; at the same time, load sc_makefloat64's address, to
- * get ready for calling it, in case the multiply overflows
- 	.3 = sc$makefloat64, .fd8 *= .fd2
- 
- * The floating point constants do not change, so we can put them in
- * the shared text segment.  Change the address base to .PC, so we
- * use PC-relative addressing.
- 	drop .2
- 
- * look for overflow by comparing with the maximum allowable integer
- 	.fd2 = maxint		; get maxint
- 	.fcc = .fd8 ? .fd2
- 	bfgt.sf 2$		; see if the result fits into an integer
- 	.fd2 = minint.fd
- 	.fcc = .fd8 ? .fd2
- 	bflt.sf 2$
- 
- 	.fs0.i = round(.fd8)	; yes, so convert it to an integer
- 	b.sa 3$			; and return
- 	.0 = .fs0.i
- 
- 2$	.fd0 = four
- 	.fd8 /= .fd0		; get the real floating point value
- 	.return = call.sn [.3]	; call sc_makefloat64()
- 	nop
- 	.return = [.sf,8]	; pop the return PC
- 
- 3$	b.sa [.return]		; return
- 	.sf = [.sf]		; restore the old .SF
- 
- * constant value for the division, above
- four	data.fd	4.0
- 
- * maximum and minimum possible integer, for comparison, above
- maxint	data.fd  2147483644.0
- 
- * The assembler seems to ignore the sign of a floating point constant.
- * A Prism uses IEEE format, so the smallest possible integer
- * is pretty easy to write in hexadecimal.
- *minint	data.fd -2147483648.0
- minint	data.q	h'C1E00000, h'00000000
- 	endp
- 
- 	end
--- 0 ----
diff -crN schemetoc.NeXT/scrt/prism.o.uu schemetoc/scrt/prism.o.uu
*** schemetoc.NeXT/scrt/prism.o.uu	Sun Apr 14 20:44:23 1991
--- schemetoc/scrt/prism.o.uu
***************
*** 1,82 ****
- begin 444 prism.o
- M 90 ""8]YI@   K0    )0 L@ H  0 !   $R    *             (    
- M$                        "YT97AT      @!@  ( 8    +8   !@   
- M             ! @ " N=6YW:6YD   (!%@ " 18    <   !%@   GX    
- M   '   0   @+F1A=&$     $    !       *    3(   */@      "0  
- M$   0"YM:7(                    <   %:                    @ N
- M<W)I                    #   !80                   ( +F)L;V-K
- M<P  $ "@ !  H    U    60   *F       !0    ,  "YL:6YE<P   ! #
- M\  0 _    $8   (X                  #   N<WEM8F]L<P 0!0@ $ 4(
- M                             P  )#  %A 7(!]HEP $:M< "&E7  P1
- M0B ??!\@ #@$$@3\'R(  .0" #@$$@1@%P ,. 02!#ED$@0YA!($.:02!#G$
- M$@0YY!($.@02!#HD$@0Z1!($.F02!#J$$@0ZI!($.L02!& 7   X!!($8&H 
- MF"+   ,0GR ?8)< !#@$$@1A5P ,8M< "! ?(!\D,  68O<  &K7  @3Y6 ?
- M/ 02!"V<  (8OP !?!\  #P$$@3\'P(  .0" #U$$@0]9!($/802!#VD$@0]
- MQ!($/>02!#X$$@0^)!($/D02!#YD$@0^A!($/J02!#P$$@1H%P (/ 02!&@7
- M  !HMP $8&( E"+   -@A   8!< !&+7  @D,  68O<  #E$$@0Y9!($.802
- M!#FD$@0YQ!($.>02!#H$$@0Z)!($.D02!#ID$@0ZA!($)#  %FJD  !JUP (
- M$ 1@!1""OT0MW  /$**_1?R_ 0  Y $ _)\!! #D 023_P ?-CR 09/_ !\V
- M/   X&( D#*,@@ BQ  #$_\ 'V+7  @D,  68O<  &K7  @0!&@%$(*_1"W<
- M  \0HK]%_+\!  #D 0#\GP$$ .0!!)/_ !\V/(!!D_\ 'S8\  #@8@"0,IR"
- M "+$  ,3_P ?8M< ""0P !9B]P  :M< "! ?: 00@K]$K=P "P3$  #\GP$ 
- M .0! )/_ !\V/(  X&( D#)<@@@BQ  #$_\ 'V+7  @D,  68O<  &K7  C\
- MGP$  .0! /R_ 00 Y $$D_\ 'S8\@ "3_P ?-CP@0>!B ) P3(("[#X < 3$
- M  "3_P ?$[P" BJ<  QL/@!DD_\ 'Q.\ @*K'  (!,0  )/_ !\V' ((K#  
- M"P3$  #\'R$  .0! .P> "@$Q   D_\ 'S ,@@ BQ  #$_\ 'V+7  @D,  6
- M8O<       ! $        $'?____    P>          " &(  %H!    '  
- M      @!B   1@   @  _^V"   ( A0  $(   (  /_M@(  " +,   H   "
- M  #_[8"   @#'   *       _^P    ( VP  "       /_L    " .L  !6
- M   "  #_[8" 8!X >! W(!\87O_X)#   #@WE'!@'@!H$#<@'QA>_^0D,   
- M.#>4<& > %@0-R ?&%[_T"0P   X-Y1P8!X 2! W(!\87O^\)#   #@WE'!@
- M'@ X$#<@'QA>_Z@D,   .#>4<& > "@0-R ?&%[_E"0P   X-Y1P  @!B  (
- M A0 " ,<  @#;  ( LP " .L                          (  0 . #DC
- M6\;3    !  "  @    *       !  $ !    !@!  $"    !@ .    /@  
- M !H    R   #4 (   4 " &  !     0 *  $ /P ! %" ,   $F/>@!   "
- M0@0  @(              P<          0   *P  0   BP !    /0$  ("
- M              +4          $   !   $   'L  0   #A!  " @      
- M       "G0         !    4  !   !G  $    RP0  @(             
- M FP          0   %   0   4P !    +4$  ("              (\    
- M      $    T  $   $8  0   "A!  " @             ""0         !
- M    A  !    E  $    >@0  @(              =<          0   (P 
- M 0    @ !    %$$  ("              &=          $    (  $     
- M  0   !(!  " @             !:P         !    %  "    9  $    
- M/ 0  @(              3H          0   !0  @   %  !    # $  ("
- M              $'          $    4  (    \  0    D!  " @      
- M        T          !    %  "    *  $    & 0  @(             
- M )T          0   !0  @   !0 !     P$  ("              !K    
- M      $    4  (       0     &P    #<+R]J96QL:6]T="]L;V-A;%]U
- M<V5R+V=N=2YS<F,N<')O:B]D96,M<V-H96UE+W-C<G0O<')I<VTN87-M '-C
- M7W-E=&IM< !S8U]L;VYG:FUP '-C7VED:69F97)E;F-E '-C7VEN96=A=&4 
- M<V-?:7!L=7, <V-?:71I;65S '!R:7-M7W-T86-K7V9R86UE '-C7W-E=&IM
- M< !S8U]L;VYG:FUP '-C7W)E9W, <V-?:7!L=7, <V-?:61I9F9E<F5N8V4 
- M<V-?:6YE9V%T90!S8U]I=&EM97,  ($ $  Z !$1$1&/ 8$ $ !! !$1$1&/
- M 8$ $ !( !$1$1&/ 8$ $ !/ !$1$1&/ 8$ $ !6 !$1$1&/ 8$ $ != !$1
- M$1&/ 8$ $ !W !&/ 8$ $ "! !$1$2$1$1(1$1$1$1$1$1$1$1$1$1$1(1$1
- M$1$A$1$1$8\!@0 0 +  (1$1$1$1$1(1$1$1$1$1$1$1$1$1$1$1(1$1(1$1
- M$8\!@0 0 -P $1$1$1$1$1$1$1$1CP&! !  _@ A$1$1$1(2$B(2$1$A$8\!
- M@0 0 1D (1$1$1$2$A(B$A$1(1&/ 8$ $ $S "$1$1(2(A(1$2$1CP&! ! !
- M4P 1$A(2,H(( A(2$1$2(A(2(A(2$1$A$8\(@       " 18    $@ &  @$
- M:    !( !@ (!'@    2  8 " 2(    $@ &  @$F    !( !@ (!*@    2
- M  8 " 2X    $@ & !  >    !( !@ 0 'P    2  8 $ "     $@ & !  
- MA    !( !@ 0 (@    2  8 $ ",    $@ & !  D    "0 !@ 0 )0    B
- M  8 $ "8    (P & !  O@   !( !@ 0 ,(    6  8 $ #&    '  & !  
- MR@   !X !@ 0 ,X    @  8        N9FEL90       "+__@  9P%P<FES
- M;2YA<VT                     5  0 &0  P D @$                 
- M   $            20 0 #P  P D @$                    &        
- M    .@ 0 "@  P D @$                    (  !S8U]I<&QU<P 0 %  
- M P D @$                    *  !S8U]R96=S   ( I@  0 D @$     
- M               ,            ,  0     P D @$                 
- M   .            )0 0 !0  P D @$                    0        
- M    $P ( 8   0 D @$                    2   N=&5X=      ( 8  
- M 0   P$   +8                   N=6YW:6YD   (!%@  @   P$   !P
- M  <                N9&%T80     0     P   P$   "@  D         
- M       N;6ER            !    P$    <                   N<W)I
- M            !0   P$    ,                   N8FQO8VMS   0 *  
- M!@   P$   -0  4                N;&EN97,    0 _  !P   P$   $8
- M                   N<WEM8F]L<P 0!0@ "    P$                 
- M                ;0           @!S:6=B;&]C:P           @      
- M    7@           @    !X<')A<VT <V-?<')I<VT <')I<VU?<W1A8VM?
- M9G)A;64 <V-?;&]N9VIM< !S8U]S971J;7  <V-?:61I9F9E<F5N8V4 <V-?
- L:6YE9V%T90!S8U]I=&EM97, <V-?;6%K969L;V%T-C0 <VEG<V5T;6%S:P!?
-  
- end
--- 0 ----
diff -crN schemetoc.NeXT/scrt/scinit.c schemetoc/scrt/scinit.c
*** schemetoc.NeXT/scrt/scinit.c	Sat Jun 15 15:00:18 1991
--- schemetoc/scrt/scinit.c	Fri Sep 21 14:57:01 1990
***************
*** 47,55 ****
  
  /* External Definitions */
  
- #ifdef NeXT
- #define sbrk my_sbrk
- #endif
  extern  char *sbrk();
  extern  char *getenv();
  
--- 47,52 ----
***************
*** 73,114 ****
  #include <vax/vmparam.h>
  #define STACKBASE (int*)USRSTACK
  #endif
- #ifdef apollo
- #define ETEXT	((int)&etext)	/* First address after text */
- #include <sys/param.h>
- /* the stack back moves depending on shared libraries */
- #include <apollo/base.h>
- #include <apollo/error.h>
- #include <apollo/proc2.h>
- static proc2_$info_t sc_apollo_proc2;
- #define STACKBASE ((int*) sc_apollo_proc2.stack_base)
- #endif
- #ifdef SPARC
- #define ETEXT	((int)&etext)	/* First address after text */
- #include <sun4/vmparam.h>
- #define STACKBASE (int*)USRSTACK
- #endif
- #ifdef SUN3
- #define ETEXT	((int)&etext)	/* First address after text */
- #include <sun3/param.h>
- #include <sun3/vmparam.h>
- #define STACKBASE (int*)USRSTACK
- #endif
- #ifdef NeXT
- #define ETEXT	((int)get_etext())
- #include <next/vmparam.h>
- #define STACKBASE (int*)USRSTACK
- #endif
- #ifdef ISC386IX
- #define ETEXT	((int)&etext)	/* First address after text */
- #include <sys/types.h>
- #include <sys/fcntl.h>		/* probably should be elsewhere */
- #include <sys/immu.h>
- #define STACKBASE (int*)UVSTACK
- #endif
  
- #include <sys/types.h>
  #include <sys/file.h>
  #include <sys/uio.h>
  #include <strings.h>
  #include <varargs.h>
--- 70,78 ----
  #include <vax/vmparam.h>
  #define STACKBASE (int*)USRSTACK
  #endif
  
  #include <sys/file.h>
+ #include <sys/types.h>
  #include <sys/uio.h>
  #include <strings.h>
  #include <varargs.h>
***************
*** 132,143 ****
  
  /* Global data structure for this module. */
  
! /* this struct must look like an SCOBJ */
! static struct
! {
!     F2(unsigned  tag:8,
!     unsigned  length:24);
! } emptyvector, emptystring[2];
  
  FILE   *sc_stdin,	/* Standard I/O Subroutine FILE pointers */
         *sc_stdout,
--- 96,103 ----
  
  /* Global data structure for this module. */
  
! static int  emptyvector = VECTORTAG,
!             emptystring[2] = {STRINGTAG, 0};
  
  FILE   *sc_stdin,	/* Standard I/O Subroutine FILE pointers */
         *sc_stdout,
***************
*** 223,229 ****
  
  static  init_procs()
  {
- #ifndef SYSV
          INITIALIZEVAR( U_TX( ADR( t1030 ) ), 
                         ADR( sc_my_2drusage_v ), 
                         MAKEPROCEDURE( 0, 
--- 183,188 ----
***************
*** 233,239 ****
                         MAKEPROCEDURE( 0, 
                                        0, 
                                        sc_collect_2drusage, EMPTYLIST ) );
- #endif
          INITIALIZEVAR( U_TX( ADR( t1034 ) ), 
                         ADR( sc_collect_v ), 
                         MAKEPROCEDURE( 0, 
--- 192,197 ----
***************
*** 330,348 ****
  	char  *freebase;
  	TSCP  unknown;
  
- #ifdef apollo
- 	/* on an apollo, we get the stack top at run time */
- 	uid_$t me;
- 	status_$t status;
- 	proc2_$who_am_i(&me);
- 	proc2_$get_info(me, &sc_apollo_proc2, sizeof(sc_apollo_proc2), &status);
- 	if (status.all != status_$ok && status.all != proc2_$is_current)
- 	{
- 	    error_$print(status);
- 	    exit(2);
- 	}
- #endif
- 
  	if  (sc_gcinfo)
  	   fprintf( stderr, "***** SCGCINFO = %d  SCHEAP = %d  SCLIMIT = %d\n",
  	   	    sc_gcinfo, scheap, sclimit );
--- 288,293 ----
***************
*** 374,381 ****
  	sc_mutex = 0;
  	sc_pendingsignals = 0;
  	sc_emptylist = EMPTYLIST;
- 	emptyvector.tag = VECTORTAG;
- 	emptystring[0].tag = STRINGTAG;
  	sc_emptyvector = U_T( &emptyvector, EXTENDEDTAG );
  	sc_emptystring = U_T( emptystring, EXTENDEDTAG );
  	sc_falsevalue = FALSEVALUE;
--- 319,324 ----
***************
*** 614,625 ****
  	if  (scheap < save.heappages/(ONEMB/PAGEBYTES))
  	   scheap = save.heappages/(ONEMB/PAGEBYTES);
  	if  (sclimit < save.limit)  sclimit = save.limit;
- #ifdef sun
- 	/* in SunOS, stderr is line buffered, which causes some unwanted */
- 	/* malloc..  */
- 	if (sc_gcinfo)
- 	    setbuf(stderr, (char*)0);
- #endif
  	if  (sc_gcinfo)
  	   fprintf( stderr, "***** SCGCINFO = %d  SCHEAP = %d  SCLIMIT = %d\n",
  		    sc_gcinfo, scheap, sclimit );
--- 557,562 ----
***************
*** 665,672 ****
  	sc_mutex = 0;
  	sc_pendingsignals = 0;
  	sc_emptylist = EMPTYLIST;
- 	emptyvector.tag = VECTORTAG;
- 	emptystring[0].tag = STRINGTAG;
  	sc_emptyvector = U_T( &emptyvector, EXTENDEDTAG );
  	sc_emptystring = U_T( emptystring, EXTENDEDTAG );
  	sc_falsevalue = FALSEVALUE;
--- 602,607 ----
***************
*** 767,773 ****
  	scrt6_error( sc_string_2d_3esymbol( sc_cstringtostring( symbol ) ),
  		     sc_cstringtostring( format ),
  		     scrt1_reverse( argl ) );
- 	va_end( argp );
  }
  
  /* The following function returns informations about the implementation.  The
--- 702,707 ----
***************
*** 796,817 ****
  #ifdef VAX
  		    sc_cstringtostring( "VAX" ),
  #endif
- #ifdef apollo
- 		    sc_cstringtostring( "Apollo" ),
- #endif
- #ifdef SPARC
- 		    sc_cstringtostring( "Sun4/SPARC" ),
- #endif
- #ifdef SUN3
- 		    sc_cstringtostring( "Sun3" ),
- #endif
- #ifdef NeXT
- 		    sc_cstringtostring( "NeXT" ),
- #endif
- #ifdef I386
- 		    sc_cstringtostring( "AT/386" ),
- #endif
- 
  		    sc_cons(
  #ifdef MIPS
  		       sc_cstringtostring( "R2000" ),
--- 730,735 ----
***************
*** 822,871 ****
  #ifdef VAX
  		       sc_cstringtostring( "VAX" ),
  #endif
- #ifdef APOLLO
- 		       sc_cstringtostring( "68K" ),
- #endif
- #ifdef PRISM
- 		       sc_cstringtostring( "PRISM" ),
- #endif
- #ifdef SPARC
- 		       sc_cstringtostring( "SPARC" ),
- #endif
- #ifdef SUN3
- 		       sc_cstringtostring( "68K" ),
- #endif
- #ifdef NeXT
- 		       sc_cstringtostring( "68K" ),
- #endif
- #ifdef I386
- 		       sc_cstringtostring( "Intel 386" ),
- #endif
  		       sc_cons(
- #ifdef NeXT
- 		          sc_cstringtostring( "NeXT OS 2.0" ),
- #else
- #ifdef apollo
- 		          sc_cstringtostring( "Domain/OS" ),
- #else /* ! apollo */
- #ifdef SPARC
- #ifdef sun
- 			  sc_cstringtostring( "SunOS" ),
- #else
- 			  sc_cstringtostring( "SparcOS" ),
- #endif /* sun */
- #else /* ! SPARC */
- #ifdef SUN3
- 			  sc_cstringtostring( "SunOS" ),
- #else
- #ifdef SYSV
- 			  sc_cstringtostring( "System V.3.2" ),
- #else
  		          sc_cstringtostring( "ULTRIX" ),
- #endif /* SYSV */
- #endif /* SUN3 */
- #endif /* SPARC */
- #endif /* apollo */
- #endif /* NeXT */
  		          sc_cons(
  			      FALSEVALUE,
  			      EMPTYLIST
--- 740,747 ----
***************
*** 877,924 ****
  	          )
  	      );
  }
- 
- #ifdef NeXT
- #include <mach.h>
- #include <stdio.h>
- 
- char               *my_current_brk = 0;
- char               *my_end_brk = 0;
- 
- char *
- my_sbrk(int incr)
- {
-   char               *temp, *ptr;
-   kern_return_t       rtn;
- 
-   if (my_current_brk == 0) {
-     if ((rtn = vm_allocate(task_self(), (vm_address_t *) & my_current_brk,
- 			   vm_page_size, 1)) != KERN_SUCCESS) {
-       mach_error("my_sbrk: vm_allocate failed", rtn);
-       return ((char *)-1);
-     }
-     my_end_brk = my_current_brk + vm_page_size;
-   }
-   if (incr == 0) return (my_current_brk);
-  more:
-   ptr = my_current_brk + incr;
-   if (ptr <= my_end_brk) {
-     temp = my_current_brk;
-     my_current_brk = ptr;
-     return (temp);
-   } else {
-     if ((rtn = vm_allocate(task_self(), (vm_address_t *) &ptr,
- 			   vm_page_size, 1)) != KERN_SUCCESS) {
-       mach_error("my_sbrk: vm_allocate failed", rtn);
-       return ((char *)-1);
-     }
-     if (ptr != my_end_brk) {
-       fprintf(stderr, "my_sbrk: internal error\n");
-       fflush(stderr);
-       return ((char *)-1);
-     }
-     my_end_brk = ptr + vm_page_size;
-     goto more;
-   }
- }
- #endif /* NeXT */
--- 753,755 ----
diff -crN schemetoc.NeXT/scrt/signal.c schemetoc/scrt/signal.c
*** schemetoc.NeXT/scrt/signal.c	Sun Apr 14 20:44:15 1991
--- schemetoc/scrt/signal.c	Fri Sep 21 15:00:13 1990
***************
*** 49,57 ****
  #include "apply.h"
  #include "signal.h"
  #include "/usr/include/signal.h"
- #ifdef apollo
- #include <apollo/base.h>
- #endif
  
  extern TSCP  scrt4_onsignal2();
  
--- 49,54 ----
***************
*** 121,131 ****
  	}
  	else  {
  	   /* Signal must be defered */
- #ifdef SYSV
- 	   sighold( signal );
- #else
  	   sigblock( 1<<signal );
- #endif
  	   pendingsignals = pendingsignals | (1<<signal);
  	   if  (gcinprogress == 0)  sc_pendingsignals = 1;
  	}
--- 118,124 ----
***************
*** 157,178 ****
  	/* Send the pending signals and exit the critical section */
  	sc_pendingsignals = 0;
  	self = getpid();
- #ifndef SYSV
  	oldmask = sigblock( -1 ) & ~pendingsignals;
- #endif
  	for  (i = 0; i < 32; i++)
! 	  if  (pendingsignals & (1<<i)) {
! #ifdef SYSV
! 	    sigrelse( i );
! #endif
! 	    kill( self, i );
! 	  }
! 
  	pendingsignals = 0;
  	sc_mutex = 0;
- #ifndef SYSV
  	sigsetmask( oldmask );
! #endif
  	/* Apply the when-unreferenced procedures */
  	while  (freed != EMPTYLIST)  {
  	   object_procedure = PAIR_CAR( freed );
--- 150,162 ----
  	/* Send the pending signals and exit the critical section */
  	sc_pendingsignals = 0;
  	self = getpid();
  	oldmask = sigblock( -1 ) & ~pendingsignals;
  	for  (i = 0; i < 32; i++)
! 	   if  (pendingsignals & (1<<i))  kill( self, i );
  	pendingsignals = 0;
  	sc_mutex = 0;
  	sigsetmask( oldmask );
! 
  	/* Apply the when-unreferenced procedures */
  	while  (freed != EMPTYLIST)  {
  	   object_procedure = PAIR_CAR( freed );
***************
*** 202,208 ****
  	int sig, code;
  	struct sigcontext *scp;
  {
! #if (TITAN || (MATHTRAPS == 0))
  	sc_error( "???? (in sc_trap_handler)", "Floating point exception", 0 );
  #endif
  
--- 186,192 ----
  	int sig, code;
  	struct sigcontext *scp;
  {
! #if  (TITAN || (MATHTRAPS == 0))
  	sc_error( "???? (in sc_trap_handler)", "Floating point exception", 0 );
  #endif
  
***************
*** 245,279 ****
  		     C_FIXED( code ));
  	}
  #endif	
- #ifdef apollo
- 	if  (sig == SIGFPE)  {
- 	   if  (code == FPE_INTDIV_TRAP  ||  code == FPE_FLTDIV_FAULT  ||
- 		code == FPE_FLTDIV_TRAP)
- 		     /***** divide by zero exception *****/
- 		     sc_error ("?????", "Divide by zero", 0);
- 	   if  (code == FPE_FLTOVF_TRAP  ||  code == FPE_FLTOVF_FAULT)
- 		     /***** floating point overflow *****/
- 		     sc_error ("?????", "Overflow", 0);
- 	   if  (code == FPE_FLTUND_FAULT  ||  code == FPE_FLTUND_TRAP)
- 		     /***** floating point underflow *****/
- 		     sc_error ("?????", "Underflow", 0);
- 	   sc_error ("?????", "Floating point exception: ~s", 1,
- 		     C_FIXED( code ));
- 	}
- 	else if (sig == SIGAPOLLO) {
- 	    status_$t status;
- 	    char *subsys, *module, *error;
- 	    short lsubsys, lmodule, lerror;
- 	    char buffer[256];
- 
- 	    status.all = code;
- 	    error_$find_text(status, &subsys, &lsubsys, &module, &lmodule,
- 			     &error, &lerror);
- 	    sprintf(buffer, "%.*s (%.*s/%.*s)", lerror, error,
- 		    lsubsys, subsys, lmodule, module);
- 	    sc_error("?????", buffer, 0);
- 	}
- #endif	
  	
  	/***************************************
  	  other possibly recoverable exceptions
--- 229,234 ----
***************
*** 436,442 ****
  
  sc_mathtraps()  {
  	signal(SIGFPE, sc_trap_handler);
! #ifdef MIPS
  	signal(SIGTRAP, sc_trap_handler);
  #endif
  }
--- 391,397 ----
  
  sc_mathtraps()  {
  	signal(SIGFPE, sc_trap_handler);
! #if MIPS
  	signal(SIGTRAP, sc_trap_handler);
  #endif
  }
diff -crN schemetoc.NeXT/scrt/sparc-pragma.h schemetoc/scrt/sparc-pragma.h
*** schemetoc.NeXT/scrt/sparc-pragma.h	Sun Apr 14 20:44:23 1991
--- schemetoc/scrt/sparc-pragma.h
***************
*** 1,3 ****
- /* This is the pragma declartion that is necessary to tell the SPARC */
- /* compiler about the new setjmp routine. */
- #pragma unknown_control_flow(sc_setjmp)
--- 0 ----
diff -crN schemetoc.NeXT/scrt/sparc.s schemetoc/scrt/sparc.s
*** schemetoc.NeXT/scrt/sparc.s	Sun Apr 14 20:44:23 1991
--- schemetoc/scrt/sparc.s
***************
*** 1,106 ****
- !
- ! Rules for building continuations on the SPARC:
- !
- ! 1 - register windows must be flushed to memory before
- !	the stack is copied to the heap.
- !
- ! 2 - setjmp must save the caller's local and input register
- !	frames when saving context, because longjmp will not
- !	have access to the saved stack to fetch the registers
- !	from their normal resting place.
- !
- ! 3 - longjmp must flush register windows so the correct register
- !	values will be reloaded from memory when execution continues
- !	on the restored stack.
- !
- ! 4 - longjmp must restore the caller's local and input register
- !	frames because the stack hasn't been restored when longjmp
- !	is called.
- !
- 
- 
- !
- ! This misnamed function is responsible for providing the
- ! top of stack address, via macro STACKPTR, to the continuation
- ! builder and the heap manager.  Because both of these functions
- ! immediately begin examining the memory on the stack, the register
- ! windows are flushed to memory so their values will be saved in
- ! heap allocated continuations and seen by the garbage collector.
- !
- 	.global	_sc_processor_register
- _sc_processor_register:
- 	ta	3			! flush register windows
- 	jmp	%o7+8			! return
- 	add	%sp, 0, %o0		! return stack pointer
- 
- !
- ! Save the current environment in a heap allocated continuation.
- !
- 	.global	_sc_setjmp
- _sc_setjmp:
- 	st	%o6, [%o0 +  0]		! save stack pointer
- 	st	%o7, [%o0 +  4]		! save continuation pointer
- 	st	%g1, [%o0 +  8]		! save global registers
- 	st	%g2, [%o0 + 12]		! these may be allocated for
- 	st	%g3, [%o0 + 16]		! caller saves registers or
- 	st	%g4, [%o0 + 20]		! for global values.
- 	st	%g5, [%o0 + 24]
- 	st	%g6, [%o0 + 28]
- 	st	%g7, [%o0 + 32]
- 	st	%l0, [%o0 + 36]		! save local registers
- 	st	%l1, [%o0 + 40]		! the sunos setjmp uses
- 	st	%l2, [%o0 + 44]		! the register windows to
- 	st	%l3, [%o0 + 48]		! save these, we can't.
- 	st	%l4, [%o0 + 52]
- 	st	%l5, [%o0 + 56]
- 	st	%l6, [%o0 + 60]
- 	st	%l7, [%o0 + 64]
- 	st	%i0, [%o0 + 68]
- 	st	%i1, [%o0 + 72]
- 	st	%i2, [%o0 + 76]
- 	st	%i3, [%o0 + 80]
- 	st	%i4, [%o0 + 84]
- 	st	%i5, [%o0 + 88]
- 	st	%i6, [%o0 + 92]
- 	st	%i7, [%o0 + 96]
- 	mov	%y, %o2			! fetch %y, whatever it is
- 	st	%o2, [%o0 + 100]	! and save it
- 	jmp	%o7+8			! return
- 	add	%g0, %g0, %o0		! return 0
- 
- !
- ! Restore an environment from a heap allocated continuation.
- !
- 	.global	_sc_longjmp
- _sc_longjmp:
- 	ta	3			! flush register windows
- 	ld	[%o0 +  0], %o6		! restore stack pointer
- 	ld	[%o0 +  4], %o7		! load continuation pointer
- 	ld	[%o0 +  8], %g1		! restore global registers
- 	ld	[%o0 + 12], %g2
- 	ld	[%o0 + 16], %g3
- 	ld	[%o0 + 20], %g4
- 	ld	[%o0 + 24], %g5
- 	ld	[%o0 + 28], %g6
- 	ld	[%o0 + 32], %g7
- 	ld	[%o0 + 36], %l0		! restore local frame from stack
- 	ld	[%o0 + 40], %l1
- 	ld	[%o0 + 44], %l2
- 	ld	[%o0 + 48], %l3
- 	ld	[%o0 + 52], %l4
- 	ld	[%o0 + 56], %l5
- 	ld	[%o0 + 60], %l6
- 	ld	[%o0 + 64], %l7
- 	ld	[%o0 + 68], %i0
- 	ld	[%o0 + 72], %i1
- 	ld	[%o0 + 76], %i2
- 	ld	[%o0 + 80], %i3
- 	ld	[%o0 + 84], %i4
- 	ld	[%o0 + 88], %i5
- 	ld	[%o0 + 92], %i6
- 	ld	[%o0 + 96], %i7
- 	ld	[%o0 + 100], %o2	! restore %y, whatever it is
- 	mov	%o2, %y
- 	jmp	%o7+8			! return
- 	add	%o1, %g0, %o0		! return arg
- 
--- 0 ----
diff -crN schemetoc.NeXT/scrt/sun3.s schemetoc/scrt/sun3.s
*** schemetoc.NeXT/scrt/sun3.s	Sun Apr 14 20:44:36 1991
--- schemetoc/scrt/sun3.s
***************
*** 1,69 ****
- |
- | SCHEME->C
- |
- | Sun3 assembly code.
- |
- 
- |
- |              Copyright 1989 Digital Equipment Corporation
- |                         All Rights Reserved
- |
- | Permission to use, copy, and modify this software and its documentation is
- | hereby granted only under the following terms and conditions.  Both the
- | above copyright notice and this permission notice must appear in all copies
- | of the software, derivative works or modified versions, and any portions
- | thereof, and both notices must appear in supporting documentation.
- |
- | Users of this software agree to the terms and conditions set forth herein,
- | and hereby grant back to Digital a non-exclusive, unrestricted, royalty-free
- | right and license under any changes, enhancements or extensions made to the
- | core functions of the software, including but not limited to those affording
- | compatibility with other hardware or software environments, but excluding
- | applications which incorporate this software.  Users further agree to use
- | their best efforts to return to Digital any such changes, enhancements or
- | extensions that they make and inform Digital of noteworthy uses of this
- | software.  Correspondence should be provided to Digital at:
- | 
- |                       Director of Licensing
- |                       Western Research Laboratory
- |                       Digital Equipment Corporation
- |                       100 Hamilton Avenue
- |                       Palo Alto, California  94301  
- | 
- | This software may be distributed (but not offered for sale or transferred
- | for compensation) to third parties, provided such third parties agree to
- | abide by the terms and conditions of this notice.  
- | 
- | THE SOFTWARE IS PROVIDED "AS IS" AND DIGITAL EQUIPMENT CORP. DISCLAIMS ALL
- | WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF
- | MERCHANTABILITY AND FITNESS.   IN NO EVENT SHALL DIGITAL EQUIPMENT
- | CORPORATION BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL
- | DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR
- | PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS
- | ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
- | SOFTWARE.
- |
- 
- |
- | sc_a2to5d2to7
- |
- |   sc_a2to5d2to7( a )
- | will return the contents of A2, ..., A5, D2, ..., D7 starting at address 'a'.
- |
- |
- 	.text
- 	.globl	_sc_a2to5d2to7
- 	.even
- _sc_a2to5d2to7:
- 	movl	sp@(4),a0
- 	movl	a2,a0@(0)
- 	movl	a3,a0@(4)
- 	movl	a4,a0@(8)
- 	movl	a5,a0@(12)
- 	movl	d2,a0@(16)
- 	movl	d3,a0@(20)
- 	movl	d4,a0@(24)
- 	movl	d5,a0@(28)
- 	movl	d6,a0@(32)
- 	movl	d7,a0@(36)
- 	rts
--- 0 ----
diff -crN schemetoc.NeXT/scsc/makefile-tail schemetoc/scsc/makefile-tail
*** schemetoc.NeXT/scsc/makefile-tail	Sun Apr 14 20:44:15 1991
--- schemetoc/scsc/makefile-tail	Thu Aug 17 13:25:26 1989
***************
*** 46,52 ****
  	mv Xsccomp.heap sccomp.heap
  
  port:
! 	$(MAKE) "CC = ${CC}" "CFLAGS = ${CFLAGS}" "sccomp = echo" \
  	     Xsccomp.heap Xmv
  
  install-private:
--- 46,52 ----
  	mv Xsccomp.heap sccomp.heap
  
  port:
! 	make "CC = ${CC}" "CFLAGS = ${CFLAGS}" "sccomp = echo" \
  	     Xsccomp.heap Xmv
  
  install-private:
***************
*** 94,100 ****
  	rdist -c sccomp makefile-tail makefile ${destdir}
  
  all:
! 	$(MAKE) Xsccomp.heap Xmv
  
  srclinks:
  	for x in ${scsc} ${scc} ${scsch}; \
--- 94,100 ----
  	rdist -c sccomp makefile-tail makefile ${destdir}
  
  all:
! 	make Xsccomp.heap Xmv
  
  srclinks:
  	for x in ${scsc} ${scc} ${scsch}; \
diff -crN schemetoc.NeXT/xlib/makefile schemetoc/xlib/makefile
*** schemetoc.NeXT/xlib/makefile	Sun Apr 14 20:44:17 1991
--- schemetoc/xlib/makefile	Thu Sep 27 21:41:00 1990
***************
*** 91,97 ****
  	rm -f *.o scixl scxl.a hello puzzle clear
  
  all:
! 	$(MAKE) scixl scxl.a
  
  gensource:
! 	$(MAKE) ${xwssc} ${xwsc}
--- 91,97 ----
  	rm -f *.o scixl scxl.a hello puzzle clear
  
  all:
! 	make scixl scxl.a
  
  gensource:
! 	make ${xwssc} ${xwsc}