Segmentation fault when trying to use mllex and mlyacc

Stephen Weeks sweeks@intertrust.com
Tue, 14 Dec 1999 11:15:18 -0800 (PST)


> I enclose a program and compilation log file for which the problem occurs.
> The resulting executable gives a segmentation fault.

Thanks for the bug report.  This is due to a known bug in the
supporting C code for mlton-1999-7-12.  The bug has been fixed in our
(unreleased) working versions and will certainly be gone in the next
release.  The easiest fix for now is to replace include/mlton-lib.h
with the file below.  You don't even need to recompile the compiler!
If you still have problems after this fix, let us know and we will
make a working version available.

> I noticed in the mlton src/front-end/sources.cm file that a file import.cm
> was used to rebind basis library structures. I tried the same myself, but
> then get the problem that other source code isn't compatible with the
> basis any more. For example, String.substring suddenly seems to go
> missing.

Yes, that is correct.  The reason that is done within the internals of 
MLton is because, as the comment in sources.cm says: ML-YACC relies on
the basis library being available, and my library overrides a lot of
basis library structures.  There is no reason to do something similar
within your own code unless you are also rebinding basis library
structures.

> Any suggestions on how to use sml files generated by SML/NJ's lex and yacc
> together with normal sml files that use the basis library?

I don't understand the problem.  As long as you aren't rebinding basis 
library structures, then it should work without doing anything special.

--------------------------------------------------------------------------------

/* Copyright (C) 1997-1999 NEC Research Institute.
 * Please see the file LICENSE for license information.
 */
#ifndef _MLTON_LIB_H
#define _MLTON_LIB_H

#include <dirent.h>
#include <errno.h>
#include <fcntl.h>
#include <grp.h>
#include <math.h>
#include <pwd.h>
#include <signal.h>
#include <stdio.h>
#include <sys/stat.h>
#include <sys/time.h>
#include <sys/times.h>
#include <sys/types.h>
#include <sys/utsname.h>
#include <sys/wait.h>
#include <termios.h>
#include <time.h>
#include <unistd.h>
#include <utime.h>

#include "gc.h"
#include "int-inf.h"
#include "my-lib.h"
#include "mlton-posix.h"

#ifndef GC_EVERY_CHECK
#define GC_EVERY_CHECK FALSE
#endif

#ifndef INSTRUMENT
#define INSTRUMENT FALSE
#endif

#ifndef DETECT_OVERFLOW
#define DETECT_OVERFLOW FALSE
#endif

typedef uint cpointer;

typedef struct MLTON_state {
	uint commandName;
	int argc;
	uint argv;
	uint environ;
	
	/* used by saveWorld */
	bool isOriginal;

	/* The magic number required for a valid world file. */
	uint magic;
	
	GC_state *gcState;
} MLTON_state;

#define MLTON_argc() mltonState.argc
#define MLTON_argv() mltonState.argv
#define MLTON_commandName() mltonState.commandName

/* print a bug message and exit(2) */
void MLTON_bug(string msg);

/* initialize the machine */
void MLTON_init(int argc, 
	       char **argv,
	       MLTON_state *MLTON_state,
	       uint magic,
	       /* Read the globals from the world file.  Is NULL if a world file
		* cannot be loaded.
		*/
	       void (*loadGlobals)(FILE *file));

#define MLTON_globals 					\
	static MLTON_state mltonState; 			\
	static GC_state gcState;			\
	static int sizeRes;				\
	static pointer stackRes;			\
	static void (*nextChunk)();			\
	static int nextFun;

/* ------------------------------------------------- */
/*                     Counters                      */
/* ------------------------------------------------- */

extern ullong MLTON_numTrampolines;
extern ullong MLTON_numLimitChecks;
extern ullong MLTON_numInterReturns;
extern ullong MLTON_numReturns;

extern ullong MLTON_XmlKnown;
extern ullong MLTON_XmlUnknown;
#define MLTON_incXmlKnown() MLTON_XmlKnown++
#define MLTON_incXmlUnknown() MLTON_XmlUnknown++

extern ullong MLTON_SxmlKnown;
extern ullong MLTON_SxmlUnknown;
#define MLTON_incSxmlKnown() MLTON_SxmlKnown++
#define MLTON_incSxmlUnknown() MLTON_SxmlUnknown++

extern ullong MLTON_CpsKnown;
extern ullong MLTON_CpsUnknown;
#define MLTON_incCpsKnown() MLTON_CpsKnown++
#define MLTON_incCpsUnknown() MLTON_CpsUnknown++

extern ullong MLTON_CpsCall;
extern ullong MLTON_CpsLoop;
#define MLTON_incCpsCall() MLTON_CpsCall++
#define MLTON_incCpsLoop() MLTON_CpsLoop++

extern ullong MLTON_CpsDispatch;
#define MLTON_incCpsDispatch() MLTON_CpsDispatch++
extern ullong MLTON_CpsCoerce;
#define MLTON_incCpsCoerce() MLTON_CpsCoerce++

/* ------------------------------------------------- */
/*                       Chunk                       */
/* ------------------------------------------------- */

#define MLTON_chunk(name)				\
	static void name () {				\
		char *stackTop = gcState.stackTop; 	\
		pointer frontier = gcState.frontier;

#define MLTON_chunkSwitch			\
		top:				\
		switch (nextFun) {

#define MLTON_endChunkSwitch					\
		default:					\
			/* inter chunk return */		\
			if (INSTRUMENT)				\
				MLTON_numInterReturns++;	\
			nextChunk = nextChunks[nextFun];	\
			leaveChunk: 				\
				gcState.frontier = frontier;	\
				gcState.stackTop = stackTop;	\
				return;				\
		} /* end switch (nextFun) */

#define MLTON_endChunk					\
	} /* end chunk */

/* ------------------------------------------------- */
/*                       main                        */
/* ------------------------------------------------- */

#define MLTON_main(ufh,fs,bl,mfs,ng,gs,mfi,magic,lg,nii,mc,ml,sc,sl)	\
int main(int argc, char **argv) {					\
	gcState.useFixedHeap = ufh;					\
	gcState.fromSize = fs;						\
	gcState.bytesLive = bl;		 				\
	gcState.maxFrameSize = mfs;					\
	gcState.numGlobals = ng;					\
	gcState.globals = gs;						\
	gcState.maxFrameIndex = mfi;					\
	gcState.frameLayouts = frameLayouts;				\
	mltonState.gcState = &gcState;					\
	MLTON_init(argc, argv, &mltonState, magic, lg);			\
	if (mltonState.isOriginal) {					\
 		/* The (nii > 0) check is so that the C compiler can 	\
		 * eliminate the call if there are no IntInfs and we 	\
		 * then won't have to link in with the IntInf stuff. 	\
		 */							\
		if (nii > 0)						\
			MLTON_createIntInfs(&gcState, intInfInits);	\
		GC_createStrings(&gcState, stringInits);       		\
		MLTON_prepFarJump(mc, ml);				\
	} else {							\
		MLTON_prepFarJump(sc, sl);				\
	}								\
	/* Trampoline */						\
	while (1) {							\
 		if (INSTRUMENT)						\
			MLTON_numTrampolines++;				\
		(*nextChunk)(); 					\
	}								\
}

/* ------------------------------------------------- */
/*                       Halt                        */
/* ------------------------------------------------- */

#define MLTON_halt(x)							\
	{								\
		int status;						\
		if (INSTRUMENT) 					\
		        fprintf(stderr, "MLTON_numTrampolines = %Ld\nMLTON_numReturns = %Ld\nMLTON_numInterReturns = %Ld\nMLTON_numLimitChecks = %Ld\nMLTON_XmlKnown = %Ld\nMLTON_XmlUnknown = %Ld\nMLTON_SxmlKnown = %Ld\nMLTON_SxmlUnknown = %Ld\nMLTON_CpsKnown = %Ld\nMLTON_CpsUnknown = %Ld\nMLTON_CpsCall = %Ld\nMLTON_CpsLoop = %Ld\nMLTON_CpsDispatch = %Ld\nMLTON_CpsCoerce = %Ld\n", 					\
				MLTON_numTrampolines, MLTON_numReturns,		\
				MLTON_numInterReturns, MLTON_numLimitChecks,	\
				MLTON_XmlKnown, MLTON_XmlUnknown,			\
				MLTON_SxmlKnown, MLTON_SxmlUnknown,		\
				MLTON_CpsKnown, MLTON_CpsUnknown,			\
				MLTON_CpsCall, MLTON_CpsLoop,			\
				MLTON_CpsDispatch, MLTON_CpsCoerce);		\
		gcState.frontier = frontier;					\
		gcState.stackTop = stackTop;					\
		status = (x);							\
		GC_done(&gcState);						\
		exit(status);							\
	}

/* ------------------------------------------------- */
/*                        GC                         */
/* ------------------------------------------------- */

#define MLTON_beforeGC					\
	gc:						\
		gcState.locals = locals;		\
		gcState.frontier = frontier; 	       	\
		gcState.stackTop = stackTop;

#define MLTON_GC						\
        GC_gc(&gcState);				\
	stackTop = gcState.stackTop;			\
	frontier = gcState.frontier;

/* ------------------------------------------------- */
/*                      farJump                      */
/* ------------------------------------------------- */

#define MLTON_prepFarJump(c,l)	 	\
	do {				\
		nextChunk = c; 		\
		nextFun = l ## _index;	\
	} while (0)

#define MLTON_farJump(c,l)	 	\
	do {				\
		MLTON_prepFarJump(c,l); 	\
		goto leaveChunk;	\
	} while (0)

/* ------------------------------------------------- */
/*                      Return                       */
/* ------------------------------------------------- */

#define MLTON_return					\
	if (INSTRUMENT)					\
		MLTON_numReturns++;			\
	nextFun = *(int*)stackTop;	 		\
	goto top;

#define MLTON_raise						\
	stackTop = gcState.stackBottom + gcState.exnStack;	\
	nextFun = *(int*)stackTop;	 			\
	goto top;

#define MLTON_saveExnStack(offset)					\
	{								\
		pointer p;						\
		p = stackTop + (offset);				\
		*(uint*)(p + WORD_SIZE) = gcState.exnStack;		\
		gcState.exnStack = p - gcState.stackBottom;		\
	}

#define MLTON_restoreExnStack(offset)					\
	gcState.exnStack = *(uint*)(stackTop + (offset) + WORD_SIZE);	\

/* ------------------------------------------------- */
/*                    Limit Check                    */
/* ------------------------------------------------- */

#define MLTON_limitCheck(bytes,localIndices,frameSize,ret)	 		\
	if (INSTRUMENT)								\
		MLTON_numLimitChecks++;						\
	if (GC_EVERY_CHECK || frontier + (bytes) >= gcState.limit) {		\
		if (gcState.messages) fprintf(stderr, "gc at line %d of %s\n",	\
						__LINE__,			\
						__FILE__);			\
		gcState.bytesRequested = (bytes); 				\
		gcState.localOffsets = (localIndices);				\
		stackTop += (frameSize);					\
		*(uint*)stackTop = (ret ## _index);				\
		goto gc;							\
		ret:								\
		stackTop -= (frameSize);					\
	}

#define MLTON_stackOverflowCheck			\
	if (stackTop >= gcState.stackLimit) {	\
		gcState.stackTop = stackTop;	\
		GC_growStack(&gcState);		\
		stackTop = gcState.stackTop;	\
        }

/* The extra POINTER_SIZE added to frontier is so space is allocated for the
 * forwarding pointer in zero length arrays.
 */
#define MLTON_allocArrayNoPointers(dst,numElts,bytesPerElt)			\
	do {									\
		assert(numElts >= 0);						\
		assert(bytesPerElt >= 0);					\
		*(word*)frontier = (numElts);					\
		*(word*)(frontier + WORD_SIZE) =				\
			GC_arrayHeader((bytesPerElt), 0);			\
		(dst) = frontier + 2 * WORD_SIZE;				\
		frontier = (dst) + ((0 == numElts || 0 == bytesPerElt)		\
				? POINTER_SIZE					\
				: wordAlign((numElts) * (bytesPerElt)));	\
	} while (0)


#define MLTON_allocArrayPointers(dst,numElts,numPointers)			\
		*(word*)frontier = (numElts);					\
		*(word*)(frontier + WORD_SIZE) = 				\
			GC_arrayHeader(0, (numPointers));			\
		(dst) = frontier + 2 * WORD_SIZE; 				\
		frontier = (dst) + ((0 == (numElts)) ? POINTER_SIZE		\
				    : (numElts) * (numPointers) * POINTER_SIZE);\
		{								\
			word *p;						\
			for (p = (word*) (dst); p < (word*) frontier; ++p)	\
				*p = 0x1;					\
		}

/* ---------------------------------------------------------------- */
/*                     Basis Library Primitives                     */
/* ---------------------------------------------------------------- */

void MLTON_overflow();

/* Used to "cast" at the ML level between two different ML types that we
 * know have the same C representation.
 */
#define MLTON_id(x) x

/* Used by polymorphic equality to implement equal on ground types
 * like char, int, word,  and on ref cells.
 * It is emitted by backend/machine.fun.
 */
#define MLTON_eq(x,y) ((x) == (y))

/* ------------------------------------------------- */
/*                       Array                       */
/* ------------------------------------------------- */

#define MLTON_Array_length GC_arrayNumElements

/* ------------------------------------------------- */
/*                       Byte                        */
/* ------------------------------------------------- */

#define MLTON_Byte_byteToChar MLTON_id
#define MLTON_Byte_charToByte MLTON_id

/* ------------------------------------------------- */
/*                       Char                        */
/* ------------------------------------------------- */

#define MLTON_Char_ord(c) ((int)(c))
#define MLTON_Char_chr(c) ((uchar)(c))
#define MLTON_Char_gt(c1,c2) ((c1) > (c2))
#define MLTON_Char_ge(c1,c2) ((c1) >= (c2))
#define MLTON_Char_lt(c1,c2) ((c1) < (c2))
#define MLTON_Char_le(c1,c2) ((c1) <= (c2))

/* ------------------------------------------------- */
/*                     IEEEReal                      */
/* ------------------------------------------------- */

void setRoundingMode(int mode);
int getRoundingMode();

#define MLTON_IEEEReal_setRoundingMode setRoundingMode
#define MLTON_IEEEReal_getRoundingMode getRoundingMode

/* ------------------------------------------------- */
/*                        Int                        */
/* ------------------------------------------------- */

int intQuot(int numerator, int denominator);
int intRem(int numerator, int denominator);

#if DETECT_OVERFLOW
int MLTON_Int_addCheck(int n1, int n2);
int MLTON_Int_subCheck(int n1, int n2);
int MLTON_Int_mulCheck(int n1, int n2);
#define MLTON_Int_add MLTON_Int_addCheck
#define MLTON_Int_sub MLTON_Int_subCheck
#define MLTON_Int_mul MLTON_Int_mulCheck
#else
#define MLTON_Int_add(n1,n2) ((n1) + (n2))
#define MLTON_Int_sub(n1,n2) ((n1) - (n2))
#define MLTON_Int_mul(n1,n2) ((n1) * (n2))
#endif
#define MLTON_Int_neg(n) (-(n))
#define MLTON_Int_quot intQuot
#define MLTON_Int_rem intRem
#define MLTON_Int_gt(n1,n2) ((n1) > (n2))
#define MLTON_Int_ge(n1,n2) ((n1) >= (n2))
#define MLTON_Int_lt(n1,n2) ((n1) < (n2))
#define MLTON_Int_le(n1,n2) ((n1) <= (n2))
#define MLTON_Int_geu(x,y) ((uint)(x) >= (uint)(y))
#define MLTON_Int_gtu(x,y) ((uint)(x) > (uint)(y))

/* ------------------------------------------------- */
/*                       Int31                       */
/* ------------------------------------------------- */
/* Int31 is currently not implemented */

/* #define MLTON_Int31_toInt(n) ((n) >> 1) */
/* #define MLTON_Int31_fromInt(n) ((n) << 1) */

/* ------------------------------------------------- */
/*                      IntInf                       */
/* ------------------------------------------------- */

#define MLTON_IntInf_equal MLTON_intInfEqual
#define MLTON_IntInf_fromString MLTON_intInfFromString
#define MLTON_IntInf_toWord(i) ((uint)(i))
#define MLTON_IntInf_fromWord(w) ((pointer)(w))

/* ------------------------------------------------- */
/*                       Real                        */
/* ------------------------------------------------- */

double round(double d);
int signBit(double d);
int isNan(double d);
int isFinite(double d);
int isNormal(double d);

/* returned by class */
#define NAN_QUIET 0
#define NAN_SIGNALLING 1
#define INF 2
#define ZERO 3
#define NORMAL 4
#define SUBNORMAL 5
int class(double d);

#define MLTON_Real_Math_pi M_PI
#define MLTON_Real_Math_e M_E
#define MLTON_Real_Math_cos cos
#define MLTON_Real_Math_sin sin
#define MLTON_Real_Math_tan tan
#define MLTON_Real_Math_cosh cosh
#define MLTON_Real_Math_sinh sinh
#define MLTON_Real_Math_tanh tanh
#define MLTON_Real_Math_acos acos
#define MLTON_Real_Math_asin asin
#define MLTON_Real_Math_atan atan
#define MLTON_Real_Math_atan2 atan2
#define MLTON_Real_Math_ln log
#define MLTON_Real_Math_log10 log10
#define MLTON_Real_Math_pow pow
#define MLTON_Real_Math_sqrt sqrt
#define MLTON_Real_Math_exp exp
#define MLTON_Real_posInf HUGE_VAL
#define MLTON_Real_add(x,y) ((x) + (y))
#define MLTON_Real_sub(x,y) ((x) - (y))
#define MLTON_Real_mul(x,y) ((x) * (y))
#define MLTON_Real_div(x,y) ((x) / (y))
#define MLTON_Real_muladd(x,y,z) ((x) * (y) + (z))
#define MLTON_Real_mulsub(x,y,z) ((x) * (y) - (z))
#define MLTON_Real_neg(x) (-(x))
#define MLTON_Real_abs fabs
#define MLTON_Real_isNan isNan
#define MLTON_Real_signBit signBit
#define MLTON_Real_copySign copySign
#define MLTON_Real_gt(x1,x2) ((x1) > (x2))
#define MLTON_Real_ge(x1,x2) ((x1) >= (x2))
#define MLTON_Real_lt(x1,x2) ((x1) < (x2))
#define MLTON_Real_le(x1,x2) ((x1) <= (x2))
#define MLTON_Real_equal(x1,x2) ((x1) == (x2))
#define MLTON_Real_nequal(x1,x2) ((x1) != (x2))
#define MLTON_Real_qequal(x1,x2) (!((x1) != (x2))
#define MLTON_Real_isFinite isFinite
#define MLTON_Real_isNormal isNormal
#define MLTON_Real_frexp frexp
#define MLTON_Real_ldexp ldexp
#define MLTON_Real_modf modf
#define MLTON_Real_class class
#define MLTON_Real_fromInt(n) ((double)(n))
#define MLTON_Real_toInt(x) ((int)(x))
#define MLTON_Real_round round

#define MLTON_sprintf(buf, fmt, x) sprintf(buf, (char*) fmt, x)

/* ------------------------------------------------- */
/*                     Pointers                      */
/* ------------------------------------------------- */

#define MLTON_isNull(x) (void*)(x) == NULL

/* ------------------------------------------------- */
/*                       MLton                        */
/* ------------------------------------------------- */

uint MLTON_MLton_random();

#define MLTON_MLton_gcMessages(b)	\
	gcState.messages = b

#define MLTON_MLton_gcSummary(b)	\
	gcState.summary = b

#define MLTON_MLton_size(z)		(				\
	gcState.frontier = frontier,					\
	gcState.stackTop = stackTop,					\
	sizeRes = GC_size(&gcState, (z)),				\
	frontier = gcState.frontier,					\
	stackTop = gcState.stackTop,					\
	sizeRes)

#define MLTON_MLton_saveWorld(file)	(				\
	mltonState.isOriginal ?						\
		(							\
			gcState.frontier = frontier,			\
			gcState.stackTop = stackTop,			\
 			GC_saveWorld(&gcState, mltonState.magic, 	\
					(file), &saveGlobals),		\
			frontier = gcState.frontier,			\
			stackTop = gcState.stackTop,			\
			mltonState.isOriginal = TRUE,			\
			TRUE						\
		)							\
	:								\
		(							\
			mltonState.isOriginal = TRUE,			\
			FALSE						\
		)							\
	)
	 
#define MLTON_MLton_saveStack()	(					\
	gcState.frontier = frontier,					\
	gcState.stackTop = stackTop,					\
	stackRes = GC_saveStack(&gcState),				\
	frontier = gcState.frontier,					\
	stackTop = gcState.stackTop,					\
	stackRes)

#define MLTON_MLton_restoreStack(s)					\
	gcState.frontier = frontier;					\
	gcState.stackTop = stackTop;					\
	GC_restoreStack(&gcState, s);					\
	frontier = gcState.frontier;					\
	stackTop = gcState.stackTop;					\
	MLTON_return

/* ------------------------------------------------- */
/*                      String                       */
/* ------------------------------------------------- */

int stringEqual(char * s1, char * s2);

#define MLTON_String_equal stringEqual
#define MLTON_String_size GC_arrayNumElements

#define MLTON_cs_sub(p,i) (((char*)(p))[i])
#define MLTON_cs_update(p,i,x) (((char*)(p))[i] = (x))
#define MLTON_css_sub(p,i) ((uint)(((char**)(p))[i]))
#define MLTON_cast_cs(p) ((char*)(p))
#define MLTON_cast_css(p) ((char**)(p))

/* ------------------------------------------------- */
/*                      System                       */
/* ------------------------------------------------- */

#define MLTON_tmpnam(s) ((uint)tmpnam((char*)(s)))

/* ---------------------------------- */
/*                Date                */
/* ---------------------------------- */

void MLTON_now(pointer sec, pointer usec);

extern struct tm MLTON_tm;

#define MLTON_asctime(z) (uint)(asctime((struct tm*)(z)))
#define MLTON_localtime(t) (uint)(localtime((time_t*)(t)))
#define MLTON_gmtime(t) (uint)(gmtime((time_t*)(t)))
#define MLTON_mktime(t) mktime((struct tm*)(t))

#define MLTON_strftime(buf, n, fmt, z) strftime((char*)(buf), (n), (char*)(fmt), (struct tm*)(z))

int MLTON_localoffset();

#define MLTON_tm_sec(p) (((struct tm*)(p))->tm_sec)
#define MLTON_tm_min(p) (((struct tm*)(p))->tm_min)
#define MLTON_tm_hour(p) (((struct tm*)(p))->tm_hour)
#define MLTON_tm_mday(p) (((struct tm*)(p))->tm_mday)
#define MLTON_tm_mon(p) (((struct tm*)(p))->tm_mon)
#define MLTON_tm_year(p) (((struct tm*)(p))->tm_year)
#define MLTON_tm_wday(p) (((struct tm*)(p))->tm_wday)
#define MLTON_tm_yday(p) (((struct tm*)(p))->tm_yday)
#define MLTON_tm_isdst(p) (((struct tm*)(p))->tm_isdst)

#define MLTON_set_tm_sec(p,x) ((struct tm*)(p))->tm_sec = (x)
#define MLTON_set_tm_min(p,x) ((struct tm*)(p))->tm_min = (x)
#define MLTON_set_tm_hour(p,x) ((struct tm*)(p))->tm_hour = (x)
#define MLTON_set_tm_mday(p,x) ((struct tm*)(p))->tm_mday = (x)
#define MLTON_set_tm_mon(p,x) ((struct tm*)(p))->tm_mon = (x)
#define MLTON_set_tm_year(p,x) ((struct tm*)(p))->tm_year = (x)
#define MLTON_set_tm_wday(p,x) ((struct tm*)(p))->tm_wday = (x)
#define MLTON_set_tm_yday(p,x) ((struct tm*)(p))->tm_yday = (x)
#define MLTON_set_tm_isdst(p,x) ((struct tm*)(p))->tm_isdst = (x)

/* ---------------------------------- */
/*                Time                */
/* ---------------------------------- */

extern struct timeval MLTON_timeval;
#define MLTON_timeval_sec(p) ((int)(((struct timeval*)(p))->tv_sec))
#define MLTON_timeval_usec(p) ((int)(((struct timeval*)(p))->tv_usec))
#define MLTON_gettimeofday(p) ((int)(gettimeofday((struct timeval*)(p), (struct timezone*)NULL)))

/* ------------------------------------------------- */
/*                      Vector                       */
/* ------------------------------------------------- */

#define MLTON_Vector_length GC_arrayNumElements
#define MLTON_Vector_fromArray MLTON_id

/* ------------------------------------------------- */
/*                       Word                        */
/* ------------------------------------------------- */

#define MLTON_Word8_toInt(w) ((int)(w))
#define MLTON_Word8_toIntX(x) ((int)(signed char)(x))
#define MLTON_Word8_fromInt(x) ((uchar)(x))
#define MLTON_Word8_toLargeWord(w) ((uint)(w))
#define MLTON_Word8_toLargeWordX(x) ((uint)(signed char)(x))
#define MLTON_Word8_fromLargeWord(w) ((uchar)(w))
#define MLTON_Word8_orb(w1,w2) ((w1) | (w2))
#define MLTON_Word8_xorb(w1,w2) ((w1) ^ (w2))
#define MLTON_Word8_andb(w1,w2) ((w1) & (w2))
#define MLTON_Word8_notb(w) (~(w))
#define MLTON_Word8_lshift(w,s)  ((s) < 8 ? (w) << (s) : 0)
#define MLTON_Word8_rshift(w,s) ((s) < 8 ? (w) >> (s) : 0)
#define MLTON_Word8_add(w1,w2) ((w1) + (w2))
#define MLTON_Word8_sub(w1,w2) ((w1) - (w2))
#define MLTON_Word8_mul(w1,w2) ((w1) * (w2))
#define MLTON_Word8_div(w1,w2) ((w1) / (w2))
#define MLTON_Word8_mod(w1,w2) ((w1) % (w2))
#define MLTON_Word8_gt(w1,w2) ((w1) > (w2))
#define MLTON_Word8_ge(w1,w2) ((w1) >= (w2))
#define MLTON_Word8_lt(w1,w2) ((w1) < (w2))
#define MLTON_Word8_le(w1,w2) ((w1) <= (w2))

#define MLTON_Word32_toIntX(x) ((int)(x))
#define MLTON_Word32_fromInt(x) ((uint)(x))
#define MLTON_Word32_orb(w1,w2) ((w1) | (w2))
#define MLTON_Word32_xorb(w1,w2) ((w1) ^ (w2))
#define MLTON_Word32_andb(w1,w2) ((w1) & (w2))
#define MLTON_Word32_notb(w) (~(w))
#define MLTON_Word32_lshift(w,s)  ((s) < 32 ? (w) << (s) : 0)
#define MLTON_Word32_rshift(w,s) ((s) < 32 ? (w) >> (s) : 0)
#define MLTON_Word32_add(w1,w2) ((w1) + (w2))
#define MLTON_Word32_sub(w1,w2) ((w1) - (w2))
#define MLTON_Word32_mul(w1,w2) ((w1) * (w2))
#define MLTON_Word32_div(w1,w2) ((w1) / (w2))
#define MLTON_Word32_mod(w1,w2) ((w1) % (w2))
#define MLTON_Word32_gt(w1,w2) ((w1) > (w2))
#define MLTON_Word32_ge(w1,w2) ((w1) >= (w2))
#define MLTON_Word32_lt(w1,w2) ((w1) < (w2))
#define MLTON_Word32_le(w1,w2) ((w1) <= (w2))

/* Can't use a macro with >> for these because ANSI C doesn't guarantee 
 * sign extension.
 *
 * #define MLTON_Word8_arshift(w,s) ((signed char)(w) >> ((s) < 8 ? (s) : 7))
 */
/* I've included the macro for Word32_arshift even though it isn't ANSI and
 * may fail because using a procedure call slows down IntInf by a factor of 2.
 */
#define MLTON_Word32_arshift(w,s) ((int)(w) >> ((s) < 32 ? (s) : 31))
/*#define MLTON_Word32_arshift MLTON_Word32_arshiftAsm */
uint MLTON_Word32_arshiftAsm(uint w, uint s);

uchar MLTON_Word8_arshift(uchar w, uint s);

#endif /* #ifndef _MLTON_LIB_H */