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 */