[MLton-devel] cvs commit: first checkin of SunOS/SPARC port

Stephen Weeks sweeks@users.sourceforge.net
Wed, 09 Apr 2003 19:03:12 -0700


sweeks      03/04/09 19:03:12

  Modified:    .        Makefile
               basis-library/misc primitive.sml
               basis-library/mlton mlton.sig random.sig random.sml
               basis-library/real real.sml
               basis-library/sml-nj sml-nj.sml
               bin      add-cross build-cross-gcc clean hosttype mlton
                        mlton-basis-version regression
               doc/user-guide Makefile compiling.tex credits.tex
                        cross-compiling.tex cygwin.tex extensions.tex
                        freebsd.tex main.tex
               include  ccodegen.h
               lib/mlton/basic random.sig
               lib/mlton-stubs mlton.sig mlton.sml random.sig random.sml
               mlton/backend machine.fun machine.sig
               mlton/codegen/c-codegen c-codegen.fun
               mlton/codegen/x86-codegen x86-codegen.fun
                        x86-mlton-basic.fun x86-translate.fun x86.fun
               mlton/control control.sig control.sml
               mlton/main main.sml
               runtime  IntInf.h Makefile basis-constants.h gc.c
                        mlton-basis.h my-lib.c net-constants.h
                        posix-constants.h
               runtime/Posix/FileSys open.c
               runtime/Posix/ProcEnv getgroups.c setenv.c
               runtime/Posix/Signal Signal.c
               runtime/basis IEEEReal.c Real.c Real_const.S
               runtime/basis/Int quot.c rem.c
  Added:       doc/user-guide platform.tex sunos.tex
  Log:
  Added support for SunOS/SPARC platform using the C codegenerator.  It
  passes all the regressions and a cross-self compile as well as normal
  self compile on a SPARC.  I have not gone through a full bootstrap on
  a SPARC because it is ridiculously slow (5 hours and counting) for the
  version built with stubs to self compile.  There's still a lot of
  cleanup and performance tuning left.
  
  Here's a more detailed list of changes.
  
  Added MLton.hostType Sun.
  
  Changed the type of Random.{seed,useed} so that they return a word
  option instead of a word.  They now return NONE if
  /dev/{random,urandom} can't be read from (which may be the case on
  SunOS).
  
  Changed all shell scripts to /usr/bin/env bash.  I needed to do this
  because sh on SunOS doesn't have !.
  
  Rewrote add-cross and build-cross-gcc to work for multiple targets.
  
  Moved handling of gcc flags from shell script into the compiler
  proper.  This was done because we need different sets of flags for
  different platforms.  It shouldn't cause any problems, since you can
  always use -cc-opt to override them.
  
  Eliminated Machine.{SetExnStackLocal,SetExnStackSlot,SetSlotExnStack},
  which were vestigal.  They had been replaced by moves in the backend
  a while ago.
  
  Added -align-doubles {no|pad|skip}.  For now, only -align-doubles no
  is implemented.  On SPARCs, which give a bus error for misaligned
  doubles, this requires the C codegen to treat memory accesses to
  doubles as two word accesses, which of course slows stuff down.  In
  the near future, I plan to implement pad and skip.
  
  Rewrote many of the switch usage messages so that <> is used to
  indicate a variable that should be substituted for.
  
  Eliminated -D.  You can use instead: -cc-opt '-D<SYM>'
  
  Changed -build-constants to -build-constants {false|true}, for
  uniformity's sake.

Revision  Changes    Path
1.85      +18 -4     mlton/Makefile

Index: Makefile
===================================================================
RCS file: /cvsroot/mlton/mlton/Makefile,v
retrieving revision 1.84
retrieving revision 1.85
diff -u -r1.84 -r1.85
--- Makefile	12 Feb 2003 03:08:05 -0000	1.84
+++ Makefile	10 Apr 2003 02:03:00 -0000	1.85
@@ -62,7 +62,7 @@
 .PHONY: constants
 constants:
 	@echo 'Creating constants file.'
-	$(BIN)/mlton -build-constants >tmp.c
+	$(BIN)/mlton -build-constants true >tmp.c
 	$(BIN)/mlton -output tmp tmp.c
 	./tmp >$(LIB)/$(HOST)/constants
 	rm -f tmp tmp.c
@@ -195,6 +195,9 @@
 # puts them.
 DESTDIR = $(CURDIR)/install
 PREFIX = /usr
+ifeq ($(HOSTTYPE), sun)
+PREFIX = /usr/local
+endif
 prefix = $(PREFIX)
 MAN_PREFIX_EXTRA =
 TBIN = $(DESTDIR)$(prefix)/bin
@@ -202,6 +205,14 @@
 TLIB = $(DESTDIR)$(prefix)/$(ULIB)
 TMAN = $(DESTDIR)$(prefix)$(MAN_PREFIX_EXTRA)/man/man1
 TDOC = $(DESTDIR)$(prefix)/share/doc/mlton
+ifeq ($(HOSTTYPE), sun)
+TDOC = $(DESTDIR)$(prefix)/doc/mlton
+endif
+
+GZIP_MAN = true
+ifeq ($(HOSTTYPE), sun)
+GZIP_MAN = false
+endif
 
 .PHONY: install
 install:
@@ -225,9 +236,12 @@
 	$(CP) $(BIN)/$(LEX) $(BIN)/$(PROF) $(BIN)/$(YACC) $(TBIN)/
 	( cd $(SRC)/man && tar cf - mllex.1 mlprof.1 mlton.1 mlyacc.1 ) | \
 		( cd $(TMAN)/ && tar xf - )
-	cd $(TMAN) && $(GZIP) mllex.1 mlprof.1 mlton.1 mlyacc.1
-	find $(TDOC)/ -name CVS -type d | xargs --no-run-if-empty rm -rf
-	find $(TDOC)/ -name .cvsignore -type f | xargs --no-run-if-empty rm -rf
+	if $(GZIP_MAN); then						\
+		cd $(TMAN) && $(GZIP) mllex.1 mlprof.1 mlton.1		\
+			mlyacc.1;					\
+	fi
+	find $(TDOC)/ -name CVS -type d | xargs rm -rf
+	find $(TDOC)/ -name .cvsignore -type f | xargs rm -rf
 	for f in $(TLIB)/$(AOUT) \
 		$(TBIN)/$(LEX) $(TBIN)/$(PROF) $(TBIN)/$(YACC); do \
 		strip --remove-section=.comment --remove-section=.note $$f; \



1.47      +11 -2     mlton/basis-library/misc/primitive.sml

Index: primitive.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/misc/primitive.sml,v
retrieving revision 1.46
retrieving revision 1.47
diff -u -r1.46 -r1.47
--- primitive.sml	25 Mar 2003 04:31:22 -0000	1.46
+++ primitive.sml	10 Apr 2003 02:03:00 -0000	1.47
@@ -56,7 +56,6 @@
       val halt = _prim "MLton_halt": int -> unit;
       val handlesSignals = _prim "MLton_handlesSignals": bool;
       val installSignalHandler = _prim "MLton_installSignalHandler": unit -> unit;
-      val isLittleEndian = _const "MLton_isLittleEndian": bool;
       val safe = _build_const "MLton_safe": bool;
       val usesCallcc: bool ref = ref false;
 
@@ -290,13 +289,23 @@
       structure MLton =
 	 struct
 	    datatype hostType =
-	       Cygwin | FreeBSD | Linux
+	       Cygwin | FreeBSD | Linux | Sun
+
 	    val hostType: hostType =
 	       case _const "MLton_hostType": int; of
 		  0 => Cygwin
 		| 1 => FreeBSD
 		| 2 => Linux
+		| 3 => Sun
+		| _ => raise Fail "strange hostType constant"
 
+	    val isBigEndian =
+	       case hostType of
+		  Cygwin => false
+		| FreeBSD => false
+		| Linux => false
+		| Sun => true
+			      
 	    val native = _build_const "MLton_native": bool;
 
 	    structure Profile =



1.19      +1 -1      mlton/basis-library/mlton/mlton.sig

Index: mlton.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/mlton.sig,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- mlton.sig	25 Mar 2003 04:31:22 -0000	1.18
+++ mlton.sig	10 Apr 2003 02:03:01 -0000	1.19
@@ -17,7 +17,7 @@
        *)
       val eq: 'a * 'a -> bool
       val errno: unit -> int (* the value of the C errno global *)
-      datatype hostType = Cygwin | FreeBSD | Linux
+      datatype hostType = Cygwin | FreeBSD | Linux | Sun
       val hostType: hostType
       val isMLton: bool
       val safe: bool



1.3       +8 -4      mlton/basis-library/mlton/random.sig

Index: random.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/random.sig,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- random.sig	28 Mar 2002 18:52:07 -0000	1.2
+++ random.sig	10 Apr 2003 02:03:01 -0000	1.3
@@ -11,12 +11,16 @@
       (* Get the next pseudrandom. *)
       val rand: unit -> word
 	 
-      (* Use /dev/random to get a word.  Useful as an arg to srand. *)
-      val seed: unit -> word
+      (* Use /dev/random to get a word.  Useful as an arg to srand.
+       * Return NONE if /dev/random can't be read.
+       *)
+      val seed: unit -> word option
 	 
       (* Set the seed used by rand. *)
       val srand: word -> unit
 
-      (* Use /dev/urandom to get a word.  Useful as an arg to srand. *)
-      val useed: unit -> word
+      (* Use /dev/urandom to get a word.  Useful as an arg to srand.
+       * Return NONE if /dev/urandom can't be read.
+       *)
+      val useed: unit -> word option
    end



1.3       +29 -28    mlton/basis-library/mlton/random.sml

Index: random.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/random.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- random.sml	29 Dec 2002 01:22:58 -0000	1.2
+++ random.sml	10 Apr 2003 02:03:01 -0000	1.3
@@ -1,7 +1,7 @@
 structure MLtonRandom: MLTON_RANDOM =
    struct
-      (* Linux specific.  Uses /dev/random and /dev/urandom to get a
-       * random word.
+      (* Uses /dev/random and /dev/urandom to get a random word.
+       * If they can't be read from, return 0w13.
        *)
       local
 	 fun make (file, name) =
@@ -9,32 +9,33 @@
 	       val buf = Word8Array.array (4, 0w0)
 	    in
 	       fn () =>
-	       let
-		  val fd =
-		     let
-			open Posix.FileSys
-		     in
-			openf (file, O_RDONLY, O.flags [])
-		     end
-		  fun loop rem =
-		     let
-			val n = Posix.IO.readArr (fd, {buf = buf,
-						       i = 4 - rem,
-						       sz = SOME rem})
-			val _ = if n = 0
-				   then (Posix.IO.close fd; raise Fail name)
-				else ()
-			val rem = rem - n
-		     in
-			if rem = 0
-			   then ()
-			else loop rem
-		     end
-		  val _ = loop 4
-		  val _ = Posix.IO.close fd
-	       in
-		  Pack32Little.subArr (buf, 0)
-	       end
+	       (let
+		   val fd =
+		      let
+			 open Posix.FileSys
+		      in
+			 openf (file, O_RDONLY, O.flags [])
+		      end
+		   fun loop rem =
+		      let
+			 val n = Posix.IO.readArr (fd, {buf = buf,
+							i = 4 - rem,
+							sz = SOME rem})
+			 val _ = if n = 0
+				    then (Posix.IO.close fd; raise Fail name)
+				 else ()
+			 val rem = rem - n
+		      in
+			 if rem = 0
+			    then ()
+			 else loop rem
+		      end
+		   val _ = loop 4
+		   val _ = Posix.IO.close fd
+		in
+		   SOME (Pack32Little.subArr (buf, 0))
+		end
+		   handle OS.SysErr _ => NONE)
 	    end
       in
 	 val seed = make ("/dev/random", "Random.seed")



1.16      +7 -3      mlton/basis-library/real/real.sml

Index: real.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/real/real.sml,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -r1.15 -r1.16
--- real.sml	24 Nov 2002 01:19:39 -0000	1.15
+++ real.sml	10 Apr 2003 02:03:01 -0000	1.16
@@ -28,11 +28,15 @@
 	    open Math
 
 	    structure MLton = Primitive.MLton
-	    (* Patches for Cygwin newlib, which does not handle out of range
-	     * args.
+	    (* Patches for Cygwin and Sun, whose math libraries do not handle
+	     * out of range args.
 	     *)
 	    val (acos, asin, ln, log10) =
-	       if not MLton.native andalso MLton.hostType = MLton.Cygwin
+	       if not MLton.native
+		  andalso (case MLton.hostType of
+			      MLton.Cygwin => true
+			    | MLton.Sun => true
+			    | _ => false)
 		  then
 		     let
 			fun patch f x =



1.7       +12 -1     mlton/basis-library/sml-nj/sml-nj.sml

Index: sml-nj.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/sml-nj/sml-nj.sml,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- sml-nj.sml	29 Dec 2002 01:22:59 -0000	1.6
+++ sml-nj.sml	10 Apr 2003 02:03:02 -0000	1.7
@@ -21,7 +21,17 @@
 	    exception UNKNOWN
 	    datatype os_kind = BEOS | MACOS | OS2 | UNIX | WIN32
 
-	    fun getHostArch () = "X86"
+	    fun getHostArch () =
+	       let
+		  open Primitive.MLton
+	       in
+		  case hostType of
+		     Cygwin => "X86"
+		   | FreeBSD => "X86"
+		   | Linux => "X86"
+		   | Sun => "SPARC"
+	       end
+		     
 	    fun getOSKind () = UNIX
 	    fun getOSName () =
 	       let
@@ -31,6 +41,7 @@
 		     Cygwin => "Cygwin"
 		   | FreeBSD => "FreeBSD"
 		   | Linux => "Linux"
+		   | Sun => "Solaris"
 	       end
 	 end
       



1.9       +57 -44    mlton/bin/add-cross

Index: add-cross
===================================================================
RCS file: /cvsroot/mlton/mlton/bin/add-cross,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- add-cross	26 Feb 2003 03:09:09 -0000	1.8
+++ add-cross	10 Apr 2003 02:03:02 -0000	1.9
@@ -1,62 +1,71 @@
-#!/bin/sh
+#!/usr/bin/env bash
 
 # This script adds a new crosscompiler target for MLton.
-# You may need to set installLibDir, crossHost, or cygwin.
-# This script builds an executable in the current directory that you must
-# run on the target machine.  This executable prints on standard output
-# the values of the compile time constants needed by the MLton when 
-# cross compiling.  You must place the output of running the executable in
-# $libDir/$crossHost/constants.
+#
+# It takes three arguments.
+#
+# 1. <crossHost>, will be used via the -b flag passed to the GCC
+# cross-compiler tools.  You must already have installed the GCC
+# cross-compiler tools.  This script does not do that, although you
+# may find the script build-cross-gcc helpful.  <crossHost> here
+# should be the same as target in build-cross-gcc.  Examples are
+# i386-pc-cygwin and sparc-sun-solaris.
+#
+# 2. {cygwin|sun}, specifies the kind of system.  There are only two
+# possibilities.
+#
+# 3. <machine> specifies a remote machine of the cross type.  After
+# cross compiling the runtime, this script will ssh to that machine to
+# get the values of the constants that the MLton basis library needs.
+# Of course, you must be able to ssh to this machine.
+#
+# You also may need to set $libDir, which determines where the
+# cross-compiler target will be installed.
 
 set -e
 
+die () {
+	echo >&2 "$1"
+	exit 1
+}
+
+usage () {
+	die "usage: $name <crossHost> {cygwin|sun} <machine>"
+}
+
+case "$#" in
+3)
+	crossHost="$1"
+	crossType="$2"
+	machine="$3"
+	;;
+*)
+	usage
+	;;
+esac
+
+name=`basename $0`
 original=`pwd`
 dir=`dirname $0`
 src=`cd $dir/.. && pwd`
 
-# libDir is the mlton lib directory where you would like the 
-# cross-compiler information to be installed.  If you have installed from the
-# rpms, this will usually be /usr/local/lib/mlton.  You must have write 
-# permission there. 
+# libDir is the mlton lib directory where you would like the
+# cross-compiler information to be installed.  If you have installed
+# from the rpms, this will usually be /usr/lib/mlton.  You must have
+# write permission there.
 
 lib="$src/build/lib"
 
-# crossHost will be used via the -b flag passed to the GCC cross-compiler tools.
-# You must already have installed the GCC cross-compiler tools.  This script
-# does not do that, although you may find the script build-cross-gcc helpful.
-# crossHost here should be the same as target in build-cross-gcc.
-crossHost='i386-pc-cygwin'
-
-# There are two possible types for the target machine: cygwin and linux. 
-# It should be obvious which of those you want.
-
-crossType='cygwin'
-
 # You shouldn't need to change anything below this line.
 
-name=`basename $0`
-
-function die {
-	echo >&2 $1
-	exit 1
-}
-
-function usage {
-	die "usage: $name"
-}
-
-case "$#" in
-0)
+case "$crossType" in
+cygwin|sun)
 ;;
 *)
-	usage
+	die "invalid crossType: $crossType"
 ;;
 esac
 
-if [ "$crossType" != 'linux' -a "$crossType" != 'cygwin' ]; then
-	die "invalid crossType: $crossType"
-fi
-
 PATH=$src/build/bin:$PATH
 
 mkdir -p "$lib/$crossHost/include" ||
@@ -72,10 +81,14 @@
 exe='print-constants'
 echo 'Building print-constants executable.'
 (
-	mlton -build-constants >$exe.c
-	mlton -output $original/$exe.exe -host $crossHost $exe.c
+	mlton -build-constants true >$exe.c
+	mlton -output $original/$exe -host $crossHost $exe.c
 	rm -f $exe.c
 ) || die "Unable to build $exe executable."
 
-echo "You must now run $exe.exe on the $crossHost machine"
-echo "and put the output in $lib/$crossHost/constants."
+echo "Running print-constants on $machine."
+tar cf - $exe |
+	ssh $machine "tar xf - && ./$exe && rm -f $exe" \
+	>"$lib/$crossHost/constants"
+
+rm -f $original/$exe



1.7       +86 -48    mlton/bin/build-cross-gcc

Index: build-cross-gcc
===================================================================
RCS file: /cvsroot/mlton/mlton/bin/build-cross-gcc,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- build-cross-gcc	17 Jan 2003 02:35:11 -0000	1.6
+++ build-cross-gcc	10 Apr 2003 02:03:02 -0000	1.7
@@ -1,52 +1,82 @@
-#!/bin/sh
+#!/usr/bin/env bash
 
-# This script builds and installs a gcc cross-compiler with a cygwin target.
-#
-# It requires that you have obtained the following packages, whose
-# tarfiles shoud be in the current directory:
-#	binutils, cygwin, gcc, w32api
-# You can find ftp sites to download binutils and gcc-core at gnu.org.
-# I got cygwin and w32api by installing cygwin in a Windows machine (using
-# Cygwin's setup.exe program) and then getting the bzip'ed tar files out of
-# their Cygwin packages dir.
+# This script builds and installs a gcc cross compiler.
 
-set -e
-
-# You may need to change the version numbers below.
-# You also might want to change the installation prefix.
-#
-# I had problems with cygwin-1.3.18-1, since its libcygwin.a contained a
-# a file, pseudo-reloc.o, with some strangeness that binutils didn't 
-# correctly handle.
-
-binutils='binutils-2.12'
-cygwin='cygwin-1.3.17-1'
-gccVers='2.95.3'
-gcc="gcc-$gccVers"
-gccTar="gcc-core-$gccVers.tar"
-w32api='w32api-2.1-1'
+# It has been used to build cross compilers from Linux to Cygwin and
+# from Linux to SunOS.  It is unlikely that this script will work
+# out-of-the-box.  It is only intended as a template.  You should read
+# through it and understand what it does, and make changes as
+# necessary.  Feel free to add another targetType if you modify this
+# script for another target.
 
-root=`pwd`
-target='i386-pc-cygwin'
-prefix='/usr'
-
-name=`basename $0`
+set -e
 
 die () {
 	echo >&2 "$1"
 	exit 1
 }
 
+root=`pwd`
+name=`basename $0`
+
 usage () {
-	die "usage: $name"
+	die "usage: $name {cygwin|sun}"
 }
 
 case "$#" in
-0)
+1)
+	case "$1" in
+	cygwin|sun)
+		targetType="$1"
+	;;
+	*)
+		usage
 	;;
+	esac
+;;
 *)
 	usage
-	;;
+esac
+
+# You may want to change the installation prefix, which is where the
+# script will install the cross-compiler tools.
+prefix='/usr'
+
+# You must have have the sources to binutils and gcc, and place the
+# tarfiles in the current directory.  You can find ftp sites to
+# download binutils and gcc-core at gnu.org.  You may need to change
+# the version numbers below to match what you download.
+binutils='binutils-2.12'
+gccVers='2.95.3'
+gccTar="gcc-core-$gccVers.tar"
+
+# You may want to set the target.
+case "$targetType" in
+cygwin)
+	target='i386-pc-cygwin'
+	# For Cygwin, we also need the cygwin and w32api packages,
+	# which contain necessary header files and libraries.  I got
+	# them by installing cygwin in a Windows machine (using #
+	# Cygwin's setup.exe program) and then getting the bzip'ed tar
+	# files out of their Cygwin packages dir.  I had problems with
+	# cygwin-1.3.18-1, since its libcygwin.a contained a file,
+	# pseudo-reloc.o, with some strangeness that binutils didn't
+	# correctly handle.
+	cygwin='cygwin-1.3.17-1'
+	w32api='w32api-2.1-1'
+;;
+sun)
+	target='sparc-sun-solaris'
+	# For sun, we assume that you have already copied the includes
+	# and libraries from a SunOS machine to the host machine.
+	if ! [ -d "$prefix/$target/include" -a -d "$prefix/$target/lib" ]; then
+		die "Must create $prefix/$target/{include,lib}."
+	fi
+	# The GCC tools expect limits.h to be in sys-include, not include.
+	( cd $prefix/$target && 
+		mkdir -p sys-include &&
+		mv include/limits.h sys-include )
+;;
 esac
 
 exists () {
@@ -57,19 +87,24 @@
 
 echo 'Checking that needed files exist.'
 exists $binutils.tar
-exists $cygwin.tar
 exists $gccTar
-exists $w32api.tar
-
-echo 'Copying include files and libraries needed by cross compiler.'
-cd $root
-mkdir -p cygwin
-cd cygwin
-tar x <../$cygwin.tar
-tar x <../$w32api.tar
-mkdir -p $prefix/$target || 
-	die "Cannot create $prefix/$target."
-(cd usr && tar c include lib) | (cd $prefix/$target/ && tar x)
+case "$targetType" in
+cygwin)
+	exists $cygwin.tar
+	exists $w32api.tar
+	echo 'Copying include files and libraries needed by cross compiler.'
+	cd $root
+	mkdir -p cygwin
+	cd cygwin
+	tar x <../$cygwin.tar
+	tar x <../$w32api.tar
+	mkdir -p $prefix/$target || 
+		die "Cannot create $prefix/$target."
+	(cd usr && tar c include lib) | (cd $prefix/$target/ && tar x)
+;;
+*)
+;;
+esac
 
 echo 'Building binutils.'
 cd $root
@@ -89,10 +124,13 @@
 tar x <$gccTar
 mkdir -p build-gcc
 cd build-gcc
-../$gcc/configure --enable-languages=c --prefix=$prefix --target=$target \
-	>$root/configure-gcc-log 2>&1 ||
+../gcc-$gccVers/configure \
+	--enable-languages=c \
+	--prefix=$prefix \
+	--target=$target \
+	>$root/configure-gcc-log 2>&1 || 
 	die "Configure of gcc failed."
-make all install >$root/build-gcc-log 2>&1 ||
+make all install >$root/build-gcc-log 2>&1 || 
 	die "Build of gcc failed."
 
 echo 'Success.'



1.13      +12 -2     mlton/bin/clean

Index: clean
===================================================================
RCS file: /cvsroot/mlton/mlton/bin/clean,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- clean	29 Oct 2002 06:08:23 -0000	1.12
+++ clean	10 Apr 2003 02:03:02 -0000	1.13
@@ -1,7 +1,16 @@
-#!/bin/sh
+#!/usr/bin/env bash
 
 set -e
 
+case `hosttype` in
+cygwin|freebsd|linux)
+	grepFlags='-q'
+;;
+sun)
+	grepFlags=''
+;;
+esac
+
 doit () {
 	rm -rf '.#'* .*~ *~ *.a *.o CM core mlmon.out
 	if [ -r .cvsignore ]; then
@@ -10,7 +19,8 @@
 	for f in `ls`; do
 		if [ -d $f ]; then
 			cd $f;
-			if [ -r Makefile ] && grep -q '^clean:' Makefile ; then 
+			if [ -r Makefile ] && 
+				grep $grepFlags '^clean:' Makefile ; then 
 				gmake clean
 			else
 				doit



1.4       +4 -1      mlton/bin/hosttype

Index: hosttype
===================================================================
RCS file: /cvsroot/mlton/mlton/bin/hosttype,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- hosttype	29 Oct 2002 06:08:23 -0000	1.3
+++ hosttype	10 Apr 2003 02:03:02 -0000	1.4
@@ -1,4 +1,4 @@
-#!/bin/sh
+#!/usr/bin/env bash
 
 set -e
 
@@ -11,6 +11,9 @@
 	;;
 FreeBSD*)
 	hosttype=freebsd
+	;;
+SunOS)
+	hosttype=sun
 	;;
 *)
 	hosttype=unknown



1.21      +3 -16     mlton/bin/mlton

Index: mlton
===================================================================
RCS file: /cvsroot/mlton/mlton/bin/mlton,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -r1.20 -r1.21
--- mlton	12 Feb 2003 03:08:05 -0000	1.20
+++ mlton	10 Apr 2003 02:03:02 -0000	1.21
@@ -1,4 +1,4 @@
-#!/bin/sh
+#!/usr/bin/env bash
 
 # This script calls MLton.
 
@@ -35,22 +35,9 @@
 	exit 1
 }
 
-# You may need to add -L/path/to/libgmp before the "$@" so that the linker
-# can find the gmp.
-
-# -mcpu=pentiumpro is the same as -mcpu=i686
+# You may need to add -lib-search /path/to/libgmp before the "$@" so that the
+# linker can find the gmp.
 
 doit "$lib" \
 	-cc "$gcc" \
-	-ccopt '-malign-functions=5
-		-malign-jumps=2 
-		-fno-strict-aliasing
-		-fno-strength-reduce
-		-fomit-frame-pointer
-		-fschedule-insns 
-		-fschedule-insns2
-		-malign-loops=2
-		-mcpu=pentiumpro
-		-w' \
-	-link m \
 	"$@"



1.2       +1 -1      mlton/bin/mlton-basis-version

Index: mlton-basis-version
===================================================================
RCS file: /cvsroot/mlton/mlton/bin/mlton-basis-version,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- mlton-basis-version	24 Nov 2002 17:56:42 -0000	1.1
+++ mlton-basis-version	10 Apr 2003 02:03:02 -0000	1.2
@@ -1,4 +1,4 @@
-#!/bin/sh
+#!/usr/bin/env bash
 
 tmp="$$.sml"
 



1.57      +2 -2      mlton/bin/regression

Index: regression
===================================================================
RCS file: /cvsroot/mlton/mlton/bin/regression,v
retrieving revision 1.56
retrieving revision 1.57
diff -u -r1.56 -r1.57
--- regression	25 Feb 2003 02:05:25 -0000	1.56
+++ regression	10 Apr 2003 02:03:02 -0000	1.57
@@ -1,4 +1,4 @@
-#!/bin/sh
+#!/usr/bin/env bash
 
 # This script runs the regression tests in src/regression.
 # It also compiles the tests in benchmark/tests
@@ -56,7 +56,7 @@
 	echo "compilation of $f failed with $flags"
 }
 
-$mlton -verbose 1
+$mlton -verbose 1 || echo 'no mlton present'
 echo "flags = $flags"
 
 cd $src/regression



1.14      +2 -0      mlton/doc/user-guide/Makefile

Index: Makefile
===================================================================
RCS file: /cvsroot/mlton/mlton/doc/user-guide/Makefile,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- Makefile	29 Sep 2002 01:46:31 -0000	1.13
+++ Makefile	10 Apr 2003 02:03:03 -0000	1.14
@@ -17,7 +17,9 @@
 	main.tex		\
 	man-page.tex		\
 	nj-deviations.tex	\
+	platform.tex		\
 	profiling.tex		\
+	sunos.tex
 
 all:	main.ps main/main.html
 



1.11      +4 -2      mlton/doc/user-guide/compiling.tex

Index: compiling.tex
===================================================================
RCS file: /cvsroot/mlton/mlton/doc/user-guide/compiling.tex,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- compiling.tex	12 Mar 2003 20:35:40 -0000	1.10
+++ compiling.tex	10 Apr 2003 02:03:03 -0000	1.11
@@ -1,7 +1,9 @@
 \sec{Compiling {\mlton}}{compiling}
 
-If you want to compile {\mlton}, you need either the source {\tt rpm} or {\tt
-tgz}.  You can compile with either {\mlton} or {\smlnj}.
+If you want to compile {\mlton}, you need either the source {\tt rpm}
+or {\tt tgz}.  You can compile with either {\mlton} or {\smlnj}, but
+we strongly recommend using {\mlton}, since it generates a much faster
+executable.
 
 \subsection{Compiling with {\mlton}}
 



1.22      +2 -1      mlton/doc/user-guide/credits.tex

Index: credits.tex
===================================================================
RCS file: /cvsroot/mlton/mlton/doc/user-guide/credits.tex,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -r1.21 -r1.22
--- credits.tex	10 Apr 2003 01:32:40 -0000	1.21
+++ credits.tex	10 Apr 2003 02:03:03 -0000	1.22
@@ -38,7 +38,8 @@
 \item
 Alain Deutsch (\mailto{deutsch}{polyspace.com}) and \htmladdnormallink{PolySpace
 Technologies}{http://www.polyspace.com/} provided many bug fixes and
-runtime system improvements.
+runtime system improvements, as well as some code to help the SPARC
+port.
 
 \item
 Simon Helsen (\mailto{shelsen}{acm.org}) has provided bug reports, suggestions,



1.7       +35 -35    mlton/doc/user-guide/cross-compiling.tex

Index: cross-compiling.tex
===================================================================
RCS file: /cvsroot/mlton/mlton/doc/user-guide/cross-compiling.tex,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- cross-compiling.tex	12 Mar 2003 20:35:41 -0000	1.6
+++ cross-compiling.tex	10 Apr 2003 02:03:03 -0000	1.7
@@ -1,57 +1,57 @@
-\subsec{Cross compiling applications from Linux to Cygwin/Windows}
-       {cross-compiling}
+\sec{Cross compiling}{cross-compiling}
 
-With {\mlton} running on Linux, you can use the {\tt -host} flag to cross
-compile applications and produce executables that run on Cygwin/Windows.
-In order to use {\mlton} as a
-cross compiler, you need to do several things.
+You can use the {\mlton}'s {\tt -host} flag to cross compile
+applications.  By default, {\mlton} is only able to compile for the
+machine it is running on.  In order to use {\mlton} as a cross
+compiler, you need to do two things.  To make the terminology clear,
+we refer to the the {\em host} as the machine {\mlton} is running on
+and the {\em target} as the machine that {\mlton} is compiling for.
 
 \begin{enumerate}
 
-\item Install the Cygwin {\tt dll} in the Windows machine.
+\item Install the GCC cross-compiler tools on the host so that GCC can
+compile to the target.
 
-\item Install the GCC cross-compiler tools on your Linux machine.
-
-\item Cross compile the {\mlton} runtime system for your Windows machine.
+\item Cross compile the {\mlton} runtime system to build the runtime
+libraries for the target.
 
 \end{enumerate}
 
-To build a GCC cross-compiler toolset on your machine, you can use the script
-{\tt bin/build-cross-gcc} available in the {\mlton} sources.  There are some
-comments at the top of the script that tell you what to download and what
-variables to set in order to build the toolset.  In particular, the {\tt target}
-variable is important, since that is what you will pass to {\mlton}'s {\tt
+To build a GCC cross-compiler toolset on the host, you can use the
+script {\tt bin/build-cross-gcc}, available in the {\mlton} sources,
+as a template.  The value of the {\tt target} variable in that script
+is important, since that is what you will pass to {\mlton}'s {\tt
 -host} flag.
 
-Once you have the toolset built, you should be able to test it by cross
-compiling a simple hello world program on your Linux machine.
+Once you have the toolset built, you should be able to test it by
+cross compiling a simple hello world program on your host machine.
 \begin{verbatim}
-gcc -b i386-pc-cygwin -o hello-world.exe hello-world.c
+gcc -b i386-pc-cygwin -o hello-world hello-world.c
 \end{verbatim}
-You should now be able to run {\tt hello-world.exe} from a Cygwin shell on your
-Windows Machine.
+You should now be able to run {\tt hello-world} on the target machine,
+in this case, a Cygwin machine.
 
-Next, you must cross compile the {\mlton} runtime system and inform {\mlton} of
-the availability of the new target.  The script {\tt bin/add-cross} from
-the {\mlton} sources will help you do this.  Please read the comments at
-the top of the script.  Here is a sample run.
+Next, you must cross compile the {\mlton} runtime system and inform
+{\mlton} of the availability of the new target.  The script {\tt
+bin/add-cross} from the {\mlton} sources will help you do this.
+Please read the comments at the top of the script.  Here is a sample
+run adding a SunOS cross compiler.
 \begin{verbatim}
-% add-cross
+% add-cross sparc-sun-solaris sun blade
 Making runtime.
 Building print-constants executable.
-You must now run print-constants.exe on the i386-pc-cygwin machine
-and put the output in /tmp/mlton/build/lib/i386-pc-cygwin/constants.
+Running print-constants on blade.
 \end{verbatim}
-Running {\tt add-cross} installs the cross-compiled runtime and creates a
-cross-compiled executable, {\tt print-constants.exe}, which prints out all of
-the constants that {\mlton} needs in order to implement the basis library.  The
-final step is to run {\tt print-constants.exe} on your Windows machine, and save
-the output in the file indicated by {\tt add-cross}.
+Running {\tt add-cross} installs the cross-compiled runtime and
+creates a cross-compiled executable, {\tt print-constants}, which
+prints out all of the constants that {\mlton} needs in order to
+implement the basis library.  Then, it runs {\tt print-constants} on
+the target machine ({\tt blade} in this case, and saves the output.
 
 Once you have done all this, you should be able to cross compile SML
-applications.  For example
+applications.  For example,
 \begin{verbatim}
 mlton -host i386-pc-cygwin hello-world.sml
 \end{verbatim}
-will create {\tt hello-world.exe}, which you should be able to run from a Cygwin
-shell on your Windows machine.
+will create {\tt hello-world}, which you should be able to run from a
+Cygwin shell on your Windows machine.



1.11      +7 -7      mlton/doc/user-guide/cygwin.tex

Index: cygwin.tex
===================================================================
RCS file: /cvsroot/mlton/mlton/doc/user-guide/cygwin.tex,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- cygwin.tex	11 Feb 2003 22:27:01 -0000	1.10
+++ cygwin.tex	10 Apr 2003 02:03:03 -0000	1.11
@@ -1,4 +1,4 @@
-\sec{Running on Cygwin/Windows}{cygwin}
+\subsec{Running on Cygwin/Windows}{cygwin}
 
 {\mlton} uses the \htmladdnormallink{Cygwin}{http://www.cygwin.com/}
 emulation layer to provide a Posix-like environment while running on a
@@ -8,10 +8,12 @@
 unpack the {\mlton} binary tgz in your Cygwin environment.  This
 version of {\mlton} was built against the Cygwin 1.3.17 header files.
 
-{\mlton} under Cygwin mostly behaves like {\mlton} under Linux.  There are,
-however, a few missing features and known problems.
+To run {\mlton} cross-compiled executables on Windows, you must
+install the Cygwin {\tt dll} on the Windows machine.
 
-\begin{enumerate}
+Here are the known problems using {\mlton} on Cygwin.
+
+\begin{itemize}
 
 \item Time profiling is disabled.
 
@@ -24,6 +26,4 @@
 \item We have seen some strangeness in Cygwin's emulation of signals and
 signal handlers, but have not been able to pin it down.
 
-\end{enumerate}
-
-\input{cross-compiling}
+\end{itemize}



1.40      +9 -4      mlton/doc/user-guide/extensions.tex

Index: extensions.tex
===================================================================
RCS file: /cvsroot/mlton/mlton/doc/user-guide/extensions.tex,v
retrieving revision 1.39
retrieving revision 1.40
diff -u -r1.39 -r1.40
--- extensions.tex	12 Mar 2003 20:35:42 -0000	1.39
+++ extensions.tex	10 Apr 2003 02:03:04 -0000	1.40
@@ -443,9 +443,9 @@
    sig
       val alphaNumString: int -> string
       val rand: unit -> word
-      val seed: unit -> word
+      val seed: unit -> word option
       val srand: word -> unit
-      val useed: unit -> word
+      val useed: unit -> word option
    end
 \end{verbatim}
 
@@ -457,13 +457,18 @@
 return the next pseudrandom number.
 
 \entry{seed ()}
-return a random word from {\tt /dev/random}.  Useful as an arg to {\tt srand}.
+return a random word from {\tt /dev/random}.  Useful as an arg to {\tt
+srand}.  If {\tt /dev/random} can not be read from, {\tt seed ()}
+returns {\tt NONE}.
 
 \entry{srand w}
 set the seed used by {\tt rand} to {\tt w}.
 
 \entry{useed ()}
-return a random word from {\tt /dev/urandom}.  Useful as an arg to {\tt srand}.
+return a random word from {\tt /dev/urandom}.  Useful as an arg to
+{\tt srand}.  If {\tt /dev/urandom} can not be read from, {\tt useed
+()} returns {\tt NONE}.
+
 \end{description}
 
 \subsubsection{\tt MLton.Rlimit}



1.9       +3 -4      mlton/doc/user-guide/freebsd.tex

Index: freebsd.tex
===================================================================
RCS file: /cvsroot/mlton/mlton/doc/user-guide/freebsd.tex,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- freebsd.tex	11 Feb 2003 04:49:21 -0000	1.8
+++ freebsd.tex	10 Apr 2003 02:03:04 -0000	1.9
@@ -1,6 +1,6 @@
-\sec{Running on FreeBSD}{freebsd}
+\subsec{Running on FreeBSD}{freebsd}
 
-We have noticed a few issues when running {\mlton} on FreeBSD.  
+Here are the known problems using {\mlton} on FreeBSD.
 
 \begin{itemize}
 
@@ -12,8 +12,7 @@
 
 \end{itemize}
 
-We have also noticed a few issues when compiling {\mlton} on FreeBSD.  These
-only arise if you are working with the {\mlton} sources.
+Here are the known problems building {\mlton} on FreeBSD.
 
 \begin{itemize}
 



1.7       +2 -2      mlton/doc/user-guide/main.tex

Index: main.tex
===================================================================
RCS file: /cvsroot/mlton/mlton/doc/user-guide/main.tex,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- main.tex	14 Jan 2003 20:34:52 -0000	1.6
+++ main.tex	10 Apr 2003 02:03:04 -0000	1.7
@@ -28,12 +28,12 @@
 %\input{performance}
 \input{ffi}
 \input{profiling}
-\input{freebsd}
-\input{cygwin}
 \input{basis}
 \input{extensions}
 \input{cm}
 \input{compiling}
+\input{platform}
+\input{cross-compiling}
 \input{bugs}
 \input{credits}
 \bibliographystyle{alpha}



1.1                  mlton/doc/user-guide/platform.tex

Index: platform.tex
===================================================================
\sec{Platform-specific notes}{platform}

This section discusses issues that arise when running or building
MLton on various platforms.

\input{cygwin}
\input{freebsd}
\input{sunos}



1.1                  mlton/doc/user-guide/sunos.tex

Index: sunos.tex
===================================================================
\subsec{Running on SunOS}{sunos}

Here are the known problems using {\mlton} on SunOS.

\begin{itemize}

\item {\mlton} only supports the C code generator when running on
SPARCs. So, performance is not as good as it might be.  Compile times
are also longer.

\end{itemize}

Here are the known problems building {\mlton} on SunOS.

\begin{itemize}

\item You must install the {\tt binutils}, {\tt gcc}, and {\tt make}
packages.  You can find out how to get these at
\htmladdnormallink{Sunfreeware.com}{http://www.sunfreeware.com}.

\item Bootstrapping is so slow as to be impractical (many hours on a
500MhZ UltraSPARC).  For this reason, we strongly recommend building
with a Linux to SunOS cross compiler (\secref{cross-compiling}).

\item Making the documentation requires that you install {\tt latex}
and {\tt dvips}, which are available in the {\tt tetex} package.  It
also requires {\tt latex2html}, which we haven't yet tracked down a
package for yet.

\end{itemize}



1.54      +90 -47    mlton/include/ccodegen.h

Index: ccodegen.h
===================================================================
RCS file: /cvsroot/mlton/mlton/include/ccodegen.h,v
retrieving revision 1.53
retrieving revision 1.54
diff -u -r1.53 -r1.54
--- ccodegen.h	2 Apr 2003 02:55:55 -0000	1.53
+++ ccodegen.h	10 Apr 2003 02:03:05 -0000	1.54
@@ -18,20 +18,20 @@
 
 #define IsInt(p) (0x3 & (int)(p))
 
-#define BZ(x, l)						\
-	do {							\
-		if (DEBUG_CCODEGEN)				\
-			fprintf (stderr, "%d  BZ(%d, %s)\n", 	\
-					__LINE__, (x), #l); 	\
-		if (0 == (x)) goto l;				\
+#define BZ(x, l)							\
+	do {								\
+		if (DEBUG_CCODEGEN)					\
+			fprintf (stderr, "%s: %d  BZ(%d, %s)\n",	\
+					__FILE__, __LINE__, (x), #l);	\
+		if (0 == (x)) goto l;					\
 	} while (0)
 
-#define BNZ(x, l)						\
-	do {							\
-		if (DEBUG_CCODEGEN)				\
-			fprintf (stderr, "%d  BNZ(%d, %s)\n",	\
-					__LINE__, (x), #l);	\
-		if (x) goto l;					\
+#define BNZ(x, l)							\
+	do {								\
+		if (DEBUG_CCODEGEN)					\
+			fprintf (stderr, "%s: %d  BNZ(%d, %s)\n",	\
+					__FILE__, __LINE__, (x), #l);	\
+		if (x) goto l;						\
 	} while (0)
 
 /* ------------------------------------------------- */
@@ -58,8 +58,8 @@
 
 #define ChunkSwitch(n)							\
 		if (DEBUG_CCODEGEN)					\
-			fprintf (stderr, "%d  entering chunk %d\n",	\
-					__LINE__, n);			\
+			fprintf (stderr, "%s: %d  entering chunk %d\n",	\
+					__FILE__, __LINE__, n);		\
 		CacheFrontier();					\
 		CacheStackTop();					\
 		while (1) {						\
@@ -83,13 +83,13 @@
 /*                Calling SML from C                 */
 /* ------------------------------------------------- */
 
-#define Thread_returnToC()						\
-	do {								\
-		if (DEBUG_CCODEGEN)					\
-			fprintf (stderr, "%d  Thread_returnToC()\n",	\
-					__LINE__);			\
-		returnToC = TRUE;					\
-		return cont;						\
+#define Thread_returnToC()							\
+	do {									\
+		if (DEBUG_CCODEGEN)						\
+			fprintf (stderr, "%s: %d  Thread_returnToC()\n",	\
+					__FILE__, __LINE__);			\
+		returnToC = TRUE;						\
+		return cont;							\
 	} while (0)
 
 /* ------------------------------------------------- */
@@ -227,17 +227,18 @@
 	do {									\
 		l_nextFun = *(word*)(stackTop - WORD_SIZE);			\
 		if (DEBUG_CCODEGEN)						\
-			fprintf (stderr, "%d  Return()  l_nextFun = %d\n",	\
-					__LINE__, l_nextFun);			\
+			fprintf (stderr, "%s: %d  Return()  l_nextFun = %d\n",	\
+					__FILE__, __LINE__, l_nextFun);		\
 		goto top;							\
 	} while (0)
 
-#define Raise()								\
-	do {								\
-		if (DEBUG_CCODEGEN)					\
-			fprintf (stderr, "%d  Raise\n", __LINE__);	\
-		stackTop = StackBottom + ExnStack;			\
-		Return();						\
+#define Raise()							\
+	do {							\
+		if (DEBUG_CCODEGEN)				\
+			fprintf (stderr, "%s: %d  Raise\n", 	\
+					__FILE__, __LINE__);	\
+		stackTop = StackBottom + ExnStack;		\
+		Return();					\
 	} while (0)
 
 /* ------------------------------------------------- */
@@ -286,22 +287,11 @@
 		*(word*)frontier = (h);					\
 		x = frontier + GC_NORMAL_HEADER_SIZE;			\
 		if (DEBUG_CCODEGEN)					\
-			fprintf (stderr, "%d  0x%x = Object(%d)\n",	\
-				 __LINE__, x, h);			\
+			fprintf (stderr, "%s: %d  0x%x = Object(%d)\n",	\
+					__FILE__, __LINE__, x, h);	\
 		assert (frontier <= gcState.limitPlusSlop);		\
 	} while (0)
 
-#define Assign(ty, o, v)						\
-	do {								\
-		*(ty*)(frontier + GC_NORMAL_HEADER_SIZE + (o)) = (v);	\
-	} while (0)
-
-#define AC(o, x) Assign(uchar, o, x)
-#define AD(o, x) Assign(double, o, x)
-#define AI(o, x) Assign(int, o, x)
-#define AP(o, x) Assign(pointer, o, x)
-#define AU(o, x) Assign(uint, o, x)
-
 #define EndObject(bytes)					\
 	do {							\
 		frontier += (bytes);				\
@@ -410,27 +400,41 @@
 
 #endif
 
-static inline Int Int_addOverflow(Int lhs, Int rhs, Bool *overflow) {
+static inline Int Int_addOverflow (Int lhs, Int rhs, Bool *overflow) {
 	long long	tmp;
 
 	tmp = (long long)lhs + rhs;
 	*overflow = (tmp != (int)tmp);
 	return tmp;
 }
-static inline Int Int_mulOverflow(Int lhs, Int rhs, Bool *overflow) {
+static inline Int Int_mulOverflow (Int lhs, Int rhs, Bool *overflow) {
 	long long	tmp;
 
 	tmp = (long long)lhs * rhs;
 	*overflow = (tmp != (int)tmp);
 	return tmp;
 }
-static inline Int Int_subOverflow(Int lhs, Int rhs, Bool *overflow) {
+static inline Int Int_subOverflow (Int lhs, Int rhs, Bool *overflow) {
 	long long	tmp;
 
 	tmp = (long long)lhs - rhs;
 	*overflow = (tmp != (int)tmp);
 	return tmp;
 }
+static inline Word32 Word32_addOverflow (Word32 lhs, Word32 rhs, Bool *overflow) {
+	ullong tmp;
+
+	tmp = (ullong)lhs + rhs;
+	*overflow = (tmp != (Word32)tmp);
+	return tmp;
+}
+static inline Word32 Word32_mulOverflow (Word32 lhs, Word32 rhs, Bool *overflow) {
+	ullong tmp;
+
+	tmp = (ullong)lhs * rhs;
+	*overflow = (tmp != (Word32)tmp);
+	return tmp;
+}
 
 #if (defined (INT_TEST) || defined (INT_LONG))
 #define check(dst, n1, n2, l, f);						\
@@ -438,10 +442,12 @@
 		int overflow;							\
 		dst = f(n1, n2, &overflow);					\
 		if (DEBUG_CCODEGEN)						\
-			fprintf(stderr, #f "(%d, %d) = %d\n", n1, n2, dst);	\
+			fprintf (stderr, "%s: %d " #f "(%d, %d) = %d\n",	\
+					__FILE__, __LINE__, n1, n2, dst);	\
 		if (overflow) {							\
 			if (DEBUG_CCODEGEN)					\
-				fprintf(stderr, "overflow\n");			\
+				fprintf (stderr, "%s: %d overflow\n",		\
+						__FILE__, __LINE__);		\
 			goto l;							\
 		}								\
 	} while (0)
@@ -600,6 +606,43 @@
 #define Real_neg(x) (-(x))
 #define Real_sub(x, y) ((x) - (y))
 #define Real_toInt(x) ((int)(x))
+
+typedef volatile union {
+	word tab[2];
+	double d;
+} DoubleOr2Words;
+
+static inline double Real_fetch (double *dp) {
+ 	DoubleOr2Words u;
+	Word32 *p;
+
+	p = (Word32*)dp;
+	u.tab[0] = p[0];
+	u.tab[1] = p[1];
+ 	return u.d;
+}
+
+static inline void Real_move (double *dst, double *src) {
+	Word32 *pd;
+	Word32 *ps;
+	Word32 t;
+
+	pd = (Word32*)dst;
+	ps = (Word32*)src;
+	t = ps[1];
+	pd[0] = ps[0];
+	pd[1] = t;		
+}
+
+static inline void Real_store (double *dp, double d) {
+ 	DoubleOr2Words u;
+	Word32 *p;
+
+	p = (Word32*)dp;
+	u.d = d;
+	p[0] = u.tab[0];
+	p[1] = u.tab[1];
+}
 
 /* ------------------------------------------------- */
 /*                      Vector                       */



1.3       +2 -2      mlton/lib/mlton/basic/random.sig

Index: random.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton/basic/random.sig,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- random.sig	10 Apr 2002 07:50:31 -0000	1.2
+++ random.sig	10 Apr 2003 02:03:05 -0000	1.3
@@ -19,8 +19,8 @@
       val nRandom: {list: 'a list, length: int, n: int} -> 'a list
       (* 0.0 <= real() <= 1.0 *)
       val real: unit -> real
-      val seed: unit -> Word.t
+      val seed: unit -> Word.t option
       val srand: Word.t -> unit
-      val useed: unit -> Word.t
+      val useed: unit -> Word.t option
       val word: unit -> Word.t
    end



1.9       +1 -1      mlton/lib/mlton-stubs/mlton.sig

Index: mlton.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton-stubs/mlton.sig,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- mlton.sig	25 Mar 2003 04:31:23 -0000	1.8
+++ mlton.sig	10 Apr 2003 02:03:06 -0000	1.9
@@ -17,7 +17,7 @@
        *)
       val eq: 'a * 'a -> bool
       val errno: unit -> int (* the value of the C errno global *)
-      datatype hostType = Cygwin | FreeBSD | Linux
+      datatype hostType = Cygwin | FreeBSD | Linux | Sun
       val hostType: hostType
       val isMLton: bool
       val safe: bool



1.14      +1 -1      mlton/lib/mlton-stubs/mlton.sml

Index: mlton.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton-stubs/mlton.sml,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- mlton.sml	25 Mar 2003 04:31:23 -0000	1.13
+++ mlton.sml	10 Apr 2003 02:03:06 -0000	1.14
@@ -36,7 +36,7 @@
       val deserialize = fn _ => raise Fail "deserialize"
       val eq = fn _ => false
       val errno = fn _ => raise Fail "errno"
-      datatype hostType = Cygwin | FreeBSD | Linux
+      datatype hostType = Cygwin | FreeBSD | Linux | Sun
       val hostType = Linux
       val isMLton = false
       val safe = true



1.3       +8 -4      mlton/lib/mlton-stubs/random.sig

Index: random.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton-stubs/random.sig,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- random.sig	10 Apr 2002 07:31:54 -0000	1.2
+++ random.sig	10 Apr 2003 02:03:06 -0000	1.3
@@ -11,12 +11,16 @@
       (* Get the next pseudrandom. *)
       val rand: unit -> word
 	 
-      (* Use /dev/random to get a word.  Useful as an arg to srand. *)
-      val seed: unit -> word
+      (* Use /dev/random to get a word.  Useful as an arg to srand.
+       * Return NONE if /dev/random can't be read.
+       *)
+      val seed: unit -> word option
 	 
       (* Set the seed used by rand. *)
       val srand: word -> unit
 
-      (* Use /dev/urandom to get a word.  Useful as an arg to srand. *)
-      val useed: unit -> word
+      (* Use /dev/urandom to get a word.  Useful as an arg to srand.
+       * Return NONE if /dev/urandom can't be read.
+       *)
+      val useed: unit -> word option
    end



1.2       +2 -2      mlton/lib/mlton-stubs/random.sml

Index: random.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton-stubs/random.sml,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- random.sml	6 Aug 2002 03:19:19 -0000	1.1
+++ random.sml	10 Apr 2003 02:03:06 -0000	1.2
@@ -1,7 +1,7 @@
 structure Random: MLTON_RANDOM = 
    struct
-      fun seed _ = 0w13: Word32.word
-      fun useed _ = 0w13: Word32.word
+      fun seed _ = SOME (0w13: Word32.word)
+      fun useed _ = SOME (0w13: Word32.word)
       local
 	 val seed: word ref = ref 0w13
       in



1.44      +0 -42     mlton/mlton/backend/machine.fun

Index: machine.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/machine.fun,v
retrieving revision 1.43
retrieving revision 1.44
diff -u -r1.43 -r1.44
--- machine.fun	2 Apr 2003 02:55:56 -0000	1.43
+++ machine.fun	10 Apr 2003 02:03:06 -0000	1.44
@@ -324,9 +324,6 @@
 		     dst: Operand.t option,
 		     prim: Prim.t}
        | ProfileLabel of ProfileLabel.t
-       | SetExnStackLocal of {offset: int}
-       | SetExnStackSlot of {offset: int}
-       | SetSlotExnStack of {offset: int}
 
       val layout =
 	 let
@@ -361,12 +358,6 @@
 		  end
 	     | ProfileLabel l =>
 		  seq [str "ProfileLabel ", ProfileLabel.layout l]
-	     | SetExnStackLocal {offset} =>
-		  seq [str "SetExnStackLocal ", Int.layout offset]
-	     | SetExnStackSlot {offset} =>
-		  seq [str "SetExnStackSlot ", Int.layout offset]
-	     | SetSlotExnStack {offset} =>
-		  seq [str "SetSlotExnStack ", Int.layout offset]
 	 end
  
       fun move (arg as {dst, src}) =
@@ -1188,39 +1179,6 @@
 				    | _ => NONE
 				end
 			else SOME alloc
-		   | SetExnStackLocal {offset} =>
-			(case Alloc.peekOffset (alloc, offset) of
-			    NONE => NONE
-			  | SOME {ty, ...} =>
-			       (case ty of
-				   Type.Label l =>
-				      let
-					 val Block.T {kind, ...} = labelBlock l
-				      in
-					 case kind of
-					    Kind.Handler {frameInfo, ...} =>
-					       let
-						  val {size, ...} =
-						     getFrameInfo frameInfo
-					       in
-						  if offset = size
-						     then SOME alloc
-						  else NONE
-					       end
-					  | _ => NONE
-				      end
-				 | _ => NONE))
-		   | SetExnStackSlot {offset} =>
-			(checkOperand
-			 (Operand.StackOffset {offset = offset,
-					       ty = Type.word},
-			  alloc)
-			 ; SOME alloc)
-		   | SetSlotExnStack {offset} =>
-			SOME
-			(Alloc.define
-			 (alloc, Operand.StackOffset {offset = offset,
-						      ty = Type.word}))
 	       end
 	    fun liveIsOk (live: Operand.t vector,
 			  a: Alloc.t): bool =



1.34      +0 -3      mlton/mlton/backend/machine.sig

Index: machine.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/machine.sig,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -r1.33 -r1.34
--- machine.sig	2 Apr 2003 02:55:56 -0000	1.33
+++ machine.sig	10 Apr 2003 02:03:06 -0000	1.34
@@ -111,9 +111,6 @@
 			   dst: Operand.t option,
 			   prim: Prim.t}
 	     | ProfileLabel of ProfileLabel.t
-	     | SetExnStackLocal of {offset: int}
-	     | SetExnStackSlot of {offset: int}
-	     | SetSlotExnStack of {offset: int}
 
 	    val foldOperands: t * 'a * (Operand.t * 'a -> 'a) -> 'a
 	    val layout: t -> Layout.t



1.49      +117 -55   mlton/mlton/codegen/c-codegen/c-codegen.fun

Index: c-codegen.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/c-codegen/c-codegen.fun,v
retrieving revision 1.48
retrieving revision 1.49
diff -u -r1.48 -r1.49
--- c-codegen.fun	2 Apr 2003 02:55:56 -0000	1.48
+++ c-codegen.fun	10 Apr 2003 02:03:07 -0000	1.49
@@ -120,7 +120,14 @@
    struct
       open Operand
 
-      val layout = Layout.str o toString
+      fun isMem (z: t): bool =
+	 case z of
+	    ArrayOffset _ => true
+	  | Cast (z, _) => isMem z
+	  | Contents _ => true
+	  | Offset _ => true
+	  | StackOffset _ => true
+	  | _ => false
    end
 
 fun creturn (t: Runtime.Type.t): string =
@@ -226,7 +233,9 @@
 	  end)
       fun declareMain () =
 	 let
-	    val magic = C.word (Random.useed ())
+	    val magic = C.word (case Random.useed () of
+				   NONE => String.hash (!Control.inputFile)
+				 | SOME w => w)
 	 in 
 	    C.callNoSemi ("Main",
 			  [C.int (!Control.cardSizeLog2),
@@ -367,6 +376,27 @@
 	       then s
 	    else concat [s, " /* ", Label.toString l, " */"]
 	 end
+      val handleMisalignedReals =
+	 !Control.alignDoubles = Control.AlignNo
+	 andalso !Control.hostType = Control.Sun
+      fun addr z = concat ["&(", z, ")"]
+      fun realFetch z = concat ["Real_fetch(", addr z, ")"]
+      fun realMove {dst, src} =
+	 concat ["Real_move(", addr dst, ", ", addr src, ");\n"]
+      fun realStore {dst, src} =
+	 concat ["Real_store(", addr dst, ", ", src, ");\n"]
+      fun move {dst: string, dstIsMem: bool,
+		src: string, srcIsMem: bool,
+		ty: Type.t}: string =
+	 if handleMisalignedReals
+	    andalso Type.equals (ty, Type.real)
+	    then
+	       case (dstIsMem, srcIsMem) of
+		  (false, false) => concat [dst, " = ", src, ";\n"]
+		| (false, true) => concat [dst, " = ", realFetch src, ";\n"]
+		| (true, false) => realStore {dst = dst, src = src}
+		| (true, true) => realMove {dst = dst, src = src}
+	 else concat [dst, " = ", src, ";\n"]
       local
 	 datatype z = datatype Operand.t
       	 fun toString (z: Operand.t): string =
@@ -424,7 +454,12 @@
       in
 	 val operandToString = toString
       end
-   
+      fun fetchOperand (z: Operand.t): string =
+	 if handleMisalignedReals
+	    andalso Type.equals (Operand.ty z, Type.real)
+	    andalso Operand.isMem z
+	    then realFetch (operandToString z)
+	 else operandToString z
       fun outputStatement (s, print) =
 	 let
 	    datatype z = datatype Statement.t
@@ -435,55 +470,71 @@
 		  (print "\t"
 		   ; (case s of
 			 Move {dst, src} =>
-			    C.move ({dst = operandToString dst,
-				     src = operandToString src},
-				    print)
+			    print
+			    (move {dst = operandToString dst,
+				   dstIsMem = Operand.isMem dst,
+				   src = operandToString src,
+				   srcIsMem = Operand.isMem src,
+				   ty = Operand.ty dst})
 		       | Noop => ()
 		       | Object {dst, header, size, stores} =>
 			    (C.call ("Object", [operandToString dst,
 						C.word header],
 				     print)
-			     ; print "\t"
 			     ; (Vector.foreach
 				(stores, fn {offset, value} =>
-				 (C.call
-				  (concat ["A", Type.name (Operand.ty value)],
-				   [C.int offset, operandToString value], 
-				   print)
-				  ; print "\t")))
+				 let
+				    val ty = Operand.ty value
+				    val dst =
+				       concat
+				       ["C", Type.name (Operand.ty value),
+					"(frontier + ",
+					C.int (offset
+					       + Runtime.normalHeaderSize),
+					")"]
+				 in
+				    print "\t"
+				    ; (print
+				       (move {dst = dst,
+					      dstIsMem = true,
+					      src = operandToString value,
+					      srcIsMem = Operand.isMem value,
+					      ty = ty}))
+				 end))
+			     ; print "\t"
 			     ; C.call ("EndObject", [C.int size], print))
 		       | PrimApp {args, dst, prim} =>
 			    let
-			       val _ =
-				  case dst of
-				     NONE => ()
-				   | SOME dst =>
-					print
-					(concat [operandToString dst, " = "])
-			       fun doit () =
-				  C.call
-				  (Prim.toString prim,
-				   Vector.toListMap (args, operandToString),
-				   print)
-			       val _ =
+			       fun call (): string =
+				  concat
+				  [Prim.toString prim,
+				   "(",
+				   concat
+				   (List.separate
+				    (Vector.toListMap (args, fetchOperand),
+				     ", ")),
+				   ")"]
+			       fun app (): string =
 				  case Prim.name prim of
 				     Prim.Name.FFI s =>
 					(case Prim.numArgs prim of
-					    NONE => print (concat [s, ";\n"])
-					  | SOME _ => doit ())
-				   | _ => doit ()
-			    in 
-			       ()
+					    NONE => s
+					  | SOME _ => call ())
+				   | _ => call ()
+			    in
+			       case dst of
+				  NONE => (print (app ())
+					   ; print ";\n")
+				| SOME dst =>
+				     print (move {dst = operandToString dst,
+						  dstIsMem = Operand.isMem dst,
+						  src = app (),
+						  srcIsMem = false,
+						  ty = Operand.ty dst})
 			    end
 		       | ProfileLabel l =>
 			    C.call ("ProfileLabel", [ProfileLabel.toString l],
 				    print)
-		       | SetExnStackLocal {offset} =>
-			    C.call ("SetExnStackLocal", [C.int offset], print)
-		       | SetExnStackSlot {offset} =>
-			    C.call ("SetExnStackSlot", [C.int offset], print)
-		       | SetSlotExnStack {offset} =>
-			    C.call ("SetSlotExnStack", [C.int offset], print)
 			    ))
 	 end
       val profiling = !Control.profile <> Control.ProfileNone
@@ -546,12 +597,14 @@
 		 end)
 	    fun push (return: Label.t, size: int) =
 	       (print "\t"
-		; C.move ({dst = operandToString
-			   (Operand.StackOffset
-			    {offset = size - Runtime.labelSize,
-			     ty = Type.label return}),
-			   src = operandToString (Operand.Label return)},
-			  print)
+		; print (move {dst = (operandToString
+				      (Operand.StackOffset
+				       {offset = size - Runtime.labelSize,
+					ty = Type.label return})),
+			       dstIsMem = true,
+			       src = operandToString (Operand.Label return),
+			       srcIsMem = false,
+			       ty = Type.Label return})
 		; C.push (size, print)
 		; if profiling
 		     then print "\tFlushStackTop();\n"
@@ -574,21 +627,22 @@
 					concat ["tmp",
 						Int.toString (Counter.next c)]
 				     val _ =
-					print (concat
-					       ["\t",
-						Runtime.Type.toString
-						(Type.toRuntime ty),
-						" ", tmp,
-						" = ", operandToString z,
-						";\n"])
+					print
+					(concat
+					 ["\t",
+					  Runtime.Type.toString
+					  (Type.toRuntime ty),
+					  " ", tmp, " = ",
+					  fetchOperand z,
+					  ";\n"])
 				  in
 				     tmp
 				  end
-			     | _ => operandToString z)
+			     | _ => fetchOperand z)
 		     in
 			(args, fn () => print "\t}\n")
 		     end
-	       else (Vector.toListMap (args, operandToString),
+	       else (Vector.toListMap (args, fetchOperand),
 		     fn () => ())
 	    val tracePrintLabelCode =
 	       Trace.trace
@@ -642,10 +696,18 @@
 			     | SOME fi => pop (valOf frameInfo)
 			    ; (Option.app
 			       (dst, fn x =>
-				print (concat
-				       ["\t", operandToString x, " = ",
-					creturn (Type.toRuntime (Operand.ty x)),
-					";\n"]))))
+				let
+				   val ty = Operand.ty x
+				in
+				   print
+				   (concat
+				    ["\t",
+				     move {dst = operandToString x,
+					   dstIsMem = Operand.isMem x,
+					   src = creturn (Type.toRuntime ty),
+					   srcIsMem = false,
+					   ty = ty}])
+				end)))
 		      | Kind.Func => ()
 		      | Kind.Handler {frameInfo, ...} => pop frameInfo
 		      | Kind.Jump => ()
@@ -743,7 +805,7 @@
 			   val (args, afterCall) =
 			      case frameInfo of
 				 NONE =>
-				    (Vector.toListMap (args, operandToString),
+				    (Vector.toListMap (args, fetchOperand),
 				     fn () => ())
 			       | SOME frameInfo =>
 				    let



1.37      +2 -0      mlton/mlton/codegen/x86-codegen/x86-codegen.fun

Index: x86-codegen.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-codegen.fun,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -r1.36 -r1.37
--- x86-codegen.fun	20 Jan 2003 16:28:31 -0000	1.36
+++ x86-codegen.fun	10 Apr 2003 02:03:08 -0000	1.37
@@ -94,6 +94,7 @@
 	       Control.Cygwin => true
 	     | Control.FreeBSD => false
 	     | Control.Linux => false
+	     | _ => Error.bug "x86 can't handle hostType"
 
 	val makeC = outputC
 	val makeS = outputS
@@ -154,6 +155,7 @@
 			  Control.Cygwin => String.dropPrefix (mainLabel, 1)
 			| Control.FreeBSD => mainLabel
 			| Control.Linux => mainLabel
+			| _ => Error.bug "x86 can't handle hostType"
 		 in
 		    [mainLabel, if reserveEsp then C.truee else C.falsee]
 		 end



1.15      +3 -1      mlton/mlton/codegen/x86-codegen/x86-mlton-basic.fun

Index: x86-mlton-basic.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-mlton-basic.fun,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -r1.14 -r1.15
--- x86-mlton-basic.fun	23 Jan 2003 03:34:37 -0000	1.14
+++ x86-mlton-basic.fun	10 Apr 2003 02:03:08 -0000	1.15
@@ -315,7 +315,9 @@
       Label.fromString (case !Control.hostType of
 			   Control.Cygwin => "_LINE__"
 			 | Control.FreeBSD => "__LINE__"
-			 | Control.Linux => "__LINE__"))
+			 | Control.Linux => "__LINE__"
+			 | _ => Error.bug "x86 can't handle hostType"))
+					 
   val fileLine
     = fn () => if !Control.debug
 		 then Operand.immediate (Immediate.const_int 0)



1.40      +0 -107    mlton/mlton/codegen/x86-codegen/x86-translate.fun

Index: x86-translate.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-translate.fun,v
retrieving revision 1.39
retrieving revision 1.40
diff -u -r1.39 -r1.40
--- x86-translate.fun	23 Jan 2003 03:34:37 -0000	1.39
+++ x86-translate.fun	10 Apr 2003 02:03:08 -0000	1.40
@@ -374,113 +374,6 @@
 		   AppendList.single
 		   (x86.Block.mkProfileBlock'
 		    {profileLabel = l})
- 	      | SetSlotExnStack {offset}
-	      => let
-		   val (comment_begin, comment_end) = comments statement
-		   val exnStack
-		     = x86MLton.gcState_currentThread_exnStackContentsOperand ()
-		   val stackTop = x86MLton.gcState_stackTopContentsOperand ()
-		   val stackBottom =
-		      x86MLton.gcState_stackBottomContentsOperand ()
-		   val tempP 
-		     = let
-			 val index = x86.Immediate.const_int offset
-			 val memloc
-			   = x86.MemLoc.simple 
-			     {base = x86MLton.gcState_stackTopContents (), 
-			      index = index,
-			      scale = x86.Scale.One,
-			      size = x86MLton.pointerSize,
-			      class = x86MLton.Classes.Stack}
-		       in
-			 x86.Operand.memloc memloc
-		       end
-		 in
-		   AppendList.appends
-		   [comment_begin,
-		    AppendList.single
-		    (x86.Block.mkBlock'
-		     {entry = NONE,
-		      statements =
-		      [(* *(stackTop + offset) = exnStack *)
-		       x86.Assembly.instruction_mov 
-		       {dst = tempP,
-			src = exnStack,
-			size = x86MLton.pointerSize}],
-		      transfer = NONE}),
-		    comment_end]
-		 end
-	      | SetExnStackLocal {offset}
-	      => let
-		   val (comment_begin,
-			comment_end) = comments statement
-		   val exnStack
-		     = x86MLton.gcState_currentThread_exnStackContentsOperand ()
-		   val stackTop = x86MLton.gcState_stackTopContentsOperand ()
-		   val stackBottom =
-		      x86MLton.gcState_stackBottomContentsOperand ()
-		 in
-		   AppendList.appends
-		   [comment_begin,
-		    AppendList.single
-		    (x86.Block.mkBlock'
-		     {entry = NONE,
-		      statements
-		      = [(* exnStack = (stackTop + offset) - stackBottom *)
-			 x86.Assembly.instruction_mov 
-			 {dst = exnStack,
-			  src = stackTop,
-			  size = x86MLton.pointerSize},
-			 x86.Assembly.instruction_binal 
-			 {oper = x86.Instruction.ADD,
-			  dst = exnStack,
-			  src = x86.Operand.immediate_const_int offset,
-			  size = x86MLton.pointerSize},
-			 x86.Assembly.instruction_binal 
-			 {oper = x86.Instruction.SUB,
-			  dst = exnStack,
-			  src = stackBottom,
-			  size = x86MLton.pointerSize}],
-		      transfer = NONE}),
-		    comment_end]
-		 end
-	      | SetExnStackSlot {offset}
-	      => let
-		   val (comment_begin,
-			comment_end) = comments statement
-		     
-		   val exnStack =
-		      x86.Operand.memloc 
-		      (x86MLton.gcState_currentThread_exnStackContents ())
-		     
-		   val tempP 
-		     = let
-			 val index = x86.Immediate.const_int offset
-			 val memloc 
-			   = x86.MemLoc.simple 
-			     {base = x86MLton.gcState_stackTopContents (), 
-			      index = index,
-			      scale = x86.Scale.One,
-			      size = x86MLton.pointerSize,
-			      class = x86MLton.Classes.Stack}
-		       in
-			 x86.Operand.memloc memloc
-		       end
-		 in
-		   AppendList.appends
-		   [comment_begin,
-		    AppendList.single
-		    (x86.Block.mkBlock'
-		     {entry = NONE,
-		      statements 
-		      = [(* exnStack = *(stackTop + offset) *)
-			 x86.Assembly.instruction_mov 
-			 {dst = exnStack,
-			  src = tempP,
-			  size = x86MLton.pointerSize}],
-		      transfer = NONE}),
-		    comment_end]
-		 end
 	      | Object {dst, header, size, stores}
 	      => let
 		   val (comment_begin,



1.37      +1 -0      mlton/mlton/codegen/x86-codegen/x86.fun

Index: x86.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86.fun,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -r1.36 -r1.37
--- x86.fun	25 Mar 2003 04:31:25 -0000	1.36
+++ x86.fun	10 Apr 2003 02:03:08 -0000	1.37
@@ -58,6 +58,7 @@
 	      Control.Cygwin => concat ["_", Label.toString l]
 	    | Control.FreeBSD => Label.toString l
 	    | Control.Linux => Label.toString l
+	    | _ => Error.bug "x86 can't handle hostType"
 
 	val layout = Layout.str o toString
      end



1.71      +4 -4      mlton/mlton/control/control.sig

Index: control.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/control/control.sig,v
retrieving revision 1.70
retrieving revision 1.71
diff -u -r1.70 -r1.71
--- control.sig	26 Feb 2003 00:10:50 -0000	1.70
+++ control.sig	10 Apr 2003 02:03:09 -0000	1.71
@@ -18,6 +18,9 @@
       (*            Begin Flags             *)
       (*------------------------------------*)
 
+      datatype alignDoubles = AlignNo | AlignPad | AlignSkip
+      val alignDoubles: alignDoubles ref
+	 
       val basisLibs: string list
       val basisLibrary: string ref
 
@@ -64,10 +67,7 @@
        | Self
       val host: host ref
 
-      datatype hostType =
-	 Cygwin
-       | FreeBSD
-       | Linux
+      datatype hostType = datatype MLton.hostType
       val hostType: hostType ref
 
       (* Indentation used in laying out ILs. *)



1.87      +25 -4     mlton/mlton/control/control.sml

Index: control.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/control/control.sml,v
retrieving revision 1.86
retrieving revision 1.87
diff -u -r1.86 -r1.87
--- control.sml	26 Feb 2003 00:10:50 -0000	1.86
+++ control.sml	10 Apr 2003 02:03:09 -0000	1.87
@@ -11,6 +11,22 @@
 structure C = Control ()
 open C
 
+structure AlignDoubles =
+   struct
+      datatype t = AlignNo | AlignPad | AlignSkip
+
+      val toString =
+	 fn AlignNo => "no"
+	  | AlignPad => "pad"
+	  | AlignSkip => "skip"
+   end
+
+datatype alignDoubles = datatype AlignDoubles.t
+
+val alignDoubles = control {name = "align doubles",
+			    default = AlignNo,
+			    toString = AlignDoubles.toString}
+   
 val basisLibs = ["basis-2002", "basis-2002-strict", "basis-1997", "basis-none"]
 val basisLibrary = control {name = "basis library",
 			    default = "basis-2002",
@@ -36,6 +52,7 @@
    end
 
 datatype chunk = datatype Chunk.t
+   
 val chunk = control {name = "chunk",
 		     default = Coalesce {limit = 4096},
 		     toString = Chunk.toString}
@@ -116,24 +133,24 @@
    end
 
 datatype host = datatype Host.t
+   
 val host = control {name = "host",
 		    default = Self,
 		    toString = Host.toString}
 
 structure HostType =
    struct
-      datatype t =
-	 Cygwin
-       | FreeBSD
-       | Linux
+      datatype t = datatype MLton.hostType
 
       val toString =
 	 fn Cygwin => "Cygwin"
 	  | FreeBSD => "FreeBSD"
 	  | Linux => "Linux"
+	  | Sun => "Sun"
    end
 
 datatype hostType = datatype HostType.t
+   
 val hostType = control {name = "host type",
 			default = Linux,
 			toString = HostType.toString}
@@ -249,7 +266,9 @@
 
       val layout = Layout.str o toString
    end
+
 datatype limitCheck = datatype LimitCheck.t
+
 val limitCheck = control {name = "limit check",
 			  default = LoopHeaders {fullCFG = false,
 						 loopExits = true},
@@ -428,6 +447,7 @@
 	  | Header => "header"
 	  | HeaderIndirect => "header indirect"
    end
+
 datatype variant = datatype Variant.t
 
 val variant = control {name = "variant",
@@ -456,6 +476,7 @@
 	  | (_, Detail) => true
 	  | _ => false
    end
+
 datatype verbosity = datatype Verbosity.t
    
 val verbosity = control {name = "verbosity",



1.128     +164 -114  mlton/mlton/main/main.sml

Index: main.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/main/main.sml,v
retrieving revision 1.127
retrieving revision 1.128
diff -u -r1.127 -r1.128
--- main.sml	2 Apr 2003 02:55:57 -0000	1.127
+++ main.sml	10 Apr 2003 02:03:10 -0000	1.128
@@ -36,10 +36,10 @@
    end
 
 val buildConstants: bool ref = ref false
+val ccOpts: string list ref = ref []
 val coalesce: int option ref = ref NONE
 val expert: bool ref = ref false
 val gcc: string ref = ref "<unset>"
-val gccSwitches : string ref = ref ""
 val includeDirs: string list ref = ref []
 val keepGenerated = ref false
 val keepO = ref false
@@ -65,8 +65,18 @@
 		"cygwin" => Control.Cygwin
 	      | "freebsd" => Control.FreeBSD
 	      | "linux" => Control.Linux
+	      | "sun" => Control.Sun
 	      | _ => Error.bug (concat ["strange hostType: ", hostType]))}
       | _ => Error.bug (concat ["strange host mapping: ", line])))
+
+fun setHostType (hostString: string, usage): unit =
+   case List.peek (hostMap (), fn {host = h, ...} => h = hostString) of
+      NONE => usage (concat ["invalid host ", hostString])
+    | SOME {hostType = t, ...} =>
+	 (Control.hostType := t
+	  ; (case !Control.hostType of
+		Control.Sun => Control.Native.native := false
+	      | _ => ()))
    
 fun makeOptions {usage} = 
    let
@@ -77,6 +87,16 @@
       List.map
       (
        [
+       (Expert, "align-doubles", " {no|pad|skip}",
+	" how to align doubles",
+	(SpaceString (fn s =>
+		      alignDoubles
+		      := (case s of
+			     "no" => AlignNo
+			   | "pad" => AlignPad
+			   | "skip" => AlignSkip
+			   | _ => usage (concat ["invalid -align-doubles flag: ",
+						 s]))))),
        (Normal, "basis", " {2002|1997|...}",
 	"select basis library to prefix to the program",
 	SpaceString (fn s =>
@@ -87,30 +107,23 @@
 			   then basisLibrary := s'
 			else usage (concat ["invalid -basis flag: ", s])
 		     end)),
-       (Expert, "build-constants", "",
+       (Expert, "build-constants", " {false|true}",
 	"output C file that prints basis constants",
-	trueRef buildConstants),
-       (Expert, "card-size-log2", " n",
+	boolRef buildConstants),
+       (Expert, "card-size-log2", " <n>",
 	"log (base 2) of card size used by GC",
 	intRef cardSizeLog2),
-       (Expert, "cc", " gcc", "path to gcc executable",
-	SpaceString (fn s => (gcc := s; gccSwitches := ""))),
-       (Expert, "coalesce", " n", "coalesce chunk size for C codegen",
+       (Expert, "cc", " <gcc>", "path to gcc executable",
+	SpaceString (fn s => gcc := s)),
+       (Expert, "cc-opt", " <opt>", "pass option to C compiler", push ccOpts),
+       (Expert, "coalesce", " <n>", "coalesce chunk size for C codegen",
 	Int (fn n => coalesce := SOME n)),
-       (Expert, "ccopt", " opt", "pass option to C compiler",
-	SpaceString (fn s =>
-		     if 3 = String.size s
-			andalso String.isPrefix {string = s, prefix = "-O"}
-			then (optimization
-			      := Char.toInt (String.sub (s, 2))
-			         - Char.toInt #"0")
-		     else gccSwitches := concat [!gccSwitches, " ", s])),
        (Expert, "debug", " {false|true}", "produce executable with debug info",
 	boolRef debug),
        (Normal, "detect-overflow", " {true|false}",
 	"overflow checking on integer arithmetic",
 	boolRef detectOverflow),
-       (Expert, "diag", " pass", "keep diagnostic info for pass",
+       (Expert, "diag", " <pass>", "keep diagnostic info for pass",
 	SpaceString (fn s =>
 		     (case Regexp.fromString s of
 			 SOME (re,_) => let val re = Regexp.compileDFA re
@@ -119,10 +132,8 @@
 					   ; List.push (keepPasses, re)
 					end
 		       | NONE => usage (concat ["invalid -diag flag: ", s])))),
-       (Expert, "drop-pass", " pass", "omit optimization pass",
+       (Expert, "drop-pass", " <pass>", "omit optimization pass",
 	SpaceString (fn s => List.push (dropPasses, s))),
-       (Expert, "D", "define", "define a constant for gcc",
-	String (fn s => (List.push (defines, s)))),
        (Expert, "eliminate-overflow", " {true|false}",
 	"eliminate useless overflow tests",
 	boolRef eliminateOverflow),
@@ -152,26 +163,14 @@
 		concat (List.separate (List.map (hostMap (), #host), "|")),
 		"}"],
 	"host type that executable will run on",
-	SpaceString (fn s => host := (if s = "self" then Self else Cross s))),
+	SpaceString (fn s =>
+		     (setHostType (s, usage)
+		      ; host := (if s = "self" then Self else Cross s)))),
        (Normal, "ieee-fp", " {false|true}", "use strict IEEE floating-point",
 	boolRef Native.IEEEFP),
-       (Expert, "indentation", " n", "indentation level in ILs",
+       (Expert, "indentation", " <n>", "indentation level in ILs",
 	intRef indentation),
-(*        (Normal, "include", " file.h", "include a .h file",
- * 	SpaceString (fn s => List.push (includes, s))),
- *)
-       (Normal, "inline", " <n>", "inlining threshold",
-	Int setInlineSize),
-       (* -inline-array true is no longer allowed, because GC_arrayAllocate
-	* knows intimate details of the generational GC.
-	*)
-(*        (Expert, "inline-array", " {false|true}",
- * 	"inline array allocation",
- *	boolRef inlineArrayAllocation),
- *)
-(*        (Normal, "I", "dir", "search dir for include files",
- * 	push includeDirs),
- *)
+       (Normal, "inline", " <n>", "inlining threshold", Int setInlineSize),
        (Normal, "keep", " {g|o|sml}", "save intermediate files",
 	SpaceString (fn s =>
 		     case s of
@@ -183,14 +182,14 @@
 		      | "rssa" => keepRSSA := true
 		      | "ssa" => keepSSA := true
 		      | _ => usage (concat ["invalid -keep flag: ", s]))),
-       (Expert, "keep-pass", " pass", "keep the results of pass",
+       (Expert, "keep-pass", " <pass>", "keep the results of pass",
 	SpaceString
 	(fn s => (case Regexp.fromString s of
 		     SOME (re,_) => let val re = Regexp.compileDFA re
 				    in List.push (keepPasses, re)
 				    end
 		   | NONE => usage (concat ["invalid -keep-pass flag: ", s])))),
-       (Expert, "lib", " lib", "set MLton lib directory",
+       (Expert, "lib", " <lib>", "set MLton lib directory",
 	SpaceString (fn s => libDir := s)),
        (Normal, "lib-search", " <dir>", "search dir for libraries (like gcc -L)",
 	push libDirs),
@@ -214,7 +213,7 @@
 	boolRef limitCheckCounts),
        (Normal, "link", " <library>", "link with library (like gcc -l)",
 	push libs),
-       (Expert, "loop-passes", " n", "loop optimization passes (1)",
+       (Expert, "loop-passes", " <n>", "loop optimization passes (1)",
 	Int 
 	(fn i => 
 	 if i >= 1
@@ -225,14 +224,16 @@
        (Normal, "may-load-world", " {true|false}",
 	"may @MLton load-world be used",
 	boolRef mayLoadWorld),
-       (Normal, "native", " {true|false}", "use native code generator",
+       (Normal, "native",
+	if !hostType = Sun then " {false}" else " {true|false}",
+	"use native code generator",
 	boolRef Native.native),
-       (Expert, "native-commented", " n", "level of comments  (0)",
+       (Expert, "native-commented", " <n>", "level of comments  (0)",
 	intRef Native.commented),
        (Expert, "native-copy-prop", " {true|false}", 
 	"use copy propagation",
 	boolRef Native.copyProp),
-       (Expert, "native-cutoff", " n", 
+       (Expert, "native-cutoff", " <n>", 
 	"live transfer cutoff distance",
 	intRef Native.cutoff),
        (Expert, "native-live-transfer", " {0,...,8}",
@@ -244,9 +245,9 @@
        (Expert, "native-move-hoist", " {true|false}",
 	"use move hoisting",
 	boolRef Native.moveHoist),
-       (Expert, "native-optimize", " n", "level of optimizations",
+       (Expert, "native-optimize", " <n>", "level of optimizations",
         intRef Native.optimize),
-       (Expert, "native-split", " n", "split assembly files at ~n lines",
+       (Expert, "native-split", " <n>", "split assembly files at ~n lines",
 	Int (fn i => Native.split := SOME i)),
        (Expert, "native-shuffle", " {true|false}",
 	"shuffle registers at C-calls",
@@ -280,15 +281,13 @@
 	 case s of
 	    "source" => profileIL := ProfileSource
 	  | _ => usage (concat ["invalid -profile-il arg: ", s]))),
-       (Normal, "profile-split", " <regexp>",
-	"split duplicates of functions",
+       (Normal, "profile-split", " <regexp>", "split duplicates of functions",
 	SpaceString
 	(fn s =>
 	 case Regexp.fromString s of
 	    NONE => usage (concat ["invalid -profile-split regexp: ", s])
 	  | SOME (r, _) => profileSplit := Regexp.or [r, !profileSplit])),
-       (Normal, "profile-stack", " {false|true}",
-	"profile the stack",
+       (Normal, "profile-stack", " {false|true}", "profile the stack",
 	boolRef profileStack),
        (Normal, "safe", " {true|false}", "bounds checking and other checks",
 	boolRef safe),
@@ -315,7 +314,7 @@
 		   | "sml" => Place.SML
 		   | _ => usage (concat ["invalid -stop arg: ", s])))),
        (Expert, #1 trace, " name1,...", "trace compiler internals", #2 trace),
-       (Expert, "text-io-buf-size", " n", "TextIO buffer size",
+       (Expert, "text-io-buf-size", " <n>", "TextIO buffer size",
 	intRef textIOBufSize),
        (Expert, "type-check", " {false|true}", "type check ILs",
 	boolRef typeCheck),
@@ -327,7 +326,7 @@
 			| "1" => Top
 			| "2" => Pass
 			| "3" =>  Detail
-			| _ => usage (concat ["invalid -v arg: ", s])))),
+			| _ => usage (concat ["invalid -verbose arg: ", s])))),
        (Expert, "variant", " {header|first-word}",
 	"how to represent variant tags",
 	SpaceString
@@ -358,6 +357,7 @@
 	 case args of
 	    lib :: args => (libDir := lib; args)
 	  | _ => Error.bug "incorrect args from shell script"
+      val _ = setHostType ("self", usage)
       val result = parse args
       val gcc = !gcc
       val host = !host
@@ -369,10 +369,51 @@
       val _ = Control.libDir := lib
       val libDirs = lib :: !libDirs
       val includeDirs = concat [lib, "/include"] :: !includeDirs
+      val x86CFlags =
+	 ["-fno-strength-reduce",
+	  "-fno-strict-aliasing",
+	  "-fomit-frame-pointer",
+	  "-fschedule-insns",
+	  "-fschedule-insns2",
+	  "-malign-functions=5",
+	  "-malign-jumps=2",
+	  "-malign-loops=2",
+	  (* -mcpu=pentiumpro is the same as -mcpu=i686 *)
+	  "-mcpu=pentiumpro",
+	  "-w"]
+      val x86LinkLibs = ["m"]
+      val sparcCFlags =
+	 ["-Wa,-xarch=v8plusa",
+	  "-m32",
+	  "-malign-functions=4",
+	  "-mcpu=v9",
+	  "-mno-epilogue",
+	  "-mtune=ultrasparc",
+	  "-w"]
+      val sparcLinkLibs = ["dl", "m", "nsl", "socket"]
+      val (cFlags, defaultLibs) =
+	 case !hostType of
+	    Cygwin => (x86CFlags, x86LinkLibs)
+	  | FreeBSD => (x86CFlags, x86LinkLibs)
+	  | Linux => (x86CFlags, x86LinkLibs)
+	  | Sun => (sparcCFlags, sparcLinkLibs)
+      val ccOpts =
+	 List.fold
+	 (!ccOpts, cFlags, fn (ccOpt, ac) => 
+	  if ccOpt = ""
+	     then ac (* reset the options *)
+	  else if (3 = String.size ccOpt
+		   andalso String.isPrefix {string = ccOpt, prefix = "-O"})
+		  then (optimization := (Char.toInt (String.sub (ccOpt, 2))
+					 - Char.toInt #"0")
+			; ac)
+	       else ccOpt :: ac)
+      val ccOpts = String.tokens (concat (List.separate (ccOpts, " ")),
+				  Char.isSpace)
       val _ =
-	 case List.peek (hostMap (), fn {host = h, ...} => h = hostString) of
-	    NONE => usage (concat ["invalid host ", hostString])
-	  | SOME {hostType = t, ...} => hostType := t
+	 if !Native.native andalso !hostType = Sun
+	    then usage "can't use -native true on Sparc"
+	 else ()
       val _ =
 	 chunk := (if !Native.native
 		      then
@@ -416,18 +457,23 @@
 	       let
 		  val rec loop =
 		     fn [] => usage (concat ["invalid file suffix on ", input])
-		      | (suf, start) :: sufs =>
+		      | (suf, start, hasNum) :: sufs =>
 			   if String.isSuffix {string = input, suffix = suf}
 			      then (start,
-				    String.dropSuffix (File.fileOf input, 
-						       String.size suf))
+				    let
+				       val f = File.base input
+				    in
+				       if hasNum
+					  then File.base f
+				       else f
+				    end)
 			   else loop sufs
 		  datatype z = datatype Place.t
 	       in
-		  loop [(".cm", CM),
-			(".sml", SML),
-			(".c", Generated),
-			(".o", O)]
+		  loop [(".cm", CM, false),
+			(".sml", SML, false),
+			(".c", Generated, true),
+			(".o", O, true)]
 	       end
 	    val (csoFiles, rest) =
 	       List.splitPrefix (rest, fn s =>
@@ -480,8 +526,7 @@
 					   inputs,
 					   linkLibs])
 		     val definesAndIncludes =
-			List.concat [list ("-D", !defines),
-				     list ("-I", rev (includeDirs))]
+			list ("-I", rev (includeDirs))
 		     (* This mess is necessary because the linker on linux
 		      * adds a dependency to a shared library even if there are
 		      * no references to it.  So, on linux, we explicitly link
@@ -514,13 +559,13 @@
 				    NONE => ["-lgmp"]
 				  | SOME lib => [lib]
 			      end
+			 | Sun => ["-lgmp"]
                      val linkLibs: string list =
 			List.concat [list ("-L", rev (libDirs)),
 				     list ("-l",
-					   (if !debug
-					       then "mlton-gdb"
+					   (if !debug then "mlton-gdb"
 					    else "mlton")
-					       :: !libs),
+					    :: (defaultLibs @ (!libs))),
 				     linkWithGmp]
 		     datatype debugFormat =
 			Dwarf | DwarfPlus | Dwarf2 | Stabs | StabsPlus
@@ -555,19 +600,22 @@
 			    * move the output file to it's rightful place.
 			    *)
 			   val _ =
-			      case MLton.hostType of
-				 MLton.Cygwin =>
+			      if MLton.hostType = MLton.Cygwin
+				 then
 				    if String.contains (output, #".")
 				       then ()
 				    else
 				       File.move {from = concat [output, ".exe"],
 						  to = output}
-			       | MLton.FreeBSD => ()
-			       | MLton.Linux => ()
+			      else ()
 			in
 			   ()
 			end
 		  fun compileCSO (inputs: File.t list): unit =
+		     if List.forall (inputs, fn f =>
+				     SOME "o" = File.extension f)
+			then compileO inputs
+		     else
 		     let
 			val r = ref 0
 			val oFiles =
@@ -575,58 +623,60 @@
 			   (fn () =>
 			    List.fold
 			    (inputs, [], fn (input, ac) =>
-			     if String.isSuffix {string = input,
-						 suffix = ".o"}
-				then input :: ac
-			     else
 			     let
-				val (debugSwitches, switches) =
-				   if String.isSuffix {string = input,
-						       suffix = ".c"}
-				      then
-					 (gccDebug,
-					  List.concat
-					  [definesAndIncludes,
-					   [concat
-					    ["-O",
-					     Int.toString (!optimization)]],
-					   if !Native.native
-					      then []
-					   else String.tokens (!gccSwitches,
-							       Char.isSpace)])
-				   else ([asDebug], [])
-				val switches =
-				   if !debug
-				      then debugSwitches @ switches
-				   else switches
-				val switches =
-				   case host of
-				      Cross s => "-b" :: s :: switches
-				    | Self => switches
-				val switches = "-c" :: switches
-				val output =
-				   if stop = Place.O orelse !keepO
-				      then
-					 if !keepGenerated
-					    then
-					       concat
-					       [String.dropSuffix (input, 1),
-						"o"]
-					 else
-					    (Int.inc r
-					     ; (suffix
-						(concat [".", Int.toString (!r),
-							 ".o"])))
-				   else temp ".o"
-				val _ = docc ([input], output, switches, [])
+				val extension = File.extension input
 			     in
-				output :: ac
+				if SOME "o" = extension
+				   then input :: ac
+				else
+				   let
+				      val (debugSwitches, switches) =
+					 if SOME "c" = extension
+					    then
+					       (gccDebug,
+						List.concat
+						[definesAndIncludes,
+						 [concat
+						  ["-O", (Int.toString
+							  (!optimization))]],
+						 ccOpts])
+					 else ([asDebug], [])
+				      val switches =
+					 if !debug
+					    then debugSwitches @ switches
+					 else switches
+				      val switches =
+					 case host of
+					    Cross s => "-b" :: s :: switches
+					  | Self => switches
+				      val switches = "-c" :: switches
+				      val output =
+					 if stop = Place.O orelse !keepO
+					    then
+					       if !keepGenerated
+						  then
+						     concat
+						     [String.dropSuffix
+						      (input, 1),
+						      "o"]
+					       else
+						  (Int.inc r
+						   ; (suffix
+						      (concat
+						       [".", Int.toString (!r),
+							".o"])))
+					 else temp ".o"
+				      val _ =
+					 docc ([input], output, switches, [])
+				   in
+				      output :: ac
+				   end
 			     end))
 			   ()
 		     in
 			case stop of
 			   Place.O => ()
-			 | _ => compileO oFiles
+			 | _ => compileO (rev oFiles)
 		     end
 		  fun compileSml (files: File.t list) =
 		     let



1.10      +1 -1      mlton/runtime/IntInf.h

Index: IntInf.h
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/IntInf.h,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- IntInf.h	24 Nov 2002 01:19:45 -0000	1.9
+++ IntInf.h	10 Apr 2003 02:03:10 -0000	1.10
@@ -24,7 +24,7 @@
  * MLton package.
  */
 #include "/usr/local/include/gmp.h"
-#elif (defined (__linux__))
+#elif (defined (__linux__) || defined (__sun__))
 #include <gmp.h>
 #else
 #error gmp.h not defined for platform



1.52      +18 -1     mlton/runtime/Makefile

Index: Makefile
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/Makefile,v
retrieving revision 1.51
retrieving revision 1.52
diff -u -r1.51 -r1.52
--- Makefile	23 Jan 2003 22:01:59 -0000	1.51
+++ Makefile	10 Apr 2003 02:03:10 -0000	1.52
@@ -1,4 +1,6 @@
 HOST = self
+HOSTTYPE = $(shell ../bin/hosttype)
+
 ifeq ($(HOST), self)
 AR = ar rc
 HOSTFLAGS =
@@ -6,7 +8,22 @@
 AR = $(HOST)-ar rc
 HOSTFLAGS = -b $(HOST)
 endif
-CC =		gcc -Wall -I. -mcpu=pentiumpro -malign-loops=2 -malign-jumps=2 -malign-functions=5 -fomit-frame-pointer $(HOSTFLAGS)
+
+X86FLAGS = -mcpu=pentiumpro -malign-loops=2 -malign-jumps=2 -malign-functions=5 -fomit-frame-pointer
+ifeq ($(HOSTTYPE), cygwin)
+ARCHFLAGS = $(X86FLAGS)
+endif
+ifeq ($(HOSTTYPE), freebsd)
+ARCHFLAGS = $(X86FLAGS)
+endif
+ifeq ($(HOSTTYPE), linux)
+ARCHFLAGS = $(X86FLAGS)
+endif
+ifeq ($(HOSTTYPE), sun)
+ARCHFLAGS = 
+endif
+
+CC =		gcc -Wall -I. $(ARCHFLAGS) $(HOSTFLAGS)
 # Can't use more optimization than -O1 because gcc doesn't correctly compile
 #  Real_class in basis/Real.c
 CFLAGS = -O1



1.11      +8 -2      mlton/runtime/basis-constants.h

Index: basis-constants.h
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/basis-constants.h,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- basis-constants.h	29 Dec 2002 01:23:00 -0000	1.10
+++ basis-constants.h	10 Apr 2003 02:03:10 -0000	1.11
@@ -33,10 +33,16 @@
 #define MLton_hostType 1
 #elif (defined (__linux__))
 #define MLton_hostType 2
+#elif (defined (__sun__))
+#define MLton_hostType 3
 #else
 #error MLton_hostType not defined
 #endif
-#define MLton_isLittleEndian TRUE
+
+#if (defined (__sun__))
+#define LOG_AUTHPRIV LOG_AUTH
+#define LOG_PERROR 0
+#endif /* __sun__ */
 
 /* ------------------------------------------------- */
 /*                      Ptrace                       */
@@ -46,7 +52,7 @@
 
 /* Nothing to do -- everything comes from sys/ptrace.h. */
 
-#elif (defined (__CYGWIN__) || defined (__FreeBSD__))
+#elif (defined (__CYGWIN__) || defined (__FreeBSD__) || defined (__sun__))
 
 #define PTRACE_BOGUS 0xFFFFFFFF
 #define PTRACE_SYSCALL PTRACE_BOGUS



1.127     +75 -38    mlton/runtime/gc.c

Index: gc.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/gc.c,v
retrieving revision 1.126
retrieving revision 1.127
diff -u -r1.126 -r1.127
--- gc.c	25 Mar 2003 04:31:25 -0000	1.126
+++ gc.c	10 Apr 2003 02:03:10 -0000	1.127
@@ -36,7 +36,7 @@
 #include <limits.h>
 #endif
 
-#if (defined (__linux__) || defined (__FreeBSD__))
+#if (defined (__linux__) || defined (__FreeBSD__) || defined (__sun__))
 #include <signal.h>
 #include <sys/stat.h>
 #include <sys/time.h>
@@ -44,6 +44,10 @@
 #include <ucontext.h>
 #endif
 
+#if (defined (__sun__))
+#include <sys/swap.h>  /* For swapctl. */
+#endif
+
 #include "IntInf.h"
 
 #define METER FALSE  /* Displays distribution of object sizes at program exit. */
@@ -129,7 +133,7 @@
 	return n << 2;
 }
 
-#if (defined (__linux__) || defined (__FreeBSD__))
+#if (defined (__linux__) || defined (__FreeBSD__) || defined (__sun__))
 static inline uint min (uint x, uint y) {
 	return ((x < y) ? x : y);
 }
@@ -163,7 +167,7 @@
 	return 0 == a % b;
 }
 
-#if (defined (__linux__) || defined (__FreeBSD__))
+#if (defined (__linux__) || defined (__FreeBSD__) || defined (__sun__))
 /* A super-safe mmap.
  *  Allocates a region of memory with dead zones at the high and low ends.
  *  Any attempt to touch the dead zone (read or write) will cause a
@@ -182,6 +186,15 @@
 		diee ("mprotect failed");
 	return result;
 }
+
+#elif (defined (__CYGWIN__))
+
+/* Nothing needed. */
+
+#else
+
+#error ssmmap not defined on platform
+
 #endif
 
 static void release (void *base, size_t length) {
@@ -191,7 +204,7 @@
 				(uint)base);
 	if (0 == VirtualFree (base, 0, MEM_RELEASE))
 		die ("VirtualFree release failed");
-#elif (defined (__linux__) || defined (__FreeBSD__))
+#elif (defined (__linux__) || defined (__FreeBSD__) || defined (__sun__))
 	smunmap (base, length);
 #else
 #error release not defined
@@ -205,7 +218,7 @@
 				(uint)base, (uint)length);
 	if (0 == VirtualFree (base, length, MEM_DECOMMIT))
 		die ("VirtualFree decommit failed");
-#elif (defined (__linux__) || defined (__FreeBSD__))
+#elif (defined (__linux__) || defined (__FreeBSD__) || defined (__sun__))
 	smunmap (base, length);
 #else
 #error decommit not defined	
@@ -289,24 +302,36 @@
 	showMaps();
 }
 
-#elif (defined (__linux__))
+#elif (defined (__FreeBSD__))
 
-static void showMem() {
+static void showMem () {
 	static char buffer[256];
 
-	sprintf(buffer, "/bin/cat /proc/%d/maps\n", getpid());
-	(void)system(buffer);
+	sprintf (buffer, "/bin/cat /proc/%d/map\n", (int)getpid ());
+	(void)system (buffer);
 }
 
-#elif (defined (__FreeBSD__))
+#elif (defined (__linux__))
 
 static void showMem () {
 	static char buffer[256];
 
-	sprintf (buffer, "/bin/cat /proc/%d/map\n", getpid ());
+	sprintf (buffer, "/bin/cat /proc/%d/maps\n", (int)getpid ());
 	(void)system (buffer);
 }
 
+#elif (defined (__sun__))
+
+static void showMem () {
+	static char buffer[256];
+	sprintf (buffer, "pmap %d\n", (int)getpid ());
+	system (buffer);
+}
+
+#else
+
+#error showMem not defined on platform
+
 #endif
 
 static inline void copy (pointer src, pointer dst, uint size) {
@@ -1387,7 +1412,7 @@
 						(uint)h->start, 
 						(uint)address,
 						(uint)h->size);
-#elif (defined (__linux__) || defined (__FreeBSD__))
+#elif (defined (__linux__) || defined (__FreeBSD__) || defined (__sun__))
 			h->start = mmap (address+(void*)0, h->size, 
 						PROT_READ | PROT_WRITE,
 						MAP_PRIVATE | MAP_ANON, -1, 0);
@@ -2249,7 +2274,7 @@
 /*                            heapRemap                             */
 /* ---------------------------------------------------------------- */
 
-#if (defined (__CYGWIN__) || defined (__FreeBSD__))
+#if (defined (__CYGWIN__) || defined (__FreeBSD__) || defined (__sun__))
 
 static bool heapRemap (GC_state s, GC_heap h, W32 desired, W32 minSize) {
 	return FALSE;
@@ -3112,7 +3137,7 @@
 	}
 }
 
-#if (defined (__linux__) || defined (__FreeBSD__))
+#if (defined (__linux__) || defined (__FreeBSD__) || defined (__sun__))
 
 #ifndef EIP
 #define EIP	14
@@ -3134,6 +3159,8 @@
         pc = (pointer) ucp->uc_mcontext.gregs[EIP];
 #elif (defined (__FreeBSD__))
 	pc = (pointer) ucp->uc_mcontext.mc_eip;
+#elif (defined (__sun__))
+	pc = (pointer) ucp->uc_mcontext.gregs[REG_PC];
 #else
 #error pc not defined
 #endif
@@ -3257,8 +3284,11 @@
 
 static void initSignalStack (GC_state s) {
 #if (defined (__CYGWIN__))
+
 	/* Nothing */
-#elif (defined (__linux__) || defined (__FreeBSD__))
+
+#elif (defined (__linux__) || defined (__FreeBSD__) || defined (__sun__))
+
         static stack_t altstack;
 	size_t ss_size = align (SIGSTKSZ, s->pageSize);
 	size_t psize = s->pageSize;
@@ -3267,8 +3297,11 @@
 	altstack.ss_size = ss_size;
 	altstack.ss_flags = 0;
 	sigaltstack (&altstack, NULL);
+
 #else
+
 #error initSignalStack not defined
+
 #endif
 }
 
@@ -3343,7 +3376,7 @@
 static void setMemInfo (GC_state s) {
 	MEMORYSTATUS ms; 
 
-	GlobalMemoryStatus(&ms); 
+	GlobalMemoryStatus (&ms); 
 	s->totalRam = ms.dwTotalPhys;
 	s->totalSwap = ms.dwTotalPageFile;
 }
@@ -3351,47 +3384,51 @@
 #elif (defined (__FreeBSD__))
 
 /* returns total amount of swap available */
-static int 
-get_total_swap() 
-{
+static int totalSwap () {
         static char buffer[256];
         FILE *file;
         int total_size = 0;
 
-        file = popen("/usr/sbin/swapinfo -k | awk '{ print $4; }'\n", "r");
+        file = popen ("/usr/sbin/swapinfo -k | awk '{ print $4; }'\n", "r");
         if (file == NULL) 
                 diee ("swapinfo failed");
-
         /* skip header */
-        fgets(buffer, 255, file);
-
+        fgets (buffer, 255, file);
         while (fgets(buffer, 255, file) != NULL) { 
                 total_size += atoi(buffer);
         }
-
-        pclose(file);
-
+        pclose (file);
         return total_size * 1024;
 }
 
 /* returns total amount of memory available */
-static int
-get_total_mem()
-{
-	int i, mem, len;
-
-	len = sizeof(int);
-	i = sysctlbyname("hw.physmem", &mem, &len, NULL, 0);
-
-	if (i == -1)
-		diee("sysctl failed");
+static int totalRam() {
+	int mem, len;
 
+	len = sizeof (int);
+	if (-1 == sysctlbyname ("hw.physmem", &mem, &len, NULL, 0))
+		diee ("sysctl failed");
 	return mem;
 }
 
 static void setMemInfo (GC_state s) {
-	s->totalRam = get_total_mem();
-	s->totalSwap = get_total_swap();
+	s->totalRam = totalRam();
+	s->totalSwap = totalSwap();
+}
+
+#elif (defined (__sun__))
+
+static void setMemInfo (GC_state s) {
+	struct anoninfo anon;
+
+	s->totalRam = sysconf (_SC_PHYS_PAGES) * s->pageSize;
+	if (-1 == swapctl (SC_AINFO, &anon))
+		/* Couldn't get swap, so assume that there's as much swap as
+		 * there is RAM.
+		 */
+		s->totalSwap = s->totalRam;
+	else
+		s->totalSwap = anon.ani_max * s->pageSize;
 }
 
 #else



1.21      +15 -25    mlton/runtime/mlton-basis.h

Index: mlton-basis.h
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/mlton-basis.h,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -r1.20 -r1.21
--- mlton-basis.h	8 Jan 2003 15:19:17 -0000	1.20
+++ mlton-basis.h	10 Apr 2003 02:03:10 -0000	1.21
@@ -13,7 +13,8 @@
 typedef double Double;
 typedef int Int;
 typedef char *Pointer;
-typedef unsigned long Word;
+typedef unsigned long Word32;
+typedef Word32 Word;
 
 /* Here are some type abbreviations for abstract machine types. */
 typedef Int Bool;
@@ -98,23 +99,12 @@
 Int IEEEReal_getRoundingMode();
 
 /* ------------------------------------------------- */
-/*                        Int                        */
-/* ------------------------------------------------- */
-
-Bool Int_addOverflow(int n1, int n2, int *res);
-Bool Int_mulOverflow(int n1, int n2, int *res);
-Bool Int_negOverflow(int n, int *res);
-Bool Int_subOverflow(int n1, int n2, int *res);
-Int Int_quot(Int numerator, Int denominator);
-Int Int_rem(Int numerator, Int denominator);
-
-/* ------------------------------------------------- */
 /*                      Itimer                       */
 /* ------------------------------------------------- */
 
-void Itimer_set(Int which,
-		Int interval_tv_sec, Int interval_tv_usec,
-		Int value_tv_sec, Int value_tv_usec);
+void Itimer_set (Int which,
+			Int interval_tv_sec, Int interval_tv_usec,
+			Int value_tv_sec, Int value_tv_usec);
 
 /* ------------------------------------------------- */
 /*                       MLton                       */
@@ -174,20 +164,20 @@
 extern Double Real_minNormalPos;
 extern Double Real_minPos;
 
-Int Real_class(Double d);
-Int Real_isFinite(Double d);
-Int Real_isNan(Double d);
-Int Real_isNormal(Double d);
-Int Real_isPositive(Double d);
-Int Real_qequal(Double x1, Double x2);
-double Real_round(Double d);
-Int Real_signBit(Double d);
+Int Real_class (Double d);
+Int Real_isFinite (Double d);
+Int Real_isNan (Double d);
+Int Real_isNormal (Double d);
+Int Real_isPositive (Double d);
+Int Real_qequal (Double x1, Double x2);
+double Real_round (Double d);
+Int Real_signBit (Double d);
 
 /* ------------------------------------------------- */
 /*                      Rlimit                       */
 /* ------------------------------------------------- */
 
-#if (defined (__CYGWIN__))
+#if (defined (__CYGWIN__) || defined (__sun__))
 #define RLIMIT_BOGUS 0xFFFFFFFF
 #define RLIMIT_RSS RLIMIT_BOGUS
 #define RLIMIT_NPROC RLIMIT_BOGUS
@@ -205,7 +195,7 @@
 #define MLton_Rlimit_stackSize RLIMIT_STACK
 #if (defined (__FreeBSD__))
 #define MLton_Rlimit_virtualMemorySize RLIMIT_DATA
-#elif (defined (__CYGWIN__) || defined (__linux__))
+#elif (defined (__CYGWIN__) || defined (__linux__) || defined (__sun__))
 #define MLton_Rlimit_virtualMemorySize RLIMIT_AS
 #else
 #error MLton_Rlimit_virtualMemorySize not defined



1.19      +2 -2      mlton/runtime/my-lib.c

Index: my-lib.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/my-lib.c,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- my-lib.c	2 Jan 2003 17:45:22 -0000	1.18
+++ my-lib.c	10 Apr 2003 02:03:10 -0000	1.19
@@ -151,7 +151,7 @@
 	
 	if (0 == n)
 		buf[i--] = '0';
-#if (defined (__CYGWIN__) || defined (__FreeBSD__))
+#if (defined (__CYGWIN__) || defined (__FreeBSD__) || defined (__sun__))
 #define MININT 0x80000000
 #endif
  	else if (MININT == n) {
@@ -240,7 +240,7 @@
 	result = VirtualAlloc (0, length, MEM_COMMIT, PAGE_READWRITE);
 	if (NULL == result)
 		die("VirtualAlloc failed");
-#elif (defined (__linux__) || defined (__FreeBSD__))
+#elif (defined (__linux__) || defined (__FreeBSD__) || defined (__sun__))
 	result = mmap (NULL, length, PROT_READ | PROT_WRITE, 
 			MAP_PRIVATE | MAP_ANON, -1, 0);
 	if (result == (void*)-1) 



1.3       +4 -0      mlton/runtime/net-constants.h

Index: net-constants.h
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/net-constants.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- net-constants.h	15 Jan 2003 20:10:14 -0000	1.2
+++ net-constants.h	10 Apr 2003 02:03:10 -0000	1.3
@@ -3,6 +3,10 @@
 
 #include <stdlib.h>
 #include <errno.h>
+#if (defined __sun__)
+#include <sys/filio.h> /* For FIONBIO, FIONREAD. */
+#include <sys/sockio.h> /* For SIOCATMARK. */
+#endif
 #include <sys/ioctl.h>
 #include <sys/types.h>
 #include <sys/socket.h>



1.9       +15 -5     mlton/runtime/posix-constants.h

Index: posix-constants.h
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/posix-constants.h,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- posix-constants.h	24 Nov 2002 01:19:45 -0000	1.8
+++ posix-constants.h	10 Apr 2003 02:03:10 -0000	1.9
@@ -71,12 +71,22 @@
 #define Posix_FileSys_S_ifchr S_IFCHR
 #define Posix_FileSys_S_ififo S_IFIFO
 
-/* Cygwin/Windows distinguish between text and binary files, but Linux and
- * FreeBSD do not.
+/* Cygwin/Windows distinguish between text and binary files, but Linux,
+ * FreeBSD, and Solaris do not.
  */
-#if (defined (__linux__) || defined (__FreeBSD__))
+#if (defined (__CYGWIN__))
+
+/* Nothing. */
+
+#elif (defined (__linux__) || defined (__FreeBSD__) || defined (__sun__))
+
 #define O_BINARY 0
 #define O_TEXT 0
+
+#else 
+
+#error May need to define O_BINARY and O_TEXT on platform.
+
 #endif
 
 #define Posix_FileSys_O_append O_APPEND
@@ -85,7 +95,7 @@
 #define Posix_FileSys_O_excl O_EXCL
 #define Posix_FileSys_O_noctty O_NOCTTY
 #define Posix_FileSys_O_nonblock O_NONBLOCK
-#if (defined (__CYGWIN__) || defined (__linux__))
+#if (defined (__CYGWIN__) || defined (__linux__) || defined (__sun__))
 #define Posix_FileSys_O_sync O_SYNC
 #elif (defined (__FreeBSD__))
 #define Posix_FileSys_O_sync 0
@@ -222,7 +232,7 @@
 #define Posix_Signal_vtalrm SIGVTALRM
 
 #define Posix_Signal_block SIG_BLOCK
-#if (defined (__CYGWIN__) || defined (__FreeBSD__))
+#if (defined (__CYGWIN__) || defined (__FreeBSD__) || defined (__sun__))
 #define Posix_Signal_numSignals NSIG
 #elif (defined (__linux__))
 #define Posix_Signal_numSignals _NSIG



1.5       +1 -1      mlton/runtime/Posix/FileSys/open.c

Index: open.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/Posix/FileSys/open.c,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- open.c	16 Sep 2002 18:46:26 -0000	1.4
+++ open.c	10 Apr 2003 02:03:11 -0000	1.5
@@ -5,7 +5,7 @@
 
 Int Posix_FileSys_open (NullString p, Word w, Mode m) {
 
-#if (defined (__linux__) || defined (__FreeBSD__))
+#if (defined (__linux__) || defined (__FreeBSD__) || defined (__sun__))
 
 	return open ((char *) p, w, m);
 



1.2       +2 -2      mlton/runtime/Posix/ProcEnv/getgroups.c

Index: getgroups.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/Posix/ProcEnv/getgroups.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- getgroups.c	18 Jul 2001 05:51:06 -0000	1.1
+++ getgroups.c	10 Apr 2003 02:03:11 -0000	1.2
@@ -7,12 +7,12 @@
  * shorts (i.e. gid_t).
  */
 
-Int Posix_ProcEnv_getgroups(Pointer groups) {
+Int Posix_ProcEnv_getgroups (Pointer groups) {
 	int             i;
 	int 		result;
 	gid_t           groupList[Posix_ProcEnv_numgroups];
 
-	result = getgroups(Posix_ProcEnv_numgroups, groupList);
+	result = getgroups (Posix_ProcEnv_numgroups, groupList);
 
 	for (i = 0; i < result; i++)
 		((Word *) groups)[i] = groupList[i];



1.2       +31 -0     mlton/runtime/Posix/ProcEnv/setenv.c

Index: setenv.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/Posix/ProcEnv/setenv.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- setenv.c	18 Jul 2001 05:51:06 -0000	1.1
+++ setenv.c	10 Apr 2003 02:03:11 -0000	1.2
@@ -1,6 +1,37 @@
 #include <stdlib.h>
 #include "mlton-posix.h"
 
+
+
+#if (defined (__CYGWIN__) || defined (__FreeBSD__) || defined (__linux__))
+
 Int Posix_ProcEnv_setenv (NullString s, NullString v) {
 	return setenv ((char *)s, (char *)v, 1);
 }
+
+#elif (defined (__sun__))
+
+#include <stdio.h>  // for sprintf
+#include <strings.h>
+
+/* This has a space leak, but I don't see how to avoid it, since the
+ * specification of putenv is that it uses the memory for its arg.
+ */
+
+Int Posix_ProcEnv_setenv (NullString s, NullString v) {
+	char *b;
+	char *name;
+	char *value;
+
+	name = (char *)s;
+	value = (char *)v;
+	b = malloc (strlen (name) + strlen (value) + 2 /* = and \000 */);
+	sprintf (b, "%s=%s", name, value);
+	return putenv (b);
+}
+
+#else
+
+#error Need to define Posix_ProcEnv_setenv for platform
+
+#endif



1.9       +1 -1      mlton/runtime/Posix/Signal/Signal.c

Index: Signal.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/Posix/Signal/Signal.c,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- Signal.c	16 Sep 2002 18:46:26 -0000	1.8
+++ Signal.c	10 Apr 2003 02:03:11 -0000	1.9
@@ -10,7 +10,7 @@
 }
 
 enum {
-#if  (defined  (__linux__) || defined  (__FreeBSD__))
+#if  (defined  (__linux__) || defined  (__FreeBSD__) || defined (__sun__))
 	SA_FLAGS = SA_ONSTACK,
 #elif  (defined  (__CYGWIN__))
 	SA_FLAGS = 0,



1.2       +48 -16    mlton/runtime/basis/IEEEReal.c

Index: IEEEReal.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/basis/IEEEReal.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- IEEEReal.c	18 Jul 2001 05:51:05 -0000	1.1
+++ IEEEReal.c	10 Apr 2003 02:03:12 -0000	1.2
@@ -1,33 +1,65 @@
 #include "mlton-basis.h"
+#include "my-lib.h"
 
 /* ------------------------------------------------- */
 /*                     IEEEReal                      */
 /* ------------------------------------------------- */
 
+#if (defined (__i386__))
+
+/* Macros for accessing the hardware control word.  */
+#define _FPU_GETCW(cw) __asm__ ("fnstcw %0" : "=m" (*&cw))
+#define _FPU_SETCW(cw) __asm__ ("fldcw %0" : : "m" (*&cw))
+
 #define ROUNDING_CONTROL_MASK 0x0C00
 #define ROUNDING_CONTROL_SHIFT 10
 
-void IEEEReal_setRoundingMode(int mode) {
+void IEEEReal_setRoundingMode (int mode) {
 	unsigned short controlWord;
 
-	__asm__ __volatile__ ("fstcw %0"
-			: "=m" (controlWord)
-			: );
-	controlWord =  
-		(mode << ROUNDING_CONTROL_SHIFT) 
-		| (controlWord & ~ROUNDING_CONTROL_MASK);
-
-	__asm__ __volatile__ ("fldcw %0"
-                        :
-			: "m" (controlWord));
+	_FPU_GETCW(controlWord);
+	controlWord &= ~ROUNDING_CONTROL_MASK;
+	controlWord |= mode << ROUNDING_CONTROL_SHIFT;
+	_FPU_SETCW(controlWord);
 }
 
-Int IEEEReal_getRoundingMode() {
+Int IEEEReal_getRoundingMode () {
 	unsigned short controlWord;
 
-	__asm__ __volatile__ ("fstcw %0"
-			: "=m" (controlWord)
-			: );
-
+	_FPU_GETCW(controlWord);
 	return (controlWord & ROUNDING_CONTROL_MASK) >> ROUNDING_CONTROL_SHIFT;
 }
+
+#elif (defined (__sparc__))
+
+#include <ieeefp.h>
+
+void IEEEReal_setRoundingMode (int mode) {
+	switch (mode) {
+	case 0: mode = FP_RN; break;
+	case 1: mode = FP_RM; break;
+	case 2: mode = FP_RP; break;
+	case 3: mode = FP_RZ; break;
+	default:
+		die ("IEEEReal_setRoundingMode error: invalid mode %d\n", mode);
+	}
+	fpsetround (mode);
+}
+ 
+int IEEEReal_getRoundingMode () {
+	int mode;
+
+	mode = fpgetround ();
+	switch (mode) {
+	case FP_RN: mode = 0; break;
+	case FP_RM: mode = 1; break;
+ 	case FP_RP: mode = 2; break;
+	case FP_RZ: mode = 3; break;
+	default:
+		die ("IEEEReal_setRoundingMode error: invalid mode %d\n", mode);
+	}
+	return mode;
+}
+
+
+#endif



1.6       +64 -13    mlton/runtime/basis/Real.c

Index: Real.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/basis/Real.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- Real.c	25 Feb 2002 17:09:42 -0000	1.5
+++ Real.c	10 Apr 2003 02:03:12 -0000	1.6
@@ -44,7 +44,9 @@
 #define Real_Class_normal 4
 #define Real_Class_subnormal 5
 
-Int Real_class(Double d) {
+#if (defined (__i386__))
+
+Int Real_class (Double d) {
 	Word word0, word1;
 
 	word0 = ((Word *)&d)[0];
@@ -71,19 +73,11 @@
 	}
 }
 
-Int Real_isFinite(Double d) {
-	return finite(d); /* finite is from math.h */
-}
-
-inline Int Real_isNan(Double d) {
-	return isnan(d); /* isnan is from math.h */
+inline Int Real_isNan (Double d) {
+	return isnan (d); /* isnan is from math.h */
 }
 
-Int Real_qequal(Double x1, Double x2) {
-	return Real_isNan(x1) || Real_isNan(x2) || x1 == x2;
-}
-
-Int Real_isNormal(Double d) {
+Int Real_isNormal (Double d) {
 	Word word1, exponent;
 
 	word1 = ((Word *)&d)[1];
@@ -93,7 +87,7 @@
 	return not(exponent == 0 or exponent == EXPONENT_MASK);
 }
 
-Double Real_round(Double d) {
+Double Real_round (Double d) {
 	register double f0;
 
 	f0 = d;
@@ -103,3 +97,60 @@
 	return f0;
 
 }
+
+#elif (defined __sparc__)
+
+#include <ieeefp.h>
+
+double Real_maxFinite =    1.7976931348623157e308;
+double Real_minPos =       4.94065645841246544e-324;
+double Real_minNormalPos = 2.22507385850720140e-308;
+
+Int Real_class (Double d) {
+	fpclass_t c;
+
+	c = fpclass (d);
+	switch (c) {
+	case FP_SNAN: return Real_Class_nanSignalling;
+	case FP_QNAN: return Real_Class_nanQuiet;
+	case FP_NINF: return Real_Class_inf;
+	case FP_PINF: return Real_Class_inf;
+	case FP_NDENORM: return Real_Class_subnormal;
+	case FP_PDENORM: return Real_Class_subnormal;
+	case FP_NZERO: return Real_Class_zero;
+	case FP_PZERO: return Real_Class_zero;
+	case FP_NNORM: return Real_Class_normal;
+	case FP_PNORM: return Real_Class_normal;
+	default:
+		die ("Real_class error: invalid class %d\n", c);
+	}
+}
+
+inline Int Real_isNan (Double d) {
+	fpclass_t c;
+
+	c = fpclass (d);
+ 	return c == FP_SNAN || c == FP_QNAN;
+}
+
+Int Real_isNormal (Double d) {
+	fpclass_t c;
+
+	c = fpclass (d);
+	return c == FP_NNORM || c == FP_PNORM || c == FP_NZERO || c == FP_PZERO;
+}
+
+Double Real_round (Double d) {
+	return rint (d);
+}
+
+#endif /* __sparc__ */
+
+Int Real_isFinite (Double d) {
+	return finite (d); /* finite is from math.h */
+}
+
+Int Real_qequal (Double x1, Double x2) {
+	return Real_isNan (x1) || Real_isNan (x2) || x1 == x2;
+}
+



1.5       +5 -1      mlton/runtime/basis/Real_const.S

Index: Real_const.S
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/basis/Real_const.S,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- Real_const.S	16 Sep 2002 18:46:26 -0000	1.4
+++ Real_const.S	10 Apr 2003 02:03:12 -0000	1.5
@@ -32,7 +32,7 @@
 	.long 0x00000001
 	.long 0x00000000
 
-#elif (defined (__linux__) || defined(__FreeBSD__))
+#elif (defined (__linux__) || defined (__FreeBSD__))
 .data
 
 .globl Real_maxFinite
@@ -57,6 +57,10 @@
 Real_minPos:
 	.long 0x00000001
 	.long 0x00000000
+
+#elif (defined (__sun__))
+
+// Don't need to do anything, since Real.c defines these constants.
 
 #else
 



1.4       +1 -1      mlton/runtime/basis/Int/quot.c

Index: quot.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/basis/Int/quot.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- quot.c	7 Nov 2002 19:15:06 -0000	1.3
+++ quot.c	10 Apr 2003 02:03:12 -0000	1.4
@@ -27,7 +27,7 @@
  */
 
 Int Int_quot (Int n, Int d) {
-#if (defined (__i386__))
+#if (defined (__i386__) || defined (__sparc__))
 	return n / d;
 #else
 #error check that C / correctly implements Int.quot from the basis library



1.3       +1 -1      mlton/runtime/basis/Int/rem.c

Index: rem.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/basis/Int/rem.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- rem.c	7 Nov 2002 19:15:06 -0000	1.2
+++ rem.c	10 Apr 2003 02:03:12 -0000	1.3
@@ -3,7 +3,7 @@
 /* See the comment in quot.c. */
 
 Int Int_rem (Int n, Int d) {
-#if (defined (__i386__))
+#if (defined (__i386__) || defined (__sparc__))
 	return n % d;
 #else
 #error check that C % correctly implements Int.rem from the basis library





-------------------------------------------------------
This SF.net email is sponsored by: Etnus, makers of TotalView, The debugger 
for complex code. Debugging C/C++ programs can leave you feeling lost and 
disoriented. TotalView can help you find your way. Available on major UNIX 
and Linux platforms. Try it free. www.etnus.com
_______________________________________________
MLton-devel mailing list
MLton-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mlton-devel